MOM_ice_shelf.F90

Go to the documentation of this file.

!> 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

! 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
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_grid_initialize, only : set_grid_metrics
use mom_fixed_initialization, only : mom_initialize_topography
use mom_fixed_initialization, only : mom_initialize_rotation
use user_initialization, only : user_initialize_topography
use mom_io, only : field_exists, file_exists, read_data, write_version_number
use mom_io, only : slasher, vardesc, var_desc, 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
use mom_time_manager, only : time_type, set_time, 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
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
use mom_ice_shelf_initialize, only : initialize_ice_thickness
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_checksums, only : hchksum, qchksum, chksum, uchksum, vchksum
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
implicit none ; private

#include <MOM_memory.h>
#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
public ice_shelf_save_restart, solo_time_step

!> 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(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
                                          !! The rest is private
  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.

    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(), &              ! DNG !!!!< The UPWARD diffusive heat flux in the ice
                                          !! shelf at the ice-ocean interface, in W m-2.
    !!
    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)
    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,
                                          !! 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(), &               ! OVS !!!!< a mask to prevent the ice shelf front from
                                          !! advancing past its initial position (but it may
                                          !!  retreat)
    !!
    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(), &
    ice_visc_lower_tri => null(), &
    ice_visc_upper_tri => 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
    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
                  !! 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 :: 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.
  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 :: 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.
  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
  logical :: mass_from_file !< Read the ice shelf mass from a file every dt

  !!!! 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

  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
                    ! 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)
  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 :: 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.
  logical :: insulator                   !< If true, ice shelf is a perfect insulator
  logical :: const_gamma                 !< If true, gamma_T is specified by the user.
  logical :: find_salt_root              !< If true, if true find Sbdry using a quadratic eq.
  logical :: constant_sea_level          !< if true, apply an evaporative, heat and salt
                                         !! fluxes. It will avoid large increase in sea level.
  real    :: cutoff_depth                !< depth above which melt is set to zero (>= 0).
  real    :: lambda1, lambda2, lambda3   !< liquidus coeffs. Needed if find_salt_root = true
  !>@{
  ! Diagnostic handles
  integer :: id_melt = -1, id_exch_vel_s = -1, id_exch_vel_t = -1, &
             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_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
  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(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

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 .eq. 0) then
    slope_limiter = 0
  elseif (num*denom .le. 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
subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS)
  type(surface),         intent(inout) :: state !< structure containing fields that
                                                !!describe the surface state of the ocean
  type(forcing),         intent(inout) :: fluxes !< structure containing pointers to
                                                 !!any possible forcing fields.
                                                 !!Unused fields have NULL ptrs.
  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
                                             !! returned by a previous call to
                                             !! initialize_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
               !< with temperature, in units of kg m-3 K-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.

  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.
               !! This is computed as part of the ISOMIP diagnostics.
  real, parameter :: VK    = 0.40 !< Von Karman's constant - dimensionless
  real :: ZETA_N = 0.052 !> The fraction of the boundary layer over which the
               !! 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 :: I_VK     !< The inverse of VK.
  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 :: 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 :: 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.
  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.
  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
  real :: ustar_h
  real :: Gam_turb
  real :: Gam_mol_t, Gam_mol_s
  real :: RhoCp
  real :: I_RhoLF
  real :: ln_neut
  real :: mass_exch
  real :: Sb_min, Sb_max
  real :: dS_min, dS_max
  ! Variables used in iterating for wB_flux.
  real :: wB_flux_new, DwB, dDwB_dwB_in
  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
  character(2) :: procnum

  type(ocean_grid_type), pointer :: G
  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
  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
  i_rholf = 1.0/(cs%Rho0*lf)
  i_lf = 1.0 / lf
  sc = cs%kv_molec/cs%kd_molec_salt
  pr = cs%kv_molec/cs%kd_molec_temp
  i_vk = 1.0/vk
  rhocp = cs%Rho0 * cs%Cp
  isqrt2 = 1.0/sqrt(2.0)

  !first calculate molecular component
  gam_mol_t = 12.5 * (pr**c2_3) - 6
  gam_mol_s = 12.5 * (sc**c2_3) - 6

  idens = 1.0/cs%density_ocean_avg

  ! GMM, zero some fields of the ice shelf structure (ice_shelf_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
  ! 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(:,:)

  !update time
  cs%Time = time

  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)
  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
    ! part of the cell covered by ice shelf.
    do i=is,ie ; p_int(i) = cs%g_Earth * cs%mass_shelf(i,j) ; enddo

    ! Calculate insitu densities and expansion coefficients
    call calculate_density(state%sst(:,j),state%sss(:,j), p_int, &
             rhoml(:), is, ie-is+1, cs%eqn_of_state)
    call calculate_density_derivs(state%sst(:,j), state%sss(:,j), p_int, &
             dr0_dt, dr0_ds, is, ie-is+1, cs%eqn_of_state)

    do i=is,ie
      ! set ustar_shelf to zero. This is necessary if shelf_mass_is_dynamic
      ! but it won't make a difference otherwise.
      fluxes%ustar_shelf(i,j)= 0.0

      ! DNG - to allow this everywhere Hml>0.0 allows for melting under grounded cells
      !       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. &
          (cs%isthermo) .and. (state%Hml(i,j) > 0.0) ) then

        if (cs%threeeq) then
          !   Iteratively determine a self-consistent set of fluxes, with the ocean
          ! salinity just below the ice-shelf as the variable that is being
          ! iterated for.
          ! ### SHOULD I SET USTAR_SHELF YET?

          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))

          ustar_h = max(cs%ustar_bg, fluxes%ustar_shelf(i,j))

          fluxes%ustar_shelf(i,j) = ustar_h

          if (associated(state%taux_shelf) .and. associated(state%tauy_shelf)) then
            state%taux_shelf(i,j) = ustar_h*ustar_h*cs%Rho0*isqrt2
            state%tauy_shelf(i,j) = state%taux_shelf(i,j)
          endif

          ! 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))))
          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))

          ! Determine the mixed layer buoyancy flux, wB_flux.
          db_ds = (cs%g_Earth / rhoml(i)) * dr0_ds(i)
          db_dt = (cs%g_Earth / rhoml(i)) * dr0_dt(i)
          ln_neut = 0.0 ; if (hbl_neut_h_molec > 1.0) ln_neut = log(hbl_neut_h_molec)

          if (cs%find_salt_root) then
            ! read liquidus parameters

            s_a = cs%lambda1 * cs%Gamma_T_3EQ * cs%Cp
!            S_b = -CS%Gamma_T_3EQ*(CS%lambda2-CS%lambda3*p_int(i)-state%sst(i,j)) &
!               -LF*CS%Gamma_T_3EQ/35.0

            s_b = cs%Gamma_T_3EQ*cs%Cp*(cs%lambda2+cs%lambda3*p_int(i)- &
                  state%sst(i,j))-lf*cs%Gamma_T_3EQ/35.0
            s_c = lf*(cs%Gamma_T_3EQ/35.0)*state%sss(i,j)

            sbdry1 = (-s_b + sqrt(s_b*s_b-4*s_a*s_c))/(2*s_a)
            sbdry2 = (-s_b - sqrt(s_b*s_b-4*s_a*s_c))/(2*s_a)
            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).")
            endif
          else
            ! Guess sss as the iteration starting point for the boundary salinity.
            sbdry(i,j) = state%sss(i,j) ; sb_max_set = .false.
            sb_min_set = .false.
          endif !find_salt_root

          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)

            dt_ustar = (state%sst(i,j) - cs%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
            ! on the turbulence.  Following H & J '99, this limit also applies
            ! 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.
            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)
            endif

            wt_flux = dt_ustar * i_gam_t
            wb_flux = db_ds * (ds_ustar * i_gam_s) + db_dt * wt_flux

            if (wb_flux > 0.0) then
              ! The buoyancy flux is stabilizing and will reduce the tubulent
              ! fluxes, and iteration is required.
              n_star_term = (zeta_n/rc) * (hbl_neut * vk) / ustar_h**3
              do it3 = 1,30
               ! n_star <= 1.0 is the ratio of working boundary layer thickness
               ! to the neutral thickness.
               ! hBL = n_star*hBL_neut ; hSub = 1/8*n_star*hBL

                i_n_star = sqrt(1.0 + n_star_term * wb_flux)
                dins_dwb = 0.5 * n_star_term / i_n_star
                if (hbl_neut_h_molec > i_n_star**2) then
                  gam_turb = i_vk * ((ln_neut - 2.0*log(i_n_star)) + &
                                    (0.5*i_zeta_n*i_n_star - 1.0))
                  dg_dwb =  i_vk * ( -2.0 / i_n_star + (0.5 * i_zeta_n)) * dins_dwb
                else
                  !   The layer dominated by molecular viscosity is smaller than
                  ! the assumed boundary layer.  This should be rare!
                  gam_turb = i_vk * (0.5 * i_zeta_n*i_n_star - 1.0)
                  dg_dwb = i_vk * (0.5 * i_zeta_n) * dins_dwb
                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.
                else
                  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
                wb_flux_new = db_ds * (ds_ustar * i_gam_s) + db_dt * wt_flux

                ! Find the root where dwB = 0.0
                dwb = wb_flux_new - wb_flux
                if (abs(wb_flux_new - wb_flux) < &
                    1e-4*(abs(wb_flux_new) + abs(wb_flux))) exit

                ddwb_dwb_in = -dg_dwb * (db_ds * (ds_ustar * i_gam_s**2) + &
                                         db_dt * (dt_ustar * i_gam_t**2)) - 1.0
                ! This is Newton's method without any bounds.
                ! ### SHOULD BOUNDS BE NEEDED?
                wb_flux_new = wb_flux - dwb / ddwb_dwb_in
              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

    !Calculate the heat flux inside the ice shelf.

    !vertical adv/diff as in H+J 1999, eqns (26) & approx from (31).
    ! Q_ice = rho_ice * CS%CP_Ice * K_ice * dT/dz (at interface)
    !vertical adv/diff as in H+J 199, eqs (31) & (26)...
    !  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
            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))

              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))

                cs%tflux_shelf(i,j) = cs%t_flux(i,j) - lf*cs%lprec(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


            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
              sbdry_it = (state%sss(i,j) * mass_exch + cs%Salin_ice * &
                          cs%lprec(i,j)) / (mass_exch + cs%lprec(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


              if (ds_it < 0.0) then ! Sbdry is now the upper bound.
                if (sb_max_set .and. (sbdry(i,j) > sb_max)) &
                call mom_error(fatal,"shelf_calc_flux: Irregular iteration for Sbdry (max).")
                sb_max = sbdry(i,j) ; ds_max = ds_it ; sb_max_set = .true.
              else ! Sbdry is now the lower bound.
                if (sb_min_set .and. (sbdry(i,j) < sb_min)) &
                   call mom_error(fatal, &
                   "shelf_calc_flux: Irregular iteration for Sbdry (min).")
                   sb_min = sbdry(i,j) ; ds_min = ds_it ; sb_min_set = .true.
              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))
              else
                 sbdry(i,j) = sbdry_it
              endif ! Sb_min_set

              sbdry(i,j) = sbdry_it
            endif ! CS%find_salt_root

          enddo !it1
  ! Check for non-convergence and/or non-boundedness?

        else
          !   In the 2-equation form, the mixed layer turbulent exchange velocity
          ! 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)

          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)
          sbdry(i,j) = 0.0
        endif
      else !not shelf
        cs%t_flux(i,j) = 0.0
      endif

!      haline_driving(:,:) = state%sss(i,j) - Sbdry(i,j)

    enddo ! i-loop
  enddo ! j-loop

  ! CS%lprec = precipitating 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
  else ! use original eq.
    fluxes%iceshelf_melt = cs%lprec  * (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. &
          (cs%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* &
            cs%g_Earth) then
              cs%lprec(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))

         !!!!!!!!!!!!!!!!!!!!!!!!!!!!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

  ! 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

  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 cpu_clock_end(id_clock_pass)
  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,g,time_step, fluxes)

    endif

  endif

  if (cs%DEBUG) then
      call mom_forcing_chksum("Before add shelf flux", fluxes, g, haloshift=0)
  endif
  call add_shelf_flux(g, cs, state, 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

    ! 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, 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, cs%time_step, cs%velocity_update_time_step)
    else
      call update_od_ffrac_uncoupled (cs)
    endif

    if (cs%velocity_update_sub_counter .eq. 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)

      cs%velocity_update_sub_counter = 0

    endif
  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_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_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_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_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)
  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

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

  ! locals
  integer :: i, j

  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
        ! 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%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
           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
           ! 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
         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)

    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
          cs%mass_shelf(i,j) = cs%h_shelf(i,j)*cs%density_ice
         endif
       enddo
    enddo

    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)
    endif

end subroutine change_thickness_using_melt

!> Updates suface 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.
  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.
  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 :: 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.
  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, 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
  ! 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?
      fluxes%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)) &
        fluxes%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)))
      fluxes%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
      fluxes%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)) &
        fluxes%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)))
      fluxes%rigidity_ice_v(i,j) = (cs%kv_ice / cs%density_ice) * &
                                    max(cs%mass_shelf(i,j), cs%mass_shelf(i,j+1))
    enddo ; enddo
    call pass_vector(fluxes%frac_shelf_u, fluxes%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

    do j=jsd,jed ; do i=isd,ied-1 ! changed stride
      fluxes%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 ! changed stride
      fluxes%rigidity_ice_v(i,j) = (cs%kv_ice / cs%density_ice) * &
                    max(cs%mass_shelf(i,j), cs%mass_shelf(i,j+1))
    enddo ; enddo
  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)
      call vchksum(fluxes%rigidity_ice_u, "rigidity_ice_u", g%HI, haloshift=0)
      call vchksum(fluxes%rigidity_ice_v, "rigidity_ice_v", g%HI, haloshift=0)
      call vchksum(fluxes%frac_shelf_u, "frac_shelf_u", g%HI, haloshift=0)
      call vchksum(fluxes%frac_shelf_v, "frac_shelf_v", 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

  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

  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 = fluxes%frac_shelf_u(i-1,j) * (g%areaT(i-1,j) + g%areaT(i,j)) ! G%dxdy_u(i-1,j)
      asu2 = fluxes%frac_shelf_u(i,j) * (g%areaT(i,j) + g%areaT(i+1,j)) ! G%dxdy_u(i,j)
      asv1 = fluxes%frac_shelf_v(i,j-1) * (g%areaT(i,j-1) + g%areaT(i,j)) ! G%dxdy_v(i,j-1)
      asv2 = fluxes%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%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


      ! 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(state%frazil)) then
        fraz = state%frazil(i,j) / cs%time_step / cs%Lat_fusion
        if (associated(fluxes%evap)) fluxes%evap(i,j) = fluxes%evap(i,j) - fraz
        cs%lprec(i,j)=cs%lprec(i,j) - fraz
        state%frazil(i,j) = 0.0
      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)
      ! Same for IOB%p
      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

  ! keep sea level constant by removing mass in the sponge
  ! region (via virtual precip, vprec). Apply additional
  ! salt/heat fluxes so that the resultant surface buoyancy
  ! forcing is ~ 0.
  ! This is needed for some of the ISOMIP+ experiments.

  if (cs%constant_sea_level) then

    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

    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 + (cs%lprec(i,j)) * cs%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
    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
       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)
          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(:,:) = cs%hmask(:,:); last_area_shelf_h(:,:) = cs%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 (cs,last_h_shelf,last_area_shelf_h,last_hmask)
             ! 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. &
                (cs%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))

             endif
          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)* &
!                         (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 ! ice shelf mass does not change
       delta_mass_shelf = 0.0
    endif

    call mpp_sum(mean_melt_flux)
    call mpp_sum(sponge_area)

    ! average total melt flux over sponge area
    mean_melt_flux = (mean_melt_flux+delta_mass_shelf) / sponge_area !kg/(m^2 s)

    ! 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
    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
      call mom_forcing_chksum("After constant sea level", fluxes, g, haloshift=0)
   endif

  endif!constant_sea_level

  ! If the shelf mass is changing, the fluxes%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
      fluxes%rigidity_ice_u(i,j) = (cs%kv_ice / cs%density_ice) * &
                                    max(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
      fluxes%rigidity_ice_v(i,j) = (cs%kv_ice / cs%density_ice) * &
                                    max(cs%mass_shelf(i,j), cs%mass_shelf(i,j+1))
    enddo ; enddo
  endif

end subroutine add_shelf_flux


!> Initializes shelf model data, parameters and diagnostics
subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, 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(ice_shelf_cs), pointer         :: CS
  type(diag_ctrl), target, intent(in) :: diag
  type(forcing), optional, intent(inout) :: fluxes
  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(directories)  :: dirs
  type(vardesc) :: vd
  type(dyn_horgrid_type), pointer :: dG => null()
  real :: cdrag, drag_bg_vel
  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.
  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 :: solo_ice_sheet, read_TideAmp
  character(len=240) :: Tideamp_file
  real    :: utide
  if (associated(cs)) then
    call mom_error(fatal, "MOM_ice_shelf.F90, initialize_ice_shelf: "// &
                          "called with an associated control structure.")
    return
  endif
  allocate(cs)

  !   Go through all of the infrastructure initialization calls, since this is
  ! being treated as an independent component that just happens to use the
  ! MOM's grid and infrastructure.
  call get_mom_input(dirs=dirs)

  ! 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_)
  ! call diag_mediator_init(CS%grid,param_file,CS%diag)
  ! this needs to be fixed - will probably break when not using coupled driver 0
  call mom_grid_init(cs%grid, param_file)

  call create_dyn_horgrid(dg, cs%grid%HI)
  call clone_mom_domain(cs%grid%Domain, dg%Domain)

  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

  ! 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
  endif

  cs%Time = time ! ### This might not be in the right place?
  cs%diag => diag

  ! Are we being called from the solo ice-sheet driver? When called by the ocean
  ! model solo_ice_sheet_in is not preset.
  solo_ice_sheet = .false.
  if (present(solo_ice_sheet_in)) solo_ice_sheet = solo_ice_sheet_in
  cs%solo_ice_sheet = solo_ice_sheet

  if (present(time_in)) time = time_in

  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
  isd = g%isd ; jsd = g%jsd ; ied = g%ied ; jed = g%jed
  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.

  call log_version(param_file, mdl, version, "")
  call get_param(param_file, mdl, "DEBUG_IS", cs%debug, default=.false.)
  call get_param(param_file, mdl, "DYNAMIC_SHELF_MASS", cs%shelf_mass_is_dynamic, &
                 "If true, the ice sheet mass can evolve with time.", &
                 default=.false.)
  if (cs%shelf_mass_is_dynamic) then
    call get_param(param_file, 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, &
                 "THIS PARAMETER NEEDS A DESCRIPTION.", default=.false.)
    call get_param(param_file, mdl, "GROUNDING_LINE_INTERP_SUBGRID_N", cs%n_sub_regularize, &
                 "THIS PARAMETER NEEDS A DESCRIPTION.", default=0)
    call get_param(param_file, mdl, "GROUNDING_LINE_COUPLE", cs%GL_couple, &
                 "THIS PARAMETER NEEDS A DESCRIPTION.", default=.false.)
    if (cs%GL_regularize) cs%GL_couple = .false.
    if (cs%GL_regularize .and. (cs%n_sub_regularize.eq.0)) call mom_error (fatal, &
      "GROUNDING_LINE_INTERP_SUBGRID_N must be a positive integer if GL regularization is used")
  endif
  call get_param(param_file, mdl, "SHELF_THERMO", cs%isthermo, &
                 "If true, use a thermodynamically interactive ice shelf.", &
                 default=.false.)
  call get_param(param_file, mdl, "SHELF_THREE_EQN", cs%threeeq, &
                 "If true, use the three equation expression of \n"//&
                 "consistency to calculate the fluxes at the ice-ocean \n"//&
                 "interface.", default=.true.)
  call get_param(param_file, mdl, "SHELF_INSULATOR", cs%insulator, &
                 "If true, the ice shelf is a perfect insulatior \n"//&
                 "(no conduction).", default=.false.)
  call get_param(param_file, mdl, "MELTING_CUTOFF_DEPTH", cs%cutoff_depth, &
                 "Depth above which the melt is set to zero (it must be >= 0) \n"//&
                 "Default value won't affect the solution.", default=0.0)
  if (cs%cutoff_depth < 0.) &
     call mom_error(warning,"Initialize_ice_shelf: MELTING_CUTOFF_DEPTH must be >= 0.")

  call get_param(param_file, mdl, "CONST_SEA_LEVEL", cs%constant_sea_level, &
                 "If true, apply evaporative, heat and salt fluxes in \n"//&
                  "the sponge region. This will avoid a large increase \n"//&
                 "in sea level. This option is needed for some of the \n"//&
                 "ISOMIP+ experiments (Ocean3 and Ocean4). \n"//&
                 "IMPORTANT: it is not currently possible to do \n"//&
                 "prefect restarts using this flag.", default=.false.)

  call get_param(param_file, mdl, "ISOMIP_S_SUR_SPONGE", &
                cs%S0, "Surface salinity in the resoring region.", &
                default=33.8, do_not_log=.true.)

  call get_param(param_file, mdl, "ISOMIP_T_SUR_SPONGE", &
                cs%T0, "Surface temperature in the resoring region.", &
                default=-1.9, do_not_log=.true.)

  call get_param(param_file, mdl, "SHELF_3EQ_GAMMA", cs%const_gamma, &
                 "If true, user specifies a constant nondimensional heat-transfer coefficient \n"//&
                 "(GAMMA_T_3EQ), from which the salt-transfer coefficient is then computed \n"//&
                 " as GAMMA_T_3EQ/35. This is used with SHELF_THREE_EQN.", default=.false.)
  if (cs%const_gamma) call get_param(param_file, mdl, "SHELF_3EQ_GAMMA_T", cs%Gamma_T_3EQ, &
                 "Nondimensional heat-transfer coefficient.",default=2.2e-2, &
                  units="nondim.", fail_if_missing=.true.)

  call get_param(param_file, mdl, "ICE_SHELF_MASS_FROM_FILE", &
                cs%mass_from_file, "Read the mass of the &
                ice shelf (every time step) from a file.", default=.false.)

  if (cs%threeeq) &
    call get_param(param_file, mdl, "SHELF_S_ROOT", cs%find_salt_root, &
                 "If SHELF_S_ROOT = True, salinity at the ice/ocean interface (Sbdry) \n "//&
                 "is computed from a quadratic equation. Otherwise, the previous \n"//&
                 "interactive method to estimate Sbdry is used.", default=.false.)
  if (cs%find_salt_root) then ! read liquidus coeffs.
     call get_param(param_file, mdl, "TFREEZE_S0_P0",cs%lambda1, &
                 "this is the freezing potential temperature at \n"//&
                 "S=0, P=0.", units="deg C", default=0.0, do_not_log=.true.)
    call get_param(param_file, mdl, "DTFREEZE_DS",cs%lambda1, &
                 "this is the derivative of the freezing potential \n"//&
                 "temperature with salinity.", &
                 units="deg C PSU-1", default=-0.054, do_not_log=.true.)
    call get_param(param_file, mdl, "DTFREEZE_DP",cs%lambda3, &
                 "this is the derivative of the freezing potential \n"//&
                 "temperature with pressure.", &
                 units="deg C Pa-1", default=0.0, do_not_log=.true.)

  endif

  if (.not.cs%threeeq) &
    call get_param(param_file, mdl, "SHELF_2EQ_GAMMA_T", cs%gamma_t, &
                 "If SHELF_THREE_EQN is false, this the fixed turbulent \n"//&
                 "exchange velocity at the ice-ocean interface.", &
                 units="m s-1", fail_if_missing=.true.)

  call get_param(param_file, 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, "C_P", cs%Cp, &
                 "The heat capacity of sea water.", units="J kg-1 K-1", &
                 fail_if_missing=.true.)
  call get_param(param_file, mdl, "RHO_0", cs%Rho0, &
                 "The mean ocean density used with BOUSSINESQ true to \n"//&
                 "calculate accelerations and the mass for conservation \n"//&
                 "properties, or with BOUSSINSEQ false to convert some \n"//&
                 "parameters from vertical units of m to kg m-2.", &
                 units="kg m-3", default=1035.0) !### MAKE THIS A SEPARATE PARAMETER.
  call get_param(param_file, mdl, "C_P_ICE", cs%Cp_ice, &
                 "The heat capacity of ice.", units="J kg-1 K-1", &
                 default=2.10e3)

  call get_param(param_file, mdl, "ICE_SHELF_FLUX_FACTOR", cs%flux_factor, &
                 "Non-dimensional factor applied to shelf thermodynamic \n"//&
                 "fluxes.", units="none", default=1.0)

  call get_param(param_file, mdl, "KV_ICE", cs%kv_ice, &
                 "The viscosity of the ice.", units="m2 s-1", default=1.0e10)
  call get_param(param_file, mdl, "KV_MOLECULAR", cs%kv_molec, &
                 "The molecular kinimatic viscosity of sea water at the \n"//&
                 "freezing temperature.", units="m2 s-1", default=1.95e-6)
  call get_param(param_file, mdl, "ICE_SHELF_SALINITY", cs%Salin_ice, &
                 "The salinity of the ice inside the ice shelf.", units="PSU", &
                 default=0.0)
  call get_param(param_file, mdl, "ICE_SHELF_TEMPERATURE", cs%Temp_ice, &
                 "The temperature at the center of the ice shelf.", &
                 units = "degC", default=-15.0)
  call get_param(param_file, mdl, "KD_SALT_MOLECULAR", cs%kd_molec_salt, &
                 "The molecular diffusivity of salt in sea water at the \n"//&
                 "freezing point.", units="m2 s-1", default=8.02e-10)
  call get_param(param_file, 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, &
                 "avg ocean density used in floatation cond", &
                 units="kg m-3", default=1035.)
  call get_param(param_file, mdl, "DT_FORCING", cs%time_step, &
                 "The time step for changing forcing, coupling with other \n"//&
                 "components, or potentially writing certain diagnostics. \n"//&
                 "The default value is given by DT.", units="s", default=0.0)
  call get_param(param_file, 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", &
                 default=0.0)

  call get_param(param_file, mdl, "READ_TIDEAMP", read_tideamp, &
                 "If true, read a file (given by TIDEAMP_FILE) containing \n"//&
                 "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.)

  call safe_alloc_ptr(cs%utide,isd,ied,jsd,jed)   ; cs%utide(:,:) = 0.0

  if (read_tideamp) then
    call get_param(param_file, mdl, "TIDEAMP_FILE", tideamp_file, &
                 "The path to the file containing the spatially varying \n"//&
                 "tidal amplitudes.", &
                 default="tideamp.nc")
    call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".")
    inputdir = slasher(inputdir)
    tideamp_file = trim(inputdir) // trim(tideamp_file)
    call read_data(tideamp_file,'tideamp',cs%utide,domain=g%domain%mpp_domain,timelevel=1)
  else
    call get_param(param_file, mdl, "UTIDE", utide, &
                 "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", &
                 units="m s-1", default=0.0)
    cs%utide = utide
  endif

  call eos_init(param_file, cs%eqn_of_state)

  !! new parameters that need to be in MOM_input

  if (cs%shelf_mass_is_dynamic .and. .not.cs%override_shelf_movement) 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, "INPUT_FLUX_ICE_SHELF", cs%input_flux, &
                 "volume flux at upstream boundary", &
                 units="m2 s-1", default=0.)
    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, "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, "SHELF_MOVING_FRONT", cs%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, &
                 "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, &
        "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.

    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)
  endif

  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.)

  call get_param(param_file, mdl, "USTAR_SHELF_BG", cs%ustar_bg, &
                 "The minimum value of ustar under ice sheves.", units="m s-1", &
                 default=0.0)
  call get_param(param_file, mdl, "CDRAG_SHELF", cdrag, &
       "CDRAG is the drag coefficient relating the magnitude of \n"//&
       "the velocity field to the surface stress.", units="nondim", &
       default=0.003)
  cs%cdrag = cdrag
  if (cs%ustar_bg <= 0.0) then
    call get_param(param_file, mdl, "DRAG_BG_VEL_SHELF", drag_bg_vel, &
                 "DRAG_BG_VEL is either the assumed bottom velocity (with \n"//&
                 "LINEAR_DRAG) or an unresolved  velocity that is \n"//&
                 "combined with the resolved velocity to estimate the \n"//&
                 "velocity magnitude.", units="m s-1", default=0.0)
    if (cs%cdrag*drag_bg_vel > 0.0) cs%ustar_bg = sqrt(cs%cdrag)*drag_bg_vel

  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
  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

  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

  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

    if (cs%calve_to_mask) then
      allocate ( cs%calve_mask (isd:ied,jsd:jed) ) ; cs%calve_mask(:,:) = 0.0
    endif

  endif

  ! Allocate the arrays for passing ice-shelf data through the forcing type.
  if (.not. solo_ice_sheet) then
    if (is_root_pe())  print *,"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).
       call allocate_forcing_type(g, fluxes, ustar=.true., shelf=.true., &
                                 press=.true., water=cs%isthermo, heat=cs%isthermo)
  else
    if (is_root_pe())  print *,"allocating fluxes in solo mode"
    call allocate_forcing_type(g, fluxes, ustar=.true., shelf=.true., press=.true.)
  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)
  ! Set up the Coriolis parameter, G%f, usually analytically.
  call mom_initialize_rotation(g%CoriolisBu, dg, param_file)
  call copy_dyngrid_to_mom_grid(dg, cs%grid)

  call destroy_dyn_horgrid(dg)

  ! 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)
  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)
  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)

  if (cs%shelf_mass_is_dynamic .and. .not.cs%override_shelf_movement) 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)
    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)

    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)

    ! 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)


  !  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)

    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)

  !  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)

    vd = var_desc("float_frac","m","degree of grounding",z_grid='1')
    call register_restart_field(cs%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)

    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)
    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)
  endif

  !GMM - I think we do not need to save ustar_shelf and iceshelf_melt in the restart file
  ! if (.not. 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)
  !endif

  cs%restart_output_dir = dirs%restart_output_dir

  new_sim = .false.
  if ((dirs%input_filename(1:1) == 'n') .and. &
      (len_trim(dirs%input_filename) == 1)) new_sim = .true.

  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)

    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)

    ! 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
           cs%mass_shelf(i,j) = cs%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, cs%h_shelf, cs%area_shelf_h, cs%hmask)
    endif

    endif

    !  else if (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

  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

    !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)

  end if

  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)

    ! 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
          cs%mass_shelf(i,j) = cs%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
    !  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, &
                       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, .false.)

    if (cs%shelf_mass_is_dynamic .and. .not.cs%override_shelf_movement) 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) .eq. (g%domain%nihalo+1)).and.(cs%u_face_mask(i-1,j).eq.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
              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_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)

      if (is_root_pe()) print *, "RESTORING ICE SHELF FROM FILE!!!!!!!!!!!!!"
    endif

  endif ! .not. new_sim

  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)

  ! 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)
    call cpu_clock_end(id_clock_pass)
  endif

  do j=jsd,jed ; do i=isd,ied ! changed stride
    if (cs%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)
    endif
   !if (.not. solo_ice_sheet) 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) + &
        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) + &
        fluxes%frac_shelf_h(i,j) * (cs%g_Earth * cs%mass_shelf(i,j))
   !endif
  enddo ; enddo

  if (cs%DEBUG) then
     call hchksum (fluxes%frac_shelf_h, "IS init: frac_shelf_h", g%HI, haloshift=0)
  endif

  if (.not. solo_ice_sheet) then
    do j=jsd,jed ; do i=isd,ied-1 ! changed stride
    !do I=isd,ied-1 ; do j=isd,jed
    fluxes%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)) &
    fluxes%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)))
    fluxes%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 ! changed stride
    !do i=isd,ied ; do J=isd,jed-1
    fluxes%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)) &
    fluxes%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)))
    fluxes%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

  if (.not. solo_ice_sheet) then
  call pass_vector(fluxes%frac_shelf_u, fluxes%frac_shelf_v, g%domain, to_all, cgrid_ne)
  endif
 ! call savearray2 ('frac_shelf_u'//procnum,fluxes%frac_shelf_u,CS%write_output_to_file)
 ! call savearray2 ('frac_shelf_v'//procnum,fluxes%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 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

    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 read_data(filename,trim(var_name),cs%calve_mask,domain=g%Domain%mpp_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

  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)

    if (.not. cs%isthermo) then
      cs%lprec(:,:) = 0.0
    endif


    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)

!      write (procnum,'(I2)') mpp_pe()

      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

  call get_param(param_file, mdl, "SAVE_INITIAL_CONDS", save_ic, &
                 "If true, save the ice shelf initial conditions.", &
                 default=.false.)
  if (save_ic) call get_param(param_file, mdl, "SHELF_IC_OUTPUT_FILE", ic_file,&
                 "The name-root of the output file for the ice shelf \n"//&
                 "initial conditions.", default="MOM_Shelf_IC")

  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


  cs%id_area_shelf_h = register_diag_field('ocean_model', 'area_shelf_h', cs%diag%axesT1, cs%Time, &
     '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_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, &
     'Ice Shelf Melt Rate', 'meter year-1')
  cs%id_thermal_driving = register_diag_field('ocean_model', 'thermal_driving', cs%diag%axesT1, cs%Time, &
     'pot. temp. in the boundary layer minus freezing pot. temp. at the ice-ocean interface.', 'Celsius')
  cs%id_haline_driving = register_diag_field('ocean_model', 'haline_driving', cs%diag%axesT1, cs%Time, &
     'salinity in the boundary layer minus salinity at the ice-ocean interface.', 'PPT')
  cs%id_Sbdry = register_diag_field('ocean_model', 'sbdry', cs%diag%axesT1, cs%Time, &
     'salinity at the ice-ocean interface.', 'PPT')
  cs%id_u_ml = register_diag_field('ocean_model', 'u_ml', cs%diag%axesT1, cs%Time, &
     'Eastward vel. in the boundary layer (used to compute ustar)', 'meter second-1')
  cs%id_v_ml = register_diag_field('ocean_model', 'v_ml', cs%diag%axesT1, cs%Time, &
     'Northward vel. in the boundary layer (used to compute ustar)', 'meter second-1')
  cs%id_exch_vel_s = register_diag_field('ocean_model', 'exch_vel_s', cs%diag%axesT1, cs%Time, &
     'Sub-shelf salinity exchange velocity', 'meter second-1')
  cs%id_exch_vel_t = register_diag_field('ocean_model', 'exch_vel_t', cs%diag%axesT1, cs%Time, &
     'Sub-shelf thermal exchange velocity', 'meter second-1')
  cs%id_tfreeze = register_diag_field('ocean_model', 'tfreeze', cs%diag%axesT1, cs%Time, &
     'In Situ Freezing point at ice shelf interface', 'degrees Celsius')
  cs%id_tfl_shelf = register_diag_field('ocean_model', 'tflux_shelf', cs%diag%axesT1, cs%Time, &
     'Heat conduction into ice shelf', 'Watts meter-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%shelf_mass_is_dynamic .and. .not.cs%override_shelf_movement) then
    cs%id_u_shelf = register_diag_field('ocean_model','u_shelf',cs%diag%axesB1,cs%Time, &
       'x-velocity of ice', 'm year')
    cs%id_v_shelf = register_diag_field('ocean_model','v_shelf',cs%diag%axesB1,cs%Time, &
       'y-velocity of ice', 'm year')
    cs%id_u_mask = register_diag_field('ocean_model','u_mask',cs%diag%axesB1,cs%Time, &
       'mask for u-nodes', 'none')
    cs%id_v_mask = register_diag_field('ocean_model','v_mask',cs%diag%axesB1,cs%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, &
       '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, &
       'ocean column thickness passed to ice model', 'm')
    cs%id_OD_av = register_diag_field('ocean_model','OD_av',cs%diag%axesT1,cs%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, &
       'timesteps where cell is floating ', 'none')
    !CS%id_h_after_uflux = register_diag_field('ocean_model','h_after_uflux',CS%diag%axesh1,CS%Time, &
    !   'thickness after u flux ', 'none')
    !CS%id_h_after_vflux = register_diag_field('ocean_model','h_after_vflux',CS%diag%axesh1,CS%Time, &
    !   'thickness after v flux ', 'none')
    !CS%id_h_after_adv = register_diag_field('ocean_model','h_after_adv',CS%diag%axesh1,CS%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, &
       'T of ice', 'oC')
    cs%id_t_mask = register_diag_field('ocean_model','tmask',cs%diag%axesT1,cs%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

!> 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(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

  integer :: i, j, is, ie, js, je
  logical :: read_shelf_area, new_sim_2
  character(len=240) :: config, inputdir, shelf_file, filename
  character(len=120) :: shelf_mass_var  ! The name of shelf mass in the file.
  character(len=120) :: shelf_area_var ! The name of shelf area in the file.
  character(len=40)  :: 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

  call get_param(param_file, mdl, "ICE_SHELF_CONFIG", config, &
                 "A string that specifies how the ice shelf is \n"//&
                 "initialized. Valid options include:\n"//&
                 " \tfile\t Read from a file.\n"//&
                 " \tzero\t Set shelf mass to 0 everywhere.\n"//&
                 " \tUSER\t Call USER_initialize_shelf_mass.\n", &
                 fail_if_missing=.true.)

  select case ( trim(config) )
    case ("file")

      call time_interp_external_init()

      call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".")
      inputdir = slasher(inputdir)

      call get_param(param_file, mdl, "SHELF_FILE", shelf_file, &
              "If DYNAMIC_SHELF_MASS = True, OVERRIDE_SHELF_MOVEMENT = True \n"//&
              "and ICE_SHELF_MASS_FROM_FILE = True, this is the file from \n"//&
              "which to read the shelf mass and area.", &
               default="shelf_mass.nc")
      call get_param(param_file, mdl, "SHELF_MASS_VAR", shelf_mass_var, &
                 "The variable in SHELF_FILE with the shelf mass.", &
                 default="shelf_mass")
      call get_param(param_file, mdl, "READ_SHELF_AREA", read_shelf_area, &
                 "If true, also read the area covered by ice-shelf from SHELF_FILE.", &
                 default=.false.)

      filename = trim(slasher(inputdir))//trim(shelf_file)
      call log_param(param_file, 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

      if (read_shelf_area) then
         call get_param(param_file, mdl, "SHELF_AREA_VAR", shelf_area_var, &
                  "The variable in SHELF_FILE with the shelf area.", &
                  default="shelf_area")

         cs%id_read_area = init_external_field(filename,shelf_area_var, &
                          domain=g%Domain%mpp_domain)
      endif

      if (.not.file_exists(filename, g%Domain)) call mom_error(fatal, &
           " initialize_shelf_mass: Unable to open "//trim(filename))

    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
      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)

    case default ;  call mom_error(fatal,"initialize_ice_shelf: "// &
      "Unrecognized ice shelf setup "//trim(config))
  end select

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(time_type),            intent(in) :: Time
  type(forcing),       intent(inout) :: fluxes

  ! local variables
  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
     ! 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%p_surf)) fluxes%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
     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.
     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.)

  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)
  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)


  ! update psurf 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 (g%areaT(i,j) > 0.0) &
        fluxes%frac_shelf_h(i,j) = cs%area_shelf_h(i,j) / g%areaT(i,j)
  enddo ; enddo


end subroutine update_shelf_mass

subroutine initialize_diagnostic_fields (CS, FE, Time)
  type(ice_shelf_cs), pointer    :: CS
  integer             :: FE
  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)
  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)
      if (od.ge.0) then
    ! ice thickness does not take up whole ocean column -> floating
        od_av(i,j) = od
        float_frac(i,j) = 0.
      else
        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)

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
  type(time_type),            intent(in) :: Time !< model time at this call
  character(len=*), optional, intent(in) :: directory !< An optional directory into which to write
                                               !! these restart files.
  logical,          optional, intent(in) :: time_stamped !< f 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.
  ! local variables
  type(ocean_grid_type), pointer :: G
  character(len=200) :: restart_dir
  character(2) :: procnum

  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),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 ("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

  call save_restart(restart_dir, time, cs%grid, cs%restart_CSp, time_stamped)

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

! time_step: time step in sec
! melt_rate: basal melt rate in kg/m^2/s

! 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
  !

  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
  real                              :: rho, spy, thick_bd
  real, dimension(:,:), pointer     :: hmask
  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.

  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
!   if (is_root_pe()) write(*,*) "ice_shelf_advect called"

  do j=jsd,jed
    do i=isd,ied
      thick_bd = cs%thickness_boundary_values(i,j)
      if (thick_bd .ne. 0.0) then
          cs%h_shelf(i,j) = cs%thickness_boundary_values(i,j)
      endif
    enddo
  enddo

  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)
!  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 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 (cs%hmask(i,j) .eq. 1) then
        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)
    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)
    endif
    if (cs%calve_to_mask) then
      call calve_to_mask (cs, cs%h_shelf, cs%area_shelf_h, cs%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)
  !call disable_averaging(CS%diag)

  !call change_thickness_using_melt(CS,G,time_step, fluxes)

  call update_velocity_masks (cs)

end subroutine ice_shelf_advect

subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time)
  type(ice_shelf_cs),                     pointer       :: CS
  real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u, v
  integer,                                intent(in)    :: FE
  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, &
                        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, dimension (8,4)       :: Phi_temp
  real, dimension (2,2)       :: X,Y
  character(2)                :: iternum
  character(2)                :: procnum, numproc

  ! 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
  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) )

  ! 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

  geolonq => g%geoLonBu ; geolatq => g%geoLatBu

  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

  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)

  ! 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 (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
      do i=g%isc,g%iec
        nodefloat = 0
        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
              nodefloat = nodefloat + 1
            endif
          enddo
        enddo
        if ((nodefloat .gt. 0) .and. (nodefloat .lt. 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

  u_prev_iterate(:,:) = u(:,:)
  v_prev_iterate(:,:) = v(:,:)

  isym=0

  ! must prepare phi
  if (fe .eq. 1) then
    allocate (phi(isd:ied,jsd:jed,1:8,1:4)) ; phi(:,:,:,:)=0

    do j=jsd,jed
      do i=isd,ied

        if (((i .gt. isd) .and. (j .gt. 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
          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

        call bilinear_shape_functions (x, y, phi_temp, area)
        phi(i,j,:,:) = phi_temp

      enddo
    enddo
  endif

  if (fe .eq. 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

  ! 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 .eq. 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

  if (fe .eq. 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
    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
    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
    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

!  write (procnum,'(I2)') mpp_pe()


  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
        err_tempu = abs(au(i,j) + u_bdry_cont(i,j) - taudx(i,j))
      endif
      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
        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, 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)
    endif

    if (is_root_pe()) print *,"linear solve done",iters," iterations"

    if (fe .eq. 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

    if (iter .eq. 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
        if (fe .eq. 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

    u_bdry_cont(:,:) = 0 ; v_bdry_cont(:,:) = 0

    if (fe .eq. 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
      call apply_boundary_values_triangle (cs, time, u_bdry_cont, v_bdry_cont)
    endif

    au(:,:) = 0 ; av(:,:) = 0

    if (fe .eq. 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
      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

    err_max = 0

      if (cs%nonlin_solve_err_mode .eq. 1) then

      do j=jsumstart,g%jecB
        do i=isumstart,g%iecB
          if (cs%umask(i,j) .eq. 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
            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
            err_max = err_tempv
          endif
        enddo
      enddo

      call mpp_max (err_max)

    elseif (cs%nonlin_solve_err_mode .eq. 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
            err_tempu = abs(u_last(i,j)-u(i,j))
            tempu = u(i,j)
          endif
          if (cs%vmask(i,j) .eq. 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 .ge. err_max) then
            err_max = err_tempv
          endif
          if  (tempv .ge. 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 .le. cs%nonlinear_tolerance * err_init) then
      if (is_root_pe()) &
        print *,"exiting nonlinear solve after ",iter," iterations"
      exit
    endif

  enddo

  !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)

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
  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
  integer, intent(in)          :: FE
  integer, intent(out)         :: conv_flag, iters
  type(time_type)              :: time
  real, pointer, dimension(:,:,:,:)      :: Phi
  real, dimension (:,:,:,:,:,:),pointer :: 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(:,:), pointer :: hmask, umask, vmask, u_bdry, v_bdry, &
                        visc, visc_lo, beta, beta_lo, geolonq, geolatq
  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, &
                        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

  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

  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
  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

!   if (G%symmetric) then
!     isym = 1
!   else
!     isym = 0
!   endif

  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

  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 .eq. 1) then
    visc => cs%ice_visc_bilinear
    beta => cs%taub_beta_eff_bilinear
  elseif (fe .eq. 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
    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
    call apply_boundary_values_triangle (cs, time, ubd, vbd)
  endif

  rhsu(:,:) = taudx(:,:) - ubd(:,:)
  rhsv(:,:) = taudy(:,:) - vbd(:,:)


  call pass_vector(rhsu, rhsv, g%domain, to_all, bgrid_ne)


  if (fe .eq. 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
    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 .eq. 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
    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 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 (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
      enddo
    enddo

    call mpp_sum (dot_p1)

  else

    sum_vec(:,:) = 0.0

    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
      enddo
    enddo

    dot_p1 = reproducing_sum( sum_vec, isumstart_int_, iecq, &
                                        jsumstart_int_, jecq )

  endif

  resid0 = sqrt(dot_p1)

  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)
    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

    if (fe .eq. 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

      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


    ! 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 (umask(i,j) .eq. 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
              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 (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) + &
                                                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) + &
                                                dv(i,j) * av(i,j)
        enddo
      enddo

      dot_p1 = reproducing_sum( sum_vec, iscq, iecq, &
                                          jscq, jecq )

      dot_p2 = reproducing_sum( sum_vec_2, iscq, iecq, &
                                          jscq, jecq )

    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 (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)
      enddo
    enddo

    do j=jsd,jed
      do i=isd,ied
        if (umask(i,j) .eq. 1) then
          ru_old(i,j) = ru(i,j) ; zu_old(i,j) = zu(i,j)
        endif
        if (vmask(i,j) .eq. 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 (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)
      enddo
    enddo


    do j=jsdq,jedq
      do i=isdq,iedq
        if (umask(i,j) .eq. 1) then
          zu(i,j) = ru(i,j) / diagu(i,j)
        endif
        if (vmask(i,j) .eq. 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 (umask(i,j) .eq. 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
            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_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) + &
                                                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) + &
                                                zv_old(i,j) * rv_old(i,j)
        enddo
      enddo


      dot_p1 = reproducing_sum( sum_vec, isumstart_int_, iecq, &
                                          jsumstart_int_, jecq )

      dot_p2 = reproducing_sum( sum_vec_2, isumstart_int_, iecq, &
                                          jsumstart_int_, jecq )

    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 (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)
      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 (umask(i,j) .eq. 1) then
            dot_p1 = dot_p1 + ru(i,j)**2
          endif
          if (vmask(i,j) .eq. 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_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
        enddo
      enddo

      dot_p1 = reproducing_sum( sum_vec, isumstart_int_, iecq, &
                                        jsumstart_int_, jecq )

!      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 .le. cs%cg_tolerance * resid0) then
      iters = iter
      conv_flag = 1
      exit
    endif

    cg_halo = cg_halo - 1

    if (cg_halo .eq. 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 (umask(i,j) .eq. 3) then
        u(i,j) = u_bdry(i,j)
      elseif (umask(i,j) .eq. 0) then
        u(i,j) = 0
      endif

      if (vmask(i,j) .eq. 3) then
        v(i,j) = v_bdry(i,j)
      elseif (vmask(i,j) .eq. 0) then
        v(i,j) = 0
      endif
    enddo
  enddo

  call pass_vector (u,v, g%domain, to_all, bgrid_ne)

  if (conv_flag .eq. 0) then
    iters = cs%cg_max_iterations
  endif

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
  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

  ! 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 :: 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
  real, dimension(-2:2) :: stencil
  real, dimension(:,:), pointer  :: hmask, 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

!   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
  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) .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

      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 .eq. 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
            at_east_bdry=.true.
          else
            at_east_bdry=.false.
          endif

          if (hmask(i,j) .eq. 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 (u_face_mask(i-1,j) .eq. 4.) then

              flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values(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 (at_west_bdry .and. (i .eq. G%isc)) then
  !                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

              ! 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
                  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
                  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 .lt. 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 * &
                             (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) .eq. 0) .OR. (hmask(i-1,j) .eq. 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 (u_face_mask(i+1,j) .eq. 4.) then

              flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values(i+1,j) / dxdyh

            else

              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 (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

                elseif (hmask(i+1,j) * hmask(i+2,j) .eq. 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 .gt. 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 * &
                      (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) .eq. 0) .OR. (hmask(i+1,j) .eq. 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) .eq. 0) .OR. (hmask(i,j) .eq. 2)) then

            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 * 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)
            endif

            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 * 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)
            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

              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

              hmask(i,j) = 2

            endif

          endif

        endif

      enddo ! i loop

    endif

  enddo ! j loop

!  write (procnum,'(I1)') mpp_pe()

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
  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

  ! 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 :: 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
  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
  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) .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

      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 .eq. 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
            at_north_bdry=.true.
          else
            at_north_bdry=.false.
          endif

          if (hmask(i,j) .eq. 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 (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) / 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 .gt. 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).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

                  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 .lt. 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))
                  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
                    flux_enter(i,j-1,4) = abs(v_face) * dyh * time_step * stencil(0)
                  endif

                endif

              endif

            endif

            ! NEXT DO north FACE

            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) / 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 .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
                  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))
                  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 .gt. 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))
                  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) .eq. 0) .OR. (hmask(i,j+1) .eq. 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) .eq. 0) .OR. (hmask(i,j) .eq. 2)) then

            if (at_south_bdry .AND. (hmask(i,j-1) .EQ. 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
              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
              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
              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
                ! 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
              hmask(i,j) = 2
            endif

          endif
        endif
      enddo ! j loop
    endif
  enddo ! i loop

  !write (procnum,'(I1)') mpp_pe()

end subroutine ice_shelf_advect_thickness_y

subroutine shelf_advance_front (CS, flux_enter)
  type(ice_shelf_cs),         pointer    :: CS
  real, dimension(:,:,:), 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, isym
  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
  area_shelf_h => cs%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
  i_off = g%idg_offset ; j_off = g%jdg_offset
  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

  do while (iter_flag .eq. 1)

    iter_flag = 0

    if (iter_count .gt. 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...



    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

      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
        ! 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
                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)
                flux_enter(i,j,k) = 0.0
              endif
            enddo

            do k=1,2
              if (flux_enter(i,j,k+2) .gt. 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)
                flux_enter(i,j,k+2) = 0.0
              endif
            enddo

            if (n_flux .gt. 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

              if ((partial_vol / dxdyh) .eq. 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
              elseif ((partial_vol / dxdyh) .lt. 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
              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
                !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 (u_face_mask(i-2+k,j) .eq. 2) then
                    n_flux = n_flux + 1
                  elseif (hmask(i+2*k-3,j) .eq. 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
                    n_flux = n_flux + 1
                  elseif (hmask(i,j+2*k-3) .eq. 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!
                  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) &
                      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) &
                      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.gt.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, h_shelf, area_shelf_h,hmask)
  type(ice_shelf_cs),    pointer        :: CS
  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) .lt. 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
        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 (CS, h_shelf, area_shelf_h, hmask, calve_mask)
  type(ice_shelf_cs), pointer       :: CS
  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) .eq. 0.0) .and. (hmask(i,j) .ne. 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
  real, dimension(:,:), intent(in)    :: OD
  real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout)    :: TAUD_X, TAUD_Y
  integer, intent(in)            :: FE

! 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)

! FE : 1 if bilinear, 2 if triangular linear FE

  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
                            BASE     ! basal elevation of shelf/stream
  character(1)                   :: procnum


  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 :: 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)
  i_off = g%idg_offset ; j_off = g%jdg_offset

  d => g%bathyT
  h => cs%h_shelf
  float_frac => cs%float_frac
  hmask => cs%hmask
  u_face_mask => cs%u_face_mask
  v_face_mask => cs%v_face_mask
  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 ("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)

!   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(:,:)
  s(:,:) = base(:,:) + h(:,:)

!  write (procnum,'(I1)') mpp_pe()

  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)
!     print *,dxh," ",dyh," ",dxdyh

      if (hmask(i,j) .eq. 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
            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
            sx = (s(i,j)-s(i-1,j))/dxh
          else
            sx=0
          endif
        else ! interior
          if (hmask(i+1,j) .eq. 1) then
            cnt = cnt+1
                sx = s(i+1,j)
          else
            sx = s(i,j)
              endif
              if (hmask(i-1,j) .eq. 1) then
            cnt = cnt+1
                sx = sx - s(i-1,j)
          else
            sx = sx - s(i,j)
              endif
          if (cnt .eq. 0) then
            sx=0
          else
            sx = sx / (cnt * dxh)
          endif
        endif

        cnt = 0

        ! calculate sy, similarly
        if ((j+j_off) .eq. gjsc) then ! at south computational bdry
          if (hmask(i,j+1) .eq. 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
            sy = (s(i,j)-s(i,j-1))/dyh
          else
            sy = 0
          endif
        else ! interior
          if (hmask(i,j+1) .eq. 1) then
            cnt = cnt+1
            sy = s(i,j+1)
          else
            sy = s(i,j)
          endif
          if (hmask(i,j-1) .eq. 1) then
            cnt = cnt+1
            sy = sy - s(i,j-1)
          else
            sy = sy - s(i,j)
          endif
          if (cnt .eq. 0) then
            sy=0
          else
            sy = sy / (cnt * dyh)
          endif
        endif


        if (fe .eq. 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_y(i-1,j-1) = taud_y(i-1,j-1) - .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

        if (float_frac(i,j) .eq. 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 ! 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
          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
          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
          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
          taud_y(i,j) = taud_y(i,j) + .5 * dxh * neumann_val
        endif

      endif
    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, time, input_flux, input_thick, new_sim)
  type(time_type),       intent(in)    :: Time
  type(ice_shelf_cs),    pointer       :: CS
  real, intent(in)               :: input_flux, input_thick
  logical, optional               :: new_sim

! 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

  real, dimension (:,:) , pointer      :: thickness_boundary_values, &
                          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, giec, 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
  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

  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

  domain_width = cs%len_lat

  ! this loop results in some values being set twice but... eh.

  do j=jsd,jed
    do i=isd,ied

!      if ((i .eq. 4) .AND. ((mpp_pe() .eq. 0) .or. (mpp_pe() .eq. 6))) then
!    print *,hmask(i,j),i,j,mpp_pe()
!      endif

      if (hmask(i,j) .eq. 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 ((i.le.iec).and.(i.ge.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
            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
      endif

      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
            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
            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
    enddo
  enddo

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) .eq. 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

          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) .eq. 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) .eq. 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) .eq. 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) .eq. 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) .eq. 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

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
! 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
! 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 .ne. 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) .eq. 1) then
!     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)
!
!     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 .eq. 2) then
            ilq = 2
        else
            ilq = 1
        endif

        if (jq .eq. 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) .eq. 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

            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
            ilq = 2
          else
            ilq = 1
          endif

          if (jq .eq. jphi) then
            jlq = 2
          else
            jlq = 1
          endif

          if (float_cond(i,j) .eq. 0) then

            if (umask(i-2+iphi,j-2+jphi) .eq. 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

              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)
!              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
      enddo ; enddo

      if (float_cond(i,j) .eq. 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
            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
            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)
          endif
        enddo ; enddo
      endif

    endif
  enddo ; enddo

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(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 .gt. 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

 !               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

            enddo
          enddo
        enddo
      enddo
    enddo
  enddo

end subroutine cg_action_subgrid_basal_bilinear

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 :: 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) .eq. 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

      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) .eq. 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) .eq. 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) .eq. 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)

  type(ice_shelf_cs),    pointer       :: CS
  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


! 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
  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

  umask => cs%umask ; vmask => cs%vmask ; hmask => cs%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
    !  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) .eq. 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 .eq. iphi) then
            ilq = 2
          else
            ilq = 1
          endif

          if (jq .eq. jphi) then
            jlq = 2
          else
            jlq = 1
          endif

        if (umask(i-2+iphi,j-2+jphi) .eq. 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) .eq. 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

          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) .eq. 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) .eq. 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
          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_bilinear

subroutine cg_diagonal_subgrid_basal_bilinear (Phisub, H, DXDYH, D, dens_ratio, Ucontr, Vcontr)
  real, pointer, dimension(:,:,:,:,:,:) :: 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 .gt. 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_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
  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) .eq. 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

      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) .eq. 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) .eq. 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) .eq. 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) .eq. 3) .OR. (umask(i,j-1) .eq. 3) .OR. (umask(i-1,j) .eq. 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) .eq. 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) .eq. 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) .eq. 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, u_boundary_contr, v_boundary_contr)

  type(time_type),       intent(in)    :: Time
  real, dimension (:,:,:,:,:,:),pointer:: Phisub
  type(ice_shelf_cs),    pointer       :: CS
  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

! 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
  type(ocean_grid_type), pointer :: G
  integer :: isym, 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

  u_boundary_values => cs%u_boundary_values
  v_boundary_values => cs%v_boundary_values
  umask => cs%umask ; vmask => cs%vmask ; hmask => cs%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
    !  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) .eq. 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


      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 = 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)

        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)

        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)

        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)

        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)

        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)

        do iphi=1,2 ; do jphi=1,2

          if (iq .eq. iphi) then
            ilq = 2
          else
            ilq = 1
          endif

          if (jq .eq. jphi) then
            jlq = 2
          else
            jlq = 1
          endif

          if (umask(i-2+iphi,j-2+jphi) .eq. 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
              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


            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
              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

          endif
        enddo ; enddo
      enddo ; enddo

      if (float_cond(i,j) .eq. 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
            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
            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
    endif
  endif ; enddo ; enddo

end subroutine apply_boundary_values_bilinear

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 :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, 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) .eq. 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
  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

! 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, &
                       beta
  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, 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)

  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
  nu => cs%ice_visc_bilinear
  beta => cs%taub_beta_eff_bilinear

  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 (hmask(i,j) .eq. 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)

        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)
      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)
  type(ice_shelf_cs),         pointer   :: CS
  real, dimension(CS%grid%isd:,CS%grid%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

  threshold_col_depth = cs%thresh_float_col_depth

  g=>cs%grid

  rho_ocean = cs%density_ocean_avg
  inv_rho_ocean = 1./rho_ocean

  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 .eq. nstep_velocity) then

    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
!        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
      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)
  type(ice_shelf_cs), pointer    :: CS

  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)
  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

!   print *,"rhow",rhow,"rho",rhoi

  do j=jsd,jed
    do i=isd,ied
      od = g%bathyT(i,j) - rhoi/rhow * h_shelf(i,j)
      if (od.ge.0) then
    ! ice thickness does not take up whole ocean column -> floating
        od_av(i,j) = od
        float_frac(i,j) = 0.
      else
        od_av(i,j) = 0.
        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 .ne. 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 .eq. 1) then
        yexp = 1-yquad(qpoint)
      else
        yexp = yquad(qpoint)
      endif

      if (1 .eq. 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 .eq. 1) then
                val = val * (1.0-x)
              else
                val = val * x
              endif
              if (l .eq. 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

!  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)
  type(ice_shelf_cs),    pointer    :: 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)

  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
  real, dimension(:,:), pointer  :: umask, vmask, u_face_mask, v_face_mask, hmask, 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
  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 => 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
  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

  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) .eq. 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(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.
              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(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.
              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 (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.
        !endif

        !if (j_off+j .eq. 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
        !  v_face_mask (i,j) = 0.
        !  umask (i-1:i,j) = 0.
        !  vmask (i-1:i,j) = 0.
        !endif

        if (i .lt. 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
            u_face_mask(i,j) = 2.
          endif
        endif

        if (i .gt. 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 ((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 ((hmask(i,j+1) .eq. 0) .OR. (hmask(i,j+1) .eq. 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


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(ocean_grid_type), pointer :: G
  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

  ! 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) .eq. 1.0) then
            summ = summ + h_shelf(i+k,j+l)
            num_h = num_h + 1
          endif
        enddo
      enddo
      if (num_h .gt. 0) then
        h_node(i,j) = summ / num_h
      endif
    enddo
  enddo

  call pass_var(h_node, g%domain)

end subroutine interpolate_h_to_b

!> Deallocates all memory associated with this module
subroutine ice_shelf_end(CS)
  type(ice_shelf_cs), pointer   :: CS

  if (.not.associated(cs)) return

  deallocate(cs%mass_shelf) ; deallocate(cs%area_shelf_h)
  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)
!!! 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%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

  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 .gt. 1300) THEN
   WRITE(fin) 'SECOND DIMENSION TOO LARGE'
   CLOSE(fin)
   RETURN
END IF

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


  IF(i.eq.1) THEN

   lh = len(trim(ln))

   fmt1 = '(A'

   SELECT CASE (lh)
     CASE(1:9)
    WRITE(fmt1(3:3),'(I1)') lh

     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) // ')'

  END IF

  WRITE(unit=fin,iostat=iock,fmt=trim(fmt1)) trim(ln)

  IF(iock .ne. 0) THEN
     print*,iock
  END IF
END DO

CLOSE(fin)

end subroutine savearray2


subroutine solo_time_step (CS, time_step, n, Time, min_time_step_in)
  type(ice_shelf_cs), pointer    :: CS
  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
  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
  character(4)         :: stepnum

  cs%velocity_update_sub_counter = cs%velocity_update_sub_counter + 1
  spy = 365 * 86400
  g => cs%grid
  u_shelf => cs%u_shelf
  v_shelf => cs%v_shelf
  hmask => cs%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
  else
   min_time_step=min_time_step_in
  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

  do while (time_step_remain .gt. 0.0)

  min_ratio = 1.0e16
  n=n+1
  do j=js,jec
    do i=is,iec

       local_u_max = 0 ; local_v_max = 0

       if (hmask(i,j) .eq. 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)))

        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 .lt. 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 .ge. 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 (cs, time_step_int, cs%lprec, time)

   if (mpp_pe() .eq. 7) then
      call savearray2 ("hmask",cs%hmask,cs%write_output_to_file)
!!! OVS!!!
!      call savearray2 ("tshelf",CS%t_shelf,CS%write_output_to_file)
   endif

   ! 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
     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)
   endif

!!! OVS!!!
   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)
   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_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)

  call disable_averaging(cs%diag)

 enddo

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

! 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
  !

  type(ocean_grid_type), pointer :: G
  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
  real                              :: rho, spy, t_bd, Tsurf, adot
  real, dimension(:,:), pointer     :: hmask, Tbot
  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.

  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
  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_boundary_values(i,j)
!      if (CS%hmask(i,j) .gt. 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
    enddo
  enddo

  do j=jsd,jed
    do i=isd,ied
        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)
!  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)
!  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)

  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
        cs%t_shelf (i,j) = th_after_vflux(i,j)/cs%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_boundary_values(i,j)
!      if (CS%hmask(i,j) .gt. 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
      endif
    enddo
  enddo

  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
!          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
          ! 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, time_step, h0, h_after_uflux, flux_enter)
  type(ice_shelf_cs),         pointer    :: CS
  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

  ! 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 :: 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
  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
      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
  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
  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

  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

      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 .eq. 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
            at_east_bdry=.true.
          else
            at_east_bdry=.false.
          endif

          if (hmask(i,j) .eq. 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 (u_face_mask(i-1,j) .eq. 4.) then

              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

            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 (at_west_bdry .and. (i .eq. G%isc)) then
  !                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

              ! 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
                  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
                  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 .lt. 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 * &
                             (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) .eq. 0) .OR. (hmask(i-1,j) .eq. 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 (u_face_mask(i+1,j) .eq. 4.) then

              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

            else

              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 (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

                elseif (hmask(i+1,j) * hmask(i+2,j) .eq. 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 .gt. 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 * &
                      (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) .eq. 0) .OR. (hmask(i+1,j) .eq. 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) .eq. 0) .OR. (hmask(i,j) .eq. 2)) then

            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)
            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)
! assume no flux bc for temp
            endif

            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)
            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
!              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
              ! 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

!              hmask(i,j) = 2

!            endif

          endif

        endif

      enddo ! i loop

    endif

  enddo ! j loop

!  write (procnum,'(I1)') mpp_pe()

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
  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

  ! 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 :: 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
  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
  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

  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

      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 .eq. 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
            at_north_bdry=.true.
          else
            at_north_bdry=.false.
          endif

          if (hmask(i,j) .eq. 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 (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
! 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

            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 .gt. 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).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

                  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 .lt. 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))
                  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
                    flux_enter(i,j-1,4) = abs(v_face) * dyh * time_step * stencil(0)
                  endif

                endif

              endif

            endif

            ! NEXT DO north FACE

            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
! 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

            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 .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
                  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))
                  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 .gt. 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))
                  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) .eq. 0) .OR. (hmask(i,j+1) .eq. 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) .eq. 0) .OR. (hmask(i,j) .eq. 2)) then

            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)
            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
!              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
              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
              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
 ! 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
!              hmask (i,j) = 2
!            endif

          endif
        endif
      enddo ! j loop
    endif
  enddo ! i loop

  !write (procnum,'(I1)') mpp_pe()

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.
!!
!! 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
!!      - 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_bilinear, taub_beta_eff_bilinear
!!  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 mpp_sum 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_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 ???)
!!    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.
!!
!! 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:
!! 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.



! GMM, I am putting all the commented functions below

! subroutine add_shelf_flux_IOB(CS, state, fluxes)
! !  type(ice_ocean_boundary_type),              intent(inout)    :: IOB
!   type(ice_shelf_CS),                 intent(in)    :: CS
!   type(surface),                      intent(inout)    :: state
!   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?
!       fluxes%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)) &
!         fluxes%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)))
!       fluxes%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
!       fluxes%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)) &
!         fluxes%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)))
!       fluxes%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(fluxes%frac_shelf_u, fluxes%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 = fluxes%frac_shelf_u(i-1,j) * (G%areaT(i-1,j) + G%areaT(i,j)) ! G%dxdy_u(i-1,j)
!       asu2 = fluxes%frac_shelf_u(i,j) * (G%areaT(i,j) + G%areaT(i+1,j)) ! G%dxdy_u(i,j)
!       asv1 = fluxes%frac_shelf_v(i,j-1) * (G%areaT(i,j-1) + G%areaT(i,j)) ! G%dxdy_v(i,j-1)
!       asv2 = fluxes%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 fluxes%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
!       fluxes%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
!       fluxes%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