MOM6
Data Types | Functions/Subroutines | Variables
mom_ice_shelf Module Reference

Detailed Description

Implements the thermodynamic aspects of ocean / ice-shelf interactions,.

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

ICE_SHELF equations

The three fundamental equations are: Heat flux

\[ \qquad \rho_w C_{pw} \gamma_T (T_w - T_b) = \rho_i \dot{m} L_f \]

Salt flux

\[ \qquad \rho_w \gamma_s (S_w - S_b) = \rho_i \dot{m} S_b \]

Freezing temperature

\[ \qquad T_b = a S_b + b + c P \]

where ....

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.

Data Types

type  ice_shelf_cs
 Control structure that contains ice shelf parameters and diagnostics handles. More...
 

Functions/Subroutines

real function slope_limiter (num, denom)
 used for flux limiting in advective subroutines Van Leer limiter (source: Wikipedia) More...
 
real function quad_area (X, Y)
 Calculate area of quadrilateral. More...
 
subroutine, public shelf_calc_flux (state, fluxes, Time, time_step, CS)
 Calculates fluxes between the ocean and ice-shelf using the three-equations formulation (optional to use just two equations). See ICE_SHELF equations. More...
 
subroutine change_thickness_using_melt (CS, G, time_step, fluxes)
 Changes the thickness (mass) of the ice shelf based on sub-ice-shelf melting. More...
 
subroutine, public add_shelf_flux (G, CS, state, fluxes)
 Updates suface fluxes that are influenced by sub-ice-shelf melting. More...
 
subroutine, public initialize_ice_shelf (param_file, ocn_grid, Time, CS, diag, fluxes, Time_in, solo_ice_sheet_in)
 Initializes shelf model data, parameters and diagnostics. More...
 
subroutine initialize_shelf_mass (G, param_file, CS, new_sim)
 Initializes shelf mass based on three options (file, zero and user) More...
 
subroutine update_shelf_mass (G, CS, Time, fluxes)
 Updates the ice shelf mass using data from a file. More...
 
subroutine initialize_diagnostic_fields (CS, FE, Time)
 
subroutine, public ice_shelf_save_restart (CS, Time, directory, time_stamped, filename_suffix)
 Save the ice shelf restart file. More...
 
subroutine ice_shelf_advect (CS, time_step, melt_rate, Time)
 
subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time)
 
subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE, conv_flag, iters, time, Phi, Phisub)
 
subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_enter)
 
subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_vflux, flux_enter)
 
subroutine shelf_advance_front (CS, flux_enter)
 
subroutine ice_shelf_min_thickness_calve (CS, h_shelf, area_shelf_h, hmask)
 Apply a very simple calving law using a minimum thickness rule. More...
 
subroutine calve_to_mask (CS, h_shelf, area_shelf_h, hmask, calve_mask)
 
subroutine calc_shelf_driving_stress (CS, TAUD_X, TAUD_Y, OD, FE)
 
subroutine init_boundary_values (CS, time, input_flux, input_thick, new_sim)
 
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)
 
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)
 
subroutine cg_action_subgrid_basal_bilinear (Phisub, H, U, V, DXDYH, D, dens_ratio, Ucontr, Vcontr, iin, jin)
 
subroutine matrix_diagonal_triangle (CS, u_diagonal, v_diagonal)
 
subroutine matrix_diagonal_bilinear (CS, float_cond, H_node, dens_ratio, Phisub, u_diagonal, v_diagonal)
 
subroutine cg_diagonal_subgrid_basal_bilinear (Phisub, H, DXDYH, D, dens_ratio, Ucontr, Vcontr)
 
subroutine apply_boundary_values_triangle (CS, time, u_boundary_contr, v_boundary_contr)
 
subroutine apply_boundary_values_bilinear (CS, time, Phisub, H_node, float_cond, dens_ratio, u_boundary_contr, v_boundary_contr)
 
subroutine calc_shelf_visc_triangular (CS, u, v)
 
subroutine calc_shelf_visc_bilinear (CS, u, v)
 
subroutine update_od_ffrac (CS, ocean_mass, counter, nstep_velocity, time_step, velocity_update_time_step)
 
subroutine update_od_ffrac_uncoupled (CS)
 
subroutine bilinear_shape_functions (X, Y, Phi, area)
 
subroutine bilinear_shape_functions_subgrid (Phisub, nsub)
 
subroutine update_velocity_masks (CS)
 
subroutine interpolate_h_to_b (CS, h_shelf, hmask, H_node)
 
subroutine, public ice_shelf_end (CS)
 Deallocates all memory associated with this module. More...
 
subroutine savearray2 (fname, A, flag)
 
subroutine, public solo_time_step (CS, time_step, n, Time, min_time_step_in)
 
subroutine ice_shelf_temp (CS, time_step, melt_rate, Time)
 
subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter)
 
subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, flux_enter)
 

Variables

integer id_clock_shelf
 
integer id_clock_pass
 Clock for group pass calls. More...
 

Function/Subroutine Documentation

◆ add_shelf_flux()

subroutine, public mom_ice_shelf::add_shelf_flux ( type(ocean_grid_type), intent(inout)  G,
type(ice_shelf_cs), pointer  CS,
type(surface), intent(inout)  state,
type(forcing), intent(inout)  fluxes 
)

Updates suface fluxes that are influenced by sub-ice-shelf melting.

Parameters
[in,out]gThe ocean's grid structure.
csThis module's control structure.
[in,out]stateSurface ocean state
[in,out]fluxesA structure of surface fluxes that may be used/updated.

Definition at line 924 of file MOM_ice_shelf.F90.

References ice_shelf_min_thickness_calve(), and mom_domains::to_all.

Referenced by shelf_calc_flux().

924  type(ocean_grid_type), intent(inout) :: g !< The ocean's grid structure.
925  type(ice_shelf_cs), pointer :: cs !< This module's control structure.
926  type(surface), intent(inout) :: state!< Surface ocean state
927  type(forcing), intent(inout) :: fluxes !< A structure of surface fluxes that may be used/updated.
928 
929  ! local variables
930  real :: irho0 !< The inverse of the mean density in m3 kg-1.
931  real :: frac_area !< The fractional area covered by the ice shelf, nondim.
932  real :: shelf_mass0 !< Total ice shelf mass at previous time (Time-dt).
933  real :: shelf_mass1 !< Total ice shelf mass at current time (Time).
934  real :: delta_mass_shelf!< Change in ice shelf mass over one time step in kg/s
935  real :: taux2, tauy2 !< The squared surface stresses, in Pa.
936  real :: asu1, asu2 !< Ocean areas covered by ice shelves at neighboring u-
937  real :: asv1, asv2 !< and v-points, in m2.
938  real :: fraz !< refreezing rate in kg m-2 s-1
939  real :: mean_melt_flux !< spatial mean melt flux kg/s
940  real :: sponge_area !< total area of sponge region
941  real :: t0 !< The previous time (Time-dt) in sec.
942  type(time_type) :: time0!< The previous time (Time-dt)
943  real, dimension(:,:), allocatable, target :: last_mass_shelf !< Ice shelf mass
944  ! at at previous time (Time-dt), in kg/m^2
945  real, dimension(:,:), allocatable, target :: last_h_shelf !< Ice shelf thickness
946  ! at at previous time (Time-dt), in m
947  real, dimension(:,:), allocatable, target :: last_hmask !< Ice shelf mask
948  ! at at previous time (Time-dt)
949  real, dimension(:,:), allocatable, target :: last_area_shelf_h !< Ice shelf area
950  ! at at previous time (Time-dt), m^2
951 
952  real, parameter :: rho_fw = 1000.0 ! fresh water density
953  integer :: i, j, is, ie, js, je, isd, ied, jsd, jed
954  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
955  isd = g%isd ; jsd = g%jsd ; ied = g%ied ; jed = g%jed
956 
957  irho0 = 1.0 / cs%Rho0
958  ! Determine ustar and the square magnitude of the velocity in the
959  ! bottom boundary layer. Together these give the TKE source and
960  ! vertical decay scale.
961  if (cs%shelf_mass_is_dynamic) then
962  do j=jsd,jed ; do i=isd,ied
963  if (g%areaT(i,j) > 0.0) &
964  fluxes%frac_shelf_h(i,j) = cs%area_shelf_h(i,j) / g%areaT(i,j)
965  enddo ; enddo
966  !do I=isd,ied-1 ; do j=isd,jed
967  do j=jsd,jed ; do i=isd,ied-1 ! ### changed stride order; i->ied-1?
968  fluxes%frac_shelf_u(i,j) = 0.0
969  if ((g%areaT(i,j) + g%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) &
970  fluxes%frac_shelf_u(i,j) = ((cs%area_shelf_h(i,j) + cs%area_shelf_h(i+1,j)) / &
971  (g%areaT(i,j) + g%areaT(i+1,j)))
972  fluxes%rigidity_ice_u(i,j) = (cs%kv_ice / cs%density_ice) * &
973  min(cs%mass_shelf(i,j), cs%mass_shelf(i+1,j))
974  enddo ; enddo
975  do j=jsd,jed-1 ; do i=isd,ied ! ### change stride order; j->jed-1?
976  !do i=isd,ied ; do J=isd,jed-1
977  fluxes%frac_shelf_v(i,j) = 0.0
978  if ((g%areaT(i,j) + g%areaT(i,j+1) > 0.0)) & ! .and. (G%dxdy_v(i,J) > 0.0)) &
979  fluxes%frac_shelf_v(i,j) = ((cs%area_shelf_h(i,j) + cs%area_shelf_h(i,j+1)) / &
980  (g%areaT(i,j) + g%areaT(i,j+1)))
981  fluxes%rigidity_ice_v(i,j) = (cs%kv_ice / cs%density_ice) * &
982  max(cs%mass_shelf(i,j), cs%mass_shelf(i,j+1))
983  enddo ; enddo
984  call pass_vector(fluxes%frac_shelf_u, fluxes%frac_shelf_v, g%domain, to_all, cgrid_ne)
985  else
986  ! This is needed because rigidity is potentially modified in the coupler. Reset
987  ! in the ice shelf cavity: MJH
988 
989  do j=jsd,jed ; do i=isd,ied-1 ! changed stride
990  fluxes%rigidity_ice_u(i,j) = (cs%kv_ice / cs%density_ice) * &
991  min(cs%mass_shelf(i,j), cs%mass_shelf(i+1,j))
992  enddo ; enddo
993 
994  do j=jsd,jed-1 ; do i=isd,ied ! changed stride
995  fluxes%rigidity_ice_v(i,j) = (cs%kv_ice / cs%density_ice) * &
996  max(cs%mass_shelf(i,j), cs%mass_shelf(i,j+1))
997  enddo ; enddo
998  endif
999 
1000  if (cs%debug) then
1001  if (associated(state%taux_shelf)) then
1002  call uchksum(state%taux_shelf, "taux_shelf", g%HI, haloshift=0)
1003  endif
1004  if (associated(state%tauy_shelf)) then
1005  call vchksum(state%tauy_shelf, "tauy_shelf", g%HI, haloshift=0)
1006  call vchksum(fluxes%rigidity_ice_u, "rigidity_ice_u", g%HI, haloshift=0)
1007  call vchksum(fluxes%rigidity_ice_v, "rigidity_ice_v", g%HI, haloshift=0)
1008  call vchksum(fluxes%frac_shelf_u, "frac_shelf_u", g%HI, haloshift=0)
1009  call vchksum(fluxes%frac_shelf_v, "frac_shelf_v", g%HI, haloshift=0)
1010  endif
1011  endif
1012 
1013  if (associated(state%taux_shelf) .and. associated(state%tauy_shelf)) then
1014  call pass_vector(state%taux_shelf, state%tauy_shelf, g%domain, to_all, cgrid_ne)
1015  endif
1016 
1017  if (associated(fluxes%sw_vis_dir)) fluxes%sw_vis_dir = 0.0
1018  if (associated(fluxes%sw_vis_dif)) fluxes%sw_vis_dif = 0.0
1019  if (associated(fluxes%sw_nir_dir)) fluxes%sw_nir_dir = 0.0
1020  if (associated(fluxes%sw_nir_dif)) fluxes%sw_nir_dif = 0.0
1021 
1022  do j=g%jsc,g%jec ; do i=g%isc,g%iec
1023  frac_area = fluxes%frac_shelf_h(i,j)
1024  if (frac_area > 0.0) then
1025  ! ### THIS SHOULD BE AN AREA WEIGHTED AVERAGE OF THE ustar_shelf POINTS.
1026  taux2 = 0.0 ; tauy2 = 0.0
1027  asu1 = fluxes%frac_shelf_u(i-1,j) * (g%areaT(i-1,j) + g%areaT(i,j)) ! G%dxdy_u(i-1,j)
1028  asu2 = fluxes%frac_shelf_u(i,j) * (g%areaT(i,j) + g%areaT(i+1,j)) ! G%dxdy_u(i,j)
1029  asv1 = fluxes%frac_shelf_v(i,j-1) * (g%areaT(i,j-1) + g%areaT(i,j)) ! G%dxdy_v(i,j-1)
1030  asv2 = fluxes%frac_shelf_v(i,j) * (g%areaT(i,j) + g%areaT(i,j+1)) ! G%dxdy_v(i,j)
1031  if ((asu1 + asu2 > 0.0) .and. associated(state%taux_shelf)) &
1032  taux2 = (asu1 * state%taux_shelf(i-1,j)**2 + &
1033  asu2 * state%taux_shelf(i,j)**2 ) / (asu1 + asu2)
1034  if ((asv1 + asv2 > 0.0) .and. associated(state%tauy_shelf)) &
1035  tauy2 = (asv1 * state%tauy_shelf(i,j-1)**2 + &
1036  asv2 * state%tauy_shelf(i,j)**2 ) / (asv1 + asv2)
1037 
1038  ! GMM: melting is computed using ustar_shelf (and not ustar), which has already
1039  ! been passed, so believe we do not need to update fluxes%ustar.
1040  !fluxes%ustar(i,j) = MAX(CS%ustar_bg, sqrt(Irho0 * sqrt(taux2 + tauy2)))
1041 
1042  if (associated(fluxes%sw)) fluxes%sw(i,j) = 0.0
1043  if (associated(fluxes%lw)) fluxes%lw(i,j) = 0.0
1044  if (associated(fluxes%latent)) fluxes%latent(i,j) = 0.0
1045  if (associated(fluxes%evap)) fluxes%evap(i,j) = 0.0
1046  if (associated(fluxes%lprec)) then
1047  if (cs%lprec(i,j) > 0.0 ) then
1048  fluxes%lprec(i,j) = frac_area*cs%lprec(i,j)*cs%flux_factor
1049  else
1050  fluxes%lprec(i,j) = 0.0
1051  fluxes%evap(i,j) = frac_area*cs%lprec(i,j)*cs%flux_factor
1052  endif
1053  endif
1054 
1055 
1056  ! Add frazil formation diagnosed by the ocean model (J m-2) in the
1057  ! form of surface layer evaporation (kg m-2 s-1). Update lprec in the
1058  ! control structure for diagnostic purposes.
1059 
1060  if (associated(state%frazil)) then
1061  fraz = state%frazil(i,j) / cs%time_step / cs%Lat_fusion
1062  if (associated(fluxes%evap)) fluxes%evap(i,j) = fluxes%evap(i,j) - fraz
1063  cs%lprec(i,j)=cs%lprec(i,j) - fraz
1064  state%frazil(i,j) = 0.0
1065  endif
1066 
1067  if (associated(fluxes%sens)) fluxes%sens(i,j) = -frac_area*cs%t_flux(i,j)*cs%flux_factor
1068  if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = frac_area * cs%salt_flux(i,j)*cs%flux_factor
1069  if (associated(fluxes%p_surf)) fluxes%p_surf(i,j) = frac_area * cs%g_Earth * cs%mass_shelf(i,j)
1070  ! Same for IOB%p
1071  if (associated(fluxes%p_surf_full) ) fluxes%p_surf_full(i,j) = &
1072  frac_area * cs%g_Earth * cs%mass_shelf(i,j)
1073 
1074  endif
1075  enddo ; enddo
1076 
1077  ! keep sea level constant by removing mass in the sponge
1078  ! region (via virtual precip, vprec). Apply additional
1079  ! salt/heat fluxes so that the resultant surface buoyancy
1080  ! forcing is ~ 0.
1081  ! This is needed for some of the ISOMIP+ experiments.
1082 
1083  if (cs%constant_sea_level) then
1084 
1085  if (.not. associated(fluxes%salt_flux)) allocate(fluxes%salt_flux(ie,je))
1086  if (.not. associated(fluxes%vprec)) allocate(fluxes%vprec(ie,je))
1087  fluxes%salt_flux(:,:) = 0.0; fluxes%vprec(:,:) = 0.0
1088 
1089  mean_melt_flux = 0.0; sponge_area = 0.0
1090  do j=js,je ; do i=is,ie
1091  frac_area = fluxes%frac_shelf_h(i,j)
1092  if (frac_area > 0.0) then
1093  mean_melt_flux = mean_melt_flux + (cs%lprec(i,j)) * cs%area_shelf_h(i,j)
1094  endif
1095 
1096  if (g%geoLonT(i,j) >= 790.0 .AND. g%geoLonT(i,j) <= 800.0) then
1097  sponge_area = sponge_area + g%areaT(i,j)
1098  endif
1099  enddo; enddo
1100 
1101  ! take into account changes in mass (or thickness) when imposing ice shelf mass
1102  if (cs%shelf_mass_is_dynamic .and. cs%override_shelf_movement .and. &
1103  cs%mass_from_file) then
1104  t0 = time_type_to_real(cs%Time) - cs%time_step
1105 
1106  ! just compute changes in mass after first time step
1107  if (t0>0.0) then
1108  time0 = real_to_time_type(t0)
1109  allocate(last_mass_shelf(isd:ied,jsd:jed))
1110  allocate(last_h_shelf(isd:ied,jsd:jed))
1111  allocate(last_area_shelf_h(isd:ied,jsd:jed))
1112  allocate(last_hmask(isd:ied,jsd:jed))
1113  last_hmask(:,:) = cs%hmask(:,:); last_area_shelf_h(:,:) = cs%area_shelf_h(:,:)
1114  call time_interp_external(cs%id_read_mass, time0, last_mass_shelf)
1115  last_h_shelf = last_mass_shelf/cs%density_ice
1116 
1117  ! apply calving
1118  if (cs%min_thickness_simple_calve > 0.0) then
1119  call ice_shelf_min_thickness_calve (cs,last_h_shelf,last_area_shelf_h,last_hmask)
1120  ! convert to mass again
1121  last_mass_shelf = last_h_shelf * cs%density_ice
1122  endif
1123 
1124  shelf_mass0 = 0.0; shelf_mass1 = 0.0
1125  ! get total ice shelf mass at (Time-dt) and (Time), in kg
1126  do j=js,je ; do i=is,ie
1127  ! just floating shelf (0.1 is a threshold for min ocean thickness)
1128  if (((1.0/cs%density_ocean_avg)*state%ocean_mass(i,j) > 0.1) .and. &
1129  (cs%area_shelf_h(i,j) > 0.0)) then
1130 
1131  shelf_mass0 = shelf_mass0 + (last_mass_shelf(i,j) * cs%area_shelf_h(i,j))
1132  shelf_mass1 = shelf_mass1 + (cs%mass_shelf(i,j) * cs%area_shelf_h(i,j))
1133 
1134  endif
1135  enddo; enddo
1136  call mpp_sum(shelf_mass0); call mpp_sum(shelf_mass1)
1137  delta_mass_shelf = (shelf_mass1 - shelf_mass0)/cs%time_step
1138 ! delta_mass_shelf = (shelf_mass1 - shelf_mass0)* &
1139 ! (rho_fw/CS%density_ice)/CS%time_step
1140 ! if (is_root_pe()) write(*,*)'delta_mass_shelf',delta_mass_shelf
1141  else! first time step
1142  delta_mass_shelf = 0.0
1143  endif
1144  else ! ice shelf mass does not change
1145  delta_mass_shelf = 0.0
1146  endif
1147 
1148  call mpp_sum(mean_melt_flux)
1149  call mpp_sum(sponge_area)
1150 
1151  ! average total melt flux over sponge area
1152  mean_melt_flux = (mean_melt_flux+delta_mass_shelf) / sponge_area !kg/(m^2 s)
1153 
1154  ! apply fluxes
1155  do j=js,je ; do i=is,ie
1156  ! Note the following is hard coded for ISOMIP
1157  if (g%geoLonT(i,j) >= 790.0 .AND. g%geoLonT(i,j) <= 800.0) then
1158  fluxes%vprec(i,j) = -mean_melt_flux * cs%density_ice/1000. ! evap is negative
1159  fluxes%sens(i,j) = fluxes%vprec(i,j) * cs%Cp * cs%T0 ! W /m^2
1160  fluxes%salt_flux(i,j) = fluxes%vprec(i,j) * cs%S0*1.0e-3 ! kg (salt)/(m^2 s)
1161  endif
1162  enddo; enddo
1163 
1164  if (cs%DEBUG) then
1165  if (is_root_pe()) write(*,*)'Mean melt flux (kg/(m^2 s)),dt',mean_melt_flux,cs%time_step
1166  call mom_forcing_chksum("After constant sea level", fluxes, g, haloshift=0)
1167  endif
1168 
1169  endif!constant_sea_level
1170 
1171  ! If the shelf mass is changing, the fluxes%rigidity_ice_[uv] needs to be
1172  ! updated here.
1173 
1174  if (cs%shelf_mass_is_dynamic) then
1175  do j=g%jsc,g%jec ; do i=g%isc-1,g%iec
1176  fluxes%rigidity_ice_u(i,j) = (cs%kv_ice / cs%density_ice) * &
1177  max(cs%mass_shelf(i,j), cs%mass_shelf(i+1,j))
1178  enddo ; enddo
1179 
1180  do j=g%jsc-1,g%jec ; do i=g%isc,g%iec
1181  fluxes%rigidity_ice_v(i,j) = (cs%kv_ice / cs%density_ice) * &
1182  max(cs%mass_shelf(i,j), cs%mass_shelf(i,j+1))
1183  enddo ; enddo
1184  endif
1185 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the call graph for this function:
Here is the caller graph for this function:

◆ apply_boundary_values_bilinear()

subroutine mom_ice_shelf::apply_boundary_values_bilinear ( type(ice_shelf_cs), pointer  CS,
type(time_type), intent(in)  time,
real, dimension (:,:,:,:,:,:), pointer  Phisub,
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,
real, dimension (nilimb_sym_,njlimb_sym_), intent(inout)  v_boundary_contr 
)
private

Definition at line 5043 of file MOM_ice_shelf.F90.

References bilinear_shape_functions(), and cg_action_subgrid_basal_bilinear().

Referenced by ice_shelf_solve_inner(), and ice_shelf_solve_outer().

5043 
5044  type(time_type), intent(in) :: time
5045  real, dimension (:,:,:,:,:,:),pointer:: phisub
5046  type(ice_shelf_cs), pointer :: cs
5047  real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent (in) :: h_node
5048  real, dimension (:,:), intent (in) :: float_cond
5049  real :: dens_ratio
5050  real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u_boundary_contr, v_boundary_contr
5051 
5052 ! this will be a per-setup function. the boundary values of thickness and velocity
5053 ! (and possibly other variables) will be updated in this function
5054 
5055  real, pointer, dimension (:,:) :: u_boundary_values, &
5056  v_boundary_values, &
5057  umask, vmask, &
5058  nu, beta, hmask
5059  real, dimension(8,4) :: phi
5060  real, dimension(4) :: x, y
5061  real, dimension(2) :: xquad
5062  type(ocean_grid_type), pointer :: g
5063  integer :: isym, i, j, isc, jsc, iec, jec, iq, jq, iphi, jphi, ilq, jlq
5064  real :: a, n, ux, uy, vx, vy, eps_min, domain_width, dxh, dyh, dxdyh, uq, vq, area, basel
5065  real, dimension(2,2) :: ucell,vcell,hcell,usubcontr,vsubcontr
5066 
5067  g => cs%grid
5068 
5069 ! if (G%symmetric) then
5070 ! isym=1
5071 ! else
5072 ! isym=0
5073 ! endif
5074 
5075  isym = 0
5076 
5077  isc = g%isc ; jsc = g%jsc ; iec = g%iec ; jec = g%jec
5078 
5079  u_boundary_values => cs%u_boundary_values
5080  v_boundary_values => cs%v_boundary_values
5081  umask => cs%umask ; vmask => cs%vmask ; hmask => cs%hmask
5082  nu => cs%ice_visc_bilinear
5083  beta => cs%taub_beta_eff_bilinear
5084 
5085  xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3))
5086 
5087 ! X and Y must be passed in the form
5088  ! 3 - 4
5089  ! | |
5090  ! 1 - 2
5091 ! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j
5092 ! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j
5093 
5094  do j=jsc-1,jec+1 ; do i=isc-1,iec+1 ; if (hmask(i,j) .eq. 1) then
5095 
5096  ! process this cell if any corners have umask set to non-dirichlet bdry.
5097  ! NOTE: vmask not considered, probably should be
5098 
5099  if ((umask(i-1,j-1) .eq. 3) .OR. (umask(i,j-1) .eq. 3) .OR. &
5100  (umask(i-1,j) .eq. 3) .OR. (umask(i,j) .eq. 3)) then
5101 
5102 
5103  dxh = g%dxT(i,j)
5104  dyh = g%dyT(i,j)
5105  dxdyh = g%areaT(i,j)
5106 
5107  x(1:2) = g%geoLonBu (i-1:i,j-1)*1000
5108  x(3:4) = g%geoLonBu (i-1:i,j)*1000
5109  y(1:2) = g%geoLatBu (i-1:i,j-1)*1000
5110  y(3:4) = g%geoLatBu (i-1:i,j)*1000
5111 
5112  call bilinear_shape_functions (x, y, phi, area)
5113 
5114  ! X and Y must be passed in the form
5115  ! 3 - 4
5116  ! | |
5117  ! 1 - 2
5118  ! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j
5119  ! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j
5120 
5121 
5122 
5123  do iq=1,2 ; do jq=1,2
5124 
5125  uq = u_boundary_values(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + &
5126  u_boundary_values(i,j-1) * xquad(iq) * xquad(3-jq) + &
5127  u_boundary_values(i-1,j) * xquad(3-iq) * xquad(jq) + &
5128  u_boundary_values(i,j) * xquad(iq) * xquad(jq)
5129 
5130  vq = v_boundary_values(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + &
5131  v_boundary_values(i,j-1) * xquad(iq) * xquad(3-jq) + &
5132  v_boundary_values(i-1,j) * xquad(3-iq) * xquad(jq) + &
5133  v_boundary_values(i,j) * xquad(iq) * xquad(jq)
5134 
5135  ux = u_boundary_values(i-1,j-1) * phi(1,2*(jq-1)+iq) + &
5136  u_boundary_values(i,j-1) * phi(3,2*(jq-1)+iq) + &
5137  u_boundary_values(i-1,j) * phi(5,2*(jq-1)+iq) + &
5138  u_boundary_values(i,j) * phi(7,2*(jq-1)+iq)
5139 
5140  vx = v_boundary_values(i-1,j-1) * phi(1,2*(jq-1)+iq) + &
5141  v_boundary_values(i,j-1) * phi(3,2*(jq-1)+iq) + &
5142  v_boundary_values(i-1,j) * phi(5,2*(jq-1)+iq) + &
5143  v_boundary_values(i,j) * phi(7,2*(jq-1)+iq)
5144 
5145  uy = u_boundary_values(i-1,j-1) * phi(2,2*(jq-1)+iq) + &
5146  u_boundary_values(i,j-1) * phi(4,2*(jq-1)+iq) + &
5147  u_boundary_values(i-1,j) * phi(6,2*(jq-1)+iq) + &
5148  u_boundary_values(i,j) * phi(8,2*(jq-1)+iq)
5149 
5150  vy = v_boundary_values(i-1,j-1) * phi(2,2*(jq-1)+iq) + &
5151  v_boundary_values(i,j-1) * phi(4,2*(jq-1)+iq) + &
5152  v_boundary_values(i-1,j) * phi(6,2*(jq-1)+iq) + &
5153  v_boundary_values(i,j) * phi(8,2*(jq-1)+iq)
5154 
5155  do iphi=1,2 ; do jphi=1,2
5156 
5157  if (iq .eq. iphi) then
5158  ilq = 2
5159  else
5160  ilq = 1
5161  endif
5162 
5163  if (jq .eq. jphi) then
5164  jlq = 2
5165  else
5166  jlq = 1
5167  endif
5168 
5169  if (umask(i-2+iphi,j-2+jphi) .eq. 1) then
5170 
5171 
5172  u_boundary_contr(i-2+iphi,j-2+jphi) = u_boundary_contr(i-2+iphi,j-2+jphi) + &
5173  .25 * dxdyh * nu(i,j) * ( (4*ux+2*vy) * phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + &
5174  (uy+vx) * phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq) )
5175 
5176  if (float_cond(i,j) .eq. 0) then
5177  u_boundary_contr(i-2+iphi,j-2+jphi) = u_boundary_contr(i-2+iphi,j-2+jphi) + &
5178  .25 * beta(i,j) * dxdyh * uq * xquad(ilq) * xquad(jlq)
5179  endif
5180 
5181  endif
5182 
5183  if (vmask(i-2+iphi,j-2+jphi) .eq. 1) then
5184 
5185 
5186  v_boundary_contr(i-2+iphi,j-2+jphi) = v_boundary_contr(i-2+iphi,j-2+jphi) + &
5187  .25 * dxdyh * nu(i,j) * ( (uy+vx) * phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + &
5188  (4*vy+2*ux) * phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq))
5189 
5190  if (float_cond(i,j) .eq. 0) then
5191  v_boundary_contr(i-2+iphi,j-2+jphi) = v_boundary_contr(i-2+iphi,j-2+jphi) + &
5192  .25 * beta(i,j) * dxdyh * vq * xquad(ilq) * xquad(jlq)
5193  endif
5194 
5195  endif
5196  enddo ; enddo
5197  enddo ; enddo
5198 
5199  if (float_cond(i,j) .eq. 1) then
5200  usubcontr = 0.0 ; vsubcontr = 0.0 ; basel = g%bathyT(i,j)
5201  ucell(:,:) = u_boundary_values(i-1:i,j-1:j) ; vcell(:,:) = v_boundary_values(i-1:i,j-1:j)
5202  hcell(:,:) = h_node(i-1:i,j-1:j)
5203  call cg_action_subgrid_basal_bilinear &
5204  (phisub, hcell, ucell, vcell, dxdyh, basel, dens_ratio, usubcontr, vsubcontr)
5205  do iphi=1,2 ; do jphi = 1,2
5206  if (umask(i-2+iphi,j-2+jphi) .eq. 1) then
5207  u_boundary_contr(i-2+iphi,j-2+jphi) = u_boundary_contr(i-2+iphi,j-2+jphi) + &
5208  usubcontr(iphi,jphi) * beta(i,j)
5209  endif
5210  if (vmask(i-2+iphi,j-2+jphi) .eq. 1) then
5211  v_boundary_contr(i-2+iphi,j-2+jphi) = v_boundary_contr(i-2+iphi,j-2+jphi) + &
5212  vsubcontr(iphi,jphi) * beta(i,j)
5213  endif
5214  enddo ; enddo
5215  endif
5216  endif
5217  endif ; enddo ; enddo
5218 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the call graph for this function:
Here is the caller graph for this function:

◆ apply_boundary_values_triangle()

subroutine mom_ice_shelf::apply_boundary_values_triangle ( type(ice_shelf_cs), pointer  CS,
type(time_type), intent(in)  time,
real, dimension (:,:), intent(inout)  u_boundary_contr,
real, dimension (:,:), intent(inout)  v_boundary_contr 
)
private

Definition at line 4866 of file MOM_ice_shelf.F90.

Referenced by ice_shelf_solve_inner(), and ice_shelf_solve_outer().

4866 
4867  type(time_type), intent(in) :: time
4868  type(ice_shelf_cs), pointer :: cs
4869  real, dimension (:,:), intent(inout) :: u_boundary_contr, v_boundary_contr
4870 
4871 ! this will be a per-setup function. the boundary values of thickness and velocity
4872 ! (and possibly other variables) will be updated in this function
4873 
4874  real, pointer, dimension (:,:) :: u_boundary_values, &
4875  v_boundary_values, &
4876  umask, vmask, hmask, &
4877  nu_lower, nu_upper, beta_lower, beta_upper
4878  type(ocean_grid_type), pointer :: g
4879  integer :: isym, i, j, cnt, isc, jsc, iec, jec
4880  real :: a, n, ux, uy, vx, vy, eps_min, domain_width, dxh, dyh, dxdyh
4881 
4882  g => cs%grid
4883 
4884 ! if (G%symmetric) then
4885 ! isym=1
4886 ! else
4887 ! isym=0
4888 ! endif
4889 
4890  isym = 0
4891 
4892  isc = g%isc ; jsc = g%jsc ; iec = g%iec ; jec = g%jec
4893 
4894  u_boundary_values => cs%u_boundary_values
4895  v_boundary_values => cs%v_boundary_values
4896  umask => cs%umask ; vmask => cs%vmask ; hmask => cs%hmask
4897  nu_lower => cs%ice_visc_lower_tri ; nu_upper => cs%ice_visc_upper_tri
4898  beta_lower => cs%taub_beta_eff_lower_tri ; beta_upper => cs%taub_beta_eff_upper_tri
4899 
4900  domain_width = cs%len_lat
4901 
4902  do i=isc-1,iec+1 ; do j=jsc-1,jec+1 ; if (hmask(i,j) .eq. 1) then
4903 
4904  if ((umask(i-1,j-1) .eq. 3) .OR. (umask(i,j-1) .eq. 3) .OR. (umask(i-1,j) .eq. 3)) then
4905 
4906  dxh = g%dxT(i,j)
4907  dyh = g%dyT(i,j)
4908  dxdyh = g%areaT(i,j)
4909 
4910  ux = (u_boundary_values(i,j-1)-u_boundary_values(i-1,j-1))/dxh
4911  vx = (v_boundary_values(i,j-1)-v_boundary_values(i-1,j-1))/dxh
4912  uy = (u_boundary_values(i-1,j)-u_boundary_values(i-1,j-1))/dyh
4913  vy = (v_boundary_values(i-1,j)-v_boundary_values(i-1,j-1))/dyh
4914 
4915  if (umask(i,j-1) .eq. 1) then ! this (bot right) is a degree of freedom node
4916 
4917  u_boundary_contr(i,j-1) = u_boundary_contr(i,j-1) + &
4918  .5 * dxdyh * nu_lower(i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (0./dyh))
4919 
4920  v_boundary_contr(i,j-1) = v_boundary_contr(i,j-1) + &
4921  .5 * dxdyh * nu_lower(i,j) * ((uy+vx) * (1./dxh) + (4*vy+2*ux) * (0./dyh))
4922 
4923  u_boundary_contr(i,j-1) = u_boundary_contr(i,j-1) + &
4924  beta_lower(i,j) * dxdyh * 1./24 * (u_boundary_values(i-1,j-1) + &
4925  u_boundary_values(i-1,j) + u_boundary_values(i,j-1))
4926 
4927  v_boundary_contr(i,j-1) = v_boundary_contr(i,j-1) + &
4928  beta_lower(i,j) * dxdyh * 1./24 * (v_boundary_values(i-1,j-1) + &
4929  v_boundary_values(i-1,j) + v_boundary_values(i,j-1))
4930  endif
4931 
4932  if (umask(i-1,j) .eq. 1) then ! this (top left) is a degree of freedom node
4933 
4934  u_boundary_contr(i-1,j) = u_boundary_contr(i-1,j) + &
4935  .5 * dxdyh * nu_lower(i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (1./dyh))
4936 
4937  v_boundary_contr(i-1,j) = v_boundary_contr(i-1,j) + &
4938  .5 * dxdyh * nu_lower(i,j) * ((uy+vx) * (0./dxh) + (4*vy+2*ux) * (1./dyh))
4939 
4940  u_boundary_contr(i,j-1) = u_boundary_contr(i,j-1) + &
4941  beta_lower(i,j) * dxdyh * 1./24 * (u_boundary_values(i-1,j-1) + &
4942  u_boundary_values(i-1,j) + u_boundary_values(i,j-1))
4943 
4944  v_boundary_contr(i,j-1) = v_boundary_contr(i,j-1) + &
4945  beta_lower(i,j) * dxdyh * 1./24 * (v_boundary_values(i-1,j-1) + &
4946  v_boundary_values(i-1,j) + v_boundary_values(i,j-1))
4947  endif
4948 
4949  if (umask(i-1,j-1) .eq. 1) then ! this (bot left) is a degree of freedom node
4950 
4951  u_boundary_contr(i-1,j-1) = u_boundary_contr(i-1,j-1) + &
4952  .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (-1./dyh))
4953 
4954  v_boundary_contr(i-1,j-1) = v_boundary_contr(i-1,j-1) + &
4955  .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (-1./dxh) + (4*vy+2*ux) * (-1./dyh))
4956 
4957  u_boundary_contr(i-1,j-1) = u_boundary_contr(i-1,j-1) + &
4958  beta_lower(i,j) * dxdyh * 1./24 * (u_boundary_values(i-1,j-1) + &
4959  u_boundary_values(i-1,j) + u_boundary_values(i,j-1))
4960 
4961  v_boundary_contr(i-1,j-1) = v_boundary_contr(i-1,j-1) + &
4962  beta_lower(i,j) * dxdyh * 1./24 * (v_boundary_values(i-1,j-1) + &
4963  v_boundary_values(i-1,j) + v_boundary_values(i,j-1))
4964  endif
4965 
4966  endif
4967 
4968  if ((umask(i,j) .eq. 3) .OR. (umask(i,j-1) .eq. 3) .OR. (umask(i-1,j) .eq. 3)) then
4969 
4970  dxh = g%dxT(i,j)
4971  dyh = g%dyT(i,j)
4972  dxdyh = g%areaT(i,j)
4973 
4974  ux = (u_boundary_values(i,j)-u_boundary_values(i-1,j))/dxh
4975  vx = (v_boundary_values(i,j)-v_boundary_values(i-1,j))/dxh
4976  uy = (u_boundary_values(i,j)-u_boundary_values(i,j-1))/dyh
4977  vy = (v_boundary_values(i,j)-v_boundary_values(i,j-1))/dyh
4978 
4979  if (umask(i,j-1) .eq. 1) then ! this (bot right) is a degree of freedom node
4980 
4981  u_boundary_contr(i,j-1) = u_boundary_contr(i,j-1) + &
4982  .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (-1./dyh))
4983 
4984  v_boundary_contr(i,j-1) = v_boundary_contr(i,j-1) + &
4985  .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (0./dxh) + (4*vy+2*ux) * (-1./dyh))
4986 
4987  u_boundary_contr(i,j-1) = u_boundary_contr(i,j-1) + &
4988  beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + &
4989  u_boundary_values(i-1,j) + &
4990  u_boundary_values(i,j-1))
4991 
4992  v_boundary_contr(i,j-1) = v_boundary_contr(i,j-1) + &
4993  beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + &
4994  u_boundary_values(i-1,j) + &
4995  u_boundary_values(i,j-1))
4996  endif
4997 
4998  if (umask(i-1,j) .eq. 1) then ! this (top left) is a degree of freedom node
4999 
5000  u_boundary_contr(i-1,j) = u_boundary_contr(i-1,j) + &
5001  .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (0./dyh))
5002 
5003  v_boundary_contr(i-1,j) = v_boundary_contr(i-1,j) + &
5004  .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (-1./dxh) + (4*vy+2*ux) * (0./dyh))
5005 
5006  u_boundary_contr(i,j-1) = u_boundary_contr(i,j-1) + &
5007  beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + &
5008  u_boundary_values(i-1,j) + &
5009  u_boundary_values(i,j-1))
5010 
5011  v_boundary_contr(i,j-1) = v_boundary_contr(i,j-1) + &
5012  beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + &
5013  u_boundary_values(i-1,j) + &
5014  u_boundary_values(i,j-1))
5015  endif
5016 
5017  if (umask(i,j) .eq. 1) then ! this (top right) is a degree of freedom node
5018 
5019  u_boundary_contr(i,j) = u_boundary_contr(i,j) + &
5020  .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (1./dyh))
5021 
5022  v_boundary_contr(i,j) = v_boundary_contr(i,j) + &
5023  .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (1./dxh) + (4*vy+2*ux) * (1./dyh))
5024 
5025  u_boundary_contr(i,j) = u_boundary_contr(i,j) + &
5026  beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + &
5027  u_boundary_values(i-1,j) + &
5028  u_boundary_values(i,j-1))
5029 
5030  v_boundary_contr(i,j) = v_boundary_contr(i,j) + &
5031  beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + &
5032  u_boundary_values(i-1,j) + &
5033  u_boundary_values(i,j-1))
5034  endif
5035 
5036 
5037  endif
5038  endif ; enddo ; enddo
5039 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the caller graph for this function:

◆ bilinear_shape_functions()

subroutine mom_ice_shelf::bilinear_shape_functions ( real, dimension(4), intent(in)  X,
real, dimension(4), intent(in)  Y,
real, dimension(8,4), intent(inout)  Phi,
real, intent(out)  area 
)
private

Definition at line 5457 of file MOM_ice_shelf.F90.

References quad_area().

Referenced by apply_boundary_values_bilinear(), ice_shelf_solve_outer(), and matrix_diagonal_bilinear().

5457  real, dimension(4), intent(in) :: x, y
5458  real, dimension(8,4), intent (inout) :: phi
5459  real, intent (out) :: area
5460 
5461 ! X and Y must be passed in the form
5462  ! 3 - 4
5463  ! | |
5464  ! 1 - 2
5465 
5466 ! this subroutine calculates the gradients of bilinear basis elements that
5467 ! that are centered at the vertices of the cell. values are calculated at
5468 ! points of gaussian quadrature. (in 1D: .5 * (1 +/- sqrt(1/3)) for [0,1])
5469 ! (ordered in same way as vertices)
5470 !
5471 ! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j
5472 ! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j
5473 ! Phi_i is equal to 1 at vertex i, and 0 at vertex k .ne. i, and bilinear
5474 !
5475 ! This should be a one-off; once per nonlinear solve? once per lifetime?
5476 ! ... will all cells have the same shape and dimension?
5477 
5478  real, dimension (4) :: xquad, yquad
5479  integer :: node, qpoint, xnode, xq, ynode, yq
5480  real :: a,b,c,d,e,f,xexp,yexp
5481 
5482  xquad(1:3:2) = .5 * (1-sqrt(1./3)) ; yquad(1:2) = .5 * (1-sqrt(1./3))
5483  xquad(2:4:2) = .5 * (1+sqrt(1./3)) ; yquad(3:4) = .5 * (1+sqrt(1./3))
5484 
5485  do qpoint=1,4
5486 
5487  a = -x(1)*(1-yquad(qpoint)) + x(2)*(1-yquad(qpoint)) - x(3)*yquad(qpoint) + x(4)*yquad(qpoint) ! d(x)/d(x*)
5488  b = -y(1)*(1-yquad(qpoint)) + y(2)*(1-yquad(qpoint)) - y(3)*yquad(qpoint) + y(4)*yquad(qpoint) ! d(y)/d(x*)
5489  c = -x(1)*(1-xquad(qpoint)) - x(2)*(xquad(qpoint)) + x(3)*(1-xquad(qpoint)) + x(4)*(xquad(qpoint)) ! d(x)/d(y*)
5490  d = -y(1)*(1-xquad(qpoint)) - y(2)*(xquad(qpoint)) + y(3)*(1-xquad(qpoint)) + y(4)*(xquad(qpoint)) ! d(y)/d(y*)
5491 
5492  do node=1,4
5493 
5494  xnode = 2-mod(node,2) ; ynode = ceiling(REAL(node)/2)
5495 
5496  if (ynode .eq. 1) then
5497  yexp = 1-yquad(qpoint)
5498  else
5499  yexp = yquad(qpoint)
5500  endif
5501 
5502  if (1 .eq. xnode) then
5503  xexp = 1-xquad(qpoint)
5504  else
5505  xexp = xquad(qpoint)
5506  endif
5507 
5508  phi(2*node-1,qpoint) = ( d * (2 * xnode - 3) * yexp - b * (2 * ynode - 3) * xexp) / (a*d-b*c)
5509  phi(2*node,qpoint) = ( -c * (2 * xnode - 3) * yexp + a * (2 * ynode - 3) * xexp) / (a*d-b*c)
5510 
5511  enddo
5512  enddo
5513 
5514  area = quad_area(x,y)
5515 
Here is the call graph for this function:
Here is the caller graph for this function:

◆ bilinear_shape_functions_subgrid()

subroutine mom_ice_shelf::bilinear_shape_functions_subgrid ( real, dimension(nsub,nsub,2,2,2,2), intent(inout)  Phisub,
integer  nsub 
)
private

Definition at line 5520 of file MOM_ice_shelf.F90.

Referenced by ice_shelf_solve_outer().

5520  real, dimension(nsub,nsub,2,2,2,2), intent(inout) :: phisub
5521  integer :: nsub
5522 
5523  ! this subroutine is a helper for interpolation of floatation condition
5524  ! for the purposes of evaluating the terms \int (u,v) \phi_i dx dy in a cell that is
5525  ! in partial floatation
5526  ! the array Phisub contains the values of \phi_i (where i is a node of the cell)
5527  ! at quad point j
5528  ! i think this general approach may not work for nonrectangular elements...
5529  !
5530 
5531  ! Phisub (i,j,k,l,q1,q2)
5532  ! i: subgrid index in x-direction
5533  ! j: subgrid index in y-direction
5534  ! k: basis function x-index
5535  ! l: basis function y-index
5536  ! q1: quad point x-index
5537  ! q2: quad point y-index
5538 
5539  ! e.g. k=1,l=1 => node 1
5540  ! q1=2,q2=1 => quad point 2
5541 
5542  ! 3 - 4
5543  ! | |
5544  ! 1 - 2
5545 
5546 
5547 
5548  integer :: i, j, k, l, qx, qy, indx, indy
5549  real,dimension(2) :: xquad
5550  real :: x0, y0, x, y, val, fracx
5551 
5552  xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3))
5553  fracx = 1.0/real(nsub)
5554 
5555  do j=1,nsub
5556  do i=1,nsub
5557  x0 = (i-1) * fracx ; y0 = (j-1) * fracx
5558  do qx=1,2
5559  do qy=1,2
5560  x = x0 + fracx*xquad(qx)
5561  y = y0 + fracx*xquad(qy)
5562  do k=1,2
5563  do l=1,2
5564  val = 1.0
5565  if (k .eq. 1) then
5566  val = val * (1.0-x)
5567  else
5568  val = val * x
5569  endif
5570  if (l .eq. 1) then
5571  val = val * (1.0-y)
5572  else
5573  val = val * y
5574  endif
5575  phisub(i,j,k,l,qx,qy) = val
5576  enddo
5577  enddo
5578  enddo
5579  enddo
5580  enddo
5581  enddo
5582 
5583 ! 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)
5584 
5585 
Here is the caller graph for this function:

◆ calc_shelf_driving_stress()

subroutine mom_ice_shelf::calc_shelf_driving_stress ( type(ice_shelf_cs), pointer  CS,
real, dimension( : , : ), intent(inout)  TAUD_X,
real, dimension( : , : ), intent(inout)  TAUD_Y,
real, dimension(:,:), intent(in)  OD,
integer, intent(in)  FE 
)
private

Definition at line 3813 of file MOM_ice_shelf.F90.

References savearray2().

Referenced by ice_shelf_solve_outer().

3813  type(ice_shelf_cs), pointer :: cs
3814  real, dimension(:,:), intent(in) :: od
3815  real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: taud_x, taud_y
3816  integer, intent(in) :: fe
3817 
3818 ! driving stress!
3819 
3820 ! ! TAUD_X and TAUD_Y will hold driving stress in the x- and y- directions when done.
3821 ! they will sit on the BGrid, and so their size depends on whether the grid is symmetric
3822 !
3823 ! Since this is a finite element solve, they will actually have the form \int \phi_i rho g h \nabla s
3824 !
3825 ! OD -this is important and we do not yet know where (in MOM) it will come from. It represents
3826 ! "average" ocean depth -- and is needed to find surface elevation
3827 ! (it is assumed that base_ice = bed + OD)
3828 
3829 ! FE : 1 if bilinear, 2 if triangular linear FE
3830 
3831  real, dimension (:,:), pointer :: d, & ! ocean floor depth
3832  h, & ! ice shelf thickness
3833  hmask, u_face_mask, v_face_mask, float_frac
3834  real, dimension (SIZE(OD,1),SIZE(OD,2)) :: s, & ! surface elevation
3835  base ! basal elevation of shelf/stream
3836  character(1) :: procnum
3837 
3838 
3839  real :: rho, rhow, sx, sy, neumann_val, dxh, dyh, dxdyh
3840 
3841  type(ocean_grid_type), pointer :: g
3842  integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec
3843  integer :: i_off, j_off
3844 
3845  g => cs%grid
3846 
3847  isym = 0
3848  isc = g%isc ; jsc = g%jsc ; iec = g%iec ; jec = g%jec
3849  iscq = g%iscB ; iecq = g%iecB ; jscq = g%jscB ; jecq = g%jecB
3850  isd = g%isd ; jsd = g%jsd
3851  iegq = g%iegB ; jegq = g%jegB
3852  gisc = g%domain%nihalo+1 ; gjsc = g%domain%njhalo+1
3853  giec = g%domain%niglobal+g%domain%nihalo ; gjec = g%domain%njglobal+g%domain%njhalo
3854  is = iscq - (1-isym); js = jscq - (1-isym)
3855  i_off = g%idg_offset ; j_off = g%jdg_offset
3856 
3857  d => g%bathyT
3858  h => cs%h_shelf
3859  float_frac => cs%float_frac
3860  hmask => cs%hmask
3861  u_face_mask => cs%u_face_mask
3862  v_face_mask => cs%v_face_mask
3863  rho = cs%density_ice
3864  rhow = cs%density_ocean_avg
3865 
3866  call savearray2 ("H",h,cs%write_output_to_file)
3867 ! call savearray2 ("hmask",hmask,CS%write_output_to_file)
3868  call savearray2 ("u_face_mask", cs%u_face_mask_boundary,cs%write_output_to_file)
3869  call savearray2 ("umask", cs%umask,cs%write_output_to_file)
3870  call savearray2 ("v_face_mask", cs%v_face_mask_boundary,cs%write_output_to_file)
3871  call savearray2 ("vmask", cs%vmask,cs%write_output_to_file)
3872 
3873 ! if (G%symmetric) then
3874 ! isym=1
3875 ! else
3876 ! isym=0
3877 ! endif
3878 
3879  isym = 0
3880 
3881  ! prelim - go through and calculate S
3882 
3883  ! or is this faster?
3884  base(:,:) = -d(:,:) + od(:,:)
3885  s(:,:) = base(:,:) + h(:,:)
3886 
3887 ! write (procnum,'(I1)') mpp_pe()
3888 
3889  do j=jsc-1,jec+1
3890  do i=isc-1,iec+1
3891  cnt = 0
3892  sx = 0
3893  sy = 0
3894  dxh = g%dxT(i,j)
3895  dyh = g%dyT(i,j)
3896  dxdyh = g%areaT(i,j)
3897 ! print *,dxh," ",dyh," ",dxdyh
3898 
3899  if (hmask(i,j) .eq. 1) then ! we are inside the global computational bdry, at an ice-filled cell
3900 
3901  ! calculate sx
3902  if ((i+i_off) .eq. gisc) then ! at left computational bdry
3903  if (hmask(i+1,j) .eq. 1) then
3904  sx = (s(i+1,j)-s(i,j))/dxh
3905  else
3906  sx = 0
3907  endif
3908  elseif ((i+i_off) .eq. giec) then ! at right computational bdry
3909  if (hmask(i-1,j) .eq. 1) then
3910  sx = (s(i,j)-s(i-1,j))/dxh
3911  else
3912  sx=0
3913  endif
3914  else ! interior
3915  if (hmask(i+1,j) .eq. 1) then
3916  cnt = cnt+1
3917  sx = s(i+1,j)
3918  else
3919  sx = s(i,j)
3920  endif
3921  if (hmask(i-1,j) .eq. 1) then
3922  cnt = cnt+1
3923  sx = sx - s(i-1,j)
3924  else
3925  sx = sx - s(i,j)
3926  endif
3927  if (cnt .eq. 0) then
3928  sx=0
3929  else
3930  sx = sx / (cnt * dxh)
3931  endif
3932  endif
3933 
3934  cnt = 0
3935 
3936  ! calculate sy, similarly
3937  if ((j+j_off) .eq. gjsc) then ! at south computational bdry
3938  if (hmask(i,j+1) .eq. 1) then
3939  sy = (s(i,j+1)-s(i,j))/dyh
3940  else
3941  sy = 0
3942  endif
3943  elseif ((j+j_off) .eq. gjec) then ! at nprth computational bdry
3944  if (hmask(i,j-1) .eq. 1) then
3945  sy = (s(i,j)-s(i,j-1))/dyh
3946  else
3947  sy = 0
3948  endif
3949  else ! interior
3950  if (hmask(i,j+1) .eq. 1) then
3951  cnt = cnt+1
3952  sy = s(i,j+1)
3953  else
3954  sy = s(i,j)
3955  endif
3956  if (hmask(i,j-1) .eq. 1) then
3957  cnt = cnt+1
3958  sy = sy - s(i,j-1)
3959  else
3960  sy = sy - s(i,j)
3961  endif
3962  if (cnt .eq. 0) then
3963  sy=0
3964  else
3965  sy = sy / (cnt * dyh)
3966  endif
3967  endif
3968 
3969 
3970  if (fe .eq. 1) then
3971 
3972  ! SW vertex
3973  taud_x(i-1,j-1) = taud_x(i-1,j-1) - .25 * rho * grav * h(i,j) * sx * dxdyh
3974  taud_y(i-1,j-1) = taud_y(i-1,j-1) - .25 * rho * grav * h(i,j) * sy * dxdyh
3975 
3976  ! SE vertex
3977  taud_x(i,j-1) = taud_x(i,j-1) - .25 * rho * grav * h(i,j) * sx * dxdyh
3978  taud_y(i,j-1) = taud_y(i,j-1) - .25 * rho * grav * h(i,j) * sy * dxdyh
3979 
3980  ! NW vertex
3981  taud_x(i-1,j) = taud_x(i-1,j) - .25 * rho * grav * h(i,j) * sx * dxdyh
3982  taud_y(i-1,j) = taud_y(i-1,j) - .25 * rho * grav * h(i,j) * sy * dxdyh
3983 
3984  ! NE vertex
3985  taud_x(i,j) = taud_x(i,j) - .25 * rho * grav * h(i,j) * sx * dxdyh
3986  taud_y(i,j) = taud_y(i,j) - .25 * rho * grav * h(i,j) * sy * dxdyh
3987 
3988 
3989  else
3990 
3991  ! SW vertex
3992  taud_x(i-1,j-1) = taud_x(i-1,j-1) - (1./6) * rho * grav * h(i,j) * sx * dxdyh
3993  taud_y(i-1,j-1) = taud_y(i-1,j-1) - (1./6) * rho * grav * h(i,j) * sy * dxdyh
3994 
3995  ! SE vertex
3996  taud_x(i,j-1) = taud_x(i,j-1) - (1./3) * rho * grav * h(i,j) * sx * dxdyh
3997  taud_y(i,j-1) = taud_y(i,j-1) - (1./3) * rho * grav * h(i,j) * sy * dxdyh
3998 
3999  ! NW vertex
4000  taud_x(i-1,j) = taud_x(i-1,j) - (1./3) * rho * grav * h(i,j) * sx * dxdyh
4001  taud_y(i-1,j) = taud_y(i-1,j) - (1./3) * rho * grav * h(i,j) * sy * dxdyh
4002 
4003  ! NE vertex
4004  taud_x(i,j) = taud_x(i,j) - (1./6) * rho * grav * h(i,j) * sx * dxdyh
4005  taud_y(i,j) = taud_y(i,j) - (1./6) * rho * grav * h(i,j) * sy * dxdyh
4006 
4007  endif
4008 
4009  if (float_frac(i,j) .eq. 1) then
4010  neumann_val = .5 * grav * (rho * h(i,j) ** 2 - rhow * d(i,j) ** 2)
4011  else
4012  neumann_val = .5 * grav * (1-rho/rhow) * rho * h(i,j) ** 2
4013  endif
4014 
4015 
4016  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
4017  ! the depth-integrated longitudinal stress is equal to the difference of depth-integrated pressure on either side of the face
4018  ! on the ice side, it is rho g h^2 / 2
4019  ! on the ocean side, it is rhow g (delta OD)^2 / 2
4020  ! 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
4021  ! ice in the current cell
4022  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
4023  taud_x(i-1,j) = taud_x(i-1,j) - .5 * dyh * neumann_val
4024  endif
4025 
4026  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
4027  taud_x(i,j-1) = taud_x(i,j-1) + .5 * dyh * neumann_val
4028  taud_x(i,j) = taud_x(i,j) + .5 * dyh * neumann_val
4029  endif
4030 
4031  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
4032  taud_y(i-1,j-1) = taud_y(i-1,j-1) - .5 * dxh * neumann_val
4033  taud_y(i,j-1) = taud_y(i,j-1) - .5 * dxh * neumann_val
4034  endif
4035 
4036  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
4037  taud_y(i-1,j) = taud_y(i-1,j) + .5 * dxh * neumann_val ! note negative sign is due to direction of normal vector
4038  taud_y(i,j) = taud_y(i,j) + .5 * dxh * neumann_val
4039  endif
4040 
4041  endif
4042  enddo
4043  enddo
4044 
4045 
4046 ! call savearray2 ("Taux"//"p"//procnum,taud_x,CS%write_output_to_file)
4047 ! call savearray2 ("Tauy"//"p"//procnum,taud_y,CS%write_output_to_file)
4048 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the call graph for this function:
Here is the caller graph for this function:

◆ calc_shelf_visc_bilinear()

subroutine mom_ice_shelf::calc_shelf_visc_bilinear ( type(ice_shelf_cs), pointer  CS,
real, dimension(nilimb_sym_,njlimb_sym_), intent(inout)  u,
real, dimension(nilimb_sym_,njlimb_sym_), intent(inout)  v 
)
private

Definition at line 5305 of file MOM_ice_shelf.F90.

Referenced by ice_shelf_solve_outer().

5305  type(ice_shelf_cs), pointer :: cs
5306  real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u, v
5307 
5308 ! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for triangle FEM solve so there is
5309 ! an "upper" and "lower" triangular viscosity
5310 
5311 ! also this subroutine updates the nonlinear part of the basal traction
5312 
5313 ! this may be subject to change later... to make it "hybrid"
5314 
5315  real, pointer, dimension (:,:) :: nu, &
5316  beta
5317  real, pointer, dimension (:,:) :: h, &! thickness
5318  hmask
5319 
5320  type(ocean_grid_type), pointer :: g
5321  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
5322  real :: a, n, ux, uy, vx, vy, eps_min, umid, vmid, unorm, c_basal_friction, n_basal_friction, dxh, dyh, dxdyh
5323 
5324  g => cs%grid
5325 
5326  isym=0
5327  isc = g%isc ; jsc = g%jsc ; iec = g%iec ; jec = g%jec
5328  iscq = g%iscB ; iecq = g%iecB ; jscq = g%jscB ; jecq = g%jecB
5329  isd = g%isd ; jsd = g%jsd ; ied = g%ied ; jed = g%jed
5330  iegq = g%iegB ; jegq = g%jegB
5331  gisc = g%domain%nihalo+1 ; gjsc = g%domain%njhalo+1
5332  giec = g%domain%niglobal+gisc ; gjec = g%domain%njglobal+gjsc
5333  is = iscq - (1-isym); js = jscq - (1-isym)
5334 
5335  a = cs%A_glen_isothermal ; n = cs%n_glen; eps_min = cs%eps_glen_min
5336  c_basal_friction = cs%C_basal_friction ; n_basal_friction = cs%n_basal_friction
5337 
5338  h => cs%h_shelf
5339  hmask => cs%hmask
5340  nu => cs%ice_visc_bilinear
5341  beta => cs%taub_beta_eff_bilinear
5342 
5343  do j=jsd+1,jed-1
5344  do i=isd+1,ied-1
5345 
5346  dxh = g%dxT(i,j)
5347  dyh = g%dyT(i,j)
5348  dxdyh = g%areaT(i,j)
5349 
5350  if (hmask(i,j) .eq. 1) then
5351  ux = (u(i,j) + u(i,j-1) - u(i-1,j) - u(i-1,j-1)) / (2*dxh)
5352  vx = (v(i,j) + v(i,j-1) - v(i-1,j) - v(i-1,j-1)) / (2*dxh)
5353  uy = (u(i,j) - u(i,j-1) + u(i-1,j) - u(i-1,j-1)) / (2*dyh)
5354  vy = (v(i,j) - v(i,j-1) + v(i-1,j) - v(i-1,j-1)) / (2*dyh)
5355 
5356  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)
5357 
5358  umid = (u(i,j) + u(i,j-1) + u(i-1,j) + u(i-1,j-1))/4
5359  vmid = (v(i,j) + v(i,j-1) + v(i-1,j) + v(i-1,j-1))/4
5360  unorm = sqrt(umid**2+vmid**2+(eps_min*dxh)**2) ; beta(i,j) = c_basal_friction * unorm ** (n_basal_friction-1)
5361  endif
5362  enddo
5363  enddo
5364 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the caller graph for this function:

◆ calc_shelf_visc_triangular()

subroutine mom_ice_shelf::calc_shelf_visc_triangular ( type(ice_shelf_cs), pointer  CS,
real, dimension(:,:), intent(inout)  u,
real, dimension(:,:), intent(inout)  v 
)
private

Definition at line 5222 of file MOM_ice_shelf.F90.

Referenced by ice_shelf_solve_outer().

5222  type(ice_shelf_cs), pointer :: cs
5223  real, dimension(:,:), intent(inout) :: u, v
5224 
5225 ! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for triangle FEM solve so there is
5226 ! an "upper" and "lower" triangular viscosity
5227 
5228 ! also this subroutine updates the nonlinear part of the basal traction
5229 
5230 ! this may be subject to change later... to make it "hybrid"
5231 
5232  real, pointer, dimension (:,:) :: nu_lower , &
5233  nu_upper, &
5234  beta_eff_lower, &
5235  beta_eff_upper
5236  real, pointer, dimension (:,:) :: h, &! thickness
5237  hmask
5238 
5239  type(ocean_grid_type), pointer :: g
5240  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
5241  real :: a, n, ux, uy, vx, vy, eps_min, umid, vmid, unorm, c_basal_friction, n_basal_friction, dxh, dyh, dxdyh
5242 
5243  g => cs%grid
5244 
5245  if (g%symmetric) then
5246  isym = 1
5247  else
5248  isym = 0
5249  endif
5250 
5251  isc = g%isc ; jsc = g%jsc ; iec = g%iec ; jec = g%jec
5252  iscq = g%iscB ; iecq = g%iecB ; jscq = g%jscB ; jecq = g%jecB
5253  isd = g%isd ; jsd = g%jsd ; ied = g%isd ; jed = g%jsd
5254  iegq = g%iegB ; jegq = g%jegB
5255  gisc = g%domain%nihalo+1 ; gjsc = g%domain%njhalo+1
5256  giec = g%domain%niglobal+gisc ; gjec = g%domain%njglobal+gjsc
5257  is = iscq - (1-isym); js = jscq - (1-isym)
5258 
5259  a = cs%A_glen_isothermal ; n = cs%n_glen; eps_min = cs%eps_glen_min
5260 
5261  h => cs%h_shelf
5262  hmask => cs%hmask
5263  nu_upper => cs%ice_visc_upper_tri
5264  nu_lower => cs%ice_visc_lower_tri
5265  beta_eff_upper => cs%taub_beta_eff_upper_tri
5266  beta_eff_lower => cs%taub_beta_eff_lower_tri
5267 
5268  c_basal_friction = cs%C_basal_friction ; n_basal_friction = cs%n_basal_friction
5269 
5270  do i=isd,ied
5271  do j=jsd,jed
5272 
5273  dxh = g%dxT(i,j)
5274  dyh = g%dyT(i,j)
5275  dxdyh = g%areaT(i,j)
5276 
5277  if (hmask(i,j) .eq. 1) then
5278  ux = (u(i,j-1)-u(i-1,j-1)) / dxh
5279  vx = (v(i,j-1)-v(i-1,j-1)) / dxh
5280  uy = (u(i-1,j)-u(i-1,j-1)) / dyh
5281  vy = (v(i-1,j)-v(i-1,j-1)) / dyh
5282 
5283  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)
5284  umid = 1./3 * (u(i-1,j-1)+u(i-1,j)+u(i,j-1))
5285  vmid = 1./3 * (v(i-1,j-1)+v(i-1,j)+v(i,j-1))
5286  unorm = sqrt(umid**2+vmid**2+(eps_min*dxh)**2) ; beta_eff_lower(i,j) = c_basal_friction * unorm ** (n_basal_friction-1)
5287 
5288  ux = (u(i,j)-u(i-1,j)) / dxh
5289  vx = (v(i,j)-v(i-1,j)) / dxh
5290  uy = (u(i,j)-u(i,j-1)) / dyh
5291  vy = (u(i,j)-u(i,j-1)) / dyh
5292 
5293  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)
5294  umid = 1./3 * (u(i,j)+u(i-1,j)+u(i,j-1))
5295  vmid = 1./3 * (v(i,j)+v(i-1,j)+v(i,j-1))
5296  unorm = sqrt(umid**2+vmid**2+(eps_min*dxh)**2) ; beta_eff_upper(i,j) = c_basal_friction * unorm ** (n_basal_friction-1)
5297 
5298  endif
5299  enddo
5300  enddo
5301 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the caller graph for this function:

◆ calve_to_mask()

subroutine mom_ice_shelf::calve_to_mask ( type(ice_shelf_cs), pointer  CS,
real, dimension(:,:), intent(inout)  h_shelf,
real, dimension(:,:), intent(inout)  area_shelf_h,
real, dimension(:,:), intent(inout)  hmask,
real, dimension(:,:), intent(inout)  calve_mask 
)
private

Definition at line 3790 of file MOM_ice_shelf.F90.

Referenced by ice_shelf_advect().

3790  type(ice_shelf_cs), pointer :: cs
3791  real, dimension(:,:), intent(inout) :: h_shelf, area_shelf_h, hmask, calve_mask
3792 
3793  type(ocean_grid_type), pointer :: g
3794  integer :: i,j
3795 
3796  g => cs%grid
3797 
3798  if (cs%calve_to_mask) then
3799  do j=g%jsc,g%jec
3800  do i=g%isc,g%iec
3801  if ((calve_mask(i,j) .eq. 0.0) .and. (hmask(i,j) .ne. 0.0)) then
3802  h_shelf(i,j) = 0.0
3803  area_shelf_h(i,j) = 0.0
3804  hmask(i,j) = 0.0
3805  endif
3806  enddo
3807  enddo
3808  endif
3809 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the caller graph for this function:

◆ cg_action_bilinear()

subroutine mom_ice_shelf::cg_action_bilinear ( real, dimension (nilimb_sym_,njlimb_sym_), intent(inout)  uret,
real, dimension (nilimb_sym_,njlimb_sym_), intent(inout)  vret,
real, dimension (nilimb_sym_,njlimb_sym_), intent(in)  u,
real, dimension (nilimb_sym_,njlimb_sym_), intent(in)  v,
real, dimension (:,:,:,:), pointer  Phi,
real, dimension (:,:,:,:,:,:), pointer  Phisub,
real, dimension (nilimb_sym_,njlimb_sym_), intent(in)  umask,
real, dimension (nilimb_sym_,njlimb_sym_), intent(in)  vmask,
real, dimension (:,:), intent(in)  hmask,
real, dimension (nilimb_sym_,njlimb_sym_), intent(in)  H_node,
real, dimension (:,:), intent(in)  nu,
real, dimension (:,:), intent(in)  float_cond,
real, dimension (:,:), intent(in)  D,
real, dimension (:,:), intent(in)  beta,
real, dimension (:,:), intent(in)  dxdyh,
integer, intent(in)  is,
integer, intent(in)  ie,
integer, intent(in)  js,
integer, intent(in)  je,
real, intent(in)  dens_ratio 
)
private

Definition at line 4286 of file MOM_ice_shelf.F90.

References cg_action_subgrid_basal_bilinear().

Referenced by ice_shelf_solve_inner(), and ice_shelf_solve_outer().

4286 
4287 real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent (inout) :: uret, vret
4288 real, dimension (:,:,:,:), pointer :: phi
4289 real, dimension (:,:,:,:,:,:),pointer :: phisub
4290 real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent (in) :: u, v
4291 real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent (in) :: umask, vmask, h_node
4292 real, dimension (:,:), intent (in) :: hmask, nu, float_cond, d, beta, dxdyh
4293 real, intent(in) :: dens_ratio
4294 integer, intent(in) :: is, ie, js, je
4295 
4296 ! the linear action of the matrix on (u,v) with triangular finite elements
4297 ! as of now everything is passed in so no grid pointers or anything of the sort have to be dereferenced,
4298 ! but this may change pursuant to conversations with others
4299 !
4300 ! is & ie are the cells over which the iteration is done; this may change between calls to this subroutine
4301 ! in order to make less frequent halo updates
4302 ! isym = 1 if grid is symmetric, 0 o.w.
4303 
4304 ! the linear action of the matrix on (u,v) with triangular finite elements
4305 ! Phi has the form
4306 ! Phi (i,j,k,q) - applies to cell i,j
4307 
4308  ! 3 - 4
4309  ! | |
4310  ! 1 - 2
4311 
4312 ! Phi (i,j,2*k-1,q) gives d(Phi_k)/dx at quadrature point q
4313 ! Phi (i,j,2*k,q) gives d(Phi_k)/dy at quadrature point q
4314 ! Phi_k is equal to 1 at vertex k, and 0 at vertex l .ne. k, and bilinear
4315 
4316  real :: ux, vx, uy, vy, uq, vq, area, basel
4317  integer :: iq, jq, iphi, jphi, i, j, ilq, jlq
4318  real, dimension(2) :: xquad
4319  real, dimension(2,2) :: ucell,vcell,hcell,usubcontr,vsubcontr,ucontr
4320 
4321  xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3))
4322 
4323  do j=js,je
4324  do i=is,ie ; if (hmask(i,j) .eq. 1) then
4325 ! dxh = G%dxh(i,j)
4326 ! dyh = G%dyh(i,j)
4327 !
4328 ! X(:,:) = geolonq (i-1:i,j-1:j)
4329 ! Y(:,:) = geolatq (i-1:i,j-1:j)
4330 !
4331 ! call bilinear_shape_functions (X, Y, Phi, area)
4332 
4333  ! X and Y must be passed in the form
4334  ! 3 - 4
4335  ! | |
4336  ! 1 - 2
4337  ! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j
4338  ! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j
4339 
4340  area = dxdyh(i,j)
4341 
4342  ucontr=0
4343  do iq=1,2 ; do jq=1,2
4344 
4345 
4346  if (iq .eq. 2) then
4347  ilq = 2
4348  else
4349  ilq = 1
4350  endif
4351 
4352  if (jq .eq. 2) then
4353  jlq = 2
4354  else
4355  jlq = 1
4356  endif
4357 
4358  uq = u(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + &
4359  u(i,j-1) * xquad(iq) * xquad(3-jq) + &
4360  u(i-1,j) * xquad(3-iq) * xquad(jq) + &
4361  u(i,j) * xquad(iq) * xquad(jq)
4362 
4363  vq = v(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + &
4364  v(i,j-1) * xquad(iq) * xquad(3-jq) + &
4365  v(i-1,j) * xquad(3-iq) * xquad(jq) + &
4366  v(i,j) * xquad(iq) * xquad(jq)
4367 
4368  ux = u(i-1,j-1) * phi(i,j,1,2*(jq-1)+iq) + &
4369  u(i,j-1) * phi(i,j,3,2*(jq-1)+iq) + &
4370  u(i-1,j) * phi(i,j,5,2*(jq-1)+iq) + &
4371  u(i,j) * phi(i,j,7,2*(jq-1)+iq)
4372 
4373  vx = v(i-1,j-1) * phi(i,j,1,2*(jq-1)+iq) + &
4374  v(i,j-1) * phi(i,j,3,2*(jq-1)+iq) + &
4375  v(i-1,j) * phi(i,j,5,2*(jq-1)+iq) + &
4376  v(i,j) * phi(i,j,7,2*(jq-1)+iq)
4377 
4378  uy = u(i-1,j-1) * phi(i,j,2,2*(jq-1)+iq) + &
4379  u(i,j-1) * phi(i,j,4,2*(jq-1)+iq) + &
4380  u(i-1,j) * phi(i,j,6,2*(jq-1)+iq) + &
4381  u(i,j) * phi(i,j,8,2*(jq-1)+iq)
4382 
4383  vy = v(i-1,j-1) * phi(i,j,2,2*(jq-1)+iq) + &
4384  v(i,j-1) * phi(i,j,4,2*(jq-1)+iq) + &
4385  v(i-1,j) * phi(i,j,6,2*(jq-1)+iq) + &
4386  v(i,j) * phi(i,j,8,2*(jq-1)+iq)
4387 
4388  do iphi=1,2 ; do jphi=1,2
4389  if (umask(i-2+iphi,j-2+jphi) .eq. 1) then
4390 
4391  uret(i-2+iphi,j-2+jphi) = uret(i-2+iphi,j-2+jphi) + &
4392  .25 * area * nu(i,j) * ((4*ux+2*vy) * phi(i,j,2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + &
4393  (uy+vx) * phi(i,j,2*(2*(jphi-1)+iphi),2*(jq-1)+iq))
4394  endif
4395  if (vmask(i-2+iphi,j-2+jphi) .eq. 1) then
4396 
4397  vret(i-2+iphi,j-2+jphi) = vret(i-2+iphi,j-2+jphi) + &
4398  .25 * area * nu(i,j) * ((uy+vx) * phi(i,j,2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + &
4399  (4*vy+2*ux) * phi(i,j,2*(2*(jphi-1)+iphi),2*(jq-1)+iq))
4400  endif
4401 
4402  if (iq .eq. iphi) then
4403  ilq = 2
4404  else
4405  ilq = 1
4406  endif
4407 
4408  if (jq .eq. jphi) then
4409  jlq = 2
4410  else
4411  jlq = 1
4412  endif
4413 
4414  if (float_cond(i,j) .eq. 0) then
4415 
4416  if (umask(i-2+iphi,j-2+jphi) .eq. 1) then
4417 
4418  uret(i-2+iphi,j-2+jphi) = uret(i-2+iphi,j-2+jphi) + &
4419  .25 * beta(i,j) * area * uq * xquad(ilq) * xquad(jlq)
4420 
4421  endif
4422 
4423  if (vmask(i-2+iphi,j-2+jphi) .eq. 1) then
4424 
4425  vret(i-2+iphi,j-2+jphi) = vret(i-2+iphi,j-2+jphi) + &
4426  .25 * beta(i,j) * area * vq * xquad(ilq) * xquad(jlq)
4427 
4428  endif
4429 
4430  endif
4431  ucontr(iphi,jphi) = ucontr(iphi,jphi) + .25 * area * uq * xquad(ilq) * xquad(jlq) * beta(i,j)
4432 ! 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)
4433 
4434  !endif
4435  enddo ; enddo
4436  enddo ; enddo
4437 
4438  if (float_cond(i,j) .eq. 1) then
4439  usubcontr = 0.0 ; vsubcontr = 0.0 ; basel = d(i,j)
4440  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)
4441  call cg_action_subgrid_basal_bilinear &
4442  (phisub, hcell, ucell, vcell, area, basel, dens_ratio, usubcontr, vsubcontr, i, j)
4443  do iphi=1,2 ; do jphi=1,2
4444  if (umask(i-2+iphi,j-2+jphi) .eq. 1) then
4445  uret(i-2+iphi,j-2+jphi) = uret(i-2+iphi,j-2+jphi) + usubcontr(iphi,jphi) * beta(i,j)
4446  endif
4447  if (vmask(i-2+iphi,j-2+jphi) .eq. 1) then
4448  vret(i-2+iphi,j-2+jphi) = vret(i-2+iphi,j-2+jphi) + vsubcontr(iphi,jphi) * beta(i,j)
4449  !if ( (iphi.eq.1) .and. (jphi.eq.1)) print *, i,j, Usubcontr (iphi,jphi) * beta(i,j), " ", Ucontr(iphi,jphi)
4450  endif
4451  enddo ; enddo
4452  endif
4453 
4454  endif
4455  enddo ; enddo
4456 
Here is the call graph for this function:
Here is the caller graph for this function:

◆ cg_action_subgrid_basal_bilinear()

subroutine mom_ice_shelf::cg_action_subgrid_basal_bilinear ( real, dimension(:,:,:,:,:,:), pointer  Phisub,
real, dimension(2,2), intent(in)  H,
real, dimension(2,2), intent(in)  U,
real, dimension(2,2), intent(in)  V,
real, intent(in)  DXDYH,
real, intent(in)  D,
real, intent(in)  dens_ratio,
real, dimension(2,2), intent(inout)  Ucontr,
real, dimension(2,2), intent(inout)  Vcontr,
integer, intent(in), optional  iin,
integer, intent(in), optional  jin 
)
private

Definition at line 4460 of file MOM_ice_shelf.F90.

Referenced by apply_boundary_values_bilinear(), and cg_action_bilinear().

4460  real, pointer, dimension(:,:,:,:,:,:) :: phisub
4461  real, dimension(2,2), intent(in) :: h,u,v
4462  real, intent(in) :: dxdyh, d, dens_ratio
4463  real, dimension(2,2), intent(inout) :: ucontr, vcontr
4464  integer, optional, intent(in) :: iin, jin
4465 
4466  ! D = cellwise-constant bed elevation
4467 
4468  integer :: nsub, i, j, k, l, qx, qy, m, n, i_m, j_m
4469  real :: subarea, hloc, uq, vq
4470 
4471  nsub = size(phisub,1)
4472  subarea = dxdyh / (nsub**2)
4473 
4474 
4475  if (.not. present(iin)) then
4476  i_m = -1
4477  else
4478  i_m = iin
4479  endif
4480 
4481  if (.not. present(jin)) then
4482  j_m = -1
4483  else
4484  j_m = jin
4485  endif
4486 
4487 
4488  do m=1,2
4489  do n=1,2
4490  do j=1,nsub
4491  do i=1,nsub
4492  do qx=1,2
4493  do qy = 1,2
4494 
4495  hloc = phisub(i,j,1,1,qx,qy)*h(1,1)+phisub(i,j,1,2,qx,qy)*h(1,2)+&
4496  phisub(i,j,2,1,qx,qy)*h(2,1)+phisub(i,j,2,2,qx,qy)*h(2,2)
4497 
4498  if (dens_ratio * hloc - d .gt. 0) then
4499  !if (.true.) then
4500  uq = 0 ; vq = 0
4501  do k=1,2
4502  do l=1,2
4503  !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)
4504  !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)
4505  uq = uq + phisub(i,j,k,l,qx,qy) * u(k,l) ; vq = vq + phisub(i,j,k,l,qx,qy) * v(k,l)
4506  enddo
4507  enddo
4508 
4509  ucontr(m,n) = ucontr(m,n) + subarea * 0.25 * phisub(i,j,m,n,qx,qy) * uq
4510  vcontr(m,n) = vcontr(m,n) + subarea * 0.25 * phisub(i,j,m,n,qx,qy) * vq
4511 
4512  ! 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)
4513 
4514  endif
4515 
4516  enddo
4517  enddo
4518  enddo
4519  enddo
4520  enddo
4521  enddo
4522 
Here is the caller graph for this function:

◆ cg_action_triangular()

subroutine mom_ice_shelf::cg_action_triangular ( real, dimension (:,:), intent(inout)  uret,
real, dimension (:,:), intent(inout)  vret,
real, dimension (:,:), intent(in)  u,
real, dimension (:,:), intent(in)  v,
real, dimension (:,:), intent(in)  umask,
real, dimension (:,:), intent(in)  vmask,
real, dimension (:,:), intent(in)  hmask,
real, dimension (:,:), intent(in)  nu_upper,
real, dimension (:,:), intent(in)  nu_lower,
real, dimension (:,:), intent(in)  beta_upper,
real, dimension (:,:), intent(in)  beta_lower,
real, dimension (:,:), intent(in)  dxh,
real, dimension (:,:), intent(in)  dyh,
real, dimension (:,:), intent(in)  dxdyh,
integer, intent(in)  is,
integer, intent(in)  ie,
integer, intent(in)  js,
integer, intent(in)  je,
integer, intent(in)  isym 
)
private

Definition at line 4140 of file MOM_ice_shelf.F90.

Referenced by ice_shelf_solve_inner(), and ice_shelf_solve_outer().

4140 
4141 real, dimension (:,:), intent (inout) :: uret, vret
4142 real, dimension (:,:), intent (in) :: u, v
4143 real, dimension (:,:), intent (in) :: umask, vmask
4144 real, dimension (:,:), intent (in) :: hmask, nu_upper, nu_lower, beta_upper, beta_lower
4145 real, dimension (:,:), intent (in) :: dxh, dyh, dxdyh
4146 integer, intent(in) :: is, ie, js, je, isym
4147 
4148 ! the linear action of the matrix on (u,v) with triangular finite elements
4149 ! as of now everything is passed in so no grid pointers or anything of the sort have to be dereferenced,
4150 ! but this may change pursuant to conversations with others
4151 !
4152 ! is & ie are the cells over which the iteration is done; this may change between calls to this subroutine
4153 ! in order to make less frequent halo updates
4154 ! isym = 1 if grid is symmetric, 0 o.w.
4155 
4156  real :: ux, uy, vx, vy
4157  integer :: i,j
4158 
4159  do i=is,ie
4160  do j=js,je
4161 
4162  if (hmask(i,j) .eq. 1) then ! this cell's vertices contain degrees of freedom
4163 
4164  ux = (u(i,j-1)-u(i-1,j-1))/dxh(i,j)
4165  vx = (v(i,j-1)-v(i-1,j-1))/dxh(i,j)
4166  uy = (u(i-1,j)-u(i-1,j-1))/dyh(i,j)
4167  vy = (v(i-1,j)-v(i-1,j-1))/dyh(i,j)
4168 
4169  if (umask(i,j-1) .eq. 1) then ! this (bot right) is a degree of freedom node
4170 
4171  uret(i,j-1) = uret(i,j-1) + &
4172  .5 * dxdyh(i,j) * nu_lower(i,j) * ((4*ux+2*vy) * (1./dxh(i,j)) + (uy+vy) * (0./dyh(i,j)))
4173 
4174  vret(i,j-1) = vret(i,j-1) + &
4175  .5 * dxdyh(i,j) * nu_lower(i,j) * ((uy+vx) * (1./dxh(i,j)) + (4*vy+2*ux) * (0./dyh(i,j)))
4176 
4177  uret(i,j-1) = uret(i,j-1) + &
4178  beta_lower(i,j) * dxdyh(i,j) * 1./24 * (u(i-1,j-1) + &
4179  u(i-1,j) + u(i,j-1))
4180 
4181  vret(i,j-1) = vret(i,j-1) + &
4182  beta_lower(i,j) * dxdyh(i,j) * 1./24 * (v(i-1,j-1) + &
4183  v(i-1,j) + v(i,j-1))
4184  endif
4185 
4186  if (umask(i-1,j) .eq. 1) then ! this (top left) is a degree of freedom node
4187 
4188  uret(i-1,j) = uret(i-1,j) + &
4189  .5 * dxdyh(i,j) * nu_lower(i,j) * ((4*ux+2*vy) * (0./dxh(i,j)) + (uy+vy) * (1./dyh(i,j)))
4190 
4191  vret(i-1,j) = vret(i-1,j) + &
4192  .5 * dxdyh(i,j) * nu_lower(i,j) * ((uy+vx) * (0./dxh(i,j)) + (4*vy+2*ux) * (1./dyh(i,j)))
4193 
4194  uret(i,j-1) = uret(i,j-1) + &
4195  beta_lower(i,j) * dxdyh(i,j) * 1./24 * (u(i-1,j-1) + &
4196  u(i-1,j) + u(i,j-1))
4197 
4198  vret(i,j-1) = vret(i,j-1) + &
4199  beta_lower(i,j) * dxdyh(i,j) * 1./24 * (v(i-1,j-1) + &
4200  v(i-1,j) + v(i,j-1))
4201  endif
4202 
4203  if (umask(i-1,j-1) .eq. 1) then ! this (bot left) is a degree of freedom node
4204 
4205  uret(i-1,j-1) = uret(i-1,j-1) + &
4206  .5 * dxdyh(i,j) * nu_upper(i,j) * ((4*ux+2*vy) * (-1./dxh(i,j)) + (uy+vy) * (-1./dyh(i,j)))
4207 
4208  vret(i-1,j-1) = vret(i-1,j-1) + &
4209  .5 * dxdyh(i,j) * nu_upper(i,j) * ((uy+vx) * (-1./dxh(i,j)) + (4*vy+2*ux) * (-1./dyh(i,j)))
4210 
4211  uret(i-1,j-1) = uret(i-1,j-1) + &
4212  beta_lower(i,j) * dxdyh(i,j) * 1./24 * (u(i-1,j-1) + &
4213  u(i-1,j) + u(i,j-1))
4214 
4215  vret(i-1,j-1) = vret(i-1,j-1) + &
4216  beta_lower(i,j) * dxdyh(i,j) * 1./24 * (v(i-1,j-1) + &
4217  v(i-1,j) + v(i,j-1))
4218  endif
4219 
4220 
4221  ux = (u(i,j)-u(i-1,j))/dxh(i,j)
4222  vx = (v(i,j)-v(i-1,j))/dxh(i,j)
4223  uy = (u(i,j)-u(i,j-1))/dyh(i,j)
4224  vy = (v(i,j)-v(i,j-1))/dyh(i,j)
4225 
4226  if (umask(i,j-1) .eq. 1) then ! this (bot right) is a degree of freedom node
4227 
4228  uret(i,j-1) = uret(i,j-1) + &
4229  .5 * dxdyh(i,j) * nu_upper(i,j) * ((4*ux+2*vy) * (0./dxh(i,j)) + (uy+vy) * (-1./dyh(i,j)))
4230 
4231  vret(i,j-1) = vret(i,j-1) + &
4232  .5 * dxdyh(i,j) * nu_upper(i,j) * ((uy+vx) * (0./dxh(i,j)) + (4*vy+2*ux) * (-1./dyh(i,j)))
4233 
4234  uret(i,j-1) = uret(i,j-1) + &
4235  beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + &
4236  u(i-1,j) + u(i,j-1))
4237 
4238  vret(i,j-1) = vret(i,j-1) + &
4239  beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + &
4240  u(i-1,j) + u(i,j-1))
4241  endif
4242 
4243  if (umask(i-1,j) .eq. 1) then ! this (top left) is a degree of freedom node
4244 
4245  uret(i-1,j) = uret(i-1,j) + &
4246  .5 * dxdyh(i,j) * nu_upper(i,j) * ((4*ux+2*vy) * (-1./dxh(i,j)) + (uy+vy) * (0./dyh(i,j)))
4247 
4248  vret(i-1,j) = vret(i-1,j) + &
4249  .5 * dxdyh(i,j) * nu_upper(i,j) * ((uy+vx) * (-1./dxh(i,j)) + (4*vy+2*ux) * (0./dyh(i,j)))
4250 
4251  uret(i,j-1) = uret(i,j-1) + &
4252  beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + &
4253  u(i-1,j) + u(i,j-1))
4254 
4255  vret(i,j-1) = vret(i,j-1) + &
4256  beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + &
4257  u(i-1,j) + u(i,j-1))
4258  endif
4259 
4260  if (umask(i,j) .eq. 1) then ! this (top right) is a degree of freedom node
4261 
4262  uret(i,j) = uret(i,j) + &
4263  .5 * dxdyh(i,j) * nu_upper(i,j) * ((4*ux+2*vy) * (1./dxh(i,j)) + (uy+vy) * (1./dyh(i,j)))
4264 
4265  vret(i,j) = vret(i,j) + &
4266  .5 * dxdyh(i,j) * nu_upper(i,j) * ((uy+vx) * (1./dxh(i,j)) + (4*vy+2*ux) * (1./dyh(i,j)))
4267 
4268  uret(i,j) = uret(i,j) + &
4269  beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + &
4270  u(i-1,j) + u(i,j-1))
4271 
4272  vret(i,j) = vret(i,j) + &
4273  beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + &
4274  u(i-1,j) + u(i,j-1))
4275  endif
4276 
4277  endif
4278 
4279  enddo
4280  enddo
4281 
Here is the caller graph for this function:

◆ cg_diagonal_subgrid_basal_bilinear()

subroutine mom_ice_shelf::cg_diagonal_subgrid_basal_bilinear ( real, dimension(:,:,:,:,:,:), pointer  Phisub,
real, dimension(2,2), intent(in)  H,
real, intent(in)  DXDYH,
real, intent(in)  D,
real, intent(in)  dens_ratio,
real, dimension(2,2), intent(inout)  Ucontr,
real, dimension(2,2), intent(inout)  Vcontr 
)
private

Definition at line 4826 of file MOM_ice_shelf.F90.

Referenced by matrix_diagonal_bilinear().

4826  real, pointer, dimension(:,:,:,:,:,:) :: phisub
4827  real, dimension(2,2), intent(in) :: h
4828  real, intent(in) :: dxdyh, d, dens_ratio
4829  real, dimension(2,2), intent(inout) :: ucontr, vcontr
4830 
4831  ! D = cellwise-constant bed elevation
4832 
4833  integer :: nsub, i, j, k, l, qx, qy, m, n
4834  real :: subarea, hloc
4835 
4836  nsub = size(phisub,1)
4837  subarea = dxdyh / (nsub**2)
4838 
4839  do m=1,2
4840  do n=1,2
4841  do j=1,nsub
4842  do i=1,nsub
4843  do qx=1,2
4844  do qy = 1,2
4845 
4846  hloc = phisub(i,j,1,1,qx,qy)*h(1,1)+phisub(i,j,1,2,qx,qy)*h(1,2)+&
4847  phisub(i,j,2,1,qx,qy)*h(2,1)+phisub(i,j,2,2,qx,qy)*h(2,2)
4848 
4849  if (dens_ratio * hloc - d .gt. 0) then
4850  ucontr(m,n) = ucontr(m,n) + subarea * 0.25 * phisub(i,j,m,n,qx,qy)**2
4851  vcontr(m,n) = vcontr(m,n) + subarea * 0.25 * phisub(i,j,m,n,qx,qy)**2
4852  endif
4853 
4854 
4855  enddo
4856  enddo
4857  enddo
4858  enddo
4859  enddo
4860  enddo
4861 
Here is the caller graph for this function:

◆ change_thickness_using_melt()

subroutine mom_ice_shelf::change_thickness_using_melt ( type(ice_shelf_cs), intent(inout)  CS,
type(ocean_grid_type), intent(inout)  G,
real, intent(in)  time_step,
type(forcing), intent(inout)  fluxes 
)
private

Changes the thickness (mass) of the ice shelf based on sub-ice-shelf melting.

Definition at line 865 of file MOM_ice_shelf.F90.

Referenced by shelf_calc_flux().

865  type(ocean_grid_type), intent(inout) :: g
866  type(ice_shelf_cs), intent(inout) :: cs
867  real, intent(in) :: time_step
868  type(forcing), intent(inout) :: fluxes
869 
870  ! locals
871  integer :: i, j
872 
873  do j=g%jsc,g%jec
874  do i=g%isc,g%iec
875 
876  if ((cs%hmask(i,j) .eq. 1) .or. (cs%hmask(i,j) .eq. 2)) then
877  ! first, zero out fluxes applied during previous time step
878  if (associated(fluxes%lprec)) fluxes%lprec(i,j) = 0.0
879  if (associated(fluxes%sens)) fluxes%sens(i,j) = 0.0
880  if (associated(fluxes%frac_shelf_h)) fluxes%frac_shelf_h(i,j) = 0.0
881  if (associated(fluxes%p_surf)) fluxes%p_surf(i,j) = 0.0
882  if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = 0.0
883 
884  if (cs%lprec(i,j) / cs%density_ice * time_step .lt. cs%h_shelf (i,j)) then
885  cs%h_shelf (i,j) = cs%h_shelf (i,j) - cs%lprec(i,j) / cs%density_ice * time_step
886  else
887  ! the ice is about to melt away
888  ! in this case set thickness, area, and mask to zero
889  ! NOTE: not mass conservative
890  ! should maybe scale salt & heat flux for this cell
891 
892  cs%h_shelf(i,j) = 0.0
893  cs%hmask(i,j) = 0.0
894  cs%area_shelf_h(i,j) = 0.0
895  endif
896  endif
897  enddo
898  enddo
899 
900  call pass_var(cs%area_shelf_h, g%domain)
901  call pass_var(cs%h_shelf, g%domain)
902  call pass_var(cs%hmask, g%domain)
903 
904  do j=g%jsd,g%jed
905  do i=g%isd,g%ied
906 
907  if ((cs%hmask(i,j) .eq. 1) .or. (cs%hmask(i,j) .eq. 2)) then
908  cs%mass_shelf(i,j) = cs%h_shelf(i,j)*cs%density_ice
909  endif
910  enddo
911  enddo
912 
913  call pass_var(cs%mass_shelf, g%domain)
914 
915  if (cs%DEBUG) then
916  call hchksum (cs%h_shelf, "h_shelf after change thickness using melt", g%HI, haloshift=0)
917  call hchksum (cs%mass_shelf, "mass_shelf after change thickness using melt", g%HI, haloshift=0)
918  endif
919 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the caller graph for this function:

◆ ice_shelf_advect()

subroutine mom_ice_shelf::ice_shelf_advect ( type(ice_shelf_cs), pointer  CS,
real, intent(in)  time_step,
real, dimension(:,:), intent(in), pointer  melt_rate,
type(time_type)  Time 
)
private

Definition at line 2202 of file MOM_ice_shelf.F90.

References calve_to_mask(), ice_shelf_advect_thickness_x(), ice_shelf_advect_thickness_y(), ice_shelf_min_thickness_calve(), shelf_advance_front(), and update_velocity_masks().

Referenced by shelf_calc_flux(), and solo_time_step().

2202  type(ice_shelf_cs), pointer :: cs
2203  real, intent(in) :: time_step
2204  real,pointer,dimension(:,:),intent(in) :: melt_rate
2205  type(time_type) :: time
2206 
2207 ! time_step: time step in sec
2208 ! melt_rate: basal melt rate in kg/m^2/s
2209 
2210 ! 3/8/11 DNG
2211 ! Arguments:
2212 ! CS - A structure containing the ice shelf state - including current velocities
2213 ! h0 - an array containing the thickness at the beginning of the call
2214 ! h_after_uflux - an array containing the thickness after advection in u-direction
2215 ! h_after_vflux - similar
2216 !
2217 ! This subroutine takes the velocity (on the Bgrid) and timesteps h_t = - div (uh) once.
2218 ! ADDITIONALLY, it will update the volume of ice in partially-filled cells, and update
2219 ! hmask accordingly
2220 !
2221 ! The flux overflows are included here. That is because they will be used to advect 3D scalars
2222 ! into partial cells
2223 
2224  !
2225  ! flux_enter: this is to capture flow into partially covered cells; it gives the mass flux into a given
2226  ! cell across its boundaries.
2227  ! ###Perhaps flux_enter should be changed into u-face and v-face
2228  ! ###fluxes, which can then be used in halo updates, etc.
2229  !
2230  ! from left neighbor: flux_enter (:,:,1)
2231  ! from right neighbor: flux_enter (:,:,2)
2232  ! from bottom neighbor: flux_enter (:,:,3)
2233  ! from top neighbor: flux_enter (:,:,4)
2234  !
2235  ! THESE ARE NOT CONSISTENT ==> FIND OUT WHAT YOU IMPLEMENTED
2236 
2237  ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary
2238  !
2239  ! o--- (4) ---o
2240  ! | |
2241  ! (1) (2)
2242  ! | |
2243  ! o--- (3) ---o
2244  !
2245 
2246  type(ocean_grid_type), pointer :: g
2247  real, dimension(size(CS%h_shelf,1),size(CS%h_shelf,2)) :: h_after_uflux, h_after_vflux
2248  real, dimension(size(CS%h_shelf,1),size(CS%h_shelf,2),4) :: flux_enter
2249  integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec
2250  real :: rho, spy, thick_bd
2251  real, dimension(:,:), pointer :: hmask
2252  character(len=2) :: procnum
2253 
2254  hmask => cs%hmask
2255  g => cs%grid
2256  rho = cs%density_ice
2257  spy = 365 * 86400 ! seconds per year; is there a global constant for this? No - it is dependent upon a calendar.
2258 
2259  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
2260  isc = g%isc ; iec = g%iec ; jsc = g%jsc ; jec = g%jec
2261  flux_enter(:,:,:) = 0.0
2262 
2263  h_after_uflux(:,:) = 0.0
2264  h_after_vflux(:,:) = 0.0
2265 ! if (is_root_pe()) write(*,*) "ice_shelf_advect called"
2266 
2267  do j=jsd,jed
2268  do i=isd,ied
2269  thick_bd = cs%thickness_boundary_values(i,j)
2270  if (thick_bd .ne. 0.0) then
2271  cs%h_shelf(i,j) = cs%thickness_boundary_values(i,j)
2272  endif
2273  enddo
2274  enddo
2275 
2276  call ice_shelf_advect_thickness_x (cs, time_step/spy, cs%h_shelf, h_after_uflux, flux_enter)
2277 
2278 ! call enable_averaging(time_step,Time,CS%diag)
2279  ! call pass_var (h_after_uflux, G%domain)
2280 ! if (CS%id_h_after_uflux > 0) call post_data(CS%id_h_after_uflux, h_after_uflux, CS%diag)
2281 ! call disable_averaging(CS%diag)
2282 
2283  call ice_shelf_advect_thickness_y (cs, time_step/spy, h_after_uflux, h_after_vflux, flux_enter)
2284 
2285 ! call enable_averaging(time_step,Time,CS%diag)
2286 ! call pass_var (h_after_vflux, G%domain)
2287 ! if (CS%id_h_after_vflux > 0) call post_data(CS%id_h_after_vflux, h_after_vflux, CS%diag)
2288 ! call disable_averaging(CS%diag)
2289 
2290  do j=jsd,jed
2291  do i=isd,ied
2292  if (cs%hmask(i,j) .eq. 1) then
2293  cs%h_shelf (i,j) = h_after_vflux(i,j)
2294  endif
2295  enddo
2296  enddo
2297 
2298  if (cs%moving_shelf_front) then
2299  call shelf_advance_front (cs, flux_enter)
2300  if (cs%min_thickness_simple_calve > 0.0) then
2301  call ice_shelf_min_thickness_calve (cs, cs%h_shelf, cs%area_shelf_h, cs%hmask)
2302  endif
2303  if (cs%calve_to_mask) then
2304  call calve_to_mask (cs, cs%h_shelf, cs%area_shelf_h, cs%hmask, cs%calve_mask)
2305  endif
2306  endif
2307 
2308  !call enable_averaging(time_step,Time,CS%diag)
2309  !if (CS%id_h_after_adv > 0) call post_data(CS%id_h_after_adv, CS%h_shelf, CS%diag)
2310  !call disable_averaging(CS%diag)
2311 
2312  !call change_thickness_using_melt(CS,G,time_step, fluxes)
2313 
2314  call update_velocity_masks (cs)
2315 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the call graph for this function:
Here is the caller graph for this function:

◆ ice_shelf_advect_temp_x()

subroutine mom_ice_shelf::ice_shelf_advect_temp_x ( 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 
)
private

Definition at line 6195 of file MOM_ice_shelf.F90.

References slope_limiter().

Referenced by ice_shelf_temp().

6195  type(ice_shelf_cs), pointer :: cs
6196  real, intent(in) :: time_step
6197  real, dimension(:,:), intent(in) :: h0
6198  real, dimension(:,:), intent(inout) :: h_after_uflux
6199  real, dimension(:,:,:), intent(inout) :: flux_enter
6200 
6201  ! use will be made of CS%hmask here - its value at the boundary will be zero, just like uncovered cells
6202 
6203  ! if there is an input bdry condition, the thickness there will be set in initialization
6204 
6205  ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary
6206  !
6207  ! from left neighbor: flux_enter (:,:,1)
6208  ! from right neighbor: flux_enter (:,:,2)
6209  ! from bottom neighbor: flux_enter (:,:,3)
6210  ! from top neighbor: flux_enter (:,:,4)
6211  !
6212  ! o--- (4) ---o
6213  ! | |
6214  ! (1) (2)
6215  ! | |
6216  ! o--- (3) ---o
6217  !
6218 
6219  integer :: isym, i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied
6220  integer :: i_off, j_off
6221  logical :: at_east_bdry, at_west_bdry, one_off_west_bdry, one_off_east_bdry
6222  type(ocean_grid_type), pointer :: g
6223  real, dimension(-2:2) :: stencil
6224  real, dimension(:,:), pointer :: hmask, u_face_mask, u_flux_boundary_values,u_boundary_values,t_boundary
6225  real :: u_face, & ! positive if out
6226  flux_diff_cell, phi, dxh, dyh, dxdyh
6227 
6228  character (len=1) :: debug_str, procnum
6229 
6230 ! if (CS%grid%symmetric) then
6231 ! isym = 1
6232 ! else
6233 ! isym = 0
6234 ! endif
6235 
6236  isym = 0
6237 
6238  g => cs%grid
6239  hmask => cs%hmask
6240  u_face_mask => cs%u_face_mask
6241  u_flux_boundary_values => cs%u_flux_boundary_values
6242  u_boundary_values => cs%u_shelf
6243 ! h_boundaries => CS%h_shelf
6244  t_boundary => cs%t_boundary_values
6245  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
6246  i_off = g%idg_offset ; j_off = g%jdg_offset
6247 
6248  do j=jsd+1,jed-1
6249  if (((j+j_off) .le. g%domain%njglobal+g%domain%njhalo) .AND. &
6250  ((j+j_off) .ge. g%domain%njhalo+1)) then ! based on mehmet's code - only if btw north & south boundaries
6251 
6252  stencil(:) = -1
6253 ! if (i+i_off .eq. G%domain%nihalo+G%domain%nihalo)
6254  do i=is,ie
6255 
6256  if (((i+i_off) .le. g%domain%niglobal+g%domain%nihalo) .AND. &
6257  ((i+i_off) .ge. g%domain%nihalo+1)) then
6258 
6259  if (i+i_off .eq. g%domain%nihalo+1) then
6260  at_west_bdry=.true.
6261  else
6262  at_west_bdry=.false.
6263  endif
6264 
6265  if (i+i_off .eq. g%domain%niglobal+g%domain%nihalo) then
6266  at_east_bdry=.true.
6267  else
6268  at_east_bdry=.false.
6269  endif
6270 
6271  if (hmask(i,j) .eq. 1) then
6272 
6273  dxh = g%dxT(i,j) ; dyh = g%dyT(i,j) ; dxdyh = g%areaT(i,j)
6274 
6275  h_after_uflux(i,j) = h0(i,j)
6276 
6277  stencil(:) = h0(i-2:i+2,j) ! fine as long has nx_halo >= 2
6278 
6279  flux_diff_cell = 0
6280 
6281  ! 1ST DO LEFT FACE
6282 
6283  if (u_face_mask(i-1,j) .eq. 4.) then
6284 
6285  flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values(i-1,j) * &
6286  t_boundary(i-1,j) / dxdyh
6287 ! assume no flux bc for temp
6288 ! flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_shelf(i,j)*t_boundary(i-1,j) / dxdyh
6289 
6290  else
6291 
6292  ! get u-velocity at center of left face
6293  u_face = 0.5 * (cs%u_shelf(i-1,j-1) + cs%u_shelf(i-1,j))
6294 
6295  ! if (at_west_bdry .and. (i .eq. G%isc)) then
6296  ! print *, j, u_face, stencil(-1)
6297  ! endif
6298 
6299  if (u_face .gt. 0) then !flux is into cell - we need info from h(i-2), h(i-1) if available
6300 
6301  ! i may not cover all the cases.. but i cover the realistic ones
6302 
6303  if (at_west_bdry .AND. (hmask(i-1,j).eq.3)) then ! at western bdry but there is a thickness bdry condition,
6304  ! and the stencil contains it
6305  stencil(-1) = cs%t_boundary_values(i-1,j)*cs%h_shelf(i-1,j)
6306  flux_diff_cell = flux_diff_cell + abs(u_face) * dyh * time_step * stencil(-1) / dxdyh
6307 
6308  elseif (hmask(i-1,j) * hmask(i-2,j) .eq. 1) then ! h(i-2) and h(i-1) are valid
6309  phi = slope_limiter(stencil(-1)-stencil(-2), stencil(0)-stencil(-1))
6310  flux_diff_cell = flux_diff_cell + abs(u_face) * dyh* time_step / dxdyh * &
6311  (stencil(-1) - phi * (stencil(-1)-stencil(0))/2)
6312 
6313  else ! h(i-1) is valid
6314  ! (o.w. flux would most likely be out of cell)
6315  ! but h(i-2) is not
6316 
6317  flux_diff_cell = flux_diff_cell + abs(u_face) * dyh * time_step / dxdyh * stencil(-1)
6318 
6319  endif
6320 
6321  elseif (u_face .lt. 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available
6322  if (hmask(i-1,j) * hmask(i+1,j) .eq. 1) then ! h(i-1) and h(i+1) are both valid
6323  phi = slope_limiter(stencil(0)-stencil(1), stencil(-1)-stencil(0))
6324  flux_diff_cell = flux_diff_cell - abs(u_face) * dyh * time_step / dxdyh * &
6325  (stencil(0) - phi * (stencil(0)-stencil(-1))/2)
6326 
6327  else
6328  flux_diff_cell = flux_diff_cell - abs(u_face) * dyh * time_step / dxdyh * stencil(0)
6329 
6330  if ((hmask(i-1,j) .eq. 0) .OR. (hmask(i-1,j) .eq. 2)) then
6331  flux_enter(i-1,j,2) = abs(u_face) * dyh * time_step * stencil(0)
6332  endif
6333  endif
6334  endif
6335  endif
6336 
6337  ! NEXT DO RIGHT FACE
6338 
6339  ! get u-velocity at center of right face
6340 
6341  if (u_face_mask(i+1,j) .eq. 4.) then
6342 
6343  flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values(i+1,j) *&
6344  t_boundary(i+1,j)/ dxdyh
6345 ! assume no flux bc for temp
6346 ! flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_shelf(i,j)*t_boundary (i+1,j)/ dxdyh
6347 
6348  else
6349 
6350  u_face = 0.5 * (cs%u_shelf(i,j-1) + cs%u_shelf(i,j))
6351 
6352  if (u_face .lt. 0) then !flux is into cell - we need info from h(i+2), h(i+1) if available
6353 
6354  if (at_east_bdry .AND. (hmask(i+1,j).eq.3)) then ! at eastern bdry but there is a thickness bdry condition,
6355  ! and the stencil contains it
6356 
6357  flux_diff_cell = flux_diff_cell + abs(u_face) * dyh * time_step * stencil(1) / dxdyh
6358 
6359  elseif (hmask(i+1,j) * hmask(i+2,j) .eq. 1) then ! h(i+2) and h(i+1) are valid
6360 
6361  phi = slope_limiter(stencil(1)-stencil(2), stencil(0)-stencil(1))
6362  flux_diff_cell = flux_diff_cell + abs(u_face) * dyh * time_step / dxdyh * &
6363  (stencil(1) - phi * (stencil(1)-stencil(0))/2)
6364 
6365  else ! h(i+1) is valid
6366  ! (o.w. flux would most likely be out of cell)
6367  ! but h(i+2) is not
6368 
6369  flux_diff_cell = flux_diff_cell + abs(u_face) * dyh * time_step / dxdyh * stencil(1)
6370 
6371  endif
6372 
6373  elseif (u_face .gt. 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available
6374 
6375  if (hmask(i-1,j) * hmask(i+1,j) .eq. 1) then ! h(i-1) and h(i+1) are both valid
6376 
6377  phi = slope_limiter(stencil(0)-stencil(-1), stencil(1)-stencil(0))
6378  flux_diff_cell = flux_diff_cell - abs(u_face) * dyh * time_step / dxdyh * &
6379  (stencil(0) - phi * (stencil(0)-stencil(1))/2)
6380 
6381  else ! h(i+1) is valid
6382  ! (o.w. flux would most likely be out of cell)
6383  ! but h(i+2) is not
6384 
6385  flux_diff_cell = flux_diff_cell - abs(u_face) * dyh * time_step / dxdyh * stencil(0)
6386 
6387  if ((hmask(i+1,j) .eq. 0) .OR. (hmask(i+1,j) .eq. 2)) then
6388 
6389  flux_enter(i+1,j,1) = abs(u_face) * dyh * time_step * stencil(0)
6390  endif
6391 
6392  endif
6393 
6394  endif
6395 
6396  h_after_uflux(i,j) = h_after_uflux(i,j) + flux_diff_cell
6397 
6398  endif
6399 
6400  elseif ((hmask(i,j) .eq. 0) .OR. (hmask(i,j) .eq. 2)) then
6401 
6402  if (at_west_bdry .AND. (hmask(i-1,j) .EQ. 3)) then
6403  u_face = 0.5 * (cs%u_shelf(i-1,j-1) + cs%u_shelf(i-1,j))
6404  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)
6405  elseif (u_face_mask(i-1,j) .eq. 4.) then
6406  flux_enter(i,j,1) = g%dyT(i,j) * time_step * u_flux_boundary_values(i-1,j)*t_boundary(i-1,j)
6407 ! flux_enter (i,j,1) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*t_boundary (i-1,j)
6408 ! assume no flux bc for temp
6409  endif
6410 
6411  if (at_east_bdry .AND. (hmask(i+1,j) .EQ. 3)) then
6412  u_face = 0.5 * (cs%u_shelf(i,j-1) + cs%u_shelf(i,j))
6413  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)
6414  elseif (u_face_mask(i+1,j) .eq. 4.) then
6415  flux_enter(i,j,2) = g%dyT(i,j) * time_step * u_flux_boundary_values(i+1,j) * t_boundary(i+1,j)
6416 ! assume no flux bc for temp
6417 ! flux_enter (i,j,2) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*t_boundary (i+1,j)
6418  endif
6419 
6420 ! if ((i .eq. is) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i-1,j) .eq. 1)) then
6421  ! this is solely for the purposes of keeping the mask consistent while advancing the front without having
6422  ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered
6423 
6424 ! hmask(i,j) = 2
6425 ! elseif ((i .eq. ie) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i+1,j) .eq. 1)) then
6426  ! this is solely for the purposes of keeping the mask consistent while advancing the front without having
6427  ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered
6428 
6429 ! hmask(i,j) = 2
6430 
6431 ! endif
6432 
6433  endif
6434 
6435  endif
6436 
6437  enddo ! i loop
6438 
6439  endif
6440 
6441  enddo ! j loop
6442 
6443 ! write (procnum,'(I1)') mpp_pe()
6444 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the call graph for this function:
Here is the caller graph for this function:

◆ ice_shelf_advect_temp_y()

subroutine mom_ice_shelf::ice_shelf_advect_temp_y ( 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 
)
private

Definition at line 6448 of file MOM_ice_shelf.F90.

References slope_limiter().

Referenced by ice_shelf_temp().

6448  type(ice_shelf_cs), pointer :: cs
6449  real, intent(in) :: time_step
6450  real, dimension(:,:), intent(in) :: h_after_uflux
6451  real, dimension(:,:), intent(inout) :: h_after_vflux
6452  real, dimension(:,:,:), intent(inout) :: flux_enter
6453 
6454  ! use will be made of CS%hmask here - its value at the boundary will be zero, just like uncovered cells
6455 
6456  ! if there is an input bdry condition, the thickness there will be set in initialization
6457 
6458  ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary
6459  !
6460  ! from left neighbor: flux_enter (:,:,1)
6461  ! from right neighbor: flux_enter (:,:,2)
6462  ! from bottom neighbor: flux_enter (:,:,3)
6463  ! from top neighbor: flux_enter (:,:,4)
6464  !
6465  ! o--- (4) ---o
6466  ! | |
6467  ! (1) (2)
6468  ! | |
6469  ! o--- (3) ---o
6470  !
6471 
6472  integer :: isym, i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied
6473  integer :: i_off, j_off
6474  logical :: at_north_bdry, at_south_bdry, one_off_west_bdry, one_off_east_bdry
6475  type(ocean_grid_type), pointer :: g
6476  real, dimension(-2:2) :: stencil
6477  real, dimension(:,:), pointer :: hmask, v_face_mask, v_flux_boundary_values,t_boundary,v_boundary_values
6478  real :: v_face, & ! positive if out
6479  flux_diff_cell, phi, dxh, dyh, dxdyh
6480  character(len=1) :: debug_str, procnum
6481 
6482 ! if (CS%grid%symmetric) then
6483 ! isym = 1
6484 ! else
6485 ! isym = 0
6486 ! endif
6487 
6488  isym = 0
6489 
6490  g => cs%grid
6491  hmask => cs%hmask
6492  v_face_mask => cs%v_face_mask
6493  v_flux_boundary_values => cs%v_flux_boundary_values
6494  t_boundary => cs%t_boundary_values
6495  v_boundary_values => cs%v_shelf
6496  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
6497  i_off = g%idg_offset ; j_off = g%jdg_offset
6498 
6499  do i=isd+2,ied-2
6500  if (((i+i_off) .le. g%domain%niglobal+g%domain%nihalo) .AND. &
6501  ((i+i_off) .ge. g%domain%nihalo+1)) then ! based on mehmet's code - only if btw east & west boundaries
6502 
6503  stencil(:) = -1
6504 
6505  do j=js,je
6506 
6507  if (((j+j_off) .le. g%domain%njglobal+g%domain%njhalo) .AND. &
6508  ((j+j_off) .ge. g%domain%njhalo+1)) then
6509 
6510  if (j+j_off .eq. g%domain%njhalo+1) then
6511  at_south_bdry=.true.
6512  else
6513  at_south_bdry=.false.
6514  endif
6515  if (j+j_off .eq. g%domain%njglobal+g%domain%njhalo) then
6516  at_north_bdry=.true.
6517  else
6518  at_north_bdry=.false.
6519  endif
6520 
6521  if (hmask(i,j) .eq. 1) then
6522  dxh = g%dxT(i,j) ; dyh = g%dyT(i,j) ; dxdyh = g%areaT(i,j)
6523  h_after_vflux(i,j) = h_after_uflux(i,j)
6524 
6525  stencil(:) = h_after_uflux(i,j-2:j+2) ! fine as long has ny_halo >= 2
6526  flux_diff_cell = 0
6527 
6528  ! 1ST DO south FACE
6529 
6530  if (v_face_mask(i,j-1) .eq. 4.) then
6531 
6532  flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values(i,j-1) * t_boundary(i,j-1)/ dxdyh
6533 ! assume no flux bc for temp
6534 ! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*t_boundary (i,j-1) / dxdyh
6535 
6536  else
6537 
6538  ! get u-velocity at center of left face
6539  v_face = 0.5 * (cs%v_shelf(i-1,j-1) + cs%v_shelf(i,j-1))
6540 
6541  if (v_face .gt. 0) then !flux is into cell - we need info from h(j-2), h(j-1) if available
6542 
6543  ! i may not cover all the cases.. but i cover the realistic ones
6544 
6545  if (at_south_bdry .AND. (hmask(i,j-1).eq.3)) then ! at western bdry but there is a thickness bdry condition,
6546  ! and the stencil contains it
6547  flux_diff_cell = flux_diff_cell + abs(v_face) * dxh * time_step * stencil(-1) / dxdyh
6548 
6549  elseif (hmask(i,j-1) * hmask(i,j-2) .eq. 1) then ! h(j-2) and h(j-1) are valid
6550 
6551  phi = slope_limiter(stencil(-1)-stencil(-2), stencil(0)-stencil(-1))
6552  flux_diff_cell = flux_diff_cell + abs(v_face) * dxh * time_step / dxdyh * &
6553  (stencil(-1) - phi * (stencil(-1)-stencil(0))/2)
6554 
6555  else ! h(j-1) is valid
6556  ! (o.w. flux would most likely be out of cell)
6557  ! but h(j-2) is not
6558  flux_diff_cell = flux_diff_cell + abs(v_face) * dxh * time_step / dxdyh * stencil(-1)
6559  endif
6560 
6561  elseif (v_face .lt. 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available
6562 
6563  if (hmask(i,j-1) * hmask(i,j+1) .eq. 1) then ! h(j-1) and h(j+1) are both valid
6564  phi = slope_limiter(stencil(0)-stencil(1), stencil(-1)-stencil(0))
6565  flux_diff_cell = flux_diff_cell - abs(v_face) * dxh * time_step / dxdyh * &
6566  (stencil(0) - phi * (stencil(0)-stencil(-1))/2)
6567  else
6568  flux_diff_cell = flux_diff_cell - abs(v_face) * dxh * time_step / dxdyh * stencil(0)
6569 
6570  if ((hmask(i,j-1) .eq. 0) .OR. (hmask(i,j-1) .eq. 2)) then
6571  flux_enter(i,j-1,4) = abs(v_face) * dyh * time_step * stencil(0)
6572  endif
6573 
6574  endif
6575 
6576  endif
6577 
6578  endif
6579 
6580  ! NEXT DO north FACE
6581 
6582  if (v_face_mask(i,j+1) .eq. 4.) then
6583 
6584  flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values(i,j+1) *&
6585  t_boundary(i,j+1)/ dxdyh
6586 ! assume no flux bc for temp
6587 ! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*t_boundary (i,j+1) / dxdyh
6588 
6589  else
6590 
6591  ! get u-velocity at center of right face
6592  v_face = 0.5 * (cs%v_shelf(i-1,j) + cs%v_shelf(i,j))
6593 
6594  if (v_face .lt. 0) then !flux is into cell - we need info from h(j+2), h(j+1) if available
6595 
6596  if (at_north_bdry .AND. (hmask(i,j+1).eq.3)) then ! at eastern bdry but there is a thickness bdry condition,
6597  ! and the stencil contains it
6598  flux_diff_cell = flux_diff_cell + abs(v_face) * dxh * time_step * stencil(1) / dxdyh
6599  elseif (hmask(i,j+1) * hmask(i,j+2) .eq. 1) then ! h(j+2) and h(j+1) are valid
6600  phi = slope_limiter(stencil(1)-stencil(2), stencil(0)-stencil(1))
6601  flux_diff_cell = flux_diff_cell + abs(v_face) * dxh * time_step / dxdyh * &
6602  (stencil(1) - phi * (stencil(1)-stencil(0))/2)
6603  else ! h(j+1) is valid
6604  ! (o.w. flux would most likely be out of cell)
6605  ! but h(j+2) is not
6606  flux_diff_cell = flux_diff_cell + abs(v_face) * dxh * time_step / dxdyh * stencil(1)
6607  endif
6608 
6609  elseif (v_face .gt. 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available
6610 
6611  if (hmask(i,j-1) * hmask(i,j+1) .eq. 1) then ! h(j-1) and h(j+1) are both valid
6612  phi = slope_limiter(stencil(0)-stencil(-1), stencil(1)-stencil(0))
6613  flux_diff_cell = flux_diff_cell - abs(v_face) * dxh * time_step / dxdyh * &
6614  (stencil(0) - phi * (stencil(0)-stencil(1))/2)
6615  else ! h(j+1) is valid
6616  ! (o.w. flux would most likely be out of cell)
6617  ! but h(j+2) is not
6618  flux_diff_cell = flux_diff_cell - abs(v_face) * dxh * time_step / dxdyh * stencil(0)
6619  if ((hmask(i,j+1) .eq. 0) .OR. (hmask(i,j+1) .eq. 2)) then
6620  flux_enter(i,j+1,3) = abs(v_face) * dxh * time_step * stencil(0)
6621  endif
6622  endif
6623 
6624  endif
6625 
6626  endif
6627 
6628  h_after_vflux(i,j) = h_after_vflux(i,j) + flux_diff_cell
6629 
6630  elseif ((hmask(i,j) .eq. 0) .OR. (hmask(i,j) .eq. 2)) then
6631 
6632  if (at_south_bdry .AND. (hmask(i,j-1) .EQ. 3)) then
6633  v_face = 0.5 * (cs%v_shelf(i-1,j-1) + cs%v_shelf(i,j-1))
6634  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)
6635  elseif (v_face_mask(i,j-1) .eq. 4.) then
6636  flux_enter(i,j,3) = g%dxT(i,j) * time_step * v_flux_boundary_values(i,j-1)*t_boundary(i,j-1)
6637 ! assume no flux bc for temp
6638 ! flux_enter (i,j,3) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*t_boundary (i,j-1)
6639 
6640  endif
6641 
6642  if (at_north_bdry .AND. (hmask(i,j+1) .EQ. 3)) then
6643  v_face = 0.5 * (cs%v_shelf(i-1,j) + cs%v_shelf(i,j))
6644  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)
6645  elseif (v_face_mask(i,j+1) .eq. 4.) then
6646  flux_enter(i,j,4) = g%dxT(i,j) * time_step * v_flux_boundary_values(i,j+1)*t_boundary(i,j+1)
6647 ! assume no flux bc for temp
6648 ! flux_enter (i,j,4) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*t_boundary (i,j+1)
6649  endif
6650 
6651 ! if ((j .eq. js) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i,j-1) .eq. 1)) then
6652  ! this is solely for the purposes of keeping the mask consistent while advancing the front without having
6653  ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered
6654  ! hmask (i,j) = 2
6655  ! elseif ((j .eq. je) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i,j+1) .eq. 1)) then
6656  ! this is solely for the purposes of keeping the mask consistent while advancing the front without having
6657  ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered
6658 ! hmask (i,j) = 2
6659 ! endif
6660 
6661  endif
6662  endif
6663  enddo ! j loop
6664  endif
6665  enddo ! i loop
6666 
6667  !write (procnum,'(I1)') mpp_pe()
6668 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the call graph for this function:
Here is the caller graph for this function:

◆ ice_shelf_advect_thickness_x()

subroutine mom_ice_shelf::ice_shelf_advect_thickness_x ( 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 
)
private

Definition at line 3123 of file MOM_ice_shelf.F90.

References slope_limiter().

Referenced by ice_shelf_advect().

3123  type(ice_shelf_cs), pointer :: cs
3124  real, intent(in) :: time_step
3125  real, dimension(:,:), intent(in) :: h0
3126  real, dimension(:,:), intent(inout) :: h_after_uflux
3127  real, dimension(:,:,:), intent(inout) :: flux_enter
3128 
3129  ! use will be made of CS%hmask here - its value at the boundary will be zero, just like uncovered cells
3130 
3131  ! if there is an input bdry condition, the thickness there will be set in initialization
3132 
3133  ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary
3134  !
3135  ! from left neighbor: flux_enter (:,:,1)
3136  ! from right neighbor: flux_enter (:,:,2)
3137  ! from bottom neighbor: flux_enter (:,:,3)
3138  ! from top neighbor: flux_enter (:,:,4)
3139  !
3140  ! o--- (4) ---o
3141  ! | |
3142  ! (1) (2)
3143  ! | |
3144  ! o--- (3) ---o
3145  !
3146 
3147  integer :: isym, i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied
3148  integer :: i_off, j_off
3149  logical :: at_east_bdry, at_west_bdry, one_off_west_bdry, one_off_east_bdry
3150  type(ocean_grid_type), pointer :: g
3151  real, dimension(-2:2) :: stencil
3152  real, dimension(:,:), pointer :: hmask, u_face_mask, u_flux_boundary_values
3153  real :: u_face, & ! positive if out
3154  flux_diff_cell, phi, dxh, dyh, dxdyh
3155 
3156  character (len=1) :: debug_str, procnum
3157 
3158 ! if (CS%grid%symmetric) then
3159 ! isym = 1
3160 ! else
3161 ! isym = 0
3162 ! endif
3163 
3164  isym = 0
3165 
3166  g => cs%grid
3167  hmask => cs%hmask
3168  u_face_mask => cs%u_face_mask
3169  u_flux_boundary_values => cs%u_flux_boundary_values
3170  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
3171  i_off = g%idg_offset ; j_off = g%jdg_offset
3172 
3173  do j=jsd+1,jed-1
3174  if (((j+j_off) .le. g%domain%njglobal+g%domain%njhalo) .AND. &
3175  ((j+j_off) .ge. g%domain%njhalo+1)) then ! based on mehmet's code - only if btw north & south boundaries
3176 
3177  stencil(:) = -1
3178 ! if (i+i_off .eq. G%domain%nihalo+G%domain%nihalo)
3179  do i=is,ie
3180 
3181  if (((i+i_off) .le. g%domain%niglobal+g%domain%nihalo) .AND. &
3182  ((i+i_off) .ge. g%domain%nihalo+1)) then
3183 
3184  if (i+i_off .eq. g%domain%nihalo+1) then
3185  at_west_bdry=.true.
3186  else
3187  at_west_bdry=.false.
3188  endif
3189 
3190  if (i+i_off .eq. g%domain%niglobal+g%domain%nihalo) then
3191  at_east_bdry=.true.
3192  else
3193  at_east_bdry=.false.
3194  endif
3195 
3196  if (hmask(i,j) .eq. 1) then
3197 
3198  dxh = g%dxT(i,j) ; dyh = g%dyT(i,j) ; dxdyh = g%areaT(i,j)
3199 
3200  h_after_uflux(i,j) = h0(i,j)
3201 
3202  stencil(:) = h0(i-2:i+2,j) ! fine as long has nx_halo >= 2
3203 
3204  flux_diff_cell = 0
3205 
3206  ! 1ST DO LEFT FACE
3207 
3208  if (u_face_mask(i-1,j) .eq. 4.) then
3209 
3210  flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values(i-1,j) / dxdyh
3211 
3212  else
3213 
3214  ! get u-velocity at center of left face
3215  u_face = 0.5 * (cs%u_shelf(i-1,j-1) + cs%u_shelf(i-1,j))
3216 
3217  ! if (at_west_bdry .and. (i .eq. G%isc)) then
3218  ! print *, j, u_face, stencil(-1)
3219  ! endif
3220 
3221  if (u_face .gt. 0) then !flux is into cell - we need info from h(i-2), h(i-1) if available
3222 
3223  ! i may not cover all the cases.. but i cover the realistic ones
3224 
3225  if (at_west_bdry .AND. (hmask(i-1,j).eq.3)) then ! at western bdry but there is a thickness bdry condition,
3226  ! and the stencil contains it
3227  stencil(-1) = cs%thickness_boundary_values(i-1,j)
3228  flux_diff_cell = flux_diff_cell + abs(u_face) * dyh * time_step * stencil(-1) / dxdyh
3229 
3230  elseif (hmask(i-1,j) * hmask(i-2,j) .eq. 1) then ! h(i-2) and h(i-1) are valid
3231  phi = slope_limiter(stencil(-1)-stencil(-2), stencil(0)-stencil(-1))
3232  flux_diff_cell = flux_diff_cell + abs(u_face) * dyh* time_step / dxdyh * &
3233  (stencil(-1) - phi * (stencil(-1)-stencil(0))/2)
3234 
3235  else ! h(i-1) is valid
3236  ! (o.w. flux would most likely be out of cell)
3237  ! but h(i-2) is not
3238 
3239  flux_diff_cell = flux_diff_cell + abs(u_face) * dyh * time_step / dxdyh * stencil(-1)
3240 
3241  endif
3242 
3243  elseif (u_face .lt. 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available
3244  if (hmask(i-1,j) * hmask(i+1,j) .eq. 1) then ! h(i-1) and h(i+1) are both valid
3245  phi = slope_limiter(stencil(0)-stencil(1), stencil(-1)-stencil(0))
3246  flux_diff_cell = flux_diff_cell - abs(u_face) * dyh * time_step / dxdyh * &
3247  (stencil(0) - phi * (stencil(0)-stencil(-1))/2)
3248 
3249  else
3250  flux_diff_cell = flux_diff_cell - abs(u_face) * dyh * time_step / dxdyh * stencil(0)
3251 
3252  if ((hmask(i-1,j) .eq. 0) .OR. (hmask(i-1,j) .eq. 2)) then
3253  flux_enter(i-1,j,2) = abs(u_face) * dyh * time_step * stencil(0)
3254  endif
3255  endif
3256  endif
3257  endif
3258 
3259  ! NEXT DO RIGHT FACE
3260 
3261  ! get u-velocity at center of right face
3262 
3263  if (u_face_mask(i+1,j) .eq. 4.) then
3264 
3265  flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values(i+1,j) / dxdyh
3266 
3267  else
3268 
3269  u_face = 0.5 * (cs%u_shelf(i,j-1) + cs%u_shelf(i,j))
3270 
3271  if (u_face .lt. 0) then !flux is into cell - we need info from h(i+2), h(i+1) if available
3272 
3273  if (at_east_bdry .AND. (hmask(i+1,j).eq.3)) then ! at eastern bdry but there is a thickness bdry condition,
3274  ! and the stencil contains it
3275 
3276  flux_diff_cell = flux_diff_cell + abs(u_face) * dyh * time_step * stencil(1) / dxdyh
3277 
3278  elseif (hmask(i+1,j) * hmask(i+2,j) .eq. 1) then ! h(i+2) and h(i+1) are valid
3279 
3280  phi = slope_limiter(stencil(1)-stencil(2), stencil(0)-stencil(1))
3281  flux_diff_cell = flux_diff_cell + abs(u_face) * dyh * time_step / dxdyh * &
3282  (stencil(1) - phi * (stencil(1)-stencil(0))/2)
3283 
3284  else ! h(i+1) is valid
3285  ! (o.w. flux would most likely be out of cell)
3286  ! but h(i+2) is not
3287 
3288  flux_diff_cell = flux_diff_cell + abs(u_face) * dyh * time_step / dxdyh * stencil(1)
3289 
3290  endif
3291 
3292  elseif (u_face .gt. 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available
3293 
3294  if (hmask(i-1,j) * hmask(i+1,j) .eq. 1) then ! h(i-1) and h(i+1) are both valid
3295 
3296  phi = slope_limiter(stencil(0)-stencil(-1), stencil(1)-stencil(0))
3297  flux_diff_cell = flux_diff_cell - abs(u_face) * dyh * time_step / dxdyh * &
3298  (stencil(0) - phi * (stencil(0)-stencil(1))/2)
3299 
3300  else ! h(i+1) is valid
3301  ! (o.w. flux would most likely be out of cell)
3302  ! but h(i+2) is not
3303 
3304  flux_diff_cell = flux_diff_cell - abs(u_face) * dyh * time_step / dxdyh * stencil(0)
3305 
3306  if ((hmask(i+1,j) .eq. 0) .OR. (hmask(i+1,j) .eq. 2)) then
3307  flux_enter(i+1,j,1) = abs(u_face) * dyh * time_step * stencil(0)
3308  endif
3309 
3310  endif
3311 
3312  endif
3313 
3314  h_after_uflux(i,j) = h_after_uflux(i,j) + flux_diff_cell
3315 
3316  endif
3317 
3318  elseif ((hmask(i,j) .eq. 0) .OR. (hmask(i,j) .eq. 2)) then
3319 
3320  if (at_west_bdry .AND. (hmask(i-1,j) .EQ. 3)) then
3321  u_face = 0.5 * (cs%u_shelf(i-1,j-1) + cs%u_shelf(i-1,j))
3322  flux_enter(i,j,1) = abs(u_face) * g%dyT(i,j) * time_step * cs%thickness_boundary_values(i-1,j)
3323  elseif (u_face_mask(i-1,j) .eq. 4.) then
3324  flux_enter(i,j,1) = g%dyT(i,j) * time_step * u_flux_boundary_values(i-1,j)
3325  endif
3326 
3327  if (at_east_bdry .AND. (hmask(i+1,j) .EQ. 3)) then
3328  u_face = 0.5 * (cs%u_shelf(i,j-1) + cs%u_shelf(i,j))
3329  flux_enter(i,j,2) = abs(u_face) * g%dyT(i,j) * time_step * cs%thickness_boundary_values(i+1,j)
3330  elseif (u_face_mask(i+1,j) .eq. 4.) then
3331  flux_enter(i,j,2) = g%dyT(i,j) * time_step * u_flux_boundary_values(i+1,j)
3332  endif
3333 
3334  if ((i .eq. is) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i-1,j) .eq. 1)) then
3335  ! this is solely for the purposes of keeping the mask consistent while advancing the front without having
3336  ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered
3337 
3338  hmask(i,j) = 2
3339  elseif ((i .eq. ie) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i+1,j) .eq. 1)) then
3340  ! this is solely for the purposes of keeping the mask consistent while advancing the front without having
3341  ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered
3342 
3343  hmask(i,j) = 2
3344 
3345  endif
3346 
3347  endif
3348 
3349  endif
3350 
3351  enddo ! i loop
3352 
3353  endif
3354 
3355  enddo ! j loop
3356 
3357 ! write (procnum,'(I1)') mpp_pe()
3358 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the call graph for this function:
Here is the caller graph for this function:

◆ ice_shelf_advect_thickness_y()

subroutine mom_ice_shelf::ice_shelf_advect_thickness_y ( 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 
)
private

Definition at line 3362 of file MOM_ice_shelf.F90.

References slope_limiter().

Referenced by ice_shelf_advect().

3362  type(ice_shelf_cs), pointer :: cs
3363  real, intent(in) :: time_step
3364  real, dimension(:,:), intent(in) :: h_after_uflux
3365  real, dimension(:,:), intent(inout) :: h_after_vflux
3366  real, dimension(:,:,:), intent(inout) :: flux_enter
3367 
3368  ! use will be made of CS%hmask here - its value at the boundary will be zero, just like uncovered cells
3369 
3370  ! if there is an input bdry condition, the thickness there will be set in initialization
3371 
3372  ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary
3373  !
3374  ! from left neighbor: flux_enter (:,:,1)
3375  ! from right neighbor: flux_enter (:,:,2)
3376  ! from bottom neighbor: flux_enter (:,:,3)
3377  ! from top neighbor: flux_enter (:,:,4)
3378  !
3379  ! o--- (4) ---o
3380  ! | |
3381  ! (1) (2)
3382  ! | |
3383  ! o--- (3) ---o
3384  !
3385 
3386  integer :: isym, i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied
3387  integer :: i_off, j_off
3388  logical :: at_north_bdry, at_south_bdry, one_off_west_bdry, one_off_east_bdry
3389  type(ocean_grid_type), pointer :: g
3390  real, dimension(-2:2) :: stencil
3391  real, dimension(:,:), pointer :: hmask, v_face_mask, v_flux_boundary_values
3392  real :: v_face, & ! positive if out
3393  flux_diff_cell, phi, dxh, dyh, dxdyh
3394  character(len=1) :: debug_str, procnum
3395 
3396 ! if (CS%grid%symmetric) then
3397 ! isym = 1
3398 ! else
3399 ! isym = 0
3400 ! endif
3401 
3402  isym = 0
3403 
3404  g => cs%grid
3405  hmask => cs%hmask
3406  v_face_mask => cs%v_face_mask
3407  v_flux_boundary_values => cs%v_flux_boundary_values
3408  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
3409  i_off = g%idg_offset ; j_off = g%jdg_offset
3410 
3411  do i=isd+2,ied-2
3412  if (((i+i_off) .le. g%domain%niglobal+g%domain%nihalo) .AND. &
3413  ((i+i_off) .ge. g%domain%nihalo+1)) then ! based on mehmet's code - only if btw east & west boundaries
3414 
3415  stencil(:) = -1
3416 
3417  do j=js,je
3418 
3419  if (((j+j_off) .le. g%domain%njglobal+g%domain%njhalo) .AND. &
3420  ((j+j_off) .ge. g%domain%njhalo+1)) then
3421 
3422  if (j+j_off .eq. g%domain%njhalo+1) then
3423  at_south_bdry=.true.
3424  else
3425  at_south_bdry=.false.
3426  endif
3427 
3428  if (j+j_off .eq. g%domain%njglobal+g%domain%njhalo) then
3429  at_north_bdry=.true.
3430  else
3431  at_north_bdry=.false.
3432  endif
3433 
3434  if (hmask(i,j) .eq. 1) then
3435  dxh = g%dxT(i,j) ; dyh = g%dyT(i,j) ; dxdyh = g%areaT(i,j)
3436  h_after_vflux(i,j) = h_after_uflux(i,j)
3437 
3438  stencil(:) = h_after_uflux(i,j-2:j+2) ! fine as long has ny_halo >= 2
3439  flux_diff_cell = 0
3440 
3441  ! 1ST DO south FACE
3442 
3443  if (v_face_mask(i,j-1) .eq. 4.) then
3444 
3445  flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values(i,j-1) / dxdyh
3446 
3447  else
3448 
3449  ! get u-velocity at center of left face
3450  v_face = 0.5 * (cs%v_shelf(i-1,j-1) + cs%v_shelf(i,j-1))
3451 
3452  if (v_face .gt. 0) then !flux is into cell - we need info from h(j-2), h(j-1) if available
3453 
3454  ! i may not cover all the cases.. but i cover the realistic ones
3455 
3456  if (at_south_bdry .AND. (hmask(i,j-1).eq.3)) then ! at western bdry but there is a thickness bdry condition,
3457  ! and the stencil contains it
3458  flux_diff_cell = flux_diff_cell + abs(v_face) * dxh * time_step * stencil(-1) / dxdyh
3459 
3460  elseif (hmask(i,j-1) * hmask(i,j-2) .eq. 1) then ! h(j-2) and h(j-1) are valid
3461 
3462  phi = slope_limiter(stencil(-1)-stencil(-2), stencil(0)-stencil(-1))
3463  flux_diff_cell = flux_diff_cell + abs(v_face) * dxh * time_step / dxdyh * &
3464  (stencil(-1) - phi * (stencil(-1)-stencil(0))/2)
3465 
3466  else ! h(j-1) is valid
3467  ! (o.w. flux would most likely be out of cell)
3468  ! but h(j-2) is not
3469  flux_diff_cell = flux_diff_cell + abs(v_face) * dxh * time_step / dxdyh * stencil(-1)
3470  endif
3471 
3472  elseif (v_face .lt. 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available
3473 
3474  if (hmask(i,j-1) * hmask(i,j+1) .eq. 1) then ! h(j-1) and h(j+1) are both valid
3475  phi = slope_limiter(stencil(0)-stencil(1), stencil(-1)-stencil(0))
3476  flux_diff_cell = flux_diff_cell - abs(v_face) * dxh * time_step / dxdyh * &
3477  (stencil(0) - phi * (stencil(0)-stencil(-1))/2)
3478  else
3479  flux_diff_cell = flux_diff_cell - abs(v_face) * dxh * time_step / dxdyh * stencil(0)
3480 
3481  if ((hmask(i,j-1) .eq. 0) .OR. (hmask(i,j-1) .eq. 2)) then
3482  flux_enter(i,j-1,4) = abs(v_face) * dyh * time_step * stencil(0)
3483  endif
3484 
3485  endif
3486 
3487  endif
3488 
3489  endif
3490 
3491  ! NEXT DO north FACE
3492 
3493  if (v_face_mask(i,j+1) .eq. 4.) then
3494 
3495  flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values(i,j+1) / dxdyh
3496 
3497  else
3498 
3499  ! get u-velocity at center of right face
3500  v_face = 0.5 * (cs%v_shelf(i-1,j) + cs%v_shelf(i,j))
3501 
3502  if (v_face .lt. 0) then !flux is into cell - we need info from h(j+2), h(j+1) if available
3503 
3504  if (at_north_bdry .AND. (hmask(i,j+1).eq.3)) then ! at eastern bdry but there is a thickness bdry condition,
3505  ! and the stencil contains it
3506  flux_diff_cell = flux_diff_cell + abs(v_face) * dxh * time_step * stencil(1) / dxdyh
3507  elseif (hmask(i,j+1) * hmask(i,j+2) .eq. 1) then ! h(j+2) and h(j+1) are valid
3508  phi = slope_limiter(stencil(1)-stencil(2), stencil(0)-stencil(1))
3509  flux_diff_cell = flux_diff_cell + abs(v_face) * dxh * time_step / dxdyh * &
3510  (stencil(1) - phi * (stencil(1)-stencil(0))/2)
3511  else ! h(j+1) is valid
3512  ! (o.w. flux would most likely be out of cell)
3513  ! but h(j+2) is not
3514  flux_diff_cell = flux_diff_cell + abs(v_face) * dxh * time_step / dxdyh * stencil(1)
3515  endif
3516 
3517  elseif (v_face .gt. 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available
3518 
3519  if (hmask(i,j-1) * hmask(i,j+1) .eq. 1) then ! h(j-1) and h(j+1) are both valid
3520  phi = slope_limiter(stencil(0)-stencil(-1), stencil(1)-stencil(0))
3521  flux_diff_cell = flux_diff_cell - abs(v_face) * dxh * time_step / dxdyh * &
3522  (stencil(0) - phi * (stencil(0)-stencil(1))/2)
3523  else ! h(j+1) is valid
3524  ! (o.w. flux would most likely be out of cell)
3525  ! but h(j+2) is not
3526  flux_diff_cell = flux_diff_cell - abs(v_face) * dxh * time_step / dxdyh * stencil(0)
3527  if ((hmask(i,j+1) .eq. 0) .OR. (hmask(i,j+1) .eq. 2)) then
3528  flux_enter(i,j+1,3) = abs(v_face) * dxh * time_step * stencil(0)
3529  endif
3530  endif
3531 
3532  endif
3533 
3534  endif
3535 
3536  h_after_vflux(i,j) = h_after_vflux(i,j) + flux_diff_cell
3537 
3538  elseif ((hmask(i,j) .eq. 0) .OR. (hmask(i,j) .eq. 2)) then
3539 
3540  if (at_south_bdry .AND. (hmask(i,j-1) .EQ. 3)) then
3541  v_face = 0.5 * (cs%u_shelf(i-1,j-1) + cs%u_shelf(i,j-1))
3542  flux_enter(i,j,3) = abs(v_face) * g%dxT(i,j) * time_step * cs%thickness_boundary_values(i,j-1)
3543  elseif (v_face_mask(i,j-1) .eq. 4.) then
3544  flux_enter(i,j,3) = g%dxT(i,j) * time_step * v_flux_boundary_values(i,j-1)
3545  endif
3546 
3547  if (at_north_bdry .AND. (hmask(i,j+1) .EQ. 3)) then
3548  v_face = 0.5 * (cs%u_shelf(i-1,j) + cs%u_shelf(i,j))
3549  flux_enter(i,j,4) = abs(v_face) * g%dxT(i,j) * time_step * cs%thickness_boundary_values(i,j+1)
3550  elseif (v_face_mask(i,j+1) .eq. 4.) then
3551  flux_enter(i,j,4) = g%dxT(i,j) * time_step * v_flux_boundary_values(i,j+1)
3552  endif
3553 
3554  if ((j .eq. js) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i,j-1) .eq. 1)) then
3555  ! this is solely for the purposes of keeping the mask consistent while advancing the front without having
3556  ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered
3557  hmask(i,j) = 2
3558  elseif ((j .eq. je) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i,j+1) .eq. 1)) then
3559  ! this is solely for the purposes of keeping the mask consistent while advancing the front without having
3560  ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered
3561  hmask(i,j) = 2
3562  endif
3563 
3564  endif
3565  endif
3566  enddo ! j loop
3567  endif
3568  enddo ! i loop
3569 
3570  !write (procnum,'(I1)') mpp_pe()
3571 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the call graph for this function:
Here is the caller graph for this function:

◆ ice_shelf_end()

subroutine, public mom_ice_shelf::ice_shelf_end ( type(ice_shelf_cs), pointer  CS)

Deallocates all memory associated with this module.

Definition at line 5792 of file MOM_ice_shelf.F90.

Referenced by mom_main(), and ocean_model_mod::ocean_model_end().

5792  type(ice_shelf_cs), pointer :: cs
5793 
5794  if (.not.associated(cs)) return
5795 
5796  deallocate(cs%mass_shelf) ; deallocate(cs%area_shelf_h)
5797  deallocate(cs%t_flux) ; deallocate(cs%lprec)
5798  deallocate(cs%salt_flux)
5799 
5800  deallocate(cs%tflux_shelf) ; deallocate(cs%tfreeze);
5801  deallocate(cs%exch_vel_t) ; deallocate(cs%exch_vel_s)
5802 
5803  deallocate(cs%h_shelf) ; deallocate(cs%hmask)
5804 
5805  if (cs%shelf_mass_is_dynamic .and. .not.cs%override_shelf_movement) then
5806  deallocate(cs%u_shelf) ; deallocate(cs%v_shelf)
5807 !!! OVS !!!
5808  deallocate(cs%t_shelf); deallocate(cs%tmask);
5809  deallocate(cs%t_boundary_values)
5810  deallocate(cs%u_boundary_values) ; deallocate(cs%v_boundary_values)
5811  deallocate(cs%ice_visc_bilinear)
5812  deallocate(cs%ice_visc_lower_tri) ; deallocate(cs%ice_visc_upper_tri)
5813  deallocate(cs%u_face_mask) ; deallocate(cs%v_face_mask)
5814  deallocate(cs%umask) ; deallocate(cs%vmask)
5815 
5816  deallocate(cs%taub_beta_eff_bilinear)
5817  deallocate(cs%taub_beta_eff_upper_tri)
5818  deallocate(cs%taub_beta_eff_lower_tri)
5819  deallocate(cs%OD_rt) ; deallocate(cs%OD_av)
5820  deallocate(cs%float_frac) ; deallocate(cs%float_frac_rt)
5821  endif
5822 
5823  deallocate(cs)
5824 
Here is the caller graph for this function:

◆ ice_shelf_min_thickness_calve()

subroutine mom_ice_shelf::ice_shelf_min_thickness_calve ( type(ice_shelf_cs), pointer  CS,
real, dimension(:,:), intent(inout)  h_shelf,
real, dimension(:,:), intent(inout)  area_shelf_h,
real, dimension(:,:), intent(inout)  hmask 
)
private

Apply a very simple calving law using a minimum thickness rule.

Definition at line 3768 of file MOM_ice_shelf.F90.

Referenced by add_shelf_flux(), ice_shelf_advect(), initialize_ice_shelf(), and update_shelf_mass().

3768  type(ice_shelf_cs), pointer :: cs
3769  real, dimension(:,:), intent(inout) :: h_shelf, area_shelf_h, hmask
3770  type(ocean_grid_type), pointer :: g
3771  integer :: i,j
3772 
3773  g => cs%grid
3774 
3775  do j=g%jsd,g%jed
3776  do i=g%isd,g%ied
3777 ! if ((h_shelf(i,j) .lt. CS%min_thickness_simple_calve) .and. (hmask(i,j).eq.1) .and. &
3778 ! (CS%float_frac(i,j) .eq. 0.0)) then
3779  if ((h_shelf(i,j) .lt. cs%min_thickness_simple_calve) .and. (area_shelf_h(i,j).gt. 0.)) then
3780  h_shelf(i,j) = 0.0
3781  area_shelf_h(i,j) = 0.0
3782  hmask(i,j) = 0.0
3783  endif
3784  enddo
3785  enddo
3786 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the caller graph for this function:

◆ ice_shelf_save_restart()

subroutine, public mom_ice_shelf::ice_shelf_save_restart ( type(ice_shelf_cs), pointer  CS,
type(time_type), intent(in)  Time,
character(len=*), intent(in), optional  directory,
logical, intent(in), optional  time_stamped,
character(len=*), intent(in), optional  filename_suffix 
)

Save the ice shelf restart file.

Parameters
csice shelf control structure
[in]timemodel time at this call
[in]directoryAn optional directory into which to write these restart files.
[in]time_stampedf true, the restart file names include a unique time stamp. The default is false.
[in]filename_suffixAn optional suffix (e.g., a time-stamp) to append to the restart file names.

Definition at line 2167 of file MOM_ice_shelf.F90.

Referenced by mom_main(), ocean_model_mod::ocean_model_restart(), and ocean_model_mod::ocean_model_save_restart().

2167  type(ice_shelf_cs), pointer :: cs !< ice shelf control structure
2168  type(time_type), intent(in) :: time !< model time at this call
2169  character(len=*), optional, intent(in) :: directory !< An optional directory into which to write
2170  !! these restart files.
2171  logical, optional, intent(in) :: time_stamped !< f true, the restart file names include
2172  !! a unique time stamp. The default is false.
2173  character(len=*), optional, intent(in) :: filename_suffix !< An optional suffix (e.g., a
2174  !! time-stamp) to append to the restart file names.
2175  ! local variables
2176  type(ocean_grid_type), pointer :: g
2177  character(len=200) :: restart_dir
2178  character(2) :: procnum
2179 
2180  g => cs%grid
2181 
2182 ! write (procnum,'(I2)') mpp_pe()
2183 
2184  !### THESE ARE ONLY HERE FOR DEBUGGING?
2185 ! call savearray2 ("U_before_"//"p"//trim(procnum),CS%u_shelf,CS%write_output_to_file)
2186 ! call savearray2 ("V_before_"//"p"//trim(procnum),CS%v_shelf,CS%write_output_to_file)
2187 ! call savearray2 ("H_before_"//"p"//trim(procnum),CS%h_shelf,CS%write_output_to_file)
2188 ! call savearray2 ("Hmask_before_"//"p"//trim(procnum),CS%hmask,CS%write_output_to_file)
2189 ! call savearray2 ("Harea_before_"//"p"//trim(procnum),CS%area_shelf_h,CS%write_output_to_file)
2190 ! call savearray2 ("Visc_before_"//"p"//trim(procnum),CS%ice_visc_bilinear,CS%write_output_to_file)
2191 ! call savearray2 ("taub_before_"//"p"//trim(procnum),CS%taub_beta_eff_bilinear,CS%write_output_to_file)
2192 ! call savearray2 ("taub_before_"//"p"//trim(procnum),CS%taub_beta_eff_bilinear,CS%write_output_to_file)
2193  if (present(directory)) then ; restart_dir = directory
2194  else ; restart_dir = cs%restart_output_dir ; endif
2195 
2196  call save_restart(restart_dir, time, cs%grid, cs%restart_CSp, time_stamped)
2197 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the caller graph for this function:

◆ ice_shelf_solve_inner()

subroutine mom_ice_shelf::ice_shelf_solve_inner ( type(ice_shelf_cs), pointer  CS,
real, dimension( : , : ), intent(inout)  u,
real, dimension( : , : ), intent(inout)  v,
real, dimension( : , : ), intent(in)  taudx,
real, dimension( : , : ), intent(in)  taudy,
real, dimension( : , : ), intent(in)  H_node,
real, dimension(:,:), intent(in)  float_cond,
integer, intent(in)  FE,
integer, intent(out)  conv_flag,
integer, intent(out)  iters,
type(time_type)  time,
real, dimension(:,:,:,:), pointer  Phi,
real, dimension (:,:,:,:,:,:), pointer  Phisub 
)
private

Definition at line 2677 of file MOM_ice_shelf.F90.

References apply_boundary_values_bilinear(), apply_boundary_values_triangle(), cg_action_bilinear(), cg_action_triangular(), matrix_diagonal_bilinear(), and matrix_diagonal_triangle().

Referenced by ice_shelf_solve_outer().

2677  type(ice_shelf_cs), pointer :: cs
2678  real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u, v
2679  real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(in) :: taudx, taudy, h_node
2680  real, dimension(:,:),intent(in) :: float_cond
2681  integer, intent(in) :: fe
2682  integer, intent(out) :: conv_flag, iters
2683  type(time_type) :: time
2684  real, pointer, dimension(:,:,:,:) :: phi
2685  real, dimension (:,:,:,:,:,:),pointer :: phisub
2686 
2687 ! one linear solve (nonlinear iteration) of the solution for velocity
2688 
2689 ! in this subroutine:
2690 ! boundary contributions are added to taud to get the RHS
2691 ! diagonal of matrix is found (for Jacobi precondition)
2692 ! CG iteration is carried out for max. iterations or until convergence
2693 
2694 ! assumed - u, v, taud, visc, beta_eff are valid on the halo
2695 
2696 
2697  real, dimension(:,:), pointer :: hmask, umask, vmask, u_bdry, v_bdry, &
2698  visc, visc_lo, beta, beta_lo, geolonq, geolatq
2699  real, dimension(LBOUND(u,1):UBOUND(u,1),LBOUND(u,2):UBOUND(u,2)) :: &
2700  ru, rv, zu, zv, diagu, diagv, rhsu, rhsv, &
2701  ubd, vbd, au, av, du, dv, &
2702  zu_old, zv_old, ru_old, rv_old, &
2703  sum_vec, sum_vec_2
2704  integer :: iter, i, j, isym, isd, ied, jsd, jed, &
2705  isc, iec, jsc, jec, is, js, ie, je, isumstart, jsumstart, &
2706  isdq, iedq, jsdq, jedq, iscq, iecq, jscq, jecq, nx_halo, ny_halo
2707  real :: tol, beta_k, alpha_k, area, dot_p1, dot_p2, resid0, cg_halo, dot_p1a, dot_p2a
2708  type(ocean_grid_type), pointer :: g
2709  character(1) :: procnum
2710  character(2) :: gridsize
2711 
2712  real, dimension (8,4) :: phi_temp
2713  real, dimension (2,2) :: x,y
2714 
2715  hmask => cs%hmask
2716  umask => cs%umask
2717  vmask => cs%vmask
2718  u_bdry => cs%u_boundary_values
2719  v_bdry => cs%v_boundary_values
2720 
2721  g => cs%grid
2722  geolonq => g%geoLonBu
2723  geolatq => g%geoLatBu
2724  hmask => cs%hmask
2725  isdq = g%isdB ; iedq = g%iedB ; jsdq = g%jsdB ; jedq = g%jedB
2726  iscq = g%iscB ; iecq = g%iecB ; jscq = g%jscB ; jecq = g%jecB
2727  ny_halo = g%domain%njhalo ; nx_halo = g%domain%nihalo
2728  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
2729  isc = g%isc ; iec = g%iec ; jsc = g%jsc ; jec = g%jec
2730 
2731  zu(:,:) = 0 ; zv(:,:) = 0 ; diagu(:,:) = 0 ; diagv(:,:) = 0
2732  ru(:,:) = 0 ; rv(:,:) = 0 ; au(:,:) = 0 ; av(:,:) = 0
2733  du(:,:) = 0 ; dv(:,:) = 0 ; ubd(:,:) = 0 ; vbd(:,:) = 0
2734  dot_p1 = 0 ; dot_p2 = 0
2735 
2736 ! if (G%symmetric) then
2737 ! isym = 1
2738 ! else
2739 ! isym = 0
2740 ! endif
2741 
2742  isym = 0
2743 
2744  if (g%isc+g%idg_offset==g%isg) then
2745  ! tile is at west bdry
2746  isumstart = g%iscB
2747  else
2748  ! tile is interior
2749  isumstart = isumstart_int_
2750  endif
2751 
2752  if (g%jsc+g%jdg_offset==g%jsg) then
2753  ! tile is at south bdry
2754  jsumstart = g%jscB
2755  else
2756  ! tile is interior
2757  jsumstart = jsumstart_int_
2758  endif
2759 
2760  if (fe .eq. 1) then
2761  visc => cs%ice_visc_bilinear
2762  beta => cs%taub_beta_eff_bilinear
2763  elseif (fe .eq. 2) then
2764  visc => cs%ice_visc_upper_tri
2765  visc_lo => cs%ice_visc_lower_tri
2766  beta => cs%taub_beta_eff_upper_tri
2767  beta_lo => cs%taub_beta_eff_lower_tri
2768  endif
2769 
2770  if (fe .eq. 1) then
2771  call apply_boundary_values_bilinear (cs, time, phisub, h_node, float_cond, &
2772  cs%density_ice/cs%density_ocean_avg, ubd, vbd)
2773  elseif (fe .eq. 2) then
2774  call apply_boundary_values_triangle (cs, time, ubd, vbd)
2775  endif
2776 
2777  rhsu(:,:) = taudx(:,:) - ubd(:,:)
2778  rhsv(:,:) = taudy(:,:) - vbd(:,:)
2779 
2780 
2781  call pass_vector(rhsu, rhsv, g%domain, to_all, bgrid_ne)
2782 
2783 
2784  if (fe .eq. 1) then
2785  call matrix_diagonal_bilinear(cs, float_cond, h_node, &
2786  cs%density_ice/cs%density_ocean_avg, phisub, diagu, diagv)
2787 ! DIAGu(:,:) = 1 ; DIAGv(:,:) = 1
2788  elseif (fe .eq. 2) then
2789  call matrix_diagonal_triangle (cs, diagu, diagv)
2790  diagu(:,:) = 1 ; diagv(:,:) = 1
2791  endif
2792 
2793  call pass_vector(diagu, diagv, g%domain, to_all, bgrid_ne)
2794 
2795 
2796 
2797  if (fe .eq. 1) then
2798  call cg_action_bilinear (au, av, u, v, phi, phisub, umask, vmask, hmask, &
2799  h_node, visc, float_cond, g%bathyT, beta, g%areaT, isc-1, iec+1, jsc-1, &
2800  jec+1, cs%density_ice/cs%density_ocean_avg)
2801  elseif (fe .eq. 2) then
2802  call cg_action_triangular (au, av, u, v, umask, vmask, hmask, visc, visc_lo, &
2803  beta, beta_lo, g%dxT, g%dyT, g%areaT, isc-1, iec+1, jsc-1, jec+1, isym)
2804  endif
2805 
2806  call pass_vector(au, av, g%domain, to_all, bgrid_ne)
2807 
2808  ru(:,:) = rhsu(:,:) - au(:,:) ; rv(:,:) = rhsv(:,:) - av(:,:)
2809 
2810  if (.not. cs%use_reproducing_sums) then
2811 
2812  do j=jsumstart,jecq
2813  do i=isumstart,iecq
2814  if (umask(i,j) .eq. 1) dot_p1 = dot_p1 + ru(i,j)**2
2815  if (vmask(i,j) .eq. 1) dot_p1 = dot_p1 + rv(i,j)**2
2816  enddo
2817  enddo
2818 
2819  call mpp_sum (dot_p1)
2820 
2821  else
2822 
2823  sum_vec(:,:) = 0.0
2824 
2825  do j=jsumstart_int_,jecq
2826  do i=isumstart_int_,iecq
2827  if (umask(i,j) .eq. 1) sum_vec(i,j) = ru(i,j)**2
2828  if (vmask(i,j) .eq. 1) sum_vec(i,j) = sum_vec(i,j) + rv(i,j)**2
2829  enddo
2830  enddo
2831 
2832  dot_p1 = reproducing_sum( sum_vec, isumstart_int_, iecq, &
2833  jsumstart_int_, jecq )
2834 
2835  endif
2836 
2837  resid0 = sqrt(dot_p1)
2838 
2839  do j=jsdq,jedq
2840  do i=isdq,iedq
2841  if (umask(i,j) .eq. 1) zu(i,j) = ru(i,j) / diagu(i,j)
2842  if (vmask(i,j) .eq. 1) zv(i,j) = rv(i,j) / diagv(i,j)
2843  enddo
2844  enddo
2845 
2846  du(:,:) = zu(:,:) ; dv(:,:) = zv(:,:)
2847 
2848  cg_halo = 3
2849  conv_flag = 0
2850 
2851  !!!!!!!!!!!!!!!!!!
2852  !! !!
2853  !! MAIN CG LOOP !!
2854  !! !!
2855  !!!!!!!!!!!!!!!!!!
2856 
2857 
2858 
2859  ! initially, c-grid data is valid up to 3 halo nodes out
2860 
2861  do iter = 1,cs%cg_max_iterations
2862 
2863  ! assume asymmetry
2864  ! thus we can never assume that any arrays are legit more than 3 vertices past
2865  ! the computational domain - this is their state in the initial iteration
2866 
2867 
2868  is = isc - cg_halo ; ie = iecq + cg_halo
2869  js = jscq - cg_halo ; je = jecq + cg_halo
2870 
2871  au(:,:) = 0 ; av(:,:) = 0
2872 
2873  if (fe .eq. 1) then
2874 
2875  call cg_action_bilinear (au, av, du, dv, phi, phisub, umask, vmask, hmask, &
2876  h_node, visc, float_cond, g%bathyT, beta, g%areaT, is, ie, js, &
2877  je, cs%density_ice/cs%density_ocean_avg)
2878 
2879  elseif (fe .eq. 2) then
2880 
2881  call cg_action_triangular (au, av, du, dv, umask, vmask, hmask, visc, visc_lo, &
2882  beta, beta_lo, g%dxT, g%dyT, g%areaT, is, ie, js, je, isym)
2883  endif
2884 
2885 
2886  ! Au, Av valid region moves in by 1
2887 
2888  if ( .not. cs%use_reproducing_sums) then
2889 
2890 
2891  ! alpha_k = (Z \dot R) / (D \dot AD}
2892  dot_p1 = 0 ; dot_p2 = 0
2893  do j=jsumstart,jecq
2894  do i=isumstart,iecq
2895  if (umask(i,j) .eq. 1) then
2896  dot_p1 = dot_p1 + zu(i,j)*ru(i,j)
2897  dot_p2 = dot_p2 + du(i,j)*au(i,j)
2898  endif
2899  if (vmask(i,j) .eq. 1) then
2900  dot_p1 = dot_p1 + zv(i,j)*rv(i,j)
2901  dot_p2 = dot_p2 + dv(i,j)*av(i,j)
2902  endif
2903  enddo
2904  enddo
2905  call mpp_sum (dot_p1) ; call mpp_sum (dot_p2)
2906  else
2907 
2908  sum_vec(:,:) = 0.0 ; sum_vec_2(:,:) = 0.0
2909 
2910  do j=jscq,jecq
2911  do i=iscq,iecq
2912  if (umask(i,j) .eq. 1) sum_vec(i,j) = zu(i,j) * ru(i,j)
2913  if (vmask(i,j) .eq. 1) sum_vec(i,j) = sum_vec(i,j) + &
2914  zv(i,j) * rv(i,j)
2915 
2916  if (umask(i,j) .eq. 1) sum_vec_2(i,j) = du(i,j) * au(i,j)
2917  if (vmask(i,j) .eq. 1) sum_vec_2(i,j) = sum_vec_2(i,j) + &
2918  dv(i,j) * av(i,j)
2919  enddo
2920  enddo
2921 
2922  dot_p1 = reproducing_sum( sum_vec, iscq, iecq, &
2923  jscq, jecq )
2924 
2925  dot_p2 = reproducing_sum( sum_vec_2, iscq, iecq, &
2926  jscq, jecq )
2927 
2928  endif
2929 
2930  alpha_k = dot_p1/dot_p2
2931 
2932  !### These should probably use explicit index notation so that they are
2933  !### not applied outside of the valid range. - RWH
2934 
2935  ! u(:,:) = u(:,:) + alpha_k * Du(:,:)
2936  ! v(:,:) = v(:,:) + alpha_k * Dv(:,:)
2937 
2938  do j=jsd,jed
2939  do i=isd,ied
2940  if (umask(i,j) .eq. 1) u(i,j) = u(i,j) + alpha_k * du(i,j)
2941  if (vmask(i,j) .eq. 1) v(i,j) = v(i,j) + alpha_k * dv(i,j)
2942  enddo
2943  enddo
2944 
2945  do j=jsd,jed
2946  do i=isd,ied
2947  if (umask(i,j) .eq. 1) then
2948  ru_old(i,j) = ru(i,j) ; zu_old(i,j) = zu(i,j)
2949  endif
2950  if (vmask(i,j) .eq. 1) then
2951  rv_old(i,j) = rv(i,j) ; zv_old(i,j) = zv(i,j)
2952  endif
2953  enddo
2954  enddo
2955 
2956 ! Ru(:,:) = Ru(:,:) - alpha_k * Au(:,:)
2957 ! Rv(:,:) = Rv(:,:) - alpha_k * Av(:,:)
2958 
2959  do j=jsd,jed
2960  do i=isd,ied
2961  if (umask(i,j) .eq. 1) ru(i,j) = ru(i,j) - alpha_k * au(i,j)
2962  if (vmask(i,j) .eq. 1) rv(i,j) = rv(i,j) - alpha_k * av(i,j)
2963  enddo
2964  enddo
2965 
2966 
2967  do j=jsdq,jedq
2968  do i=isdq,iedq
2969  if (umask(i,j) .eq. 1) then
2970  zu(i,j) = ru(i,j) / diagu(i,j)
2971  endif
2972  if (vmask(i,j) .eq. 1) then
2973  zv(i,j) = rv(i,j) / diagv(i,j)
2974  endif
2975  enddo
2976  enddo
2977 
2978  ! R,u,v,Z valid region moves in by 1
2979 
2980  if (.not. cs%use_reproducing_sums) then
2981 
2982  ! beta_k = (Z \dot R) / (Zold \dot Rold}
2983  dot_p1 = 0 ; dot_p2 = 0
2984  do j=jsumstart,jecq
2985  do i=isumstart,iecq
2986  if (umask(i,j) .eq. 1) then
2987  dot_p1 = dot_p1 + zu(i,j)*ru(i,j)
2988  dot_p2 = dot_p2 + zu_old(i,j)*ru_old(i,j)
2989  endif
2990  if (vmask(i,j) .eq. 1) then
2991  dot_p1 = dot_p1 + zv(i,j)*rv(i,j)
2992  dot_p2 = dot_p2 + zv_old(i,j)*rv_old(i,j)
2993  endif
2994  enddo
2995  enddo
2996  call mpp_sum (dot_p1) ; call mpp_sum (dot_p2)
2997 
2998 
2999  else
3000 
3001  sum_vec(:,:) = 0.0 ; sum_vec_2(:,:) = 0.0
3002 
3003  do j=jsumstart_int_,jecq
3004  do i=isumstart_int_,iecq
3005  if (umask(i,j) .eq. 1) sum_vec(i,j) = zu(i,j) * ru(i,j)
3006  if (vmask(i,j) .eq. 1) sum_vec(i,j) = sum_vec(i,j) + &
3007  zv(i,j) * rv(i,j)
3008 
3009  if (umask(i,j) .eq. 1) sum_vec_2(i,j) = zu_old(i,j) * ru_old(i,j)
3010  if (vmask(i,j) .eq. 1) sum_vec_2(i,j) = sum_vec_2(i,j) + &
3011  zv_old(i,j) * rv_old(i,j)
3012  enddo
3013  enddo
3014 
3015 
3016  dot_p1 = reproducing_sum( sum_vec, isumstart_int_, iecq, &
3017  jsumstart_int_, jecq )
3018 
3019  dot_p2 = reproducing_sum( sum_vec_2, isumstart_int_, iecq, &
3020  jsumstart_int_, jecq )
3021 
3022  endif
3023 
3024  beta_k = dot_p1/dot_p2
3025 
3026 
3027 ! Du(:,:) = Zu(:,:) + beta_k * Du(:,:)
3028 ! Dv(:,:) = Zv(:,:) + beta_k * Dv(:,:)
3029 
3030  do j=jsd,jed
3031  do i=isd,ied
3032  if (umask(i,j) .eq. 1) du(i,j) = zu(i,j) + beta_k * du(i,j)
3033  if (vmask(i,j) .eq. 1) dv(i,j) = zv(i,j) + beta_k * dv(i,j)
3034  enddo
3035  enddo
3036 
3037  ! D valid region moves in by 1
3038 
3039  dot_p1 = 0
3040 
3041  if (.not. cs%use_reproducing_sums) then
3042 
3043  do j=jsumstart,jecq
3044  do i=isumstart,iecq
3045  if (umask(i,j) .eq. 1) then
3046  dot_p1 = dot_p1 + ru(i,j)**2
3047  endif
3048  if (vmask(i,j) .eq. 1) then
3049  dot_p1 = dot_p1 + rv(i,j)**2
3050  endif
3051  enddo
3052  enddo
3053  call mpp_sum (dot_p1)
3054 
3055  else
3056 
3057  sum_vec(:,:) = 0.0
3058 
3059  do j=jsumstart_int_,jecq
3060  do i=isumstart_int_,iecq
3061  if (umask(i,j) .eq. 1) sum_vec(i,j) = ru(i,j)**2
3062  if (vmask(i,j) .eq. 1) sum_vec(i,j) = sum_vec(i,j) + rv(i,j)**2
3063  enddo
3064  enddo
3065 
3066  dot_p1 = reproducing_sum( sum_vec, isumstart_int_, iecq, &
3067  jsumstart_int_, jecq )
3068 
3069 ! if (is_root_pe()) print *, dot_p1
3070 ! if (is_root_pe()) print *, dot_p1a
3071 
3072  endif
3073 
3074  dot_p1 = sqrt(dot_p1)
3075 
3076 ! if (mpp_pe () == 0) then
3077 ! print *,"|r|",dot_p1
3078 ! endif
3079 
3080  if (dot_p1 .le. cs%cg_tolerance * resid0) then
3081  iters = iter
3082  conv_flag = 1
3083  exit
3084  endif
3085 
3086  cg_halo = cg_halo - 1
3087 
3088  if (cg_halo .eq. 0) then
3089  ! pass vectors
3090  call pass_vector(du, dv, g%domain, to_all, bgrid_ne)
3091  call pass_vector(u, v, g%domain, to_all, bgrid_ne)
3092  call pass_vector(ru, rv, g%domain, to_all, bgrid_ne)
3093  cg_halo = 3
3094  endif
3095 
3096  enddo ! end of CG loop
3097 
3098  do j=jsdq,jedq
3099  do i=isdq,iedq
3100  if (umask(i,j) .eq. 3) then
3101  u(i,j) = u_bdry(i,j)
3102  elseif (umask(i,j) .eq. 0) then
3103  u(i,j) = 0
3104  endif
3105 
3106  if (vmask(i,j) .eq. 3) then
3107  v(i,j) = v_bdry(i,j)
3108  elseif (vmask(i,j) .eq. 0) then
3109  v(i,j) = 0
3110  endif
3111  enddo
3112  enddo
3113 
3114  call pass_vector (u,v, g%domain, to_all, bgrid_ne)
3115 
3116  if (conv_flag .eq. 0) then
3117  iters = cs%cg_max_iterations
3118  endif
3119 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the call graph for this function:
Here is the caller graph for this function:

◆ ice_shelf_solve_outer()

subroutine mom_ice_shelf::ice_shelf_solve_outer ( type(ice_shelf_cs), pointer  CS,
real, dimension( : , : ), intent(inout)  u,
real, dimension( : , : ), intent(inout)  v,
integer, intent(in)  FE,
integer, intent(out)  iters,
type(time_type), intent(in)  time 
)
private

Definition at line 2319 of file MOM_ice_shelf.F90.

References apply_boundary_values_bilinear(), apply_boundary_values_triangle(), bilinear_shape_functions(), bilinear_shape_functions_subgrid(), calc_shelf_driving_stress(), calc_shelf_visc_bilinear(), calc_shelf_visc_triangular(), cg_action_bilinear(), cg_action_triangular(), ice_shelf_solve_inner(), interpolate_h_to_b(), and savearray2().

Referenced by initialize_diagnostic_fields(), initialize_ice_shelf(), shelf_calc_flux(), and solo_time_step().

2319  type(ice_shelf_cs), pointer :: cs
2320  real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u, v
2321  integer, intent(in) :: fe
2322  integer, intent(out) :: iters
2323  type(time_type), intent(in) :: time
2324 
2325  real, dimension(:,:), pointer :: taudx, taudy, u_prev_iterate, v_prev_iterate, &
2326  u_bdry_cont, v_bdry_cont, au, av, err_u, err_v, &
2327  geolonq, geolatq, u_last, v_last, float_cond, h_node
2328  type(ocean_grid_type), pointer :: g
2329  integer :: conv_flag, i, j, k,l, iter, isym, &
2330  isdq, iedq, jsdq, jedq, isd, ied, jsd, jed, isumstart, jsumstart, nodefloat, nsub
2331  real :: err_max, err_tempu, err_tempv, err_init, area, max_vel, tempu, tempv, rhoi, rhow
2332  real, pointer, dimension(:,:,:,:) :: phi
2333  real, pointer, dimension(:,:,:,:,:,:) :: phisub
2334  real, dimension (8,4) :: phi_temp
2335  real, dimension (2,2) :: x,y
2336  character(2) :: iternum
2337  character(2) :: procnum, numproc
2338 
2339  ! for GL interpolation - need to make this a readable parameter
2340  nsub = cs%n_sub_regularize
2341 
2342  g => cs%grid
2343  isdq = g%isdB ; iedq = g%iedB ; jsdq = g%jsdB ; jedq = g%jedB
2344  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
2345  rhoi = cs%density_ice
2346  rhow = cs%density_ocean_avg
2347  ALLOCATE (taudx(isdq:iedq,jsdq:jedq) ) ; taudx(:,:)=0
2348  ALLOCATE (taudy(isdq:iedq,jsdq:jedq) ) ; taudy(:,:)=0
2349  ALLOCATE (u_prev_iterate(isdq:iedq,jsdq:jedq) )
2350  ALLOCATE (v_prev_iterate(isdq:iedq,jsdq:jedq) )
2351  ALLOCATE (u_bdry_cont(isdq:iedq,jsdq:jedq) ) ; u_bdry_cont(:,:)=0
2352  ALLOCATE (v_bdry_cont(isdq:iedq,jsdq:jedq) ) ; v_bdry_cont(:,:)=0
2353  ALLOCATE (au(isdq:iedq,jsdq:jedq) ) ; au(:,:)=0
2354  ALLOCATE (av(isdq:iedq,jsdq:jedq) ) ; av(:,:)=0
2355  ALLOCATE (err_u(isdq:iedq,jsdq:jedq) )
2356  ALLOCATE (err_v(isdq:iedq,jsdq:jedq) )
2357  ALLOCATE (u_last(isdq:iedq,jsdq:jedq) )
2358  ALLOCATE (v_last(isdq:iedq,jsdq:jedq) )
2359 
2360  ! need to make these conditional on GL interpolation
2361  ALLOCATE (float_cond(g%isd:g%ied,g%jsd:g%jed)) ; float_cond(:,:)=0
2362  ALLOCATE (h_node(g%isdB:g%iedB,g%jsdB:g%jedB)) ; h_node(:,:)=0
2363  ALLOCATE (phisub(nsub,nsub,2,2,2,2)) ; phisub = 0.0
2364 
2365  geolonq => g%geoLonBu ; geolatq => g%geoLatBu
2366 
2367  if (g%isc+g%idg_offset==g%isg) then
2368  ! tile is at west bdry
2369  isumstart = g%iscB
2370  else
2371  ! tile is interior
2372  isumstart = isumstart_int_
2373  endif
2374 
2375  if (g%jsc+g%jdg_offset==g%jsg) then
2376  ! tile is at south bdry
2377  jsumstart = g%jscB
2378  else
2379  ! tile is interior
2380  jsumstart = jsumstart_int_
2381  endif
2382 
2383  call calc_shelf_driving_stress (cs, taudx, taudy, cs%OD_av, fe)
2384 
2385  ! this is to determine which cells contain the grounding line,
2386  ! the criterion being that the cell is ice-covered, with some nodes
2387  ! floating and some grounded
2388  ! floatation condition is estimated by assuming topography is cellwise constant
2389  ! and H is bilinear in a cell; floating where rho_i/rho_w * H_node + D is nonpositive
2390 
2391  ! need to make this conditional on GL interp
2392 
2393  if (cs%GL_regularize) then
2394 
2395  call interpolate_h_to_b (cs, cs%h_shelf, cs%hmask, h_node)
2396  call savearray2 ("H_node",h_node,cs%write_output_to_file)
2397 
2398  do j=g%jsc,g%jec
2399  do i=g%isc,g%iec
2400  nodefloat = 0
2401  do k=0,1
2402  do l=0,1
2403  if ((cs%hmask(i,j) .eq. 1) .and. &
2404  (rhoi/rhow * h_node(i-1+k,j-1+l) - g%bathyT(i,j) .le. 0)) then
2405  nodefloat = nodefloat + 1
2406  endif
2407  enddo
2408  enddo
2409  if ((nodefloat .gt. 0) .and. (nodefloat .lt. 4)) then
2410  !print *,"nodefloat",nodefloat
2411  float_cond(i,j) = 1.0
2412  cs%float_frac (i,j) = 1.0
2413  endif
2414  enddo
2415  enddo
2416  call savearray2 ("float_cond",float_cond,cs%write_output_to_file)
2417 
2418  call pass_var (float_cond, g%Domain)
2419 
2420  call bilinear_shape_functions_subgrid (phisub, nsub)
2421 
2422  call savearray2("Phisub1111",phisub(:,:,1,1,1,1),cs%write_output_to_file)
2423 
2424  endif
2425 
2426  ! make above conditional
2427 
2428  u_prev_iterate(:,:) = u(:,:)
2429  v_prev_iterate(:,:) = v(:,:)
2430 
2431  isym=0
2432 
2433  ! must prepare phi
2434  if (fe .eq. 1) then
2435  allocate (phi(isd:ied,jsd:jed,1:8,1:4)) ; phi(:,:,:,:)=0
2436 
2437  do j=jsd,jed
2438  do i=isd,ied
2439 
2440  if (((i .gt. isd) .and. (j .gt. jsd)) .or. (isym .eq. 1)) then
2441  x(:,:) = geolonq(i-1:i,j-1:j)*1000
2442  y(:,:) = geolatq(i-1:i,j-1:j)*1000
2443  else
2444  x(2,:) = geolonq(i,j)*1000
2445  x(1,:) = geolonq(i,j)*1000-g%dxT(i,j)
2446  y(:,2) = geolatq(i,j)*1000
2447  y(:,1) = geolatq(i,j)*1000-g%dyT(i,j)
2448  endif
2449 
2450  call bilinear_shape_functions (x, y, phi_temp, area)
2451  phi(i,j,:,:) = phi_temp
2452 
2453  enddo
2454  enddo
2455  endif
2456 
2457  if (fe .eq. 1) then
2458  call calc_shelf_visc_bilinear (cs, u, v)
2459 
2460  call pass_var (cs%ice_visc_bilinear, g%domain)
2461  call pass_var (cs%taub_beta_eff_bilinear, g%domain)
2462  else
2463  call calc_shelf_visc_triangular (cs,u,v)
2464 
2465  call pass_var (cs%ice_visc_upper_tri, g%domain)
2466  call pass_var (cs%taub_beta_eff_upper_tri, g%domain)
2467  call pass_var (cs%ice_visc_lower_tri, g%domain)
2468  call pass_var (cs%taub_beta_eff_lower_tri, g%domain)
2469  endif
2470 
2471  ! makes sure basal stress is only applied when it is supposed to be
2472 
2473  do j=g%jsd,g%jed
2474  do i=g%isd,g%ied
2475  if (fe .eq. 1) then
2476  cs%taub_beta_eff_bilinear (i,j) = cs%taub_beta_eff_bilinear (i,j) * cs%float_frac (i,j)
2477  else
2478  cs%taub_beta_eff_upper_tri (i,j) = cs%taub_beta_eff_upper_tri (i,j) * cs%float_frac (i,j)
2479  cs%taub_beta_eff_lower_tri (i,j) = cs%taub_beta_eff_lower_tri (i,j) * cs%float_frac (i,j)
2480  endif
2481  enddo
2482  enddo
2483 
2484  if (fe .eq. 1) then
2485  call apply_boundary_values_bilinear (cs, time, phisub, h_node, float_cond, &
2486  rhoi/rhow, u_bdry_cont, v_bdry_cont)
2487  elseif (fe .eq. 2) then
2488  call apply_boundary_values_triangle (cs, time, u_bdry_cont, v_bdry_cont)
2489  endif
2490 
2491  au(:,:) = 0.0 ; av(:,:) = 0.0
2492 
2493  if (fe .eq. 1) then
2494  call cg_action_bilinear (au, av, u, v, phi, phisub, cs%umask, cs%vmask, cs%hmask, h_node, &
2495  cs%ice_visc_bilinear, float_cond, g%bathyT, cs%taub_beta_eff_bilinear, g%areaT, &
2496  g%isc-1, g%iec+1, g%jsc-1, g%jec+1, rhoi/rhow)
2497  elseif (fe .eq. 2) then
2498  call cg_action_triangular (au, av, u, v, cs%umask, cs%vmask, cs%hmask, cs%ice_visc_upper_tri, &
2499  cs%ice_visc_lower_tri, cs%taub_beta_eff_upper_tri, cs%taub_beta_eff_lower_tri, &
2500  g%dxT, g%dyT, g%areaT, g%isc-1, g%iec+1, g%jsc-1, g%jec+1, isym)
2501  endif
2502 
2503 ! write (procnum,'(I2)') mpp_pe()
2504 
2505 
2506  err_init = 0 ; err_tempu = 0; err_tempv = 0
2507  do j=jsumstart,g%jecB
2508  do i=isumstart,g%iecB
2509  if (cs%umask(i,j) .eq. 1) then
2510  err_tempu = abs(au(i,j) + u_bdry_cont(i,j) - taudx(i,j))
2511  endif
2512  if (cs%vmask(i,j) .eq. 1) then
2513  err_tempv = max(abs(av(i,j) + v_bdry_cont(i,j) - taudy(i,j)), err_tempu)
2514  endif
2515  if (err_tempv .ge. err_init) then
2516  err_init = err_tempv
2517  endif
2518  enddo
2519  enddo
2520 
2521  call mpp_max (err_init)
2522 
2523  if (is_root_pe()) print *,"INITIAL nonlinear residual: ",err_init
2524 
2525  u_last(:,:) = u(:,:) ; v_last(:,:) = v(:,:)
2526 
2527  !! begin loop
2528 
2529  do iter=1,100
2530 
2531 
2532  call ice_shelf_solve_inner (cs, u, v, taudx, taudy, h_node, float_cond, &
2533  fe, conv_flag, iters, time, phi, phisub)
2534 
2535 
2536  if (cs%DEBUG) then
2537  call qchksum (u, "u shelf", g%HI, haloshift=2)
2538  call qchksum (v, "v shelf", g%HI, haloshift=2)
2539  endif
2540 
2541  if (is_root_pe()) print *,"linear solve done",iters," iterations"
2542 
2543  if (fe .eq. 1) then
2544  call calc_shelf_visc_bilinear (cs,u,v)
2545  call pass_var (cs%ice_visc_bilinear, g%domain)
2546  call pass_var (cs%taub_beta_eff_bilinear, g%domain)
2547  else
2548  call calc_shelf_visc_triangular (cs,u,v)
2549  call pass_var (cs%ice_visc_upper_tri, g%domain)
2550  call pass_var (cs%taub_beta_eff_upper_tri, g%domain)
2551  call pass_var (cs%ice_visc_lower_tri, g%domain)
2552  call pass_var (cs%taub_beta_eff_lower_tri, g%domain)
2553  endif
2554 
2555  if (iter .eq. 1) then
2556 ! call savearray2 ("visc1",CS%ice_visc_bilinear,CS%write_output_to_file)
2557  endif
2558 
2559  ! makes sure basal stress is only applied when it is supposed to be
2560 
2561  do j=g%jsd,g%jed
2562  do i=g%isd,g%ied
2563  if (fe .eq. 1) then
2564  cs%taub_beta_eff_bilinear (i,j) = cs%taub_beta_eff_bilinear (i,j) * cs%float_frac (i,j)
2565  else
2566  cs%taub_beta_eff_upper_tri (i,j) = cs%taub_beta_eff_upper_tri (i,j) * cs%float_frac (i,j)
2567  cs%taub_beta_eff_lower_tri (i,j) = cs%taub_beta_eff_lower_tri (i,j) * cs%float_frac (i,j)
2568  endif
2569  enddo
2570  enddo
2571 
2572  u_bdry_cont(:,:) = 0 ; v_bdry_cont(:,:) = 0
2573 
2574  if (fe .eq. 1) then
2575  call apply_boundary_values_bilinear (cs, time, phisub, h_node, float_cond, &
2576  rhoi/rhow, u_bdry_cont, v_bdry_cont)
2577  elseif (fe .eq. 2) then
2578  call apply_boundary_values_triangle (cs, time, u_bdry_cont, v_bdry_cont)
2579  endif
2580 
2581  au(:,:) = 0 ; av(:,:) = 0
2582 
2583  if (fe .eq. 1) then
2584  call cg_action_bilinear (au, av, u, v, phi, phisub, cs%umask, cs%vmask, cs%hmask, h_node, &
2585  cs%ice_visc_bilinear, float_cond, g%bathyT, cs%taub_beta_eff_bilinear, g%areaT, g%isc-1, &
2586  g%iec+1, g%jsc-1, g%jec+1, rhoi/rhow)
2587  elseif (fe .eq. 2) then
2588  call cg_action_triangular (au, av, u, v, cs%umask, cs%vmask, cs%hmask, cs%ice_visc_upper_tri, &
2589  cs%ice_visc_lower_tri, cs%taub_beta_eff_upper_tri, cs%taub_beta_eff_lower_tri, &
2590  g%dxT, g%dyT, g%areaT, g%isc-1, g%iec+1, g%jsc-1, g%jec+1, isym)
2591  endif
2592 
2593  err_max = 0
2594 
2595  if (cs%nonlin_solve_err_mode .eq. 1) then
2596 
2597  do j=jsumstart,g%jecB
2598  do i=isumstart,g%iecB
2599  if (cs%umask(i,j) .eq. 1) then
2600  err_tempu = abs(au(i,j) + u_bdry_cont(i,j) - taudx(i,j))
2601  endif
2602  if (cs%vmask(i,j) .eq. 1) then
2603  err_tempv = max(abs(av(i,j) + v_bdry_cont(i,j) - taudy(i,j)), err_tempu)
2604  endif
2605  if (err_tempv .ge. err_max) then
2606  err_max = err_tempv
2607  endif
2608  enddo
2609  enddo
2610 
2611  call mpp_max (err_max)
2612 
2613  elseif (cs%nonlin_solve_err_mode .eq. 2) then
2614 
2615  max_vel = 0 ; tempu = 0 ; tempv = 0
2616 
2617  do j=jsumstart,g%jecB
2618  do i=isumstart,g%iecB
2619  if (cs%umask(i,j) .eq. 1) then
2620  err_tempu = abs(u_last(i,j)-u(i,j))
2621  tempu = u(i,j)
2622  endif
2623  if (cs%vmask(i,j) .eq. 1) then
2624  err_tempv = max(abs(v_last(i,j)- v(i,j)), err_tempu)
2625  tempv = sqrt(v(i,j)**2+tempu**2)
2626  endif
2627  if (err_tempv .ge. err_max) then
2628  err_max = err_tempv
2629  endif
2630  if (tempv .ge. max_vel) then
2631  max_vel = tempv
2632  endif
2633  enddo
2634  enddo
2635 
2636  u_last(:,:) = u(:,:)
2637  v_last(:,:) = v(:,:)
2638 
2639  call mpp_max (max_vel)
2640  call mpp_max (err_max)
2641  err_init = max_vel
2642 
2643  endif
2644 
2645  if (is_root_pe()) print *,"nonlinear residual: ",err_max/err_init
2646 
2647  if (err_max .le. cs%nonlinear_tolerance * err_init) then
2648  if (is_root_pe()) &
2649  print *,"exiting nonlinear solve after ",iter," iterations"
2650  exit
2651  endif
2652 
2653  enddo
2654 
2655  !write (procnum,'(I1)') mpp_pe()
2656  !write (numproc,'(I1)') mpp_npes()
2657 
2658  DEALLOCATE (taudx)
2659  DEALLOCATE (taudy)
2660  DEALLOCATE (u_prev_iterate)
2661  DEALLOCATE (v_prev_iterate)
2662  DEALLOCATE (u_bdry_cont)
2663  DEALLOCATE (v_bdry_cont)
2664  DEALLOCATE (au)
2665  DEALLOCATE (av)
2666  DEALLOCATE (err_u)
2667  DEALLOCATE (err_v)
2668  DEALLOCATE (u_last)
2669  DEALLOCATE (v_last)
2670  DEALLOCATE (h_node)
2671  DEALLOCATE (float_cond)
2672  DEALLOCATE (phisub)
2673 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the call graph for this function:
Here is the caller graph for this function:

◆ ice_shelf_temp()

subroutine mom_ice_shelf::ice_shelf_temp ( type(ice_shelf_cs), pointer  CS,
real, intent(in)  time_step,
real, dimension(:,:), intent(in), pointer  melt_rate,
type(time_type)  Time 
)
private

Definition at line 6044 of file MOM_ice_shelf.F90.

References ice_shelf_advect_temp_x(), and ice_shelf_advect_temp_y().

Referenced by solo_time_step().

6044  type(ice_shelf_cs), pointer :: cs
6045  real, intent(in) :: time_step
6046  real,pointer,dimension(:,:),intent(in) :: melt_rate
6047  type(time_type) :: time
6048 
6049 ! time_step: time step in sec
6050 ! melt_rate: basal melt rate in kg/m^2/s
6051 
6052 ! 5/23/12 OVS
6053 ! Arguments:
6054 ! CS - A structure containing the ice shelf state - including current velocities
6055 ! t0 - an array containing temperature at the beginning of the call
6056 ! t_after_uflux - an array containing the temperature after advection in u-direction
6057 ! t_after_vflux - similar
6058 !
6059 ! 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
6060 !
6061 ! The flux overflows are included here. That is because they will be used to advect 3D scalars
6062 ! into partial cells
6063 
6064  !
6065  ! flux_enter: this is to capture flow into partially covered cells; it gives the mass flux into a given
6066  ! cell across its boundaries.
6067  ! ###Perhaps flux_enter should be changed into u-face and v-face
6068  ! ###fluxes, which can then be used in halo updates, etc.
6069  !
6070  ! from left neighbor: flux_enter (:,:,1)
6071  ! from right neighbor: flux_enter (:,:,2)
6072  ! from bottom neighbor: flux_enter (:,:,3)
6073  ! from top neighbor: flux_enter (:,:,4)
6074  !
6075  ! THESE ARE NOT CONSISTENT ==> FIND OUT WHAT YOU IMPLEMENTED
6076 
6077  ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary
6078  !
6079  ! o--- (4) ---o
6080  ! | |
6081  ! (1) (2)
6082  ! | |
6083  ! o--- (3) ---o
6084  !
6085 
6086  type(ocean_grid_type), pointer :: g
6087  real, dimension(size(CS%h_shelf,1),size(CS%h_shelf,2)) :: th_after_uflux, th_after_vflux, th
6088  real, dimension(size(CS%h_shelf,1),size(CS%h_shelf,2),4) :: flux_enter
6089  integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec
6090  real :: rho, spy, t_bd, tsurf, adot
6091  real, dimension(:,:), pointer :: hmask, tbot
6092  character(len=2) :: procnum
6093 
6094  hmask => cs%hmask
6095  g => cs%grid
6096  rho = cs%density_ice
6097  spy = 365 * 86400 ! seconds per year; is there a global constant for this? No - it is dependent upon a calendar.
6098 
6099  adot = 0.1/spy ! for now adot and Tsurf are defined here adot=surf acc 0.1m/yr, Tsurf=-20oC, vary them later
6100  tbot =>cs%Tfreeze
6101  tsurf = -20.0
6102 
6103  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
6104  isc = g%isc ; iec = g%iec ; jsc = g%jsc ; jec = g%jec
6105  flux_enter(:,:,:) = 0.0
6106 
6107  th_after_uflux(:,:) = 0.0
6108  th_after_vflux(:,:) = 0.0
6109 
6110  do j=jsd,jed
6111  do i=isd,ied
6112  t_bd = cs%t_boundary_values(i,j)
6113 ! if (CS%hmask(i,j) .gt. 1) then
6114  if ((cs%hmask(i,j) .eq. 3) .or. (cs%hmask(i,j) .eq. -2)) then
6115  cs%t_shelf(i,j) = cs%t_boundary_values(i,j)
6116  endif
6117  enddo
6118  enddo
6119 
6120  do j=jsd,jed
6121  do i=isd,ied
6122  th(i,j) = cs%t_shelf(i,j)*cs%h_shelf (i,j)
6123  enddo
6124  enddo
6125 
6126 
6127 ! call enable_averaging(time_step,Time,CS%diag)
6128  ! call pass_var (h_after_uflux, G%domain)
6129 ! if (CS%id_h_after_uflux > 0) call post_data(CS%id_h_after_uflux, h_after_uflux, CS%diag)
6130 ! call disable_averaging(CS%diag)
6131 
6132 
6133 ! call enable_averaging(time_step,Time,CS%diag)
6134 ! call pass_var (h_after_vflux, G%domain)
6135 ! if (CS%id_h_after_vflux > 0) call post_data(CS%id_h_after_vflux, h_after_vflux, CS%diag)
6136 ! call disable_averaging(CS%diag)
6137 
6138 
6139 
6140  call ice_shelf_advect_temp_x (cs, time_step/spy, th, th_after_uflux, flux_enter)
6141  call ice_shelf_advect_temp_y (cs, time_step/spy, th_after_uflux, th_after_vflux, flux_enter)
6142 
6143  do j=jsd,jed
6144  do i=isd,ied
6145 ! if (CS%hmask(i,j) .eq. 1) then
6146  if (cs%h_shelf(i,j) .gt. 0.0) then
6147  cs%t_shelf (i,j) = th_after_vflux(i,j)/cs%h_shelf (i,j)
6148  else
6149  cs%t_shelf(i,j) = -10.0
6150  endif
6151  enddo
6152  enddo
6153 
6154  do j=jsd,jed
6155  do i=isd,ied
6156  t_bd = cs%t_boundary_values(i,j)
6157 ! if (CS%hmask(i,j) .gt. 1) then
6158  if ((cs%hmask(i,j) .eq. 3) .or. (cs%hmask(i,j) .eq. -2)) then
6159  cs%t_shelf(i,j) = t_bd
6160 ! CS%t_shelf(i,j) = -15.0
6161  endif
6162  enddo
6163  enddo
6164 
6165  do j=jsc,jec
6166  do i=isc,iec
6167  if ((cs%hmask(i,j) .eq. 1) .or. (cs%hmask(i,j) .eq. 2)) then
6168  if (cs%h_shelf(i,j) .gt. 0.0) then
6169 ! 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)
6170  cs%t_shelf (i,j) = cs%t_shelf (i,j) + time_step*(adot*tsurf -3/spy*tbot(i,j))/cs%h_shelf (i,j)
6171  else
6172  ! the ice is about to melt away
6173  ! in this case set thickness, area, and mask to zero
6174  ! NOTE: not mass conservative
6175  ! should maybe scale salt & heat flux for this cell
6176 
6177  cs%t_shelf(i,j) = -10.0
6178  cs%tmask(i,j) = 0.0
6179  endif
6180  endif
6181  enddo
6182  enddo
6183 
6184  call pass_var(cs%t_shelf, g%domain)
6185  call pass_var(cs%tmask, g%domain)
6186 
6187  if (cs%DEBUG) then
6188  call hchksum (cs%t_shelf, "temp after front", g%HI, haloshift=3)
6189  endif
6190 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the call graph for this function:
Here is the caller graph for this function:

◆ init_boundary_values()

subroutine mom_ice_shelf::init_boundary_values ( type(ice_shelf_cs), pointer  CS,
type(time_type), intent(in)  time,
real, intent(in)  input_flux,
real, intent(in)  input_thick,
logical, optional  new_sim 
)
private

Definition at line 4052 of file MOM_ice_shelf.F90.

4052  type(time_type), intent(in) :: time
4053  type(ice_shelf_cs), pointer :: cs
4054  real, intent(in) :: input_flux, input_thick
4055  logical, optional :: new_sim
4056 
4057 ! this will be a per-setup function. the boundary values of thickness and velocity
4058 ! (and possibly other variables) will be updated in this function
4059 
4060 ! FOR RESTARTING PURPOSES: if grid is not symmetric and the model is restarted, we will
4061 ! need to update those velocity points not *technically* in any
4062 ! computational domain -- if this function gets moves to another module,
4063 ! DO NOT TAKE THE RESTARTING BIT WITH IT
4064 
4065  real, dimension (:,:) , pointer :: thickness_boundary_values, &
4066  u_boundary_values, &
4067  v_boundary_values, &
4068  u_face_mask, v_face_mask, hmask
4069  type(ocean_grid_type), pointer :: g
4070  integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec
4071  integer :: i_off, j_off
4072  real :: a, n, ux, uy, vx, vy, eps_min, domain_width
4073 
4074  g => cs%grid
4075 
4076 ! if (G%symmetric) then
4077 ! isym=1
4078 ! else
4079 ! isym=0
4080 ! endif
4081 
4082  isym = 0
4083 
4084  isc = g%isc ; jsc = g%jsc ; iec = g%iec ; jec = g%jec
4085 ! iscq = G%iscq ; iecq = G%iecq ; jscq = G%jscq ; jecq = G%jecq
4086  isd = g%isd ; jsd = g%jsd ; ied = g%ied ; jed = g%jed
4087 ! iegq = G%iegq ; jegq = G%jegq
4088  i_off = g%idg_offset ; j_off = g%jdg_offset
4089 
4090  thickness_boundary_values => cs%thickness_boundary_values
4091  u_boundary_values => cs%u_boundary_values ; v_boundary_values => cs%v_boundary_values
4092  u_face_mask => cs%u_face_mask ; v_face_mask => cs%v_face_mask ; hmask => cs%hmask
4093 
4094  domain_width = cs%len_lat
4095 
4096  ! this loop results in some values being set twice but... eh.
4097 
4098  do j=jsd,jed
4099  do i=isd,ied
4100 
4101 ! if ((i .eq. 4) .AND. ((mpp_pe() .eq. 0) .or. (mpp_pe() .eq. 6))) then
4102 ! print *,hmask(i,j),i,j,mpp_pe()
4103 ! endif
4104 
4105  if (hmask(i,j) .eq. 3) then
4106  thickness_boundary_values(i,j) = input_thick
4107  endif
4108 
4109  if ((hmask(i,j) .eq. 0) .or. (hmask(i,j) .eq. 1) .or. (hmask(i,j) .eq. 2)) then
4110  if ((i.le.iec).and.(i.ge.isc)) then
4111  if (u_face_mask(i-1,j) .eq. 3) then
4112  u_boundary_values(i-1,j-1) = (1 - ((g%geoLatBu(i-1,j-1) - 0.5*cs%len_lat)*2./cs%len_lat)**2) * &
4113  1.5 * input_flux / input_thick
4114  u_boundary_values(i-1,j) = (1 - ((g%geoLatBu(i-1,j) - 0.5*cs%len_lat)*2./cs%len_lat)**2) * &
4115  1.5 * input_flux / input_thick
4116  endif
4117  endif
4118  endif
4119 
4120  if (.not.(new_sim)) then
4121  if (.not. g%symmetric) then
4122  if (((i+i_off) .eq. (g%domain%nihalo+1)).and.(u_face_mask(i-1,j).eq.3)) then
4123  cs%u_shelf (i-1,j-1) = u_boundary_values(i-1,j-1)
4124  cs%u_shelf (i-1,j) = u_boundary_values(i-1,j)
4125 ! print *, u_boundary_values (i-1,j)
4126  endif
4127  if (((j+j_off) .eq. (g%domain%njhalo+1)).and.(v_face_mask(i,j-1).eq.3)) then
4128  cs%u_shelf (i-1,j-1) = u_boundary_values(i-1,j-1)
4129  cs%u_shelf (i,j-1) = u_boundary_values(i,j-1)
4130  endif
4131  endif
4132  endif
4133  enddo
4134  enddo
4135 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19

◆ initialize_diagnostic_fields()

subroutine mom_ice_shelf::initialize_diagnostic_fields ( type(ice_shelf_cs), pointer  CS,
integer  FE,
type(time_type), intent(in)  Time 
)
private

Definition at line 2128 of file MOM_ice_shelf.F90.

References ice_shelf_solve_outer().

2128  type(ice_shelf_cs), pointer :: cs
2129  integer :: fe
2130  type(time_type), intent(in) :: time
2131 
2132  type(ocean_grid_type), pointer :: g
2133  integer :: i, j, iters, isd, ied, jsd, jed
2134  real :: rhoi, rhow, od
2135  type(time_type) :: dummy_time
2136  real,dimension(:,:),pointer :: od_av, float_frac, h_shelf
2137 
2138  g => cs%grid
2139  rhoi = cs%density_ice
2140  rhow = cs%density_ocean_avg
2141  dummy_time = set_time(0,0)
2142  od_av => cs%OD_av
2143  h_shelf => cs%h_shelf
2144  float_frac => cs%float_frac
2145  isd=g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
2146 
2147  do j=jsd,jed
2148  do i=isd,ied
2149  od = g%bathyT(i,j) - rhoi/rhow * h_shelf(i,j)
2150  if (od.ge.0) then
2151  ! ice thickness does not take up whole ocean column -> floating
2152  od_av(i,j) = od
2153  float_frac(i,j) = 0.
2154  else
2155  od_av(i,j) = 0.
2156  float_frac(i,j) = 1.
2157  endif
2158  enddo
2159  enddo
2160 
2161  call ice_shelf_solve_outer (cs, cs%u_shelf, cs%v_shelf, fe, iters, dummy_time)
2162 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the call graph for this function:

◆ initialize_ice_shelf()

subroutine, public mom_ice_shelf::initialize_ice_shelf ( type(param_file_type), intent(in)  param_file,
type(ocean_grid_type), pointer  ocn_grid,
type(time_type), intent(inout)  Time,
type(ice_shelf_cs), pointer  CS,
type(diag_ctrl), intent(in), target  diag,
type(forcing), intent(inout), optional  fluxes,
type(time_type), intent(in), optional  Time_in,
logical, intent(in), optional  solo_ice_sheet_in 
)

Initializes shelf model data, parameters and diagnostics.

Parameters
[in]param_fileA structure to parse for run-time parameters

Definition at line 1191 of file MOM_ice_shelf.F90.

References ice_shelf_min_thickness_calve(), ice_shelf_solve_outer(), id_clock_pass, id_clock_shelf, initialize_shelf_mass(), update_od_ffrac_uncoupled(), and update_velocity_masks().

Referenced by mom_main().

1191  type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
1192  type(ocean_grid_type), pointer :: ocn_grid
1193  type(time_type), intent(inout) :: time
1194  type(ice_shelf_cs), pointer :: cs
1195  type(diag_ctrl), target, intent(in) :: diag
1196  type(forcing), optional, intent(inout) :: fluxes
1197  type(time_type), optional, intent(in) :: time_in
1198  logical, optional,intent(in) :: solo_ice_sheet_in
1199 
1200  type(ocean_grid_type), pointer :: g, og ! Convenience pointers
1201  type(directories) :: dirs
1202  type(vardesc) :: vd
1203  type(dyn_horgrid_type), pointer :: dg => null()
1204  real :: cdrag, drag_bg_vel
1205  logical :: new_sim, save_ic, var_force
1206  !This include declares and sets the variable "version".
1207 #include "version_variable.h"
1208  character(len=200) :: config
1209  character(len=200) :: ic_file,filename,inputdir
1210  character(len=40) :: var_name
1211  character(len=40) :: mdl = "MOM_ice_shelf" ! This module's name.
1212  character(len=2) :: procnum
1213  integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, isdq, iedq, jsdq, jedq, iters
1214  integer :: wd_halos(2)
1215  logical :: solo_ice_sheet, read_tideamp
1216  character(len=240) :: tideamp_file
1217  real :: utide
1218  if (associated(cs)) then
1219  call mom_error(fatal, "MOM_ice_shelf.F90, initialize_ice_shelf: "// &
1220  "called with an associated control structure.")
1221  return
1222  endif
1223  allocate(cs)
1224 
1225  ! Go through all of the infrastructure initialization calls, since this is
1226  ! being treated as an independent component that just happens to use the
1227  ! MOM's grid and infrastructure.
1228  call get_mom_input(dirs=dirs)
1229 
1230  ! Set up the ice-shelf domain and grid
1231  wd_halos(:)=0
1232  call mom_domains_init(cs%grid%domain, param_file, min_halo=wd_halos, symmetric=grid_sym_)
1233  ! call diag_mediator_init(CS%grid,param_file,CS%diag)
1234  ! this needs to be fixed - will probably break when not using coupled driver 0
1235  call mom_grid_init(cs%grid, param_file)
1236 
1237  call create_dyn_horgrid(dg, cs%grid%HI)
1238  call clone_mom_domain(cs%grid%Domain, dg%Domain)
1239 
1240  call set_grid_metrics(dg, param_file)
1241  ! call set_diag_mediator_grid(CS%grid, CS%diag)
1242 
1243  ! The ocean grid is possibly different
1244  if (associated(ocn_grid)) cs%ocn_grid => ocn_grid
1245 
1246  ! Convenience pointers
1247  g => cs%grid
1248  og => cs%ocn_grid
1249 
1250  if (is_root_pe()) then
1251  write(0,*) 'OG: ', og%isd, og%isc, og%iec, og%ied, og%jsd, og%jsc, og%jsd, og%jed
1252  write(0,*) 'IG: ', g%isd, g%isc, g%iec, g%ied, g%jsd, g%jsc, g%jsd, g%jed
1253  endif
1254 
1255  cs%Time = time ! ### This might not be in the right place?
1256  cs%diag => diag
1257 
1258  ! Are we being called from the solo ice-sheet driver? When called by the ocean
1259  ! model solo_ice_sheet_in is not preset.
1260  solo_ice_sheet = .false.
1261  if (present(solo_ice_sheet_in)) solo_ice_sheet = solo_ice_sheet_in
1262  cs%solo_ice_sheet = solo_ice_sheet
1263 
1264  if (present(time_in)) time = time_in
1265 
1266  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
1267  isd = g%isd ; jsd = g%jsd ; ied = g%ied ; jed = g%jed
1268  isdq = g%IsdB ; iedq = g%IedB ; jsdq = g%JsdB ; jedq = g%JedB
1269 
1270  cs%Lat_fusion = 3.34e5
1271  cs%override_shelf_movement = .false.
1272 
1273  cs%use_reproducing_sums = .false.
1274  cs%switch_var = .false.
1275 
1276  call log_version(param_file, mdl, version, "")
1277  call get_param(param_file, mdl, "DEBUG_IS", cs%debug, default=.false.)
1278  call get_param(param_file, mdl, "DYNAMIC_SHELF_MASS", cs%shelf_mass_is_dynamic, &
1279  "If true, the ice sheet mass can evolve with time.", &
1280  default=.false.)
1281  if (cs%shelf_mass_is_dynamic) then
1282  call get_param(param_file, mdl, "OVERRIDE_SHELF_MOVEMENT", cs%override_shelf_movement, &
1283  "If true, user provided code specifies the ice-shelf \n"//&
1284  "movement instead of the dynamic ice model.", default=.false.)
1285  call get_param(param_file, mdl, "GROUNDING_LINE_INTERPOLATE", cs%GL_regularize, &
1286  "THIS PARAMETER NEEDS A DESCRIPTION.", default=.false.)
1287  call get_param(param_file, mdl, "GROUNDING_LINE_INTERP_SUBGRID_N", cs%n_sub_regularize, &
1288  "THIS PARAMETER NEEDS A DESCRIPTION.", default=0)
1289  call get_param(param_file, mdl, "GROUNDING_LINE_COUPLE", cs%GL_couple, &
1290  "THIS PARAMETER NEEDS A DESCRIPTION.", default=.false.)
1291  if (cs%GL_regularize) cs%GL_couple = .false.
1292  if (cs%GL_regularize .and. (cs%n_sub_regularize.eq.0)) call mom_error (fatal, &
1293  "GROUNDING_LINE_INTERP_SUBGRID_N must be a positive integer if GL regularization is used")
1294  endif
1295  call get_param(param_file, mdl, "SHELF_THERMO", cs%isthermo, &
1296  "If true, use a thermodynamically interactive ice shelf.", &
1297  default=.false.)
1298  call get_param(param_file, mdl, "SHELF_THREE_EQN", cs%threeeq, &
1299  "If true, use the three equation expression of \n"//&
1300  "consistency to calculate the fluxes at the ice-ocean \n"//&
1301  "interface.", default=.true.)
1302  call get_param(param_file, mdl, "SHELF_INSULATOR", cs%insulator, &
1303  "If true, the ice shelf is a perfect insulatior \n"//&
1304  "(no conduction).", default=.false.)
1305  call get_param(param_file, mdl, "MELTING_CUTOFF_DEPTH", cs%cutoff_depth, &
1306  "Depth above which the melt is set to zero (it must be >= 0) \n"//&
1307  "Default value won't affect the solution.", default=0.0)
1308  if (cs%cutoff_depth < 0.) &
1309  call mom_error(warning,"Initialize_ice_shelf: MELTING_CUTOFF_DEPTH must be >= 0.")
1310 
1311  call get_param(param_file, mdl, "CONST_SEA_LEVEL", cs%constant_sea_level, &
1312  "If true, apply evaporative, heat and salt fluxes in \n"//&
1313  "the sponge region. This will avoid a large increase \n"//&
1314  "in sea level. This option is needed for some of the \n"//&
1315  "ISOMIP+ experiments (Ocean3 and Ocean4). \n"//&
1316  "IMPORTANT: it is not currently possible to do \n"//&
1317  "prefect restarts using this flag.", default=.false.)
1318 
1319  call get_param(param_file, mdl, "ISOMIP_S_SUR_SPONGE", &
1320  cs%S0, "Surface salinity in the resoring region.", &
1321  default=33.8, do_not_log=.true.)
1322 
1323  call get_param(param_file, mdl, "ISOMIP_T_SUR_SPONGE", &
1324  cs%T0, "Surface temperature in the resoring region.", &
1325  default=-1.9, do_not_log=.true.)
1326 
1327  call get_param(param_file, mdl, "SHELF_3EQ_GAMMA", cs%const_gamma, &
1328  "If true, user specifies a constant nondimensional heat-transfer coefficient \n"//&
1329  "(GAMMA_T_3EQ), from which the salt-transfer coefficient is then computed \n"//&
1330  " as GAMMA_T_3EQ/35. This is used with SHELF_THREE_EQN.", default=.false.)
1331  if (cs%const_gamma) call get_param(param_file, mdl, "SHELF_3EQ_GAMMA_T", cs%Gamma_T_3EQ, &
1332  "Nondimensional heat-transfer coefficient.",default=2.2e-2, &
1333  units="nondim.", fail_if_missing=.true.)
1334 
1335  call get_param(param_file, mdl, "ICE_SHELF_MASS_FROM_FILE", &
1336  cs%mass_from_file, "Read the mass of the &
1337  ice shelf (every time step) from a file.", default=.false.)
1338 
1339  if (cs%threeeq) &
1340  call get_param(param_file, mdl, "SHELF_S_ROOT", cs%find_salt_root, &
1341  "If SHELF_S_ROOT = True, salinity at the ice/ocean interface (Sbdry) \n "//&
1342  "is computed from a quadratic equation. Otherwise, the previous \n"//&
1343  "interactive method to estimate Sbdry is used.", default=.false.)
1344  if (cs%find_salt_root) then ! read liquidus coeffs.
1345  call get_param(param_file, mdl, "TFREEZE_S0_P0",cs%lambda1, &
1346  "this is the freezing potential temperature at \n"//&
1347  "S=0, P=0.", units="deg C", default=0.0, do_not_log=.true.)
1348  call get_param(param_file, mdl, "DTFREEZE_DS",cs%lambda1, &
1349  "this is the derivative of the freezing potential \n"//&
1350  "temperature with salinity.", &
1351  units="deg C PSU-1", default=-0.054, do_not_log=.true.)
1352  call get_param(param_file, mdl, "DTFREEZE_DP",cs%lambda3, &
1353  "this is the derivative of the freezing potential \n"//&
1354  "temperature with pressure.", &
1355  units="deg C Pa-1", default=0.0, do_not_log=.true.)
1356 
1357  endif
1358 
1359  if (.not.cs%threeeq) &
1360  call get_param(param_file, mdl, "SHELF_2EQ_GAMMA_T", cs%gamma_t, &
1361  "If SHELF_THREE_EQN is false, this the fixed turbulent \n"//&
1362  "exchange velocity at the ice-ocean interface.", &
1363  units="m s-1", fail_if_missing=.true.)
1364 
1365  call get_param(param_file, mdl, "G_EARTH", cs%g_Earth, &
1366  "The gravitational acceleration of the Earth.", &
1367  units="m s-2", default = 9.80)
1368  call get_param(param_file, mdl, "C_P", cs%Cp, &
1369  "The heat capacity of sea water.", units="J kg-1 K-1", &
1370  fail_if_missing=.true.)
1371  call get_param(param_file, mdl, "RHO_0", cs%Rho0, &
1372  "The mean ocean density used with BOUSSINESQ true to \n"//&
1373  "calculate accelerations and the mass for conservation \n"//&
1374  "properties, or with BOUSSINSEQ false to convert some \n"//&
1375  "parameters from vertical units of m to kg m-2.", &
1376  units="kg m-3", default=1035.0) !### MAKE THIS A SEPARATE PARAMETER.
1377  call get_param(param_file, mdl, "C_P_ICE", cs%Cp_ice, &
1378  "The heat capacity of ice.", units="J kg-1 K-1", &
1379  default=2.10e3)
1380 
1381  call get_param(param_file, mdl, "ICE_SHELF_FLUX_FACTOR", cs%flux_factor, &
1382  "Non-dimensional factor applied to shelf thermodynamic \n"//&
1383  "fluxes.", units="none", default=1.0)
1384 
1385  call get_param(param_file, mdl, "KV_ICE", cs%kv_ice, &
1386  "The viscosity of the ice.", units="m2 s-1", default=1.0e10)
1387  call get_param(param_file, mdl, "KV_MOLECULAR", cs%kv_molec, &
1388  "The molecular kinimatic viscosity of sea water at the \n"//&
1389  "freezing temperature.", units="m2 s-1", default=1.95e-6)
1390  call get_param(param_file, mdl, "ICE_SHELF_SALINITY", cs%Salin_ice, &
1391  "The salinity of the ice inside the ice shelf.", units="PSU", &
1392  default=0.0)
1393  call get_param(param_file, mdl, "ICE_SHELF_TEMPERATURE", cs%Temp_ice, &
1394  "The temperature at the center of the ice shelf.", &
1395  units = "degC", default=-15.0)
1396  call get_param(param_file, mdl, "KD_SALT_MOLECULAR", cs%kd_molec_salt, &
1397  "The molecular diffusivity of salt in sea water at the \n"//&
1398  "freezing point.", units="m2 s-1", default=8.02e-10)
1399  call get_param(param_file, mdl, "KD_TEMP_MOLECULAR", cs%kd_molec_temp, &
1400  "The molecular diffusivity of heat in sea water at the \n"//&
1401  "freezing point.", units="m2 s-1", default=1.41e-7)
1402  call get_param(param_file, mdl, "RHO_0", cs%density_ocean_avg, &
1403  "avg ocean density used in floatation cond", &
1404  units="kg m-3", default=1035.)
1405  call get_param(param_file, mdl, "DT_FORCING", cs%time_step, &
1406  "The time step for changing forcing, coupling with other \n"//&
1407  "components, or potentially writing certain diagnostics. \n"//&
1408  "The default value is given by DT.", units="s", default=0.0)
1409  call get_param(param_file, mdl, "SHELF_DIAG_TIMESTEP", cs%velocity_update_time_step, &
1410  "A timestep to use for diagnostics of the shelf.", default=0.0)
1411 
1412  call get_param(param_file, mdl, "COL_THICK_MELT_THRESHOLD", cs%col_thick_melt_threshold, &
1413  "The minimum ML thickness where melting is allowed.", units="m", &
1414  default=0.0)
1415 
1416  call get_param(param_file, mdl, "READ_TIDEAMP", read_tideamp, &
1417  "If true, read a file (given by TIDEAMP_FILE) containing \n"//&
1418  "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.)
1419 
1420  call safe_alloc_ptr(cs%utide,isd,ied,jsd,jed) ; cs%utide(:,:) = 0.0
1421 
1422  if (read_tideamp) then
1423  call get_param(param_file, mdl, "TIDEAMP_FILE", tideamp_file, &
1424  "The path to the file containing the spatially varying \n"//&
1425  "tidal amplitudes.", &
1426  default="tideamp.nc")
1427  call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".")
1428  inputdir = slasher(inputdir)
1429  tideamp_file = trim(inputdir) // trim(tideamp_file)
1430  call read_data(tideamp_file,'tideamp',cs%utide,domain=g%domain%mpp_domain,timelevel=1)
1431  else
1432  call get_param(param_file, mdl, "UTIDE", utide, &
1433  "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", &
1434  units="m s-1", default=0.0)
1435  cs%utide = utide
1436  endif
1437 
1438  call eos_init(param_file, cs%eqn_of_state)
1439 
1440  !! new parameters that need to be in MOM_input
1441 
1442  if (cs%shelf_mass_is_dynamic .and. .not.cs%override_shelf_movement) then
1443 
1444  call get_param(param_file, mdl, "A_GLEN_ISOTHERM", cs%A_glen_isothermal, &
1445  "Ice viscosity parameter in Glen's Law", &
1446  units="Pa -1/3 a", default=9.461e-18)
1447  call get_param(param_file, mdl, "GLEN_EXPONENT", cs%n_glen, &
1448  "nonlinearity exponent in Glen's Law", &
1449  units="none", default=3.)
1450  call get_param(param_file, mdl, "MIN_STRAIN_RATE_GLEN", cs%eps_glen_min, &
1451  "min. strain rate to avoid infinite Glen's law viscosity", &
1452  units="a-1", default=1.e-12)
1453  call get_param(param_file, mdl, "BASAL_FRICTION_COEFF", cs%C_basal_friction, &
1454  "ceofficient in sliding law \tau_b = C u^(n_basal_friction)", &
1455  units="Pa (m-a)-(n_basal_friction)", fail_if_missing=.true.)
1456  call get_param(param_file, mdl, "BASAL_FRICTION_EXP", cs%n_basal_friction, &
1457  "exponent in sliding law \tau_b = C u^(m_slide)", &
1458  units="none", fail_if_missing=.true.)
1459  call get_param(param_file, mdl, "DENSITY_ICE", cs%density_ice, &
1460  "A typical density of ice.", units="kg m-3", default=917.0)
1461 
1462  call get_param(param_file, mdl, "INPUT_FLUX_ICE_SHELF", cs%input_flux, &
1463  "volume flux at upstream boundary", &
1464  units="m2 s-1", default=0.)
1465  call get_param(param_file, mdl, "INPUT_THICK_ICE_SHELF", cs%input_thickness, &
1466  "flux thickness at upstream boundary", &
1467  units="m", default=1000.)
1468  call get_param(param_file, mdl, "ICE_VELOCITY_TIMESTEP", cs%velocity_update_time_step, &
1469  "seconds between ice velocity calcs", units="s", &
1470  fail_if_missing=.true.)
1471 
1472  call get_param(param_file, mdl, "CONJUGATE_GRADIENT_TOLERANCE", cs%cg_tolerance, &
1473  "tolerance in CG solver, relative to initial residual", default=1.e-6)
1474  call get_param(param_file, mdl, "ICE_NONLINEAR_TOLERANCE", &
1475  cs%nonlinear_tolerance,"nonlin tolerance in iterative velocity solve",default=1.e-6)
1476  call get_param(param_file, mdl, "CONJUGATE_GRADIENT_MAXIT", cs%cg_max_iterations, &
1477  "max iteratiions in CG solver", default=2000)
1478  call get_param(param_file, mdl, "THRESH_FLOAT_COL_DEPTH", cs%thresh_float_col_depth, &
1479  "min ocean thickness to consider ice *floating*; \n"// &
1480  "will only be important with use of tides", &
1481  units="m",default=1.e-3)
1482 
1483  call get_param(param_file, mdl, "SHELF_MOVING_FRONT", cs%moving_shelf_front, &
1484  "whether or not to advance shelf front (and calve..)")
1485  call get_param(param_file, mdl, "CALVE_TO_MASK", cs%calve_to_mask, &
1486  "if true, do not allow an ice shelf where prohibited by a mask")
1487  call get_param(param_file, mdl, "ICE_SHELF_CFL_FACTOR", cs%CFL_factor, &
1488  "limit timestep as a factor of min (\Delta x / u); \n"// &
1489  "only important for ice-only model", &
1490  default=0.25)
1491  call get_param(param_file, mdl, "NONLIN_SOLVE_ERR_MODE", cs%nonlin_solve_err_mode, &
1492  "choose whether nonlin error in vel solve is based on nonlinear residual (1) \n"// &
1493  "or relative change since last iteration (2)", &
1494  default=1)
1495 
1496 
1497  if (cs%debug) cs%use_reproducing_sums = .true.
1498 
1499  cs%nstep_velocity = floor(cs%velocity_update_time_step / cs%time_step)
1500  cs%velocity_update_counter = 0
1501  cs%velocity_update_sub_counter = 0
1502  else
1503  cs%nstep_velocity = 0
1504  ! This is here because of inconsistent defaults. I don't know why. RWH
1505  call get_param(param_file, mdl, "DENSITY_ICE", cs%density_ice, &
1506  "A typical density of ice.", units="kg m-3", default=900.0)
1507  endif
1508 
1509  call get_param(param_file, mdl, "MIN_THICKNESS_SIMPLE_CALVE", &
1510  cs%min_thickness_simple_calve, &
1511  "min thickness rule for VERY simple calving law",&
1512  units="m", default=0.0)
1513 
1514  call get_param(param_file, mdl, "WRITE_OUTPUT_TO_FILE", &
1515  cs%write_output_to_file, "for debugging purposes",default=.false.)
1516 
1517  call get_param(param_file, mdl, "USTAR_SHELF_BG", cs%ustar_bg, &
1518  "The minimum value of ustar under ice sheves.", units="m s-1", &
1519  default=0.0)
1520  call get_param(param_file, mdl, "CDRAG_SHELF", cdrag, &
1521  "CDRAG is the drag coefficient relating the magnitude of \n"//&
1522  "the velocity field to the surface stress.", units="nondim", &
1523  default=0.003)
1524  cs%cdrag = cdrag
1525  if (cs%ustar_bg <= 0.0) then
1526  call get_param(param_file, mdl, "DRAG_BG_VEL_SHELF", drag_bg_vel, &
1527  "DRAG_BG_VEL is either the assumed bottom velocity (with \n"//&
1528  "LINEAR_DRAG) or an unresolved velocity that is \n"//&
1529  "combined with the resolved velocity to estimate the \n"//&
1530  "velocity magnitude.", units="m s-1", default=0.0)
1531  if (cs%cdrag*drag_bg_vel > 0.0) cs%ustar_bg = sqrt(cs%cdrag)*drag_bg_vel
1532 
1533  endif
1534 
1535  ! Allocate and initialize variables
1536  allocate( cs%mass_shelf(isd:ied,jsd:jed) ) ; cs%mass_shelf(:,:) = 0.0
1537  allocate( cs%area_shelf_h(isd:ied,jsd:jed) ) ; cs%area_shelf_h(:,:) = 0.0
1538  allocate( cs%t_flux(isd:ied,jsd:jed) ) ; cs%t_flux(:,:) = 0.0
1539  allocate( cs%lprec(isd:ied,jsd:jed) ) ; cs%lprec(:,:) = 0.0
1540  allocate( cs%salt_flux(isd:ied,jsd:jed) ) ; cs%salt_flux(:,:) = 0.0
1541 
1542  allocate( cs%tflux_shelf(isd:ied,jsd:jed) ) ; cs%tflux_shelf(:,:) = 0.0
1543  allocate( cs%tfreeze(isd:ied,jsd:jed) ) ; cs%tfreeze(:,:) = 0.0
1544  allocate( cs%exch_vel_s(isd:ied,jsd:jed) ) ; cs%exch_vel_s(:,:) = 0.0
1545  allocate( cs%exch_vel_t(isd:ied,jsd:jed) ) ; cs%exch_vel_t(:,:) = 0.0
1546 
1547  allocate ( cs%h_shelf(isd:ied,jsd:jed) ) ; cs%h_shelf(:,:) = 0.0
1548  allocate ( cs%hmask(isd:ied,jsd:jed) ) ; cs%hmask(:,:) = -2.0
1549 
1550 
1551  ! OVS vertically integrated Temperature
1552  allocate ( cs%t_shelf(isd:ied,jsd:jed) ) ; cs%t_shelf(:,:) = -10.0
1553  allocate ( cs%t_boundary_values(isd:ied,jsd:jed) ) ; cs%t_boundary_values(:,:) = -15.0
1554  allocate ( cs%tmask(isdq:iedq,jsdq:jedq) ) ; cs%tmask(:,:) = -1.0
1555 
1556  if (cs%shelf_mass_is_dynamic .and. .not.cs%override_shelf_movement) then
1557  ! DNG
1558  allocate ( cs%u_shelf(isdq:iedq,jsdq:jedq) ) ; cs%u_shelf(:,:) = 0.0
1559  allocate ( cs%v_shelf(isdq:iedq,jsdq:jedq) ) ; cs%v_shelf(:,:) = 0.0
1560  allocate ( cs%u_boundary_values(isdq:iedq,jsdq:jedq) ) ; cs%u_boundary_values(:,:) = 0.0
1561  allocate ( cs%v_boundary_values(isdq:iedq,jsdq:jedq) ) ; cs%v_boundary_values(:,:) = 0.0
1562  allocate ( cs%h_boundary_values(isd:ied,jsd:jed) ) ; cs%h_boundary_values(:,:) = 0.0
1563  allocate ( cs%thickness_boundary_values(isd:ied,jsd:jed) ) ; cs%thickness_boundary_values(:,:) = 0.0
1564  allocate ( cs%ice_visc_bilinear(isd:ied,jsd:jed) ) ; cs%ice_visc_bilinear(:,:) = 0.0
1565  allocate ( cs%ice_visc_lower_tri(isd:ied,jsd:jed) ) ; cs%ice_visc_lower_tri = 0.0
1566  allocate ( cs%ice_visc_upper_tri(isd:ied,jsd:jed) ) ; cs%ice_visc_upper_tri = 0.0
1567  allocate ( cs%u_face_mask(isdq:iedq,jsd:jed) ) ; cs%u_face_mask(:,:) = 0.0
1568  allocate ( cs%v_face_mask(isd:ied,jsdq:jedq) ) ; cs%v_face_mask(:,:) = 0.0
1569  allocate ( cs%u_face_mask_boundary(isdq:iedq,jsd:jed) ) ; cs%u_face_mask_boundary(:,:) = -2.0
1570  allocate ( cs%v_face_mask_boundary(isd:ied,jsdq:jedq) ) ; cs%v_face_mask_boundary(:,:) = -2.0
1571  allocate ( cs%u_flux_boundary_values(isdq:iedq,jsd:jed) ) ; cs%u_flux_boundary_values(:,:) = 0.0
1572  allocate ( cs%v_flux_boundary_values(isd:ied,jsdq:jedq) ) ; cs%v_flux_boundary_values(:,:) = 0.0
1573  allocate ( cs%umask(isdq:iedq,jsdq:jedq) ) ; cs%umask(:,:) = -1.0
1574  allocate ( cs%vmask(isdq:iedq,jsdq:jedq) ) ; cs%vmask(:,:) = -1.0
1575 
1576  allocate ( cs%taub_beta_eff_bilinear(isd:ied,jsd:jed) ) ; cs%taub_beta_eff_bilinear(:,:) = 0.0
1577  allocate ( cs%taub_beta_eff_upper_tri(isd:ied,jsd:jed) ) ; cs%taub_beta_eff_upper_tri(:,:) = 0.0
1578  allocate ( cs%taub_beta_eff_lower_tri(isd:ied,jsd:jed) ) ; cs%taub_beta_eff_lower_tri(:,:) = 0.0
1579  allocate ( cs%OD_rt(isd:ied,jsd:jed) ) ; cs%OD_rt(:,:) = 0.0
1580  allocate ( cs%OD_av(isd:ied,jsd:jed) ) ; cs%OD_av(:,:) = 0.0
1581  allocate ( cs%float_frac(isd:ied,jsd:jed) ) ; cs%float_frac(:,:) = 0.0
1582  allocate ( cs%float_frac_rt(isd:ied,jsd:jed) ) ; cs%float_frac_rt(:,:) = 0.0
1583 
1584  if (cs%calve_to_mask) then
1585  allocate ( cs%calve_mask (isd:ied,jsd:jed) ) ; cs%calve_mask(:,:) = 0.0
1586  endif
1587 
1588  endif
1589 
1590  ! Allocate the arrays for passing ice-shelf data through the forcing type.
1591  if (.not. solo_ice_sheet) then
1592  if (is_root_pe()) print *,"initialize_ice_shelf: allocating fluxes"
1593  ! GMM: the following assures that water/heat fluxes are just allocated
1594  ! when SHELF_THERMO = True. These fluxes are necessary if one wants to
1595  ! use either ENERGETICS_SFC_PBL (ALE mode) or BULKMIXEDLAYER (layer mode).
1596  call allocate_forcing_type(g, fluxes, ustar=.true., shelf=.true., &
1597  press=.true., water=cs%isthermo, heat=cs%isthermo)
1598  else
1599  if (is_root_pe()) print *,"allocating fluxes in solo mode"
1600  call allocate_forcing_type(g, fluxes, ustar=.true., shelf=.true., press=.true.)
1601  endif
1602 
1603  ! Set up the bottom depth, G%D either analytically or from file
1604  call mom_initialize_topography(g%bathyT, g%max_depth, dg, param_file)
1605  ! Set up the Coriolis parameter, G%f, usually analytically.
1606  call mom_initialize_rotation(g%CoriolisBu, dg, param_file)
1607  call copy_dyngrid_to_mom_grid(dg, cs%grid)
1608 
1609  call destroy_dyn_horgrid(dg)
1610 
1611  ! Set up the restarts.
1612  call restart_init(param_file, cs%restart_CSp, "Shelf.res")
1613  vd = var_desc("shelf_mass","kg m-2","Ice shelf mass",z_grid='1')
1614  call register_restart_field(cs%mass_shelf, vd, .true., cs%restart_CSp)
1615  vd = var_desc("shelf_area","m2","Ice shelf area in cell",z_grid='1')
1616  call register_restart_field(cs%area_shelf_h, vd, .true., cs%restart_CSp)
1617  vd = var_desc("h_shelf","m","ice sheet/shelf thickness",z_grid='1')
1618  call register_restart_field(cs%h_shelf, vd, .true., cs%restart_CSp)
1619 
1620  if (cs%shelf_mass_is_dynamic .and. .not.cs%override_shelf_movement) then
1621  ! additional restarts for ice shelf state
1622  vd = var_desc("u_shelf","m s-1","ice sheet/shelf velocity",'q',z_grid='1')
1623  call register_restart_field(cs%u_shelf, vd, .true., cs%restart_CSp)
1624  vd = var_desc("v_shelf","m s-1","ice sheet/shelf velocity",'q',z_grid='1')
1625  call register_restart_field(cs%v_shelf, vd, .true., cs%restart_CSp)
1626  !vd = var_desc("h_shelf","m","ice sheet/shelf thickness",z_grid='1')
1627  !call register_restart_field(CS%h_shelf, vd, .true., CS%restart_CSp)
1628 
1629  vd = var_desc("h_mask","none","ice sheet/shelf thickness mask",z_grid='1')
1630  call register_restart_field(cs%hmask, vd, .true., cs%restart_CSp)
1631 
1632  ! OVS vertically integrated stream/shelf temperature
1633  vd = var_desc("t_shelf","deg C","ice sheet/shelf temperature",z_grid='1')
1634  call register_restart_field(cs%t_shelf, vd, .true., cs%restart_CSp)
1635 
1636 
1637  ! vd = var_desc("area_shelf_h","m-2","ice-covered area of a cell",z_grid='1')
1638  ! call register_restart_field(CS%area_shelf_h, CS%area_shelf_h, vd, .true., CS%restart_CSp)
1639 
1640  vd = var_desc("OD_av","m","avg ocean depth in a cell",z_grid='1')
1641  call register_restart_field(cs%OD_av, vd, .true., cs%restart_CSp)
1642 
1643  ! vd = var_desc("OD_av_rt","m","avg ocean depth in a cell, intermed",z_grid='1')
1644  ! call register_restart_field(CS%OD_av_rt, CS%OD_av_rt, vd, .true., CS%restart_CSp)
1645 
1646  vd = var_desc("float_frac","m","degree of grounding",z_grid='1')
1647  call register_restart_field(cs%float_frac, vd, .true., cs%restart_CSp)
1648 
1649  ! vd = var_desc("float_frac_rt","m","degree of grounding, intermed",z_grid='1')
1650  ! call register_restart_field(CS%float_frac_rt, CS%float_frac_rt, vd, .true., CS%restart_CSp)
1651 
1652  vd = var_desc("viscosity","m","glens law ice visc",z_grid='1')
1653  call register_restart_field(cs%ice_visc_bilinear, vd, .true., cs%restart_CSp)
1654  vd = var_desc("tau_b_beta","m","coefficient of basal traction",z_grid='1')
1655  call register_restart_field(cs%taub_beta_eff_bilinear, vd, .true., cs%restart_CSp)
1656  endif
1657 
1658  !GMM - I think we do not need to save ustar_shelf and iceshelf_melt in the restart file
1659  ! if (.not. solo_ice_sheet) then
1660  ! vd = var_desc("ustar_shelf","m s-1","Friction velocity under ice shelves",z_grid='1')
1661  ! call register_restart_field(fluxes%ustar_shelf, vd, .true., CS%restart_CSp)
1662  ! vd = var_desc("iceshelf_melt","m year-1","Ice Shelf Melt Rate",z_grid='1')
1663  ! call register_restart_field(fluxes%iceshelf_melt, vd, .true., CS%restart_CSp)
1664  !endif
1665 
1666  cs%restart_output_dir = dirs%restart_output_dir
1667 
1668  new_sim = .false.
1669  if ((dirs%input_filename(1:1) == 'n') .and. &
1670  (len_trim(dirs%input_filename) == 1)) new_sim = .true.
1671 
1672  if (cs%override_shelf_movement .and. cs%mass_from_file) then
1673 
1674  ! initialize the ids for reading shelf mass from a netCDF
1675  call initialize_shelf_mass(g, param_file, cs)
1676 
1677  if (new_sim) then
1678  ! new simulation, initialize ice thickness as in the static case
1679  call initialize_ice_thickness (cs%h_shelf, cs%area_shelf_h, cs%hmask, g, param_file)
1680 
1681  ! next make sure mass is consistent with thickness
1682  do j=g%jsd,g%jed
1683  do i=g%isd,g%ied
1684  if ((cs%hmask(i,j) .eq. 1) .or. (cs%hmask(i,j) .eq. 2)) then
1685  cs%mass_shelf(i,j) = cs%h_shelf(i,j)*cs%density_ice
1686  endif
1687  enddo
1688  enddo
1689 
1690  if (cs%min_thickness_simple_calve > 0.0) then
1691  call ice_shelf_min_thickness_calve (cs, cs%h_shelf, cs%area_shelf_h, cs%hmask)
1692  endif
1693 
1694  endif
1695 
1696  ! else if (CS%shelf_mass_is_dynamic) then
1697  ! call initialize_ice_shelf_boundary ( CS%u_face_mask_boundary, CS%v_face_mask_boundary, &
1698  ! CS%u_flux_boundary_values, CS%v_flux_boundary_values, &
1699  ! CS%u_boundary_values, CS%v_boundary_values, CS%h_boundary_values, &
1700 ! CS%hmask, G, param_file)
1701  end if
1702 
1703  if (cs%shelf_mass_is_dynamic .and. .not. cs%override_shelf_movement) then
1704  ! the only reason to initialize boundary conds is if the shelf is dynamic
1705 
1706  !MJHcall initialize_ice_shelf_boundary ( CS%u_face_mask_boundary, CS%v_face_mask_boundary, &
1707  !MJH CS%u_flux_boundary_values, CS%v_flux_boundary_values, &
1708  !MJH CS%u_boundary_values, CS%v_boundary_values, CS%h_boundary_values, &
1709  !MJH CS%hmask, G, param_file)
1710 
1711  end if
1712 
1713  if (new_sim .and. (.not. (cs%override_shelf_movement .and. cs%mass_from_file))) then
1714 
1715  ! This model is initialized internally or from a file.
1716  call initialize_ice_thickness (cs%h_shelf, cs%area_shelf_h, cs%hmask, g, param_file)
1717 
1718  ! next make sure mass is consistent with thickness
1719  do j=g%jsd,g%jed
1720  do i=g%isd,g%ied
1721  if ((cs%hmask(i,j) .eq. 1) .or. (cs%hmask(i,j) .eq. 2)) then
1722  cs%mass_shelf(i,j) = cs%h_shelf(i,j)*cs%density_ice
1723  endif
1724  enddo
1725  enddo
1726 
1727  ! else ! Previous block for new_sim=.T., this block restores the state.
1728  elseif (.not.new_sim) then
1729  ! This line calls a subroutine that reads the initial conditions
1730  ! from a restart file.
1731  call restore_state(dirs%input_filename, dirs%restart_input_dir, time, &
1732  g, cs%restart_CSp)
1733 
1734  ! i think this call isnt necessary - all it does is set hmask to 3 at
1735  ! the dirichlet boundary, and now this is done elsewhere
1736  ! call initialize_shelf_mass(G, param_file, CS, .false.)
1737 
1738  if (cs%shelf_mass_is_dynamic .and. .not.cs%override_shelf_movement) then
1739 
1740  ! this is unfortunately necessary; if grid is not symmetric the boundary values
1741  ! of u and v are otherwise not set till the end of the first linear solve, and so
1742  ! viscosity is not calculated correctly
1743  if (.not. g%symmetric) then
1744  do j=g%jsd,g%jed
1745  do i=g%isd,g%ied
1746  if (((i+g%idg_offset) .eq. (g%domain%nihalo+1)).and.(cs%u_face_mask(i-1,j).eq.3)) then
1747  cs%u_shelf (i-1,j-1) = cs%u_boundary_values (i-1,j-1)
1748  cs%u_shelf (i-1,j) = cs%u_boundary_values (i-1,j)
1749  endif
1750  if (((j+g%jdg_offset) .eq. (g%domain%njhalo+1)).and.(cs%v_face_mask(i,j-1).eq.3)) then
1751  cs%u_shelf (i-1,j-1) = cs%u_boundary_values (i-1,j-1)
1752  cs%u_shelf (i,j-1) = cs%u_boundary_values (i,j-1)
1753  endif
1754  enddo
1755  enddo
1756  endif
1757 
1758  call pass_var (cs%OD_av,g%domain)
1759  call pass_var (cs%float_frac,g%domain)
1760  call pass_var (cs%ice_visc_bilinear,g%domain)
1761  call pass_var (cs%taub_beta_eff_bilinear,g%domain)
1762  call pass_vector(cs%u_shelf, cs%v_shelf, g%domain, to_all, bgrid_ne)
1763  call pass_var (cs%area_shelf_h,g%domain)
1764  call pass_var (cs%h_shelf,g%domain)
1765  call pass_var (cs%hmask,g%domain)
1766 
1767  if (is_root_pe()) print *, "RESTORING ICE SHELF FROM FILE!!!!!!!!!!!!!"
1768  endif
1769 
1770  endif ! .not. new_sim
1771 
1772  cs%Time = time
1773 
1774  call pass_var(cs%area_shelf_h, g%domain)
1775  call pass_var(cs%h_shelf, g%domain)
1776  call pass_var(cs%mass_shelf, g%domain)
1777 
1778  ! Transfer the appropriate fields to the forcing type.
1779  if (cs%shelf_mass_is_dynamic .and. .not.cs%override_shelf_movement) then
1780  call cpu_clock_begin(id_clock_pass)
1781  call pass_var(g%bathyT, g%domain)
1782  call pass_var(cs%hmask, g%domain)
1783  call update_velocity_masks (cs)
1784  call cpu_clock_end(id_clock_pass)
1785  endif
1786 
1787  do j=jsd,jed ; do i=isd,ied ! changed stride
1788  if (cs%area_shelf_h(i,j) > g%areaT(i,j)) then
1789  call mom_error(warning,"Initialize_ice_shelf: area_shelf_h exceeds G%areaT.")
1790  cs%area_shelf_h(i,j) = g%areaT(i,j)
1791  endif
1792  !if (.not. solo_ice_sheet) then
1793  if (g%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = cs%area_shelf_h(i,j) / g%areaT(i,j)
1794  if (associated(fluxes%p_surf)) &
1795  fluxes%p_surf(i,j) = fluxes%p_surf(i,j) + &
1796  fluxes%frac_shelf_h(i,j) * (cs%g_Earth * cs%mass_shelf(i,j))
1797  if (associated(fluxes%p_surf_full)) &
1798  fluxes%p_surf_full(i,j) = fluxes%p_surf_full(i,j) + &
1799  fluxes%frac_shelf_h(i,j) * (cs%g_Earth * cs%mass_shelf(i,j))
1800  !endif
1801  enddo ; enddo
1802 
1803  if (cs%DEBUG) then
1804  call hchksum (fluxes%frac_shelf_h, "IS init: frac_shelf_h", g%HI, haloshift=0)
1805  endif
1806 
1807  if (.not. solo_ice_sheet) then
1808  do j=jsd,jed ; do i=isd,ied-1 ! changed stride
1809  !do I=isd,ied-1 ; do j=isd,jed
1810  fluxes%frac_shelf_u(i,j) = 0.0
1811  if ((g%areaT(i,j) + g%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) &
1812  fluxes%frac_shelf_u(i,j) = ((cs%area_shelf_h(i,j) + cs%area_shelf_h(i+1,j)) / &
1813  (g%areaT(i,j) + g%areaT(i+1,j)))
1814  fluxes%rigidity_ice_u(i,j) = (cs%kv_ice / cs%density_ice) * &
1815  min(cs%mass_shelf(i,j), cs%mass_shelf(i+1,j))
1816  enddo ; enddo
1817 
1818 
1819  do j=jsd,jed-1 ; do i=isd,ied ! changed stride
1820  !do i=isd,ied ; do J=isd,jed-1
1821  fluxes%frac_shelf_v(i,j) = 0.0
1822  if ((g%areaT(i,j) + g%areaT(i,j+1) > 0.0)) & ! .and. (G%dxdy_v(i,J) > 0.0)) &
1823  fluxes%frac_shelf_v(i,j) = ((cs%area_shelf_h(i,j) + cs%area_shelf_h(i,j+1)) / &
1824  (g%areaT(i,j) + g%areaT(i,j+1)))
1825  fluxes%rigidity_ice_v(i,j) = (cs%kv_ice / cs%density_ice) * &
1826  min(cs%mass_shelf(i,j), cs%mass_shelf(i,j+1))
1827  enddo ; enddo
1828  endif
1829 
1830  if (.not. solo_ice_sheet) then
1831  call pass_vector(fluxes%frac_shelf_u, fluxes%frac_shelf_v, g%domain, to_all, cgrid_ne)
1832  endif
1833  ! call savearray2 ('frac_shelf_u'//procnum,fluxes%frac_shelf_u,CS%write_output_to_file)
1834  ! call savearray2 ('frac_shelf_v'//procnum,fluxes%frac_shelf_v,CS%write_output_to_file)
1835  ! call savearray2 ('frac_shelf_h'//procnum,fluxes%frac_shelf_h,CS%write_output_to_file)
1836  ! call savearray2 ('area_shelf_h'//procnum,CS%area_shelf_h,CS%write_output_to_file)
1837 
1838  ! if we are calving to a mask, i.e. if a mask exists where a shelf cannot, then we read
1839  ! the mask from a file
1840 
1841  if (cs%shelf_mass_is_dynamic .and. cs%calve_to_mask .and. &
1842  .not.cs%override_shelf_movement) then
1843 
1844  call mom_mesg(" MOM_ice_shelf.F90, initialize_ice_shelf: reading calving_mask")
1845 
1846  call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".")
1847  inputdir = slasher(inputdir)
1848  call get_param(param_file, mdl, "CALVING_MASK_FILE", ic_file, &
1849  "The file with a mask for where calving might occur.", &
1850  default="ice_shelf_h.nc")
1851  call get_param(param_file, mdl, "CALVING_MASK_VARNAME", var_name, &
1852  "The variable to use in masking calving.", &
1853  default="area_shelf_h")
1854 
1855  filename = trim(inputdir)//trim(ic_file)
1856  call log_param(param_file, mdl, "INPUTDIR/CALVING_MASK_FILE", filename)
1857  if (.not.file_exists(filename, g%Domain)) call mom_error(fatal, &
1858  " calving mask file: Unable to open "//trim(filename))
1859 
1860  call read_data(filename,trim(var_name),cs%calve_mask,domain=g%Domain%mpp_domain)
1861  do j=g%jsc,g%jec
1862  do i=g%isc,g%iec
1863  if (cs%calve_mask(i,j) > 0.0) cs%calve_mask(i,j) = 1.0
1864  enddo
1865  enddo
1866 
1867  call pass_var (cs%calve_mask,g%domain)
1868  endif
1869 
1870  if (cs%shelf_mass_is_dynamic .and. .not.cs%override_shelf_movement) then
1871 ! call init_boundary_values (CS, time, CS%input_flux, CS%input_thickness, new_sim)
1872 
1873  if (.not. cs%isthermo) then
1874  cs%lprec(:,:) = 0.0
1875  endif
1876 
1877 
1878  if (new_sim) then
1879  if (is_root_pe()) print *,"NEW SIM: initialize velocity"
1880  call update_od_ffrac_uncoupled (cs)
1881  call ice_shelf_solve_outer (cs, cs%u_shelf, cs%v_shelf, 1, iters, time)
1882 
1883 ! write (procnum,'(I2)') mpp_pe()
1884 
1885  if (cs%id_u_shelf > 0) call post_data(cs%id_u_shelf,cs%u_shelf,cs%diag)
1886  if (cs%id_v_shelf > 0) call post_data(cs%id_v_shelf,cs%v_shelf,cs%diag)
1887  endif
1888  endif
1889 
1890  call get_param(param_file, mdl, "SAVE_INITIAL_CONDS", save_ic, &
1891  "If true, save the ice shelf initial conditions.", &
1892  default=.false.)
1893  if (save_ic) call get_param(param_file, mdl, "SHELF_IC_OUTPUT_FILE", ic_file,&
1894  "The name-root of the output file for the ice shelf \n"//&
1895  "initial conditions.", default="MOM_Shelf_IC")
1896 
1897  if (save_ic .and. .not.((dirs%input_filename(1:1) == 'r') .and. &
1898  (len_trim(dirs%input_filename) == 1))) then
1899 
1900  call save_restart(dirs%output_directory, cs%Time, g, &
1901  cs%restart_CSp, filename=ic_file)
1902  endif
1903 
1904 
1905  cs%id_area_shelf_h = register_diag_field('ocean_model', 'area_shelf_h', cs%diag%axesT1, cs%Time, &
1906  'Ice Shelf Area in cell', 'meter-2')
1907  cs%id_shelf_mass = register_diag_field('ocean_model', 'shelf_mass', cs%diag%axesT1, cs%Time, &
1908  'mass of shelf', 'kg/m^2')
1909  cs%id_mass_flux = register_diag_field('ocean_model', 'mass_flux', cs%diag%axesT1,&
1910  cs%Time,'Total mass flux of freshwater across the ice-ocean interface.', 'kg/s')
1911  cs%id_melt = register_diag_field('ocean_model', 'melt', cs%diag%axesT1, cs%Time, &
1912  'Ice Shelf Melt Rate', 'meter year-1')
1913  cs%id_thermal_driving = register_diag_field('ocean_model', 'thermal_driving', cs%diag%axesT1, cs%Time, &
1914  'pot. temp. in the boundary layer minus freezing pot. temp. at the ice-ocean interface.', 'Celsius')
1915  cs%id_haline_driving = register_diag_field('ocean_model', 'haline_driving', cs%diag%axesT1, cs%Time, &
1916  'salinity in the boundary layer minus salinity at the ice-ocean interface.', 'PPT')
1917  cs%id_Sbdry = register_diag_field('ocean_model', 'sbdry', cs%diag%axesT1, cs%Time, &
1918  'salinity at the ice-ocean interface.', 'PPT')
1919  cs%id_u_ml = register_diag_field('ocean_model', 'u_ml', cs%diag%axesT1, cs%Time, &
1920  'Eastward vel. in the boundary layer (used to compute ustar)', 'meter second-1')
1921  cs%id_v_ml = register_diag_field('ocean_model', 'v_ml', cs%diag%axesT1, cs%Time, &
1922  'Northward vel. in the boundary layer (used to compute ustar)', 'meter second-1')
1923  cs%id_exch_vel_s = register_diag_field('ocean_model', 'exch_vel_s', cs%diag%axesT1, cs%Time, &
1924  'Sub-shelf salinity exchange velocity', 'meter second-1')
1925  cs%id_exch_vel_t = register_diag_field('ocean_model', 'exch_vel_t', cs%diag%axesT1, cs%Time, &
1926  'Sub-shelf thermal exchange velocity', 'meter second-1')
1927  cs%id_tfreeze = register_diag_field('ocean_model', 'tfreeze', cs%diag%axesT1, cs%Time, &
1928  'In Situ Freezing point at ice shelf interface', 'degrees Celsius')
1929  cs%id_tfl_shelf = register_diag_field('ocean_model', 'tflux_shelf', cs%diag%axesT1, cs%Time, &
1930  'Heat conduction into ice shelf', 'Watts meter-2')
1931  cs%id_ustar_shelf = register_diag_field('ocean_model', 'ustar_shelf', cs%diag%axesT1, cs%Time, &
1932  'Fric vel under shelf', 'm/s')
1933 
1934  if (cs%shelf_mass_is_dynamic .and. .not.cs%override_shelf_movement) then
1935  cs%id_u_shelf = register_diag_field('ocean_model','u_shelf',cs%diag%axesB1,cs%Time, &
1936  'x-velocity of ice', 'm year')
1937  cs%id_v_shelf = register_diag_field('ocean_model','v_shelf',cs%diag%axesB1,cs%Time, &
1938  'y-velocity of ice', 'm year')
1939  cs%id_u_mask = register_diag_field('ocean_model','u_mask',cs%diag%axesB1,cs%Time, &
1940  'mask for u-nodes', 'none')
1941  cs%id_v_mask = register_diag_field('ocean_model','v_mask',cs%diag%axesB1,cs%Time, &
1942  'mask for v-nodes', 'none')
1943  cs%id_h_mask = register_diag_field('ocean_model','h_mask',cs%diag%axesT1,cs%Time, &
1944  'ice shelf thickness', 'none')
1945  cs%id_surf_elev = register_diag_field('ocean_model','ice_surf',cs%diag%axesT1,cs%Time, &
1946  'ice surf elev', 'm')
1947  cs%id_float_frac = register_diag_field('ocean_model','ice_float_frac',cs%diag%axesT1,cs%Time, &
1948  'fraction of cell that is floating (sort of)', 'none')
1949  cs%id_col_thick = register_diag_field('ocean_model','col_thick',cs%diag%axesT1,cs%Time, &
1950  'ocean column thickness passed to ice model', 'm')
1951  cs%id_OD_av = register_diag_field('ocean_model','OD_av',cs%diag%axesT1,cs%Time, &
1952  'intermediate ocean column thickness passed to ice model', 'm')
1953  cs%id_float_frac_rt = register_diag_field('ocean_model','float_frac_rt',cs%diag%axesT1,cs%Time, &
1954  'timesteps where cell is floating ', 'none')
1955  !CS%id_h_after_uflux = register_diag_field('ocean_model','h_after_uflux',CS%diag%axesh1,CS%Time, &
1956  ! 'thickness after u flux ', 'none')
1957  !CS%id_h_after_vflux = register_diag_field('ocean_model','h_after_vflux',CS%diag%axesh1,CS%Time, &
1958  ! 'thickness after v flux ', 'none')
1959  !CS%id_h_after_adv = register_diag_field('ocean_model','h_after_adv',CS%diag%axesh1,CS%Time, &
1960  ! 'thickness after front adv ', 'none')
1961 
1962 !!! OVS vertically integrated temperature
1963  cs%id_t_shelf = register_diag_field('ocean_model','t_shelf',cs%diag%axesT1,cs%Time, &
1964  'T of ice', 'oC')
1965  cs%id_t_mask = register_diag_field('ocean_model','tmask',cs%diag%axesT1,cs%Time, &
1966  'mask for T-nodes', 'none')
1967  endif
1968 
1969  id_clock_shelf = cpu_clock_id('Ice shelf', grain=clock_component)
1970  id_clock_pass = cpu_clock_id(' Ice shelf halo updates', grain=clock_routine)
1971 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the call graph for this function:
Here is the caller graph for this function:

◆ initialize_shelf_mass()

subroutine mom_ice_shelf::initialize_shelf_mass ( type(ocean_grid_type), intent(in)  G,
type(param_file_type), intent(in)  param_file,
type(ice_shelf_cs), pointer  CS,
logical, optional  new_sim 
)
private

Initializes shelf mass based on three options (file, zero and user)

Parameters
[in]param_fileA structure to parse for run-time parameters

Definition at line 1976 of file MOM_ice_shelf.F90.

Referenced by initialize_ice_shelf().

1976 
1977  type(ocean_grid_type), intent(in) :: g
1978  type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
1979  type(ice_shelf_cs), pointer :: cs
1980  logical, optional :: new_sim
1981 
1982  integer :: i, j, is, ie, js, je
1983  logical :: read_shelf_area, new_sim_2
1984  character(len=240) :: config, inputdir, shelf_file, filename
1985  character(len=120) :: shelf_mass_var ! The name of shelf mass in the file.
1986  character(len=120) :: shelf_area_var ! The name of shelf area in the file.
1987  character(len=40) :: mdl = "MOM_ice_shelf"
1988  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
1989 
1990  if (.not. present(new_sim)) then
1991  new_sim_2 = .true.
1992  else
1993  new_sim_2 = .false.
1994  endif
1995 
1996  call get_param(param_file, mdl, "ICE_SHELF_CONFIG", config, &
1997  "A string that specifies how the ice shelf is \n"//&
1998  "initialized. Valid options include:\n"//&
1999  " \tfile\t Read from a file.\n"//&
2000  " \tzero\t Set shelf mass to 0 everywhere.\n"//&
2001  " \tUSER\t Call USER_initialize_shelf_mass.\n", &
2002  fail_if_missing=.true.)
2003 
2004  select case ( trim(config) )
2005  case ("file")
2006 
2007  call time_interp_external_init()
2008 
2009  call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".")
2010  inputdir = slasher(inputdir)
2011 
2012  call get_param(param_file, mdl, "SHELF_FILE", shelf_file, &
2013  "If DYNAMIC_SHELF_MASS = True, OVERRIDE_SHELF_MOVEMENT = True \n"//&
2014  "and ICE_SHELF_MASS_FROM_FILE = True, this is the file from \n"//&
2015  "which to read the shelf mass and area.", &
2016  default="shelf_mass.nc")
2017  call get_param(param_file, mdl, "SHELF_MASS_VAR", shelf_mass_var, &
2018  "The variable in SHELF_FILE with the shelf mass.", &
2019  default="shelf_mass")
2020  call get_param(param_file, mdl, "READ_SHELF_AREA", read_shelf_area, &
2021  "If true, also read the area covered by ice-shelf from SHELF_FILE.", &
2022  default=.false.)
2023 
2024  filename = trim(slasher(inputdir))//trim(shelf_file)
2025  call log_param(param_file, mdl, "INPUTDIR/SHELF_FILE", filename)
2026 
2027  if (cs%DEBUG) then
2028  cs%id_read_mass = init_external_field(filename,shelf_mass_var, &
2029  domain=g%Domain%mpp_domain,verbose=.true.)
2030  else
2031  cs%id_read_mass = init_external_field(filename,shelf_mass_var, &
2032  domain=g%Domain%mpp_domain)
2033 
2034  endif
2035 
2036  if (read_shelf_area) then
2037  call get_param(param_file, mdl, "SHELF_AREA_VAR", shelf_area_var, &
2038  "The variable in SHELF_FILE with the shelf area.", &
2039  default="shelf_area")
2040 
2041  cs%id_read_area = init_external_field(filename,shelf_area_var, &
2042  domain=g%Domain%mpp_domain)
2043  endif
2044 
2045  if (.not.file_exists(filename, g%Domain)) call mom_error(fatal, &
2046  " initialize_shelf_mass: Unable to open "//trim(filename))
2047 
2048  case ("zero")
2049  do j=js,je ; do i=is,ie
2050  cs%mass_shelf(i,j) = 0.0
2051  cs%area_shelf_h(i,j) = 0.0
2052  enddo ; enddo
2053 
2054  case ("USER")
2055  call user_initialize_shelf_mass(cs%mass_shelf, cs%area_shelf_h, &
2056  cs%h_shelf, cs%hmask, g, cs%user_CS, param_file, new_sim_2)
2057 
2058  case default ; call mom_error(fatal,"initialize_ice_shelf: "// &
2059  "Unrecognized ice shelf setup "//trim(config))
2060  end select
2061 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the caller graph for this function:

◆ interpolate_h_to_b()

subroutine mom_ice_shelf::interpolate_h_to_b ( type(ice_shelf_cs), pointer  CS,
real, dimension (:,:), intent(in)  h_shelf,
real, dimension (:,:), intent(in)  hmask,
real, dimension (nilimb_sym_,njlimb_sym_), intent(inout)  H_node 
)
private

Definition at line 5752 of file MOM_ice_shelf.F90.

Referenced by ice_shelf_solve_outer().

5752  type(ice_shelf_cs), pointer :: cs
5753  real, dimension (:,:), intent(in) :: h_shelf, hmask
5754  real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: h_node
5755 
5756  type(ocean_grid_type), pointer :: g
5757  integer :: i, j, isc, iec, jsc, jec, num_h, k, l
5758  real :: summ
5759 
5760  g => cs%grid
5761  isc = g%isc ; jsc = g%jsc ; iec = g%iec ; jec = g%jec
5762 
5763  h_node(:,:) = 0.0
5764 
5765  ! H_node is node-centered; average over all cells that share that node
5766  ! if no (active) cells share the node then its value there is irrelevant
5767 
5768  do j=jsc-1,jec
5769  do i=isc-1,iec
5770  summ = 0.0
5771  num_h = 0
5772  do k=0,1
5773  do l=0,1
5774  if (hmask(i+k,j+l) .eq. 1.0) then
5775  summ = summ + h_shelf(i+k,j+l)
5776  num_h = num_h + 1
5777  endif
5778  enddo
5779  enddo
5780  if (num_h .gt. 0) then
5781  h_node(i,j) = summ / num_h
5782  endif
5783  enddo
5784  enddo
5785 
5786  call pass_var(h_node, g%domain)
5787 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the caller graph for this function:

◆ matrix_diagonal_bilinear()

subroutine mom_ice_shelf::matrix_diagonal_bilinear ( type(ice_shelf_cs), pointer  CS,
real, dimension (:,:), intent(in)  float_cond,
real, dimension (nilimb_sym_,njlimb_sym_), intent(in)  H_node,
real  dens_ratio,
real, dimension (:,:,:,:,:,:), pointer  Phisub,
real, dimension (nilimb_sym_,njlimb_sym_), intent(inout)  u_diagonal,
real, dimension (nilimb_sym_,njlimb_sym_), intent(inout)  v_diagonal 
)
private

Definition at line 4686 of file MOM_ice_shelf.F90.

References bilinear_shape_functions(), and cg_diagonal_subgrid_basal_bilinear().

Referenced by ice_shelf_solve_inner().

4686 
4687  type(ice_shelf_cs), pointer :: cs
4688  real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent(in) :: h_node
4689  real :: dens_ratio
4690  real, dimension (:,:), intent(in) :: float_cond
4691  real, dimension (:,:,:,:,:,:),pointer :: phisub
4692  real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u_diagonal, v_diagonal
4693 
4694 
4695 ! returns the diagonal entries of the matrix for a Jacobi preconditioning
4696 
4697  real, dimension (:,:), pointer :: umask, vmask, hmask, &
4698  nu, beta
4699  type(ocean_grid_type), pointer :: g
4700  integer :: isym, i, j, is, js, cnt, isc, jsc, iec, jec, iphi, jphi, iq, jq, ilq, jlq
4701  real :: a, n, ux, uy, vx, vy, eps_min, domain_width, dxh, dyh, dxdyh, area, uq, vq, basel
4702  real, dimension(8,4) :: phi
4703  real, dimension(4) :: x, y
4704  real, dimension(2) :: xquad
4705  real, dimension(2,2) :: hcell,usubcontr,vsubcontr
4706 
4707  g => cs%grid
4708 
4709 ! if (G%symmetric) then
4710 ! isym=1
4711 ! else
4712 ! isym=0
4713 ! endif
4714 
4715  isym = 0
4716 
4717  isc = g%isc ; jsc = g%jsc ; iec = g%iec ; jec = g%jec
4718 
4719  umask => cs%umask ; vmask => cs%vmask ; hmask => cs%hmask
4720  nu => cs%ice_visc_bilinear
4721  beta => cs%taub_beta_eff_bilinear
4722 
4723  xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3))
4724 
4725 ! X and Y must be passed in the form
4726  ! 3 - 4
4727  ! | |
4728  ! 1 - 2
4729 ! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j
4730 ! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j
4731 
4732  do j=jsc-1,jec+1 ; do i=isc-1,iec+1 ; if (hmask(i,j) .eq. 1) then
4733 
4734  dxh = g%dxT(i,j)
4735  dyh = g%dyT(i,j)
4736  dxdyh = g%areaT(i,j)
4737 
4738  x(1:2) = g%geoLonBu (i-1:i,j-1)*1000
4739  x(3:4) = g%geoLonBu (i-1:i,j) *1000
4740  y(1:2) = g%geoLatBu (i-1:i,j-1) *1000
4741  y(3:4) = g%geoLatBu (i-1:i,j)*1000
4742 
4743  call bilinear_shape_functions (x, y, phi, area)
4744 
4745  ! X and Y must be passed in the form
4746  ! 3 - 4
4747  ! | |
4748  ! 1 - 2
4749  ! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j
4750  ! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j
4751 
4752  do iq=1,2 ; do jq=1,2
4753 
4754  do iphi=1,2 ; do jphi=1,2
4755 
4756  if (iq .eq. iphi) then
4757  ilq = 2
4758  else
4759  ilq = 1
4760  endif
4761 
4762  if (jq .eq. jphi) then
4763  jlq = 2
4764  else
4765  jlq = 1
4766  endif
4767 
4768  if (umask(i-2+iphi,j-2+jphi) .eq. 1) then
4769 
4770  ux = phi(2*(2*(jphi-1)+iphi)-1, 2*(jq-1)+iq)
4771  uy = phi(2*(2*(jphi-1)+iphi), 2*(jq-1)+iq)
4772  vx = 0.
4773  vy = 0.
4774 
4775  u_diagonal(i-2+iphi,j-2+jphi) = u_diagonal(i-2+iphi,j-2+jphi) + &
4776  .25 * dxdyh * nu(i,j) * ((4*ux+2*vy) * phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + &
4777  (uy+vy) * phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq))
4778 
4779  uq = xquad(ilq) * xquad(jlq)
4780 
4781  if (float_cond(i,j) .eq. 0) then
4782  u_diagonal(i-2+iphi,j-2+jphi) = u_diagonal(i-2+iphi,j-2+jphi) + &
4783  .25 * beta(i,j) * dxdyh * uq * xquad(ilq) * xquad(jlq)
4784  endif
4785 
4786  endif
4787 
4788  if (vmask(i-2+iphi,j-2+jphi) .eq. 1) then
4789 
4790  vx = phi(2*(2*(jphi-1)+iphi)-1, 2*(jq-1)+iq)
4791  vy = phi(2*(2*(jphi-1)+iphi), 2*(jq-1)+iq)
4792  ux = 0.
4793  uy = 0.
4794 
4795  v_diagonal(i-2+iphi,j-2+jphi) = v_diagonal(i-2+iphi,j-2+jphi) + &
4796  .25 * dxdyh * nu(i,j) * ((uy+vx) * phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + &
4797  (4*vy+2*ux) * phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq))
4798 
4799  vq = xquad(ilq) * xquad(jlq)
4800 
4801  if (float_cond(i,j) .eq. 0) then
4802  v_diagonal(i-2+iphi,j-2+jphi) = v_diagonal(i-2+iphi,j-2+jphi) + &
4803  .25 * beta(i,j) * dxdyh * vq * xquad(ilq) * xquad(jlq)
4804  endif
4805 
4806  endif
4807  enddo ; enddo
4808  enddo ; enddo
4809  if (float_cond(i,j) .eq. 1) then
4810  usubcontr = 0.0 ; vsubcontr = 0.0 ; basel = g%bathyT(i,j)
4811  hcell(:,:) = h_node(i-1:i,j-1:j)
4812  call cg_diagonal_subgrid_basal_bilinear &
4813  (phisub, hcell, dxdyh, basel, dens_ratio, usubcontr, vsubcontr)
4814  do iphi=1,2 ; do jphi=1,2
4815  if (umask(i-2+iphi,j-2+jphi) .eq. 1) then
4816  u_diagonal(i-2+iphi,j-2+jphi) = u_diagonal(i-2+iphi,j-2+jphi) + usubcontr(iphi,jphi) * beta(i,j)
4817  v_diagonal(i-2+iphi,j-2+jphi) = v_diagonal(i-2+iphi,j-2+jphi) + vsubcontr(iphi,jphi) * beta(i,j)
4818  endif
4819  enddo ; enddo
4820  endif
4821  endif ; enddo ; enddo
4822 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the call graph for this function:
Here is the caller graph for this function:

◆ matrix_diagonal_triangle()

subroutine mom_ice_shelf::matrix_diagonal_triangle ( type(ice_shelf_cs), pointer  CS,
real, dimension (:,:), intent(inout)  u_diagonal,
real, dimension (:,:), intent(inout)  v_diagonal 
)
private

Definition at line 4526 of file MOM_ice_shelf.F90.

Referenced by ice_shelf_solve_inner().

4526 
4527  type(ice_shelf_cs), pointer :: cs
4528  real, dimension (:,:), intent(inout) :: u_diagonal, v_diagonal
4529 
4530 ! returns the diagonal entries of the matrix for a Jacobi preconditioning
4531 
4532  real, pointer, dimension (:,:) :: umask, vmask, &
4533  nu_lower, nu_upper, beta_lower, beta_upper, hmask
4534  type(ocean_grid_type), pointer :: g
4535  integer :: isym, i, j, is, js, cnt, isc, jsc, iec, jec
4536  real :: a, n, ux, uy, vx, vy, eps_min, domain_width, dxh, dyh, dxdyh
4537 
4538  g => cs%grid
4539 
4540 ! if (G%symmetric) then
4541 ! isym=1
4542 ! else
4543 ! isym=0
4544 ! endif
4545 
4546  isym = 0
4547 
4548  isc = g%isc ; jsc = g%jsc ; iec = g%iec ; jec = g%jec
4549 
4550  umask => cs%umask ; vmask => cs%vmask ; hmask => cs%hmask
4551  nu_lower => cs%ice_visc_lower_tri ; nu_upper => cs%ice_visc_upper_tri
4552  beta_lower => cs%taub_beta_eff_lower_tri ; beta_upper => cs%taub_beta_eff_upper_tri
4553 
4554  do i=isc-1,iec+1 ; do j=jsc-1,jec+1 ; if (hmask(i,j) .eq. 1) then
4555  dxh = g%dxT(i,j)
4556  dyh = g%dyT(i,j)
4557  dxdyh = g%areaT(i,j)
4558 
4559  if (umask(i,j-1) .eq. 1) then ! this (bot right) is a degree of freedom node
4560 
4561  ux = 1./dxh ; uy = 0./dyh
4562  vx = 0. ; vy = 0.
4563 
4564  u_diagonal(i,j-1) = u_diagonal(i,j-1) + &
4565  .5 * dxdyh * nu_lower(i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (0./dyh))
4566 
4567  u_diagonal(i,j-1) = u_diagonal(i,j-1) + &
4568  beta_lower(i,j) * dxdyh * 1./24
4569 
4570  ux = 0. ; uy = 0.
4571  vx = 1./dxh ; vy = 0./dyh
4572 
4573  v_diagonal(i,j-1) = v_diagonal(i,j-1) + &
4574  .5 * dxdyh * nu_lower(i,j) * ((uy+vx) * (1./dxh) + (4*vy+2*ux) * (0./dyh))
4575 
4576  v_diagonal(i,j-1) = v_diagonal(i,j-1) + &
4577  beta_lower(i,j) * dxdyh * 1./24
4578 
4579  ux = 0./dxh ; uy = -1./dyh
4580  vx = 0. ; vy = 0.
4581 
4582  u_diagonal(i,j-1) = u_diagonal(i,j-1) + &
4583  .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (-1./dyh))
4584 
4585  u_diagonal(i,j-1) = u_diagonal(i,j-1) + &
4586  beta_upper(i,j) * dxdyh * 1./24
4587 
4588  vx = 0./dxh ; vy = -1./dyh
4589  ux = 0. ; uy = 0.
4590 
4591  v_diagonal(i,j-1) = v_diagonal(i,j-1) + &
4592  .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (0./dxh) + (4*vy+2*ux) * (-1./dyh))
4593 
4594  v_diagonal(i,j-1) = v_diagonal(i,j-1) + &
4595  beta_upper(i,j) * dxdyh * 1./24
4596 
4597  endif
4598 
4599  if (umask(i-1,j) .eq. 1) then ! this (top left) is a degree of freedom node
4600 
4601  ux = 0./dxh ; uy = 1./dyh
4602  vx = 0. ; vy = 0.
4603 
4604  u_diagonal(i-1,j) = u_diagonal(i-1,j) + &
4605  .5 * dxdyh * nu_lower(i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (1./dyh))
4606 
4607  u_diagonal(i,j-1) = u_diagonal(i,j-1) + &
4608  beta_lower(i,j) * dxdyh * 1./24
4609 
4610  ux = 0. ; uy = 0.
4611  vx = 0./dxh ; vy = 1./dyh
4612 
4613  v_diagonal(i-1,j) = v_diagonal(i-1,j) + &
4614  .5 * dxdyh * nu_lower(i,j) * ((uy+vx) * (0./dxh) + (4*vy+2*ux) * (1./dyh))
4615 
4616  v_diagonal(i,j-1) = v_diagonal(i,j-1) + &
4617  beta_lower(i,j) * dxdyh * 1./24
4618 
4619  ux = -1./dxh ; uy = 0./dyh
4620  vx = 0. ; vy = 0.
4621 
4622  u_diagonal(i-1,j) = u_diagonal(i-1,j) + &
4623  .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (0./dyh))
4624 
4625  u_diagonal(i,j-1) = u_diagonal(i,j-1) + &
4626  beta_upper(i,j) * dxdyh * 1./24
4627 
4628  vx = -1./dxh ; vy = 0./dyh
4629  ux = 0. ; uy = 0.
4630 
4631  v_diagonal(i-1,j) = v_diagonal(i-1,j) + &
4632  .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (-1./dxh) + (4*vy+2*ux) * (0./dyh))
4633 
4634  v_diagonal(i,j-1) = v_diagonal(i,j-1) + &
4635  beta_upper(i,j) * dxdyh * 1./24
4636 
4637  endif
4638 
4639  if (umask(i-1,j-1) .eq. 1) then ! this (bot left) is a degree of freedom node
4640 
4641  ux = -1./dxh ; uy = -1./dyh
4642  vx = 0. ; vy = 0.
4643 
4644  u_diagonal(i-1,j-1) = u_diagonal(i-1,j-1) + &
4645  .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (-1./dyh))
4646 
4647  u_diagonal(i-1,j-1) = u_diagonal(i-1,j-1) + &
4648  beta_lower(i,j) * dxdyh * 1./24
4649 
4650  vx = -1./dxh ; vy = -1./dyh
4651  ux = 0. ; uy = 0.
4652 
4653  v_diagonal(i-1,j-1) = v_diagonal(i-1,j-1) + &
4654  .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (-1./dxh) + (4*vy+2*ux) * (-1./dyh))
4655 
4656  v_diagonal(i-1,j-1) = v_diagonal(i-1,j-1) + &
4657  beta_lower(i,j) * dxdyh * 1./24
4658  endif
4659 
4660  if (umask(i,j) .eq. 1) then ! this (top right) is a degree of freedom node
4661 
4662  ux = 1./ dxh ; uy = 1./dyh
4663  vx = 0. ; vy = 0.
4664 
4665  u_diagonal(i,j) = u_diagonal(i,j) + &
4666  .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (1./dyh))
4667 
4668  u_diagonal(i,j) = u_diagonal(i,j) + &
4669  beta_upper(i,j) * dxdyh * 1./24
4670 
4671  vx = 1./ dxh ; vy = 1./dyh
4672  ux = 0. ; uy = 0.
4673 
4674  v_diagonal(i,j) = v_diagonal(i,j) + &
4675  .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (1./dxh) + (4*vy+2*ux) * (1./dyh))
4676 
4677  v_diagonal(i,j) = v_diagonal(i,j) + &
4678  beta_upper(i,j) * dxdyh * 1./24
4679 
4680  endif
4681  endif ; enddo ; enddo
4682 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the caller graph for this function:

◆ quad_area()

real function mom_ice_shelf::quad_area ( real, dimension(4), intent(in)  X,
real, dimension(4), intent(in)  Y 
)
private

Calculate area of quadrilateral.

Definition at line 326 of file MOM_ice_shelf.F90.

Referenced by bilinear_shape_functions().

326  real, dimension(4), intent(in) :: x
327  real, dimension(4), intent(in) :: y
328  real :: quad_area, p2, q2, a2, c2, b2, d2
329 
330 ! X and Y must be passed in the form
331  ! 3 - 4
332  ! | |
333  ! 1 - 2
334 
335  p2 = (x(4)-x(1))**2 + (y(4)-y(1))**2 ; q2 = (x(3)-x(2))**2 + (y(3)-y(2))**2
336  a2 = (x(3)-x(4))**2 + (y(3)-y(4))**2 ; c2 = (x(1)-x(2))**2 + (y(1)-y(2))**2
337  b2 = (x(2)-x(4))**2 + (y(2)-y(4))**2 ; d2 = (x(3)-x(1))**2 + (y(3)-y(1))**2
338  quad_area = .25 * sqrt(4*p2*q2-(b2+d2-a2-c2)**2)
339 
Here is the caller graph for this function:

◆ savearray2()

subroutine mom_ice_shelf::savearray2 ( character(*), intent(in)  fname,
real, dimension(:,:), intent(in)  A,
logical  flag 
)
private

Definition at line 5828 of file MOM_ice_shelf.F90.

Referenced by calc_shelf_driving_stress(), ice_shelf_solve_outer(), and solo_time_step().

5828 
5829 ! print 2-D array to file
5830 
5831 ! this is here strictly for debug purposes
5832 
5833 CHARACTER(*),intent(in) :: fname
5834 ! This change is to allow the code to compile with the GNU compiler.
5835 ! DOUBLE PRECISION,DIMENSION(:,:),intent(in) :: A
5836 REAL, DIMENSION(:,:), intent(in) :: a
5837 LOGICAL :: flag
5838 
5839 INTEGER :: m,n,i,j,iock,lh,fin
5840 CHARACTER(23000) :: ln
5841 CHARACTER(17) :: sing
5842 CHARACTER(9) :: STR
5843 CHARACTER(7) :: FMT1
5844 
5845 if (.NOT. flag) then
5846  return
5847 endif
5848 
5849 print *,"WRITING ARRAY " // fname
5850 
5851 fin=7
5852 m = size(a,1)
5853 n = size(a,2)
5854 
5855 OPEN(unit=fin,file=fname,status='REPLACE',access='SEQUENTIAL',&
5856  action='WRITE',iostat=iock)
5857 
5858 IF(m .gt. 1300) THEN
5859  WRITE(fin) 'SECOND DIMENSION TOO LARGE'
5860  CLOSE(fin)
5861  RETURN
5862 END IF
5863 
5864 DO i=1,m
5865  WRITE(ln,'(E17.9)') a(i,1)
5866  DO j=2,n
5867  WRITE(sing,'(E17.9)') a(i,j)
5868  ln = trim(ln) // ' ' // trim(sing)
5869  END DO
5870 
5871 
5872  IF(i.eq.1) THEN
5873 
5874  lh = len(trim(ln))
5875 
5876  fmt1 = '(A'
5877 
5878  SELECT CASE (lh)
5879  CASE(1:9)
5880  WRITE(fmt1(3:3),'(I1)') lh
5881 
5882  CASE(10:99)
5883  WRITE(fmt1(3:4),'(I2)') lh
5884 
5885  CASE(100:999)
5886  WRITE(fmt1(3:5),'(I3)') lh
5887 
5888  CASE(1000:9999)
5889  WRITE(fmt1(3:6),'(I4)') lh
5890 
5891  END SELECT
5892 
5893  fmt1 = trim(fmt1) // ')'
5894 
5895  END IF
5896 
5897  WRITE(unit=fin,iostat=iock,fmt=trim(fmt1)) trim(ln)
5898 
5899  IF(iock .ne. 0) THEN
5900  print*,iock
5901  END IF
5902 END DO
5903 
5904 CLOSE(FIN)
5905 
Here is the caller graph for this function:

◆ shelf_advance_front()

subroutine mom_ice_shelf::shelf_advance_front ( type(ice_shelf_cs), pointer  CS,
real, dimension(:,:,:), intent(inout)  flux_enter 
)
private

Definition at line 3575 of file MOM_ice_shelf.F90.

Referenced by ice_shelf_advect().

3575  type(ice_shelf_cs), pointer :: cs
3576  real, dimension(:,:,:), intent(inout) :: flux_enter
3577 
3578  ! in this subroutine we go through the computational cells only and, if they are empty or partial cells,
3579  ! we find the reference thickness and update the shelf mass and partial area fraction and the hmask if necessary
3580 
3581  ! if any cells go from partial to complete, we then must set the thickness, update hmask accordingly,
3582  ! and divide the overflow across the adjacent EMPTY (not partly-covered) cells.
3583  ! (it is highly unlikely there will not be any; in which case this will need to be rethought.)
3584 
3585  ! most likely there will only be one "overflow". if not, though, a pass_var of all relevant variables
3586  ! is done; there will therefore be a loop which, in practice, will hopefully not have to go through
3587  ! many iterations
3588 
3589  ! when 3d advected scalars are introduced, they will be impacted by what is done here
3590 
3591  ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary
3592  !
3593  ! from left neighbor: flux_enter (:,:,1)
3594  ! from right neighbor: flux_enter (:,:,2)
3595  ! from bottom neighbor: flux_enter (:,:,3)
3596  ! from top neighbor: flux_enter (:,:,4)
3597  !
3598  ! o--- (4) ---o
3599  ! | |
3600  ! (1) (2)
3601  ! | |
3602  ! o--- (3) ---o
3603  !
3604 
3605  integer :: i, j, isc, iec, jsc, jec, n_flux, k, l, iter_count, isym
3606  integer :: i_off, j_off
3607  integer :: iter_flag
3608  type(ocean_grid_type), pointer :: g
3609  real, dimension(:,:), pointer :: hmask, mass_shelf, area_shelf_h, u_face_mask, v_face_mask, h_shelf
3610  real :: h_reference, dxh, dyh, dxdyh, rho, partial_vol, tot_flux
3611  integer, dimension(4) :: mapi, mapj, new_partial
3612 ! real, dimension(size(flux_enter,1),size(flux_enter,2),size(flux_enter,2)) :: flux_enter_replace
3613  real, dimension (:,:,:), pointer :: flux_enter_replace => null()
3614 
3615  g => cs%grid
3616  h_shelf => cs%h_shelf
3617  hmask => cs%hmask
3618  mass_shelf => cs%mass_shelf
3619  area_shelf_h => cs%area_shelf_h
3620  u_face_mask => cs%u_face_mask
3621  v_face_mask => cs%v_face_mask
3622  isc = g%isc ; iec = g%iec ; jsc = g%jsc ; jec = g%jec
3623  i_off = g%idg_offset ; j_off = g%jdg_offset
3624  rho = cs%density_ice
3625  iter_count = 0 ; iter_flag = 1
3626 
3627 ! if (G%symmetric) then
3628 ! isym = 1
3629 ! else
3630 ! isym = 0
3631 ! endif
3632 
3633  isym = 0
3634 
3635  mapi(1) = -1 ; mapi(2) = 1 ; mapi(3:4) = 0
3636  mapj(3) = -1 ; mapj(4) = 1 ; mapj(1:2) = 0
3637 
3638  do while (iter_flag .eq. 1)
3639 
3640  iter_flag = 0
3641 
3642  if (iter_count .gt. 0) then
3643  flux_enter(:,:,:) = flux_enter_replace(:,:,:)
3644  flux_enter_replace(:,:,:) = 0.0
3645  endif
3646 
3647  iter_count = iter_count + 1
3648 
3649  ! if iter_count .ge. 3 then some halo updates need to be done...
3650 
3651 
3652 
3653  do j=jsc-1,jec+1
3654 
3655  if (((j+j_off) .le. g%domain%njglobal+g%domain%njhalo) .AND. &
3656  ((j+j_off) .ge. g%domain%njhalo+1)) then
3657 
3658  do i=isc-1,iec+1
3659 
3660  if (((i+i_off) .le. g%domain%niglobal+g%domain%nihalo) .AND. &
3661  ((i+i_off) .ge. g%domain%nihalo+1)) then
3662  ! first get reference thickness by averaging over cells that are fluxing into this cell
3663  n_flux = 0
3664  h_reference = 0.0
3665  tot_flux = 0.0
3666 
3667  do k=1,2
3668  if (flux_enter(i,j,k) .gt. 0) then
3669  n_flux = n_flux + 1
3670  h_reference = h_reference + h_shelf(i+2*k-3,j)
3671  tot_flux = tot_flux + flux_enter(i,j,k)
3672  flux_enter(i,j,k) = 0.0
3673  endif
3674  enddo
3675 
3676  do k=1,2
3677  if (flux_enter(i,j,k+2) .gt. 0) then
3678  n_flux = n_flux + 1
3679  h_reference = h_reference + h_shelf(i,j+2*k-3)
3680  tot_flux = tot_flux + flux_enter(i,j,k+2)
3681  flux_enter(i,j,k+2) = 0.0
3682  endif
3683  enddo
3684 
3685  if (n_flux .gt. 0) then
3686  dxdyh = g%areaT(i,j)
3687  h_reference = h_reference / real(n_flux)
3688  partial_vol = h_shelf(i,j) * area_shelf_h(i,j) + tot_flux
3689 
3690  if ((partial_vol / dxdyh) .eq. h_reference) then ! cell is exactly covered, no overflow
3691  hmask(i,j) = 1
3692  h_shelf(i,j) = h_reference
3693  area_shelf_h(i,j) = dxdyh
3694  elseif ((partial_vol / dxdyh) .lt. h_reference) then
3695  hmask(i,j) = 2
3696  ! mass_shelf (i,j) = partial_vol * rho
3697  area_shelf_h(i,j) = partial_vol / h_reference
3698  h_shelf(i,j) = h_reference
3699  else
3700  if (.not. associated (flux_enter_replace)) then
3701  allocate ( flux_enter_replace(g%isd:g%ied,g%jsd:g%jed,1:4) )
3702  flux_enter_replace(:,:,:) = 0.0
3703  endif
3704 
3705  hmask(i,j) = 1
3706  area_shelf_h(i,j) = dxdyh
3707  !h_temp (i,j) = h_reference
3708  partial_vol = partial_vol - h_reference * dxdyh
3709 
3710  iter_flag = 1
3711 
3712  n_flux = 0 ; new_partial(:) = 0
3713 
3714  do k=1,2
3715  if (u_face_mask(i-2+k,j) .eq. 2) then
3716  n_flux = n_flux + 1
3717  elseif (hmask(i+2*k-3,j) .eq. 0) then
3718  n_flux = n_flux + 1
3719  new_partial(k) = 1
3720  endif
3721  enddo
3722  do k=1,2
3723  if (v_face_mask(i,j-2+k) .eq. 2) then
3724  n_flux = n_flux + 1
3725  elseif (hmask(i,j+2*k-3) .eq. 0) then
3726  n_flux = n_flux + 1
3727  new_partial(k+2) = 1
3728  endif
3729  enddo
3730 
3731  if (n_flux .eq. 0) then ! there is nowhere to put the extra ice!
3732  h_shelf(i,j) = h_reference + partial_vol / dxdyh
3733  else
3734  h_shelf(i,j) = h_reference
3735 
3736  do k=1,2
3737  if (new_partial(k) .eq. 1) &
3738  flux_enter_replace(i+2*k-3,j,3-k) = partial_vol / real(n_flux)
3739  enddo
3740  do k=1,2 ! ### Combine these two loops?
3741  if (new_partial(k+2) .eq. 1) &
3742  flux_enter_replace(i,j+2*k-3,5-k) = partial_vol / real(n_flux)
3743  enddo
3744  endif
3745 
3746  endif ! Parital_vol test.
3747  endif ! n_flux gt 0 test.
3748 
3749  endif
3750  enddo ! j-loop
3751  endif
3752  enddo
3753 
3754  ! call mpp_max(iter_flag)
3755 
3756  enddo ! End of do while(iter_flag) loop
3757 
3758  call mpp_max(iter_count)
3759 
3760  if(is_root_pe() .and. (iter_count.gt.1)) print *, iter_count, "MAX ITERATIONS,ADVANCE FRONT"
3761 
3762  if (associated(flux_enter_replace)) DEALLOCATE(flux_enter_replace)
3763 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the caller graph for this function:

◆ shelf_calc_flux()

subroutine, public mom_ice_shelf::shelf_calc_flux ( type(surface), intent(inout)  state,
type(forcing), intent(inout)  fluxes,
type(time_type), intent(in)  Time,
real, intent(in)  time_step,
type(ice_shelf_cs), pointer  CS 
)

Calculates fluxes between the ocean and ice-shelf using the three-equations formulation (optional to use just two equations). See ICE_SHELF equations.

Parameters
[in,out]statestructure containing fields that describe the surface state of the ocean
[in,out]fluxesstructure containing pointers to any possible forcing fields. Unused fields have NULL ptrs.
[in]timeStart time of the fluxes.
[in]time_stepLength of time over which these fluxes will be applied, in s.
csA pointer to the control structure returned by a previous call to initialize_ice_shelf.

Definition at line 346 of file MOM_ice_shelf.F90.

References add_shelf_flux(), change_thickness_using_melt(), mom_diag_mediator::disable_averaging(), mom_diag_mediator::enable_averaging(), ice_shelf_advect(), ice_shelf_solve_outer(), id_clock_pass, id_clock_shelf, mom_error_handler::is_root_pe(), mom_error_handler::mom_error(), mom_forcing_type::mom_forcing_chksum(), update_od_ffrac(), update_od_ffrac_uncoupled(), and update_shelf_mass().

Referenced by mom_main().

346  type(surface), intent(inout) :: state !< structure containing fields that
347  !!describe the surface state of the ocean
348  type(forcing), intent(inout) :: fluxes !< structure containing pointers to
349  !!any possible forcing fields.
350  !!Unused fields have NULL ptrs.
351  type(time_type), intent(in) :: time !< Start time of the fluxes.
352  real, intent(in) :: time_step !< Length of time over which
353  !! these fluxes will be applied, in s.
354  type(ice_shelf_cs), pointer :: cs !< A pointer to the control structure
355  !! returned by a previous call to
356  !! initialize_ice_shelf.
357 
358  real, dimension(SZI_(CS%grid)) :: &
359  rhoml, & !< Ocean mixed layer density in kg m-3.
360  dr0_dt, & !< Partial derivative of the mixed layer density
361  !< with temperature, in units of kg m-3 K-1.
362  dr0_ds, & !< Partial derivative of the mixed layer density
363  !< with salinity, in units of kg m-3 psu-1.
364  p_int !< The pressure at the ice-ocean interface, in Pa.
365 
366  real, dimension(:,:), allocatable :: mass_flux !< total mass flux of freshwater across
367  real, dimension(:,:), allocatable :: haline_driving !< (SSS - S_boundary) ice-ocean
368  !! interface, positive for melting and negative for freezing.
369  !! This is computed as part of the ISOMIP diagnostics.
370  real, parameter :: vk = 0.40 !< Von Karman's constant - dimensionless
371  real :: zeta_n = 0.052 !> The fraction of the boundary layer over which the
372  !! viscosity is linearly increasing. (Was 1/8. Why?)
373  real, parameter :: rc = 0.20 ! critical flux Richardson number.
374  real :: i_zeta_n !< The inverse of ZETA_N.
375  real :: lf, i_lf !< Latent Heat of fusion (J kg-1) and its inverse.
376  real :: i_vk !< The inverse of VK.
377  real :: pr, sc !< The Prandtl number and Schmidt number, nondim.
378 
379  ! 3 equations formulation variables
380  real, dimension(:,:), allocatable :: sbdry !< Salinities in the ocean at the interface
381  !! with the ice shelf, in PSU.
382  real :: sbdry_it
383  real :: sbdry1, sbdry2, s_a, s_b, s_c ! use to find salt roots
384  real :: ds_it !< The interface salinity change during an iteration, in PSU.
385  real :: hbl_neut !< The neutral boundary layer thickness, in m.
386  real :: hbl_neut_h_molec !< The ratio of the neutral boundary layer thickness
387  !! to the molecular boundary layer thickness, ND.
388  real :: wt_flux !< The vertical fluxes of heat and buoyancy just inside the
389  real :: wb_flux !< ocean, in C m s-1 and m2 s-3, ###CURRENTLY POSITIVE UPWARD.
390  real :: db_ds !< The derivative of buoyancy with salinity, in m s-2 PSU-1.
391  real :: db_dt !< The derivative of buoyancy with temperature, in m s-2 C-1.
392  real :: i_n_star, n_star_term, absf
393  real :: dins_dwb !< The partial derivative of I_n_star with wB_flux, in ???.
394  real :: dt_ustar, ds_ustar
395  real :: ustar_h
396  real :: gam_turb
397  real :: gam_mol_t, gam_mol_s
398  real :: rhocp
399  real :: i_rholf
400  real :: ln_neut
401  real :: mass_exch
402  real :: sb_min, sb_max
403  real :: ds_min, ds_max
404  ! Variables used in iterating for wB_flux.
405  real :: wb_flux_new, dwb, ddwb_dwb_in
406  real :: i_gam_t, i_gam_s, dg_dwb, idens
407  real :: u_at_h, v_at_h, isqrt2
408  logical :: sb_min_set, sb_max_set
409  character(4) :: stepnum
410  character(2) :: procnum
411 
412  type(ocean_grid_type), pointer :: g
413  real, parameter :: c2_3 = 2.0/3.0
414  integer :: i, j, is, ie, js, je, ied, jed, it1, it3, iters_vel_solve
415  real, parameter :: rho_fw = 1000.0 ! fresh water density
416  if (.not. associated(cs)) call mom_error(fatal, "shelf_calc_flux: "// &
417  "initialize_ice_shelf must be called before shelf_calc_flux.")
418  call cpu_clock_begin(id_clock_shelf)
419 
420  ! useful parameters
421  g => cs%grid
422  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; ied = g%ied ; jed = g%jed
423  i_zeta_n = 1.0 / zeta_n
424  lf = cs%Lat_fusion
425  i_rholf = 1.0/(cs%Rho0*lf)
426  i_lf = 1.0 / lf
427  sc = cs%kv_molec/cs%kd_molec_salt
428  pr = cs%kv_molec/cs%kd_molec_temp
429  i_vk = 1.0/vk
430  rhocp = cs%Rho0 * cs%Cp
431  isqrt2 = 1.0/sqrt(2.0)
432 
433  !first calculate molecular component
434  gam_mol_t = 12.5 * (pr**c2_3) - 6
435  gam_mol_s = 12.5 * (sc**c2_3) - 6
436 
437  idens = 1.0/cs%density_ocean_avg
438 
439  ! GMM, zero some fields of the ice shelf structure (ice_shelf_CS)
440  ! these fields are already set to zero during initialization
441  ! However, they seem to be changed somewhere and, for diagnostic
442  ! reasons, it is better to set them to zero again.
443  cs%tflux_shelf(:,:) = 0.0; cs%exch_vel_t(:,:) = 0.0
444  cs%lprec(:,:) = 0.0; cs%exch_vel_s(:,:) = 0.0
445  cs%salt_flux(:,:) = 0.0; cs%t_flux(:,:) = 0.0
446  cs%tfreeze(:,:) = 0.0
447  ! define Sbdry to avoid Run-Time Check Failure, when melt is not computed.
448  ALLOCATE ( haline_driving(g%ied,g%jed) ); haline_driving(:,:) = 0.0
449  ALLOCATE ( sbdry(g%ied,g%jed) ); sbdry(:,:) = state%sss(:,:)
450 
451  !update time
452  cs%Time = time
453 
454  if (cs%shelf_mass_is_dynamic .and. cs%override_shelf_movement) then
455  cs%time_step = time_step
456  ! update shelf mass
457  if (cs%mass_from_file) call update_shelf_mass(g, cs, time, fluxes)
458  endif
459 
460  if (cs%DEBUG) then
461  call hchksum (fluxes%frac_shelf_h, "frac_shelf_h before apply melting", g%HI, haloshift=0)
462  call hchksum (state%sst, "sst before apply melting", g%HI, haloshift=0)
463  call hchksum (state%sss, "sss before apply melting", g%HI, haloshift=0)
464  call hchksum (state%u, "u_ml before apply melting", g%HI, haloshift=0)
465  call hchksum (state%v, "v_ml before apply melting", g%HI, haloshift=0)
466  call hchksum (state%ocean_mass, "ocean_mass before apply melting", g%HI, haloshift=0)
467  endif
468 
469  do j=js,je
470  ! Find the pressure at the ice-ocean interface, averaged only over the
471  ! part of the cell covered by ice shelf.
472  do i=is,ie ; p_int(i) = cs%g_Earth * cs%mass_shelf(i,j) ; enddo
473 
474  ! Calculate insitu densities and expansion coefficients
475  call calculate_density(state%sst(:,j),state%sss(:,j), p_int, &
476  rhoml(:), is, ie-is+1, cs%eqn_of_state)
477  call calculate_density_derivs(state%sst(:,j), state%sss(:,j), p_int, &
478  dr0_dt, dr0_ds, is, ie-is+1, cs%eqn_of_state)
479 
480  do i=is,ie
481  ! set ustar_shelf to zero. This is necessary if shelf_mass_is_dynamic
482  ! but it won't make a difference otherwise.
483  fluxes%ustar_shelf(i,j)= 0.0
484 
485  ! DNG - to allow this everywhere Hml>0.0 allows for melting under grounded cells
486  ! propose instead to allow where Hml > [some threshold]
487 
488  if ((idens*state%ocean_mass(i,j) > cs%col_thick_melt_threshold) .and. &
489  (cs%area_shelf_h(i,j) > 0.0) .and. &
490  (cs%isthermo) .and. (state%Hml(i,j) > 0.0) ) then
491 
492  if (cs%threeeq) then
493  ! Iteratively determine a self-consistent set of fluxes, with the ocean
494  ! salinity just below the ice-shelf as the variable that is being
495  ! iterated for.
496  ! ### SHOULD I SET USTAR_SHELF YET?
497 
498  u_at_h = state%u(i,j)
499  v_at_h = state%v(i,j)
500 
501  fluxes%ustar_shelf(i,j)= sqrt(cs%cdrag*((u_at_h**2.0 + v_at_h**2.0) +&
502  cs%utide(i,j)**1))
503 
504  ustar_h = max(cs%ustar_bg, fluxes%ustar_shelf(i,j))
505 
506  fluxes%ustar_shelf(i,j) = ustar_h
507 
508  if (associated(state%taux_shelf) .and. associated(state%tauy_shelf)) then
509  state%taux_shelf(i,j) = ustar_h*ustar_h*cs%Rho0*isqrt2
510  state%tauy_shelf(i,j) = state%taux_shelf(i,j)
511  endif
512 
513  ! Estimate the neutral ocean boundary layer thickness as the minimum of the
514  ! reported ocean mixed layer thickness and the neutral Ekman depth.
515  absf = 0.25*((abs(g%CoriolisBu(i,j)) + abs(g%CoriolisBu(i-1,j-1))) + &
516  (abs(g%CoriolisBu(i,j-1)) + abs(g%CoriolisBu(i-1,j))))
517  if (absf*state%Hml(i,j) <= vk*ustar_h) then ; hbl_neut = state%Hml(i,j)
518  else ; hbl_neut = (vk*ustar_h) / absf ; endif
519  hbl_neut_h_molec = zeta_n * ((hbl_neut * ustar_h) / (5.0 * cs%Kv_molec))
520 
521  ! Determine the mixed layer buoyancy flux, wB_flux.
522  db_ds = (cs%g_Earth / rhoml(i)) * dr0_ds(i)
523  db_dt = (cs%g_Earth / rhoml(i)) * dr0_dt(i)
524  ln_neut = 0.0 ; if (hbl_neut_h_molec > 1.0) ln_neut = log(hbl_neut_h_molec)
525 
526  if (cs%find_salt_root) then
527  ! read liquidus parameters
528 
529  s_a = cs%lambda1 * cs%Gamma_T_3EQ * cs%Cp
530 ! S_b = -CS%Gamma_T_3EQ*(CS%lambda2-CS%lambda3*p_int(i)-state%sst(i,j)) &
531 ! -LF*CS%Gamma_T_3EQ/35.0
532 
533  s_b = cs%Gamma_T_3EQ*cs%Cp*(cs%lambda2+cs%lambda3*p_int(i)- &
534  state%sst(i,j))-lf*cs%Gamma_T_3EQ/35.0
535  s_c = lf*(cs%Gamma_T_3EQ/35.0)*state%sss(i,j)
536 
537  sbdry1 = (-s_b + sqrt(s_b*s_b-4*s_a*s_c))/(2*s_a)
538  sbdry2 = (-s_b - sqrt(s_b*s_b-4*s_a*s_c))/(2*s_a)
539  sbdry(i,j) = max(sbdry1, sbdry2)
540  ! Safety check
541  if (sbdry(i,j) < 0.) then
542  write(*,*)'state%sss(i,j)',state%sss(i,j)
543  write(*,*)'S_a, S_b, S_c',s_a, s_b, s_c
544  write(*,*)'I,J,Sbdry1,Sbdry2',i,j,sbdry1,sbdry2
545  call mom_error(fatal, &
546  "shelf_calc_flux: Negative salinity (Sbdry).")
547  endif
548  else
549  ! Guess sss as the iteration starting point for the boundary salinity.
550  sbdry(i,j) = state%sss(i,j) ; sb_max_set = .false.
551  sb_min_set = .false.
552  endif !find_salt_root
553 
554  do it1 = 1,20
555  ! Determine the potential temperature at the ice-ocean interface.
556  call calculate_tfreeze(sbdry(i,j), p_int(i), cs%tfreeze(i,j), cs%eqn_of_state)
557 
558  dt_ustar = (state%sst(i,j) - cs%tfreeze(i,j)) * ustar_h
559  ds_ustar = (state%sss(i,j) - sbdry(i,j)) * ustar_h
560 
561  ! First, determine the buoyancy flux assuming no effects of stability
562  ! on the turbulence. Following H & J '99, this limit also applies
563  ! when the buoyancy flux is destabilizing.
564 
565  if (cs%const_gamma) then ! if using a constant gamma_T
566  ! note the different form, here I_Gam_T is NOT 1/Gam_T!
567  i_gam_t = cs%Gamma_T_3EQ
568  i_gam_s = cs%Gamma_T_3EQ/35.
569  else
570  gam_turb = i_vk * (ln_neut + (0.5 * i_zeta_n - 1.0))
571  i_gam_t = 1.0 / (gam_mol_t + gam_turb)
572  i_gam_s = 1.0 / (gam_mol_s + gam_turb)
573  endif
574 
575  wt_flux = dt_ustar * i_gam_t
576  wb_flux = db_ds * (ds_ustar * i_gam_s) + db_dt * wt_flux
577 
578  if (wb_flux > 0.0) then
579  ! The buoyancy flux is stabilizing and will reduce the tubulent
580  ! fluxes, and iteration is required.
581  n_star_term = (zeta_n/rc) * (hbl_neut * vk) / ustar_h**3
582  do it3 = 1,30
583  ! n_star <= 1.0 is the ratio of working boundary layer thickness
584  ! to the neutral thickness.
585  ! hBL = n_star*hBL_neut ; hSub = 1/8*n_star*hBL
586 
587  i_n_star = sqrt(1.0 + n_star_term * wb_flux)
588  dins_dwb = 0.5 * n_star_term / i_n_star
589  if (hbl_neut_h_molec > i_n_star**2) then
590  gam_turb = i_vk * ((ln_neut - 2.0*log(i_n_star)) + &
591  (0.5*i_zeta_n*i_n_star - 1.0))
592  dg_dwb = i_vk * ( -2.0 / i_n_star + (0.5 * i_zeta_n)) * dins_dwb
593  else
594  ! The layer dominated by molecular viscosity is smaller than
595  ! the assumed boundary layer. This should be rare!
596  gam_turb = i_vk * (0.5 * i_zeta_n*i_n_star - 1.0)
597  dg_dwb = i_vk * (0.5 * i_zeta_n) * dins_dwb
598  endif
599 
600  if (cs%const_gamma) then ! if using a constant gamma_T
601  ! note the different form, here I_Gam_T is NOT 1/Gam_T!
602  i_gam_t = cs%Gamma_T_3EQ
603  i_gam_s = cs%Gamma_T_3EQ/35.
604  else
605  i_gam_t = 1.0 / (gam_mol_t + gam_turb)
606  i_gam_s = 1.0 / (gam_mol_s + gam_turb)
607  endif
608 
609  wt_flux = dt_ustar * i_gam_t
610  wb_flux_new = db_ds * (ds_ustar * i_gam_s) + db_dt * wt_flux
611 
612  ! Find the root where dwB = 0.0
613  dwb = wb_flux_new - wb_flux
614  if (abs(wb_flux_new - wb_flux) < &
615  1e-4*(abs(wb_flux_new) + abs(wb_flux))) exit
616 
617  ddwb_dwb_in = -dg_dwb * (db_ds * (ds_ustar * i_gam_s**2) + &
618  db_dt * (dt_ustar * i_gam_t**2)) - 1.0
619  ! This is Newton's method without any bounds.
620  ! ### SHOULD BOUNDS BE NEEDED?
621  wb_flux_new = wb_flux - dwb / ddwb_dwb_in
622  enddo !it3
623  endif
624 
625  cs%t_flux(i,j) = rhocp * wt_flux
626  cs%exch_vel_t(i,j) = ustar_h * i_gam_t
627  cs%exch_vel_s(i,j) = ustar_h * i_gam_s
628 
629  !Calculate the heat flux inside the ice shelf.
630 
631  !vertical adv/diff as in H+J 1999, eqns (26) & approx from (31).
632  ! Q_ice = rho_ice * CS%CP_Ice * K_ice * dT/dz (at interface)
633  !vertical adv/diff as in H+J 199, eqs (31) & (26)...
634  ! dT/dz ~= min( (lprec/(rho_ice*K_ice))*(CS%Temp_Ice-T_freeze) , 0.0 )
635  !If this approximation is not made, iterations are required... See H+J Fig 3.
636 
637  if (cs%t_flux(i,j) <= 0.0) then ! Freezing occurs, so zero ice heat flux.
638  cs%lprec(i,j) = i_lf * cs%t_flux(i,j)
639  cs%tflux_shelf(i,j) = 0.0
640  else
641  if (cs%insulator) then
642  !no conduction/perfect insulator
643  cs%tflux_shelf(i,j) = 0.0
644  cs%lprec(i,j) = i_lf * (- cs%tflux_shelf(i,j) + cs%t_flux(i,j))
645 
646  else
647  ! With melting, from H&J 1999, eqs (31) & (26)...
648  ! Q_ice ~= cp_ice * (CS%Temp_Ice-T_freeze) * lprec
649  ! RhoLF*lprec = Q_ice + CS%t_flux(i,j)
650  ! lprec = (CS%t_flux(i,j)) / (LF + cp_ice * (T_freeze-CS%Temp_Ice))
651  cs%lprec(i,j) = cs%t_flux(i,j) / &
652  (lf + cs%CP_Ice * (cs%Tfreeze(i,j) - cs%Temp_Ice))
653 
654  cs%tflux_shelf(i,j) = cs%t_flux(i,j) - lf*cs%lprec(i,j)
655  endif
656 
657  endif
658  !other options: dTi/dz linear through shelf
659  ! dTi_dz = (CS%Temp_Ice - CS%tfreeze(i,j))/G%draft(i,j)
660  ! CS%tflux_shelf(i,j) = - Rho_Ice * CS%CP_Ice * KTI * dTi_dz
661 
662 
663  if (cs%find_salt_root) then
664  exit ! no need to do interaction, so exit loop
665  else
666 
667  mass_exch = cs%exch_vel_s(i,j) * cs%Rho0
668  sbdry_it = (state%sss(i,j) * mass_exch + cs%Salin_ice * &
669  cs%lprec(i,j)) / (mass_exch + cs%lprec(i,j))
670  ds_it = sbdry_it - sbdry(i,j)
671  if (abs(ds_it) < 1e-4*(0.5*(state%sss(i,j) + sbdry(i,j) + 1.e-10))) exit
672 
673 
674  if (ds_it < 0.0) then ! Sbdry is now the upper bound.
675  if (sb_max_set .and. (sbdry(i,j) > sb_max)) &
676  call mom_error(fatal,"shelf_calc_flux: Irregular iteration for Sbdry (max).")
677  sb_max = sbdry(i,j) ; ds_max = ds_it ; sb_max_set = .true.
678  else ! Sbdry is now the lower bound.
679  if (sb_min_set .and. (sbdry(i,j) < sb_min)) &
680  call mom_error(fatal, &
681  "shelf_calc_flux: Irregular iteration for Sbdry (min).")
682  sb_min = sbdry(i,j) ; ds_min = ds_it ; sb_min_set = .true.
683  endif ! dS_it < 0.0
684 
685  if (sb_min_set .and. sb_max_set) then
686  ! Use the false position method for the next iteration.
687  sbdry(i,j) = sb_min + (sb_max-sb_min) * &
688  (ds_min / (ds_min - ds_max))
689  else
690  sbdry(i,j) = sbdry_it
691  endif ! Sb_min_set
692 
693  sbdry(i,j) = sbdry_it
694  endif ! CS%find_salt_root
695 
696  enddo !it1
697  ! Check for non-convergence and/or non-boundedness?
698 
699  else
700  ! In the 2-equation form, the mixed layer turbulent exchange velocity
701  ! is specified and large enough that the ocean salinity at the interface
702  ! is about the same as the boundary layer salinity.
703 
704  call calculate_tfreeze(state%sss(i,j), p_int(i), cs%tfreeze(i,j), cs%eqn_of_state)
705 
706  cs%exch_vel_t(i,j) = cs%gamma_t
707  cs%t_flux(i,j) = rhocp * cs%exch_vel_t(i,j) * (state%sst(i,j) - cs%tfreeze(i,j))
708  cs%tflux_shelf(i,j) = 0.0
709  cs%lprec(i,j) = i_lf * cs%t_flux(i,j)
710  sbdry(i,j) = 0.0
711  endif
712  else !not shelf
713  cs%t_flux(i,j) = 0.0
714  endif
715 
716 ! haline_driving(:,:) = state%sss(i,j) - Sbdry(i,j)
717 
718  enddo ! i-loop
719  enddo ! j-loop
720 
721  ! CS%lprec = precipitating liquid water into the ocean ( kg/(m^2 s) )
722  ! We want melt in m/year
723  if (cs%const_gamma) then ! use ISOMIP+ eq. with rho_fw
724  fluxes%iceshelf_melt = cs%lprec * (86400.0*365.0/rho_fw) * cs%flux_factor
725  else ! use original eq.
726  fluxes%iceshelf_melt = cs%lprec * (86400.0*365.0/cs%density_ice) * cs%flux_factor
727  endif
728 
729  do j=js,je
730  do i=is,ie
731  if ((idens*state%ocean_mass(i,j) > cs%col_thick_melt_threshold) .and. &
732  (cs%area_shelf_h(i,j) > 0.0) .and. &
733  (cs%isthermo) .and. (state%Hml(i,j) > 0.0) ) then
734 
735  ! Set melt to zero above a cutoff pressure
736  ! (CS%Rho0*CS%cutoff_depth*CS%g_Earth) this is needed for the isomip
737  ! test case.
738  if ((cs%g_Earth * cs%mass_shelf(i,j)) < cs%Rho0*cs%cutoff_depth* &
739  cs%g_Earth) then
740  cs%lprec(i,j) = 0.0
741  fluxes%iceshelf_melt(i,j) = 0.0
742  endif
743  ! Compute haline driving, which is one of the diags. used in ISOMIP
744  haline_driving(i,j) = (cs%lprec(i,j) * sbdry(i,j)) / &
745  (cs%Rho0 * cs%exch_vel_s(i,j))
746 
747  !!!!!!!!!!!!!!!!!!!!!!!!!!!!Safety checks !!!!!!!!!!!!!!!!!!!!!!!!!
748  !1)Check if haline_driving computed above is consistent with
749  ! haline_driving = state%sss - Sbdry
750  !if (fluxes%iceshelf_melt(i,j) /= 0.0) then
751  ! if (haline_driving(i,j) /= (state%sss(i,j) - Sbdry(i,j))) then
752  ! write(*,*)'Something is wrong at i,j',i,j
753  ! write(*,*)'haline_driving, sss-Sbdry',haline_driving(i,j), &
754  ! (state%sss(i,j) - Sbdry(i,j))
755  ! call MOM_error(FATAL, &
756  ! "shelf_calc_flux: Inconsistency in melt and haline_driving")
757  ! endif
758  !endif
759 
760  ! 2) check if |melt| > 0 when star_shelf = 0.
761  ! this should never happen
762  if (abs(fluxes%iceshelf_melt(i,j))>0.0) then
763  if (fluxes%ustar_shelf(i,j) == 0.0) then
764  write(*,*)'Something is wrong at i,j',i,j
765  call mom_error(fatal, &
766  "shelf_calc_flux: |melt| > 0 and star_shelf = 0.")
767  endif
768  endif
769  endif ! area_shelf_h
770  !!!!!!!!!!!!!!!!!!!!!!!!!!!!End of safety checks !!!!!!!!!!!!!!!!!!!
771  enddo ! i-loop
772  enddo ! j-loop
773 
774  ! mass flux (kg/s), part of ISOMIP diags.
775  ALLOCATE ( mass_flux(g%ied,g%jed) ); mass_flux(:,:) = 0.0
776  mass_flux = (cs%lprec) * cs%area_shelf_h
777 
778  if (cs%shelf_mass_is_dynamic) then
779  call cpu_clock_begin(id_clock_pass)
780  call pass_var(cs%area_shelf_h, g%domain, complete=.false.)
781  call pass_var(cs%mass_shelf, g%domain)
782  call cpu_clock_end(id_clock_pass)
783  endif
784 
785  ! Melting has been computed, now is time to update thickness and mass
786  if (cs%shelf_mass_is_dynamic .and. cs%override_shelf_movement) then
787  if (.not. (cs%mass_from_file)) then
788 
789  call change_thickness_using_melt(cs,g,time_step, fluxes)
790 
791  endif
792 
793  endif
794 
795  if (cs%DEBUG) then
796  call mom_forcing_chksum("Before add shelf flux", fluxes, g, haloshift=0)
797  endif
798  call add_shelf_flux(g, cs, state, fluxes)
799 
800  ! now the thermodynamic data is passed on... time to update the ice dynamic quantities
801 
802  if (cs%shelf_mass_is_dynamic .and. .not.cs%override_shelf_movement) then
803 
804  ! advect the ice shelf, and advance the front. Calving will be in here somewhere as well..
805  ! when we decide on how to do it
806 
807  ! note time_step is [s] and lprec is [kg / m^2 / s]
808 
809  call ice_shelf_advect (cs, time_step, cs%lprec, time)
810 
811  cs%velocity_update_sub_counter = cs%velocity_update_sub_counter+1
812 
813  if (cs%GL_couple .and. .not. cs%solo_ice_sheet) then
814  call update_od_ffrac (cs, state%ocean_mass, cs%velocity_update_sub_counter, cs%nstep_velocity, cs%time_step, cs%velocity_update_time_step)
815  else
816  call update_od_ffrac_uncoupled (cs)
817  endif
818 
819  if (cs%velocity_update_sub_counter .eq. cs%nstep_velocity) then
820 
821  if (is_root_pe()) write(*,*) "ABOUT TO CALL VELOCITY SOLVER"
822 
823  call ice_shelf_solve_outer (cs, cs%u_shelf, cs%v_shelf, 1, iters_vel_solve, time)
824 
825  cs%velocity_update_sub_counter = 0
826 
827  endif
828  endif
829 
830  call enable_averaging(time_step,time,cs%diag)
831  if (cs%id_shelf_mass > 0) call post_data(cs%id_shelf_mass, cs%mass_shelf, cs%diag)
832  if (cs%id_area_shelf_h > 0) call post_data(cs%id_area_shelf_h, cs%area_shelf_h, cs%diag)
833  if (cs%id_ustar_shelf > 0) call post_data(cs%id_ustar_shelf, fluxes%ustar_shelf, cs%diag)
834  if (cs%id_melt > 0) call post_data(cs%id_melt, fluxes%iceshelf_melt, cs%diag)
835  if (cs%id_thermal_driving > 0) call post_data(cs%id_thermal_driving, (state%sst-cs%tfreeze), cs%diag)
836  if (cs%id_Sbdry > 0) call post_data(cs%id_Sbdry, sbdry, cs%diag)
837  if (cs%id_haline_driving > 0) call post_data(cs%id_haline_driving, haline_driving, cs%diag)
838  if (cs%id_mass_flux > 0) call post_data(cs%id_mass_flux, mass_flux, cs%diag)
839  if (cs%id_u_ml > 0) call post_data(cs%id_u_ml,state%u,cs%diag)
840  if (cs%id_v_ml > 0) call post_data(cs%id_v_ml,state%v,cs%diag)
841  if (cs%id_tfreeze > 0) call post_data(cs%id_tfreeze, cs%tfreeze, cs%diag)
842  if (cs%id_tfl_shelf > 0) call post_data(cs%id_tfl_shelf, cs%tflux_shelf, cs%diag)
843  if (cs%id_exch_vel_t > 0) call post_data(cs%id_exch_vel_t, cs%exch_vel_t, cs%diag)
844  if (cs%id_exch_vel_s > 0) call post_data(cs%id_exch_vel_s, cs%exch_vel_s, cs%diag)
845  if (cs%id_col_thick > 0) call post_data(cs%id_col_thick, cs%OD_av, cs%diag)
846  if (cs%id_h_shelf > 0) call post_data(cs%id_h_shelf,cs%h_shelf,cs%diag)
847  if (cs%id_h_mask > 0) call post_data(cs%id_h_mask,cs%hmask,cs%diag)
848  if (cs%id_u_shelf > 0) call post_data(cs%id_u_shelf,cs%u_shelf,cs%diag)
849  if (cs%id_v_shelf > 0) call post_data(cs%id_v_shelf,cs%v_shelf,cs%diag)
850  if (cs%id_float_frac > 0) call post_data(cs%id_float_frac,cs%float_frac,cs%diag)
851  if (cs%id_OD_av >0) call post_data(cs%id_OD_av,cs%OD_av,cs%diag)
852  if (cs%id_float_frac_rt>0) call post_data(cs%id_float_frac_rt,cs%float_frac_rt,cs%diag)
853  call disable_averaging(cs%diag)
854 
855  call cpu_clock_end(id_clock_shelf)
856 
857  if (cs%DEBUG) then
858  call mom_forcing_chksum("End of shelf calc flux", fluxes, g, haloshift=0)
859  endif
860 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the call graph for this function:
Here is the caller graph for this function:

◆ slope_limiter()

real function mom_ice_shelf::slope_limiter ( real, intent(in)  num,
real, intent(in)  denom 
)
private

used for flux limiting in advective subroutines Van Leer limiter (source: Wikipedia)

Definition at line 308 of file MOM_ice_shelf.F90.

Referenced by ice_shelf_advect_temp_x(), ice_shelf_advect_temp_y(), ice_shelf_advect_thickness_x(), and ice_shelf_advect_thickness_y().

308  real, intent(in) :: num
309  real, intent(in) :: denom
310  real :: slope_limiter
311  real :: r
312 
313  if (denom .eq. 0) then
314  slope_limiter = 0
315  elseif (num*denom .le. 0) then
316  slope_limiter = 0
317  else
318  r = num/denom
319  slope_limiter = (r+abs(r))/(1+abs(r))
320  endif
321 
Here is the caller graph for this function:

◆ solo_time_step()

subroutine, public mom_ice_shelf::solo_time_step ( type(ice_shelf_cs), pointer  CS,
real, intent(in)  time_step,
integer, intent(inout)  n,
type(time_type)  Time,
real, intent(in), optional  min_time_step_in 
)

Definition at line 5910 of file MOM_ice_shelf.F90.

References ice_shelf_advect(), ice_shelf_solve_outer(), ice_shelf_temp(), savearray2(), update_od_ffrac_uncoupled(), and update_velocity_masks().

5910  type(ice_shelf_cs), pointer :: cs
5911  real,intent(in) :: time_step
5912  integer, intent(inout) :: n
5913  type(time_type) :: time
5914  real,optional,intent(in) :: min_time_step_in
5915 
5916  type(ocean_grid_type), pointer :: g
5917  integer :: is, iec, js, jec, i, j, ki, kj, iters
5918  real :: ratio, min_ratio, time_step_remain, local_u_max, &
5919  local_v_max, time_step_int, min_time_step,spy,dumtimeprint
5920  real, dimension(:,:), pointer :: u_shelf, v_shelf, hmask, umask, vmask
5921  logical :: flag
5922  type(time_type) :: dummy
5923  character(2) :: procnum
5924  character(4) :: stepnum
5925 
5926  cs%velocity_update_sub_counter = cs%velocity_update_sub_counter + 1
5927  spy = 365 * 86400
5928  g => cs%grid
5929  u_shelf => cs%u_shelf
5930  v_shelf => cs%v_shelf
5931  hmask => cs%hmask
5932  umask => cs%umask
5933  vmask => cs%vmask
5934  time_step_remain = time_step
5935  if (.not. (present (min_time_step_in))) then
5936  min_time_step = 1000 ! i think this is in seconds - this would imply ice is moving at ~1 meter per second
5937  else
5938  min_time_step=min_time_step_in
5939  endif
5940  is = g%isc ; iec = g%iec ; js = g%jsc ; jec = g%jec
5941 
5942  ! NOTE: this relies on NE grid indexing
5943  ! dumtimeprint=time_type_to_real(Time)/spy
5944  if (is_root_pe()) print *, "TIME in ice shelf call, yrs: ", time_type_to_real(time)/spy
5945 
5946  do while (time_step_remain .gt. 0.0)
5947 
5948  min_ratio = 1.0e16
5949  n=n+1
5950  do j=js,jec
5951  do i=is,iec
5952 
5953  local_u_max = 0 ; local_v_max = 0
5954 
5955  if (hmask(i,j) .eq. 1.0) then
5956  ! all 4 corners of the cell should have valid velocity values; otherwise something is wrong
5957  ! this is done by checking that umask and vmask are nonzero at all 4 corners
5958  do ki=1,2 ; do kj = 1,2
5959 
5960  local_u_max = max(local_u_max, abs(u_shelf(i-1+ki,j-1+kj)))
5961  local_v_max = max(local_v_max, abs(v_shelf(i-1+ki,j-1+kj)))
5962 
5963  enddo ; enddo
5964 
5965  ratio = min(g%areaT(i,j) / (local_u_max+1.0e-12), g%areaT(i,j) / (local_v_max+1.0e-12))
5966  min_ratio = min(min_ratio, ratio)
5967 
5968  endif
5969  enddo ! j loop
5970  enddo ! i loop
5971 
5972  ! solved velocities are in m/yr; we want m/s
5973 
5974  call mpp_min (min_ratio)
5975 
5976  time_step_int = min(cs%CFL_factor * min_ratio * (365*86400), time_step)
5977 
5978  if (time_step_int .lt. min_time_step) then
5979  call mom_error (fatal, "MOM_ice_shelf:solo_time_step: abnormally small timestep")
5980  else
5981  if (is_root_pe()) then
5982  write(*,*) "Ice model timestep: ", time_step_int, " seconds"
5983  endif
5984  endif
5985 
5986  if (time_step_int .ge. time_step_remain) then
5987  time_step_int = time_step_remain
5988  time_step_remain = 0.0
5989  else
5990  time_step_remain = time_step_remain - time_step_int
5991  endif
5992 
5993  write (stepnum,'(I4)') cs%velocity_update_sub_counter
5994 
5995  call ice_shelf_advect (cs, time_step_int, cs%lprec, time)
5996 
5997  if (mpp_pe() .eq. 7) then
5998  call savearray2 ("hmask",cs%hmask,cs%write_output_to_file)
5999 !!! OVS!!!
6000 ! call savearray2 ("tshelf",CS%t_shelf,CS%write_output_to_file)
6001  endif
6002 
6003  ! if the last mini-timestep is a day or less, we cannot expect velocities to change by much.
6004  ! do not update them
6005  if (time_step_int .gt. 1000) then
6006  call update_velocity_masks (cs)
6007 
6008 ! call savearray2 ("Umask"//"p"//trim(procnum)//"_"//trim(stepnum),CS%umask,CS%write_output_to_file)
6009 ! call savearray2 ("Vmask"//"p"//trim(procnum)//"_"//trim(stepnum),CS%vmask,CS%write_output_to_file)
6010 
6011  call update_od_ffrac_uncoupled (cs)
6012  call ice_shelf_solve_outer (cs, cs%u_shelf, cs%v_shelf, 1, iters, dummy)
6013  endif
6014 
6015 !!! OVS!!!
6016  call ice_shelf_temp (cs, time_step_int, cs%lprec, time)
6017 
6018  call enable_averaging(time_step,time,cs%diag)
6019  if (cs%id_area_shelf_h > 0) call post_data(cs%id_area_shelf_h, cs%area_shelf_h, cs%diag)
6020  if (cs%id_col_thick > 0) call post_data(cs%id_col_thick, cs%OD_av, cs%diag)
6021  if (cs%id_h_shelf > 0) call post_data(cs%id_h_shelf,cs%h_shelf,cs%diag)
6022  if (cs%id_h_mask > 0) call post_data(cs%id_h_mask,cs%hmask,cs%diag)
6023  if (cs%id_u_mask > 0) call post_data(cs%id_u_mask,cs%umask,cs%diag)
6024  if (cs%id_v_mask > 0) call post_data(cs%id_v_mask,cs%vmask,cs%diag)
6025  if (cs%id_u_shelf > 0) call post_data(cs%id_u_shelf,cs%u_shelf,cs%diag)
6026  if (cs%id_v_shelf > 0) call post_data(cs%id_v_shelf,cs%v_shelf,cs%diag)
6027  if (cs%id_float_frac > 0) call post_data(cs%id_float_frac,cs%float_frac,cs%diag)
6028  if (cs%id_OD_av >0) call post_data(cs%id_OD_av,cs%OD_av,cs%diag)
6029  if (cs%id_float_frac_rt>0) call post_data(cs%id_float_frac_rt,cs%float_frac_rt,cs%diag)
6030 !!! OVS!!!
6031 ! if (CS%id_t_mask > 0)
6032  call post_data(cs%id_t_mask,cs%tmask,cs%diag)
6033 ! if (CS%id_t_shelf > 0)
6034  call post_data(cs%id_t_shelf,cs%t_shelf,cs%diag)
6035 
6036  call disable_averaging(cs%diag)
6037 
6038  enddo
6039 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the call graph for this function:

◆ update_od_ffrac()

subroutine mom_ice_shelf::update_od_ffrac ( 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 
)
private

Definition at line 5368 of file MOM_ice_shelf.F90.

Referenced by shelf_calc_flux().

5368  type(ice_shelf_cs), pointer :: cs
5369  real, dimension(CS%grid%isd:,CS%grid%jsd:) :: ocean_mass
5370  integer,intent(in) :: counter
5371  integer,intent(in) :: nstep_velocity
5372  real,intent(in) :: time_step
5373  real,intent(in) :: velocity_update_time_step
5374 
5375  type(ocean_grid_type), pointer :: g
5376  integer :: isc, iec, jsc, jec, i, j
5377  real :: threshold_col_depth, rho_ocean, inv_rho_ocean
5378 
5379  threshold_col_depth = cs%thresh_float_col_depth
5380 
5381  g=>cs%grid
5382 
5383  rho_ocean = cs%density_ocean_avg
5384  inv_rho_ocean = 1./rho_ocean
5385 
5386  isc = g%isc ; jsc = g%jsc ; iec = g%iec ; jec = g%jec
5387 
5388  do j=jsc,jec
5389  do i=isc,iec
5390  cs%OD_rt(i,j) = cs%OD_rt(i,j) + ocean_mass(i,j)*inv_rho_ocean
5391  if (ocean_mass(i,j) > threshold_col_depth*rho_ocean) then
5392  cs%float_frac_rt(i,j) = cs%float_frac_rt(i,j) + 1.0
5393  endif
5394  enddo
5395  enddo
5396 
5397  if (counter .eq. nstep_velocity) then
5398 
5399  do j=jsc,jec
5400  do i=isc,iec
5401  cs%float_frac(i,j) = 1.0 - (cs%float_frac_rt(i,j) / real(nstep_velocity))
5402 ! if ((CS%float_frac(i,j) .gt. 0) .and. (CS%float_frac(i,j) .lt. 1)) then
5403 ! print *,"PARTLY GROUNDED", CS%float_frac(i,j),i,j,mpp_pe()
5404 ! endif
5405  cs%OD_av(i,j) = cs%OD_rt(i,j) / real(nstep_velocity)
5406 
5407  cs%OD_rt(i,j) = 0.0 ; cs%float_frac_rt(i,j) = 0.0
5408  enddo
5409  enddo
5410 
5411  call pass_var(cs%float_frac, g%domain)
5412  call pass_var(cs%OD_av, g%domain)
5413 
5414  endif
5415 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the caller graph for this function:

◆ update_od_ffrac_uncoupled()

subroutine mom_ice_shelf::update_od_ffrac_uncoupled ( type(ice_shelf_cs), pointer  CS)
private

Definition at line 5419 of file MOM_ice_shelf.F90.

Referenced by initialize_ice_shelf(), shelf_calc_flux(), and solo_time_step().

5419  type(ice_shelf_cs), pointer :: cs
5420 
5421  type(ocean_grid_type), pointer :: g
5422  integer :: i, j, iters, isd, ied, jsd, jed
5423  real :: rhoi, rhow, od
5424  type(time_type) :: dummy_time
5425  real,dimension(:,:),pointer :: od_av, float_frac, h_shelf
5426 
5427 
5428  g => cs%grid
5429  rhoi = cs%density_ice
5430  rhow = cs%density_ocean_avg
5431  dummy_time = set_time(0,0)
5432  od_av => cs%OD_av
5433  h_shelf => cs%h_shelf
5434  float_frac => cs%float_frac
5435  isd=g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
5436 
5437 ! print *,"rhow",rhow,"rho",rhoi
5438 
5439  do j=jsd,jed
5440  do i=isd,ied
5441  od = g%bathyT(i,j) - rhoi/rhow * h_shelf(i,j)
5442  if (od.ge.0) then
5443  ! ice thickness does not take up whole ocean column -> floating
5444  od_av(i,j) = od
5445  float_frac(i,j) = 0.
5446  else
5447  od_av(i,j) = 0.
5448  float_frac(i,j) = 1.
5449  endif
5450  enddo
5451  enddo
5452 
5453 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the caller graph for this function:

◆ update_shelf_mass()

subroutine mom_ice_shelf::update_shelf_mass ( type(ocean_grid_type), intent(inout)  G,
type(ice_shelf_cs), pointer  CS,
type(time_type), intent(in)  Time,
type(forcing), intent(inout)  fluxes 
)
private

Updates the ice shelf mass using data from a file.

Definition at line 2066 of file MOM_ice_shelf.F90.

References ice_shelf_min_thickness_calve().

Referenced by shelf_calc_flux().

2066  type(ocean_grid_type), intent(inout) :: g
2067  type(ice_shelf_cs), pointer :: cs
2068  type(time_type), intent(in) :: time
2069  type(forcing), intent(inout) :: fluxes
2070 
2071  ! local variables
2072  integer :: i, j, is, ie, js, je
2073  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
2074 
2075  ! first, zero out fluxes applied during previous time step
2076  do j=js,je; do i=is,ie
2077 
2078 
2079  enddo; enddo
2080 
2081  call time_interp_external(cs%id_read_mass, time, cs%mass_shelf)
2082 
2083  do j=js,je ; do i=is,ie
2084  ! first, zero out fluxes applied during previous time step
2085  if (cs%area_shelf_h(i,j) > 0.0) then
2086  if (associated(fluxes%lprec)) fluxes%lprec(i,j) = 0.0
2087  if (associated(fluxes%sens)) fluxes%sens(i,j) = 0.0
2088  if (associated(fluxes%frac_shelf_h)) fluxes%frac_shelf_h(i,j) = 0.0
2089  if (associated(fluxes%p_surf)) fluxes%p_surf(i,j) = 0.0
2090  if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = 0.0
2091  endif
2092  cs%area_shelf_h(i,j) = 0.0
2093  cs%hmask(i,j) = 0.
2094  if (cs%mass_shelf(i,j) > 0.0) then
2095  cs%area_shelf_h(i,j) = g%areaT(i,j)
2096  cs%h_shelf(i,j) = cs%mass_shelf(i,j)/cs%density_ice
2097  cs%hmask(i,j) = 1.
2098  endif
2099  enddo ; enddo
2100 
2101  !call USER_update_shelf_mass(CS%mass_shelf, CS%area_shelf_h, CS%h_shelf, &
2102  ! CS%hmask, CS%grid, CS%user_CS, Time, .true.)
2103 
2104  if (cs%min_thickness_simple_calve > 0.0) then
2105  call ice_shelf_min_thickness_calve (cs, cs%h_shelf, cs%area_shelf_h, cs%hmask)
2106  endif
2107 
2108  call pass_var(cs%area_shelf_h, g%domain)
2109  call pass_var(cs%h_shelf, g%domain)
2110  call pass_var(cs%hmask, g%domain)
2111  call pass_var(cs%mass_shelf, g%domain)
2112 
2113 
2114  ! update psurf and frac_shelf_h in fluxes
2115  do j=js,je ; do i=is,ie
2116  if (associated(fluxes%p_surf)) &
2117  fluxes%p_surf(i,j) = (cs%g_Earth * cs%mass_shelf(i,j))
2118  if (associated(fluxes%p_surf_full)) &
2119  fluxes%p_surf_full(i,j) = (cs%g_Earth * cs%mass_shelf(i,j))
2120  if (g%areaT(i,j) > 0.0) &
2121  fluxes%frac_shelf_h(i,j) = cs%area_shelf_h(i,j) / g%areaT(i,j)
2122  enddo ; enddo
2123 
2124 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the call graph for this function:
Here is the caller graph for this function:

◆ update_velocity_masks()

subroutine mom_ice_shelf::update_velocity_masks ( type(ice_shelf_cs), pointer  CS)
private

Definition at line 5590 of file MOM_ice_shelf.F90.

Referenced by ice_shelf_advect(), initialize_ice_shelf(), and solo_time_step().

5590  type(ice_shelf_cs), pointer :: cs
5591 
5592  ! sets masks for velocity solve
5593  ! ignores the fact that their might be ice-free cells - this only considers the computational boundary
5594 
5595  ! !!!!IMPORTANT!!!! relies on thickness mask - assumed that this is called after hmask has been updated (and halo-updated)
5596 
5597  integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq, giec, gjec, gisc, gjsc, isc, jsc, iec, jec, k
5598  integer :: i_off, j_off
5599  type(ocean_grid_type), pointer :: g
5600  real, dimension(:,:), pointer :: umask, vmask, u_face_mask, v_face_mask, hmask, u_face_mask_boundary, v_face_mask_boundary
5601 
5602  g => cs%grid
5603  isc = g%isc ; jsc = g%jsc ; iec = g%iec ; jec = g%jec
5604  iscq = g%iscB ; iecq = g%iecB ; jscq = g%jscB ; jecq = g%jecB
5605  i_off = g%idg_offset ; j_off = g%jdg_offset
5606  isd = g%isd ; jsd = g%jsd
5607  iegq = g%iegB ; jegq = g%jegB
5608  gisc = g%Domain%nihalo ; gjsc = g%Domain%njhalo
5609  giec = g%Domain%niglobal+gisc ; gjec = g%Domain%njglobal+gjsc
5610 
5611  umask => cs%umask
5612  vmask => cs%vmask
5613  u_face_mask => cs%u_face_mask
5614  v_face_mask => cs%v_face_mask
5615  u_face_mask_boundary => cs%u_face_mask_boundary
5616  v_face_mask_boundary => cs%v_face_mask_boundary
5617  hmask => cs%hmask
5618 
5619 
5620 ! if (G%symmetric) then
5621 ! isym=1
5622 ! else
5623 ! isym=0
5624 ! endif
5625 
5626  isym = 0
5627 
5628  umask(:,:) = 0 ; vmask(:,:) = 0
5629  u_face_mask(:,:) = 0 ; v_face_mask(:,:) = 0
5630 
5631  if (g%symmetric) then
5632  is = isd ; js = jsd
5633  else
5634  is = isd+1 ; js = jsd+1
5635  endif
5636 
5637  do j=js,g%jed
5638  do i=is,g%ied
5639 
5640  if (hmask(i,j) .eq. 1) then
5641 
5642  umask(i-1:i,j-1:j) = 1.
5643  vmask(i-1:i,j-1:j) = 1.
5644 
5645  do k=0,1
5646 
5647  select case (int(u_face_mask_boundary(i-1+k,j)))
5648  case (3)
5649  umask(i-1+k,j-1:j)=3.
5650  vmask(i-1+k,j-1:j)=0.
5651  u_face_mask(i-1+k,j)=3.
5652  case (2)
5653  u_face_mask(i-1+k,j)=2.
5654  case (4)
5655  umask(i-1+k,j-1:j)=0.
5656  vmask(i-1+k,j-1:j)=0.
5657  u_face_mask(i-1+k,j)=4.
5658  case (0)
5659  umask(i-1+k,j-1:j)=0.
5660  vmask(i-1+k,j-1:j)=0.
5661  u_face_mask(i-1+k,j)=0.
5662  case (1) ! stress free x-boundary
5663  umask(i-1+k,j-1:j)=0.
5664  case default
5665  end select
5666  enddo
5667 
5668  do k=0,1
5669 
5670  select case (int(v_face_mask_boundary(i,j-1+k)))
5671  case (3)
5672  vmask(i-1:i,j-1+k)=3.
5673  umask(i-1:i,j-1+k)=0.
5674  v_face_mask(i,j-1+k)=3.
5675  case (2)
5676  v_face_mask(i,j-1+k)=2.
5677  case (4)
5678  umask(i-1:i,j-1+k)=0.
5679  vmask(i-1:i,j-1+k)=0.
5680  v_face_mask(i,j-1+k)=4.
5681  case (0)
5682  umask(i-1:i,j-1+k)=0.
5683  vmask(i-1:i,j-1+k)=0.
5684  u_face_mask(i,j-1+k)=0.
5685  case (1) ! stress free y-boundary
5686  vmask(i-1:i,j-1+k)=0.
5687  case default
5688  end select
5689  enddo
5690 
5691  !if (u_face_mask_boundary(i-1,j).geq.0) then !left boundary
5692  ! u_face_mask (i-1,j) = u_face_mask_boundary(i-1,j)
5693  ! umask (i-1,j-1:j) = 3.
5694  ! vmask (i-1,j-1:j) = 0.
5695  !endif
5696 
5697  !if (j_off+j .eq. gjsc+1) then !bot boundary
5698  ! v_face_mask (i,j-1) = 0.
5699  ! umask (i-1:i,j-1) = 0.
5700  ! vmask (i-1:i,j-1) = 0.
5701  !elseif (j_off+j .eq. gjec) then !top boundary
5702  ! v_face_mask (i,j) = 0.
5703  ! umask (i-1:i,j) = 0.
5704  ! vmask (i-1:i,j) = 0.
5705  !endif
5706 
5707  if (i .lt. g%ied) then
5708  if ((hmask(i+1,j) .eq. 0) &
5709  .OR. (hmask(i+1,j) .eq. 2)) then
5710  !right boundary or adjacent to unfilled cell
5711  u_face_mask(i,j) = 2.
5712  endif
5713  endif
5714 
5715  if (i .gt. g%isd) then
5716  if ((hmask(i-1,j) .eq. 0) .OR. (hmask(i-1,j) .eq. 2)) then
5717  !adjacent to unfilled cell
5718  u_face_mask(i-1,j) = 2.
5719  endif
5720  endif
5721 
5722  if (j .gt. g%jsd) then
5723  if ((hmask(i,j-1) .eq. 0) .OR. (hmask(i,j-1) .eq. 2)) then
5724  !adjacent to unfilled cell
5725  v_face_mask(i,j-1) = 2.
5726  endif
5727  endif
5728 
5729  if (j .lt. g%jed) then
5730  if ((hmask(i,j+1) .eq. 0) .OR. (hmask(i,j+1) .eq. 2)) then
5731  !adjacent to unfilled cell
5732  v_face_mask(i,j) = 2.
5733  endif
5734  endif
5735 
5736 
5737  endif
5738 
5739  enddo
5740  enddo
5741 
5742  ! note: if the grid is nonsymmetric, there is a part that will not be transferred with a halo update
5743  ! so this subroutine must update its own symmetric part of the halo
5744 
5745  call pass_vector(u_face_mask, v_face_mask, g%domain, to_all, cgrid_ne)
5746  call pass_vector (umask,vmask,g%domain,to_all,bgrid_ne)
5747 
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:19
Here is the caller graph for this function:

Variable Documentation

◆ id_clock_pass

integer mom_ice_shelf::id_clock_pass
private

Clock for group pass calls.

Definition at line 302 of file MOM_ice_shelf.F90.

Referenced by initialize_ice_shelf(), and shelf_calc_flux().

◆ id_clock_shelf

integer mom_ice_shelf::id_clock_shelf

Definition at line 302 of file MOM_ice_shelf.F90.

Referenced by initialize_ice_shelf(), and shelf_calc_flux().

302 integer :: id_clock_shelf, id_clock_pass !< Clock for group pass calls