From 35bed8a9e64b31497e5fbf1bca0733b4eec7c2ab Mon Sep 17 00:00:00 2001 From: hollyhan Date: Wed, 10 Jan 2024 18:29:59 -0700 Subject: [PATCH 01/94] Add restart option when the SLM is coupled to MALI --- .../mpas-albany-landice/src/Registry.xml | 4 + .../src/mode_forward/mpas_li_bedtopo.F | 193 +++++++++++------- 2 files changed, 123 insertions(+), 74 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index 279d7fb3c0a0..c4cd6df05bb9 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -149,6 +149,10 @@ description="Time interval at which the sea-level model is called by MALI. The interval has to be an even multiple of the option 'config_adaptive_timestep_force_interval" possible_values="Any time interval of the format 'YYYY-MM-DD_HH:MM:SS'" /> + Date: Mon, 29 Jan 2024 21:21:10 -0700 Subject: [PATCH 02/94] Fix handling of err codes in thermal solver As written, some errors were not being handled properly, leading to runs being aborted without useful information written to an err log file. This commit writes all error related messages to the err log, sets the err code to 1, and returns control to the calling routine. --- .../src/mode_forward/mpas_li_thermal.F | 23 ++++++++++--------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_thermal.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_thermal.F index 4ef8ae672b8c..5fa521705904 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_thermal.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_thermal.F @@ -792,8 +792,9 @@ subroutine li_thermal_solver(domain, err) call mpas_pool_get_array(meshPool, 'deltat', deltat) if (deltat <= 0.0_RKIND) then + err = ior(err, 1) call mpas_log_write('li_thermal_solver was called with invalid deltat = $r', MPAS_LOG_ERR, realArgs=(/deltat/)) - call mpas_log_write("An error has occurred in li_thermal. Aborting...", MPAS_LOG_CRIT) + return endif @@ -1305,25 +1306,25 @@ subroutine li_thermal_solver(domain, err) mintemp = minval(temperature(:,iCell)) if (maxtemp > maxtempThreshold) then - call mpas_log_write('maxtemp > maxtempThreshold: indexToCellID=$i, maxtemp = $r', intArgs=(/indexToCellID(iCell)/), & + err = ior(err, 1) + call mpas_log_write('maxtemp > maxtempThreshold: indexToCellID=$i, maxtemp = $r', MPAS_LOG_ERR, intArgs=(/indexToCellID(iCell)/), & realArgs=(/maxtemp/)) - call mpas_log_write('thickness = $r', realArgs=(/thickness(iCell)/)) - call mpas_log_write('temperature:') + call mpas_log_write(' thickness = $r', MPAS_LOG_ERR, realArgs=(/thickness(iCell)/)) + call mpas_log_write(' temperature:', MPAS_LOG_ERR) do k = 1, nVertLevels - call mpas_log_write('$i $r', intArgs=(/k/), realArgs=(/temperature(k,iCell)/)) + call mpas_log_write(' $i $r', MPAS_LOG_ERR, intArgs=(/k/), realArgs=(/temperature(k,iCell)/)) enddo - call mpas_log_write("An error has occurred in li_thermal. Aborting...", MPAS_LOG_CRIT) endif if (mintemp < mintempThreshold) then - call mpas_log_write('mintemp < mintempThreshold: indexToCellID=$i, mintemp = $r', intArgs=(/indexToCellID(iCell)/), & + err = ior(err, 1) + call mpas_log_write('mintemp < mintempThreshold: indexToCellID=$i, mintemp = $r', MPAS_LOG_ERR, intArgs=(/indexToCellID(iCell)/), & realArgs=(/mintemp/)) - call mpas_log_write('thickness = $r', realArgs=(/thickness(iCell)/)) - call mpas_log_write('temperature:') + call mpas_log_write(' thickness = $r', MPAS_LOG_ERR, realArgs=(/thickness(iCell)/)) + call mpas_log_write(' temperature:', MPAS_LOG_ERR) do k = 1, nVertLevels - call mpas_log_write('$i $r', intArgs=(/k/), realArgs=(/temperature(k,iCell)/)) + call mpas_log_write(' $i $r', MPAS_LOG_ERR, intArgs=(/k/), realArgs=(/temperature(k,iCell)/)) enddo - call mpas_log_write("An error has occurred in li_thermal. Aborting...", MPAS_LOG_CRIT) endif enddo ! iCell From cfa244be77fd7965af908e2cc339d5c8fbba95aa Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Mon, 29 Jan 2024 21:42:56 -0700 Subject: [PATCH 03/94] Reduce maxTempThreshold to 0.1 deg above melting temp It was previously set to 100 degC, which seems unnecessarily permissive for ice --- .../mpas-albany-landice/src/mode_forward/mpas_li_thermal.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_thermal.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_thermal.F index 5fa521705904..96d289f400d6 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_thermal.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_thermal.F @@ -70,7 +70,7 @@ module li_thermal ! Note: kelvin_to_celsius = 273.15 (perhaps it should be called celsius_to_kelvin?) real (kind=RKIND), parameter :: & - maxtempThreshold = 100._RKIND + kelvin_to_celsius, & + maxtempThreshold = 0.1_RKIND + kelvin_to_celsius, & mintempThreshold = -100._RKIND + kelvin_to_celsius !*********************************************************************** From fd298b1420ee9e8a3015e484592d8e95aa9ac158 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 31 Jan 2024 13:50:28 -0700 Subject: [PATCH 04/94] Update basal mass balance calculation and basal water accounting Depsite comments suggesting it was the case, the existing code did not limit basal freeze on by the available basal water. This commit corrects that. It also applies the contribution of basal melting to basal water for the temperature solver, which previously was being excluded. --- .../src/mode_forward/mpas_li_thermal.F | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_thermal.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_thermal.F index 96d289f400d6..65c300963529 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_thermal.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_thermal.F @@ -2841,15 +2841,21 @@ subroutine basal_melt_grounded_ice(& ! to the form as Eqn (66) in Aschwanden and others (2012) "An ! enthalpy formulation for glaciers and ice sheets". An extra ! term (1-w) would be more accurate. - basalWaterThickness(iCell) = basalWaterThickness(iCell) - deltat*groundedBasalMassBal(iCell) - ! TZ: allow basalWaterThickness freely accumulate here. Change it to something else for difference cases - if (basalWaterThickness(iCell) < 0.0_RKIND) then - basalWaterThickness(iCell) = 0.0_RKIND - endif else ! temperature solver groundedBasalMassBal(iCell) = -netBasalFlux / (latent_heat_ice * rhoi) ! m/s endif + ! Update basal water thickness based on melting or freezing (same for enthalpy or temperature) + if (groundedBasalMassBal(iCell) > 0.0) then + ! for freezing conditions (+SMB), limit positive BMB to the available basal water + groundedBasalMassBal(iCell) = min(groundedBasalMassBal(iCell), basalWaterThickness(iCell) / deltat) + endif + basalWaterThickness(iCell) = basalWaterThickness(iCell) - deltat*groundedBasalMassBal(iCell) + + ! negative water thickness should not occur, but if round off leads to it, set back to zero + if (basalWaterThickness(iCell) < 0.0_RKIND) then + basalWaterThickness(iCell) = 0.0_RKIND + endif endif ! ice is present and grounded From c9c13aa5d4abb80e398ba361fb362ececb82b478 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 17 May 2023 10:38:16 -0600 Subject: [PATCH 05/94] Add missing channel melt source term to mass cons eqn After further inspection, I realized that the mass conservation equation used to evolve sheet thickness is missing a source term from the production of meltwater within the channel. This is the 2nd term on the RHS of Hewitt (2013) Eq. 7, and it is missing from Eq. 54 in the Hoffman et al. 2018 GMD paper. Melt production in the channel is generally a small contribution to the total water balance, which may explain why the model matched GlaDS well for the SHMIP experiments. It's possible this correction will help with channel blowup events, or it could make them worse - it's hard to think through how this affects those events without better characterizing what's causing them. In any case, this is a clear omission and should be used going forward. --- .../src/Registry_subglacial_hydro.xml | 2 ++ .../mode_forward/mpas_li_subglacial_hydro.F | 19 +++++++++++++++++-- 2 files changed, 19 insertions(+), 2 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml index 754e8385255c..c9087d164def 100644 --- a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml +++ b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml @@ -251,6 +251,8 @@ description="divergence due to channel flow in subglacial hydrology system" /> + diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index ad3642622e1f..054b756c1e09 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -259,6 +259,7 @@ subroutine li_SGH_solve(domain, err) real (kind=RKIND), dimension(:), pointer :: waterThicknessTendency real (kind=RKIND), dimension(:), pointer :: divergenceChannel real (kind=RKIND), dimension(:), pointer :: channelAreaChangeCell + real (kind=RKIND), dimension(:), pointer :: channelMeltInputCell real (kind=RKIND), dimension(:), pointer :: dvEdge real (kind=RKIND), dimension(:), pointer :: areaCell real (kind=RKIND), dimension(:), pointer :: waterVelocity @@ -534,6 +535,7 @@ subroutine li_SGH_solve(domain, err) call mpas_timer_start("halo updates") call mpas_dmpar_field_halo_exch(domain, 'divergenceChannel') call mpas_dmpar_field_halo_exch(domain, 'channelAreaChangeCell') + call mpas_dmpar_field_halo_exch(domain, 'channelMeltInputCell') call mpas_dmpar_field_halo_exch(domain, 'channelArea') call mpas_timer_stop("halo updates") endif @@ -570,12 +572,16 @@ subroutine li_SGH_solve(domain, err) call mpas_pool_get_array(hydroPool, 'divergence', divergence) call mpas_pool_get_array(hydroPool, 'divergenceChannel', divergenceChannel) call mpas_pool_get_array(hydroPool, 'channelAreaChangeCell', channelAreaChangeCell) + call mpas_pool_get_array(hydroPool, 'channelMeltInputCell', channelMeltInputCell) call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) waterThicknessOld = waterThickness - waterThickness = waterThicknessOld + deltatSGH * ( (basalMeltInput + externalWaterInput) / rho_water - divergence & + waterThickness = waterThicknessOld + deltatSGH * ( & + (basalMeltInput + externalWaterInput) / rho_water & + + channelMeltInputCell & + - divergence & - divergenceChannel - channelAreaChangeCell & - - (Wtill - WtillOld) / deltatSGH) + - (Wtill - WtillOld) / deltatSGH ) waterThickness = waterThickness * li_mask_is_grounded_ice_int(cellMask) ! zero in non-grounded locations waterThickness = max(0.0_RKIND, waterThickness) divergence = divergence * li_mask_is_grounded_ice_int(cellMask) ! zero in non-grounded locations for more convenient viz @@ -1777,6 +1783,7 @@ subroutine update_channel(block, err) end where channelChangeRate = channelOpeningRate - channelClosingRate + !-------------------------------------------------------------------- end subroutine update_channel @@ -1816,9 +1823,11 @@ subroutine evolve_channel(block, err) type (mpas_pool_type), pointer :: meshPool real (kind=RKIND), dimension(:), pointer :: channelArea real (kind=RKIND), dimension(:), pointer :: channelDischarge + real (kind=RKIND), dimension(:), pointer :: channelMelt, channelPressureFreeze real (kind=RKIND), dimension(:), pointer :: channelChangeRate real (kind=RKIND), dimension(:), pointer :: divergenceChannel real (kind=RKIND), dimension(:), pointer :: channelAreaChangeCell + real (kind=RKIND), dimension(:), pointer :: channelMeltInputCell real (kind=RKIND), pointer :: deltatSGH integer, dimension(:), pointer :: nEdgesOnCell integer, dimension(:,:), pointer :: edgesOnCell @@ -1834,9 +1843,12 @@ subroutine evolve_channel(block, err) call mpas_pool_get_array(hydroPool, 'deltatSGH', deltatSGH) call mpas_pool_get_array(hydroPool, 'channelArea', channelArea) call mpas_pool_get_array(hydroPool, 'channelDischarge', channelDischarge) + call mpas_pool_get_array(hydroPool, 'channelMelt', channelMelt) + call mpas_pool_get_array(hydroPool, 'channelPressureFreeze', channelPressureFreeze) call mpas_pool_get_array(hydroPool, 'channelChangeRate', channelChangeRate) call mpas_pool_get_array(hydroPool, 'divergenceChannel', divergenceChannel) call mpas_pool_get_array(hydroPool, 'channelAreaChangeCell', channelAreaChangeCell) + call mpas_pool_get_array(hydroPool, 'channelMeltInputCell', channelMeltInputCell) call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell) @@ -1848,6 +1860,7 @@ subroutine evolve_channel(block, err) ! Calculate flux divergence on cells and channel area change on cells divergenceChannel(:) = 0.0_RKIND ! zero div before accumulating channelAreaChangeCell(:) = 0.0_RKIND ! zero before accumulating + channelMeltInputCell(:) = 0.0_RKIND ! zero before accumulating ! loop over locally owned cells do iCell = 1, nCellsSolve ! TODO: could limit to grounded cells only @@ -1858,10 +1871,12 @@ subroutine evolve_channel(block, err) divergenceChannel(iCell) = divergenceChannel(iCell) - channelDischarge(iEdge) * edgeSignOnCell(iEdgeOnCell, iCell) channelAreaChangeCell(iCell) = channelChangeRate(iEdge) * dcEdge(iEdge) * 0.5_RKIND ! < only half of channel is in this cell + channelMeltInputCell(iCell) = 0.5_RKIND * (channelMelt(iEdge) - channelPressureFreeze(iEdge)) * dcEdge(iEdge) / rho_water end do ! edges end do ! cells divergenceChannel(1:nCellsSolve) = divergenceChannel(1:nCellsSolve) / areaCell(1:nCellsSolve) channelAreaChangeCell(1:nCellsSolve) = channelAreaChangeCell(1:nCellsSolve) / areaCell(1:nCellsSolve) + channelMeltInputCell(1:nCellsSolve) = channelMeltInputCell(1:nCellsSolve) / areaCell(1:nCellsSolve) ! Now update channel area channelArea = channelChangeRate * deltatSGH + channelArea From 9e29133edcf20018ce30414b354b812ee28b8098 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 17 May 2023 11:30:03 -0600 Subject: [PATCH 06/94] Revert "Ignore the water thickness head in the channel model" This reverts commit ae981817616596be19c52fad5a9089161d9c8d63. It seems like we would want the channel model to see the elevation head produced by a lake's water thickness to ensure that channel flow is consistent with the presence of the lake. This commit reverts the commit that dropped the water thickness elevation head from the hydropotential gradients used by the channel. In the sheet model, the elevation head is removed from the advection equation, but it is handled by the diffusion equation, so it's still represented in the evolution. As the channel model currently exists, the elevation head is almost completely absent (other than its effect on the magnitude of gradMagPhiEdge). It seems like this could lead to channels draining *into* lakes even when the full hydropotential gradient of the lake indicates water flow should be draining the lake. --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 054b756c1e09..5d048074bea9 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -1652,7 +1652,7 @@ subroutine update_channel(block, err) real (kind=RKIND), dimension(:), pointer :: channelVelocity real (kind=RKIND), dimension(:), pointer :: gradMagPhiEdge real (kind=RKIND), dimension(:), pointer :: waterFlux - real (kind=RKIND), dimension(:), pointer :: hydropotentialBaseSlopeNormal + real (kind=RKIND), dimension(:), pointer :: hydropotentialSlopeNormal real (kind=RKIND), dimension(:), pointer :: waterPressureSlopeNormal real (kind=RKIND), dimension(:), pointer :: channelOpeningRate real (kind=RKIND), dimension(:), pointer :: channelClosingRate @@ -1698,7 +1698,7 @@ subroutine update_channel(block, err) call mpas_pool_get_array(hydroPool, 'channelDischarge', channelDischarge) call mpas_pool_get_array(hydroPool, 'channelVelocity', channelVelocity) call mpas_pool_get_array(hydroPool, 'gradMagPhiEdge', gradMagPhiEdge) - call mpas_pool_get_array(hydroPool, 'hydropotentialBaseSlopeNormal', hydropotentialBaseSlopeNormal) + call mpas_pool_get_array(hydroPool, 'hydropotentialSlopeNormal', hydropotentialSlopeNormal) call mpas_pool_get_array(hydroPool, 'waterPressureSlopeNormal', waterPressureSlopeNormal) call mpas_pool_get_array(hydroPool, 'waterFlux', waterFlux) call mpas_pool_get_array(hydroPool, 'channelOpeningRate', channelOpeningRate) @@ -1720,7 +1720,7 @@ subroutine update_channel(block, err) channelDischarge(:) = 0.0_RKIND elsewhere channelDischarge = -1.0_RKIND * Kc * channelArea**alpha_c * gradMagPhiEdge**(beta_c - 2.0_RKIND) * & - hydropotentialBaseSlopeNormal + hydropotentialSlopeNormal end where where (waterFluxMask == 2) @@ -1752,8 +1752,8 @@ subroutine update_channel(block, err) Kc * channelArea**(alpha_c - 1.0_RKIND) * gradMagPhiEdge**(beta_c - 2.0_RKIND)) end where - channelMelt = (abs(channelDischarge * hydropotentialBaseSlopeNormal) & ! channel dissipation - + abs(waterFlux * hydropotentialBaseSlopeNormal * config_SGH_incipient_channel_width) & !some sheet dissipation + channelMelt = (abs(channelDischarge * hydropotentialSlopeNormal) & ! channel dissipation + + abs(waterFlux * hydropotentialSlopeNormal * config_SGH_incipient_channel_width) & !some sheet dissipation ) / latent_heat_ice channelPressureFreeze = -1.0_RKIND * iceMeltingPointPressureDependence * cp_freshwater * rho_water * & (channelDischarge + waterFlux * config_SGH_incipient_channel_width) & From d10446452ebb2fe4dfb48b9d1e245c9dce565639 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Thu, 18 May 2023 14:12:10 -0600 Subject: [PATCH 07/94] Disable diffusive water flux at grounding line The water thickness in the ocean is undefined, and if anything we'd have diffusion from the ocean (thick water layer) to the grounded ice, and we don't want any flux from the ocean inward. --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 5d048074bea9..d7b7d3deede0 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -963,11 +963,15 @@ subroutine calc_edge_quantities(block, err) waterFluxAdvec(iEdge) = waterVelocity(iEdge) * waterThicknessEdgeUpwind(iEdge) ! diffusive flux - ! Note: At the GL, the water thickness for one cell will be 0, meaning a large gradient. However, the - ! diffusivity uses a one sided water thickness. It's unclear what really happens to lakes at the GL/margin. - waterFluxDiffu(iEdge) = -1.0_RKIND * diffusivity(iEdge) * (waterThickness(cell2) - waterThickness(cell1)) & + ! Note: Water thickness at the GL is undefined. I don't think we want to assume it's 0, and + ! we also don't want to assume it's the ocean water column height, because that would imply + ! a diffusive flux inward, which is undesirable. So disabling diffusion at the GL. + if (hydroMarineMarginMask(iEdge) == 1) then + waterFluxDiffu(iEdge) = 0.0_RKIND + else + waterFluxDiffu(iEdge) = -1.0_RKIND * diffusivity(iEdge) * (waterThickness(cell2) - waterThickness(cell1)) & / dcEdge(iEdge) - !endif + endif end do where (waterFluxMask == 2) waterFluxAdvec = 0.0_RKIND From 89b3ca1157e0058c357961164082228b92313765 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Fri, 19 May 2023 16:43:25 -0600 Subject: [PATCH 08/94] Move call to mpas_calculate_barycentric_weights_for_points Previously the call to mpas_calculate_barycentric_weights_for_points to set up barycentric weights for interpolation from cells to vertices occurred in the mpas_li_sia.F module. However, these weights may also be needed by the subglacial hydro code, which can be called with any (or none) velocity solver. This commit moves that initialization to mpas_li_setup and adds logic to call the weight generation routine if either the SIA or SGH code requires it. --- .../mpas-albany-landice/src/Registry.xml | 4 +- .../src/mode_forward/mpas_li_core.F | 4 + .../src/mode_forward/mpas_li_sia.F | 44 -------- .../src/shared/mpas_li_setup.F | 106 +++++++++++++++++- 4 files changed, 111 insertions(+), 47 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index 279d7fb3c0a0..1a8523d39138 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -1125,10 +1125,10 @@ is the value of that variable from the *previous* time level! /> 0) then - call mpas_log_write("The 'from_vertex_barycentric' option for 'config_sia_tangent_slope_calculation' " & - // "does NOT work across the periodicity in periodic meshes. However, it does work within the interior " & - // "of the mesh.", MPAS_LOG_WARN) - endif - call mpas_deallocate_scratch_field(vertexIndicesField, .true.) - endif ! === error check if (err > 0) then diff --git a/components/mpas-albany-landice/src/shared/mpas_li_setup.F b/components/mpas-albany-landice/src/shared/mpas_li_setup.F index e231b4733bbd..a77178001e3c 100644 --- a/components/mpas-albany-landice/src/shared/mpas_li_setup.F +++ b/components/mpas-albany-landice/src/shared/mpas_li_setup.F @@ -53,7 +53,8 @@ module li_setup li_interpolate_vertex_to_cell_2d, & li_cells_to_vertices_1dfield_using_kiteAreas, & li_calculate_layerThickness, & - li_compute_gradient_2d + li_compute_gradient_2d, & + li_init_barycentric_weights_vertex !-------------------------------------------------------------------- @@ -817,6 +818,109 @@ subroutine li_compute_gradient_2d(& end subroutine li_compute_gradient_2d +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +! +! routine li_init_barycentric_weights_vertex +! +!> \brief compute barycentric weights for interpolating cells to vertices +!> \author Matt Hoffman +!> \date May 2023 +!> \details +!> This routine uses a framework routine to compute the barycentric +!> weights for interpolating from cells to vertices +! +!----------------------------------------------------------------------- + + subroutine li_init_barycentric_weights_vertex(block, err) + + use mpas_geometry_utils, only: mpas_calculate_barycentric_weights_for_points + + !----------------------------------------------------------------- + ! input variables + !----------------------------------------------------------------- + + !----------------------------------------------------------------- + ! input/output variables + !----------------------------------------------------------------- + type (block_type), intent(inout) :: & + block !< Input/Output: block object + + !----------------------------------------------------------------- + ! output variables + !----------------------------------------------------------------- + integer, intent(out) :: err !< Output: error flag + + !----------------------------------------------------------------- + ! local variables + !----------------------------------------------------------------- + type (mpas_pool_type), pointer :: meshPool + type (mpas_pool_type), pointer :: scratchPool + integer :: iCell, iLevel, i, iVertex, err_tmp + integer, pointer :: nVertices + character (len=StrKIND), pointer :: config_velocity_solver + character (len=StrKIND), pointer :: config_sia_tangent_slope_calculation + logical, pointer :: config_SGH + character (len=StrKIND), pointer :: config_SGH_tangent_slope_calculation + integer, dimension(:,:), pointer :: baryCellsOnVertex + real (kind=RKIND), dimension(:,:), pointer :: baryWeightsOnVertex + real (kind=RKIND), dimension(:), pointer :: xVertex, yVertex, zVertex + type (field1dInteger), pointer :: vertexIndicesField + + ! No block init needed. + err = 0 + err_tmp = 0 + + call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) + call mpas_pool_get_subpool(block % structs, 'scratch', scratchPool) + call mpas_pool_get_array(meshPool, 'baryCellsOnVertex', baryCellsOnVertex) + call mpas_pool_get_array(meshPool, 'baryWeightsOnVertex', baryWeightsOnVertex) + call mpas_pool_get_array(meshPool, 'xVertex', xVertex) + call mpas_pool_get_array(meshPool, 'yVertex', yVertex) + call mpas_pool_get_array(meshPool, 'zVertex', zVertex) + call mpas_pool_get_config(liConfigs, 'config_velocity_solver', config_velocity_solver) + call mpas_pool_get_config(liConfigs, 'config_sia_tangent_slope_calculation', config_sia_tangent_slope_calculation) + call mpas_pool_get_config(liConfigs, 'config_SGH', config_SGH) + call mpas_pool_get_config(liConfigs, 'config_SGH_tangent_slope_calculation', config_SGH_tangent_slope_calculation) + call mpas_pool_get_field(scratchPool, 'vertexIndices', vertexIndicesField) + call mpas_pool_get_dimension(meshPool, 'nVertices', nVertices) + + if ( & + (trim(config_velocity_solver) == 'sia' .and. & + trim(config_sia_tangent_slope_calculation) == 'from_vertex_barycentric') & + .or. & + (config_SGH .and. trim(config_SGH_tangent_slope_calculation) == 'from_vertex_barycentric')) then + + call mpas_allocate_scratch_field(vertexIndicesField, .true.) + do iVertex = 1, nVertices + vertexIndicesField % array(iVertex) = iVertex + enddo + call mpas_calculate_barycentric_weights_for_points(meshPool, & + xVertex(1:nVertices), yVertex(1:nVertices), zVertex(1:nVertices), & + vertexIndicesField % array(1:nVertices), & + baryCellsOnVertex(:, 1:nVertices), baryWeightsOnVertex(:, 1:nVertices), err_tmp) + ! TODO: Until framework can handle periodic meshs gracefully, this will return an error + ! for periodic meshes. This error means that the velocity solver will be very wrong across + ! the periodicity, but it will be fine everywhere else. For now, just print a warning but + ! don't make this a fatal error. + !err = ior(err, err_tmp) + if (err_tmp > 0) then + call mpas_log_write("The 'from_vertex_barycentric' option for 'config_sia_tangent_slope_calculation' " & + // "'config_SGH_tangent_slope_calculation' " & + // "does NOT work across the periodicity in periodic meshes. However, it does work within the interior " & + // "of the mesh.", MPAS_LOG_WARN) + endif + call mpas_deallocate_scratch_field(vertexIndicesField, .true.) + + endif + + ! === error check + if (err > 0) then + call mpas_log_write("An error has occurred in li_init_barycentric_weights_vertex", MPAS_LOG_ERR) + endif + + end subroutine li_init_barycentric_weights_vertex + + !*********************************************************************** !*********************************************************************** ! Private subroutines: From 34279d01f978bd0e6639b02baf1dfdade018980f Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Fri, 19 May 2023 13:07:03 -0600 Subject: [PATCH 09/94] Zero gradients at edges of the mesh Without explicitly doing this, the gradients are likely using neighboring values of 0, which would yield unexpectedly large gradients. --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index d7b7d3deede0..82b4782b3e58 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -889,6 +889,16 @@ subroutine calc_edge_quantities(block, err) endif ! GL edge or grounded margin end do + ! zero gradients at boundaries of the mesh + do iEdge = 1, nEdges + cell1 = cellsOnEdge(1, iEdge) + cell2 = cellsOnEdge(2, iEdge) + if ((cell1 == nCells+1) .or. (cell2 == nCells+1)) then + hydropotentialBaseSlopeNormal(iEdge) = 0.0_RKIND + hydropotentialSlopeNormal(iEdge) = 0.0_RKIND + waterPressureSlopeNormal(iEdge) = 0.0_RKIND + endif + end do ! Calculate tangent slope of hydropotentialBase - three possible methods to consider From be959a9c6daddf198fed032a920f53c261dd9919 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Fri, 19 May 2023 13:29:33 -0600 Subject: [PATCH 10/94] Treat tangent slope calculation near boundary of mesh This commit explicitly treats the calculation of hydropotentialBaseSlopeTangent near mesh boundaries. For the two vertex based methods, edges with vertices on the boundary of the mesh will have invalid values. For the normal slope method, any edges on cells that are at the edge of the mesh will have contaminated values. In those cases, set tangent slope to zero rather than leaving the possibility of garbage values. --- .../mode_forward/mpas_li_subglacial_hydro.F | 27 ++++++++++++++++--- 1 file changed, 24 insertions(+), 3 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 82b4782b3e58..35974d867e2a 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -744,6 +744,7 @@ subroutine calc_edge_quantities(block, err) integer, dimension(:), pointer :: edgeMask integer, dimension(:,:), pointer :: cellsOnEdge integer, dimension(:,:), pointer :: verticesOnEdge + integer, dimension(:,:), pointer :: cellsOnVertex integer, dimension(:,:), pointer :: baryCellsOnVertex real (kind=RKIND), dimension(:,:), pointer :: baryWeightsOnVertex real (kind=RKIND), pointer :: alpha, beta @@ -758,6 +759,7 @@ subroutine calc_edge_quantities(block, err) integer, pointer :: nCells integer, pointer :: nVertices integer :: iEdge, cell1, cell2 + integer :: i, j, iVertex, iCell real (kind=RKIND) :: velSign integer :: numGroundedCells integer :: err_tmp @@ -917,11 +919,14 @@ subroutine calc_edge_quantities(block, err) end select ! Now perform tangent slope calculation based on method chosen + ! For the two vertex based methods, edges with vertices on the boundary of the mesh will have invalid values + ! For the normal slope method, any edges on cells that are at the edge of the mesh will have + ! contaminated values. + call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge) + call mpas_pool_get_array(meshPool, 'verticesOnEdge', verticesOnEdge) + call mpas_pool_get_array(meshPool, 'cellsOnVertex', cellsOnVertex) select case (trim(config_SGH_tangent_slope_calculation)) case ('from_vertex_barycentric', 'from_vertex_barycentric_kiteareas') - call mpas_pool_get_array(geometryPool, 'edgeMask', edgeMask) - call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge) - call mpas_pool_get_array(meshPool, 'verticesOnEdge', verticesOnEdge) do iEdge = 1, nEdges ! Only calculate slope for edges that have ice on at least one side. if ( li_mask_is_ice(edgeMask(iEdge)) ) then @@ -930,10 +935,26 @@ subroutine calc_edge_quantities(block, err) else hydropotentialBaseSlopeTangent(iEdge) = 0.0_RKIND endif + ! check for edges where a vertex is on the edge of the mesh and zero the tangent slope there + do i = 1, 2 + iVertex = verticesOnEdge(i, iEdge) + do j = 1, 3 + iCell = cellsOnVertex(j, iVertex) + if (iCell == nCells + 1) then + hydropotentialBaseSlopeTangent(iEdge) = 0.0_RKIND + endif + enddo + enddo end do ! edges case ('from_normal_slope') call mpas_tangential_vector_1d(hydropotentialBaseSlopeNormal, meshPool, & includeHalo=.false., tangentialVector=hydropotentialBaseSlopeTangent) + ! ensure that edges that don't have ice on at least one side have tangent slope set to zero + do iEdge = 1, nEdges + if ( .not. li_mask_is_ice(edgeMask(iEdge)) ) then + hydropotentialBaseSlopeTangent(iEdge) = 0.0_RKIND + endif + end do ! edges case default call mpas_log_write('Invalid value for config_SGH_tangent_slope_calculation.', MPAS_LOG_ERR) err = 1 From e78b763bf00499204cf71a2f18207183c9112f22 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Mon, 22 May 2023 19:22:17 -0600 Subject: [PATCH 11/94] Adjust hydro CFL calculation to ignore invalid edges Without this change, the CFL condition might be overly restrictive because values from cells that aren't part of advection get included in the calculation and they may happen to have values that are more restrictive than the valid edges. --- .../mode_forward/mpas_li_subglacial_hydro.F | 57 ++++++++++++------- 1 file changed, 35 insertions(+), 22 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 35974d867e2a..cf02e943785d 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -998,6 +998,7 @@ subroutine calc_edge_quantities(block, err) ! we also don't want to assume it's the ocean water column height, because that would imply ! a diffusive flux inward, which is undesirable. So disabling diffusion at the GL. if (hydroMarineMarginMask(iEdge) == 1) then + diffusivity(iEdge) = 0.0_RKIND waterFluxDiffu(iEdge) = 0.0_RKIND else waterFluxDiffu(iEdge) = -1.0_RKIND * diffusivity(iEdge) * (waterThickness(cell2) - waterThickness(cell1)) & @@ -1139,31 +1140,43 @@ subroutine check_timestep(domain, timeLeft, numSubCycles, err) call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge) call mpas_pool_get_array(meshPool, 'indexToEdgeID', indexToEdgeID) - ! Calculate advective CFL-limited time step - dtSGHadvecBlock = 0.5_RKIND * minval(dcEdge(1:nEdgesSolve) / (abs(waterVelocity(1:nEdgesSolve)) & - + 1.0e-12_RKIND)) ! regularize - dtSGHadvecProc = min(dtSGHadvecProc, dtSGHadvecBlock) + dtSGHadvecBlock = bigNumber + dtSGHdiffuBlock = bigNumber + dtSGHpressureBlock = bigNumber + dtSGHadvecChanBlock = bigNumber + dtSGHdiffuChanBlock = bigNumber - ! Calculate diffusive CFL-limited time step - dtSGHdiffuBlock = 0.25_RKIND * minval(dcEdge(1:nEdgesSolve)**2 / (diffusivity(1:nEdgesSolve) + 1.0e-12_RKIND)) - dtSGHdiffuProc = min(dtSGHdiffuProc, dtSGHdiffuBlock) + do iEdge = 1, nEdgesSolve + ! Calculate advective CFL-limited time step + if (abs(waterVelocity(iEdge)) > 0.0) then + dtSGHadvecBlock = min(dtSGHadvecBlock, 0.5_RKIND * dcEdge(iEdge) / abs(waterVelocity(iEdge))) + endif - ! Calculate pressure limited time step - dtSGHpressureBlock = 1.0_RKIND * minval(porosity * dcEdge(1:nEdgesSolve)**2 & - / (2.0_RKIND * diffusivity(1:nEdgesSolve) + 1.0e-12_RKIND)) - dtSGHpressureProc = min(dtSGHpressureProc, dtSGHpressureBlock) + if (diffusivity(iEdge) > 0.0) then + ! Calculate diffusive CFL-limited time step + dtSGHdiffuBlock = min(dtSGHdiffuBlock, 0.25_RKIND * dcEdge(iEdge)**2 / diffusivity(iEdge)) + ! Calculate pressure limited time step + dtSGHpressureBlock = min(dtSGHpressureBlock, 1.0_RKIND * porosity * dcEdge(iEdge)**2 & + / (2.0_RKIND * diffusivity(iEdge))) + endif - if (config_SGH_chnl_active) then - ! Calculate channel advection limited time step - dtSGHadvecChanBlock = 0.5_RKIND * minval(dcEdge(1:nEdgesSolve) / (abs(channelVelocity(1:nEdgesSolve)) & - + 1.0e-12_RKIND)) - ! regularize - dtSGHadvecChanProc = min(dtSGHadvecChanProc, dtSGHadvecChanBlock) - ! Calculate channel diffusion limited time step - dtSGHdiffuChanBlock = 0.25_RKIND * minval(dcEdge(1:nEdgesSolve)**2 / (channelDiffusivity(1:nEdgesSolve) + & - 1.0e-12_RKIND)) - dtSGHdiffuChanProc = min(dtSGHdiffuChanProc, dtSGHdiffuChanBlock) - endif + if (config_SGH_chnl_active) then + if (abs(channelVelocity(iEdge)) > 0.0) then + ! Calculate channel advection limited time step + dtSGHadvecChanBlock = min(dtSGHadvecChanBlock, 0.5_RKIND * dcEdge(iEdge) / (abs(channelVelocity(iEdge)))) + endif + ! Calculate channel diffusion limited time step + if (channelDiffusivity(iEdge) > 0.0) then + dtSGHdiffuChanBlock = min(dtSGHdiffuChanBlock, 0.25_RKIND * dcEdge(iEdge)**2 / channelDiffusivity(iEdge)) + endif + endif + enddo + + dtSGHadvecProc = min(dtSGHadvecProc, dtSGHadvecBlock) + dtSGHdiffuProc = min(dtSGHdiffuProc, dtSGHdiffuBlock) + dtSGHpressureProc = min(dtSGHpressureProc, dtSGHpressureBlock) + dtSGHadvecChanProc = min(dtSGHadvecChanProc, dtSGHadvecChanBlock) + dtSGHdiffuChanProc = min(dtSGHdiffuChanProc, dtSGHdiffuChanBlock) ! Master deltat is needed below, so grab it in this block loop call mpas_pool_get_array(meshPool, 'deltat', deltat) From 4f448669204b5a947760807f6fbd8184d6b96bac Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Thu, 25 May 2023 14:21:24 -0600 Subject: [PATCH 12/94] Update gradient calulations at boundaries of hydro domain Simplify calculation disallowing inflow and move it *before* extra logic limiting outflow gradient. --- .../mode_forward/mpas_li_subglacial_hydro.F | 50 +++++++------------ 1 file changed, 19 insertions(+), 31 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index cf02e943785d..aeb9da614a00 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -833,12 +833,29 @@ subroutine calc_edge_quantities(block, err) waterPressureSlopeNormal(iEdge) = (waterPressure(cell2) - waterPressure(cell1)) / dcEdge(iEdge) end do + ! At boundaries of hydro domain, disallow inflow. Allow outflow if hydropotential gradient requires it. + do iEdge = 1, nEdges + if ( (li_mask_is_margin(edgeMask(iEdge)) .and. li_mask_is_grounded_ice(edgeMask(iEdge))) .or. & + (hydroMarineMarginMask(iEdge)==1)) then + cell1 = cellsOnEdge(1, iEdge) + cell2 = cellsOnEdge(2, iEdge) + if (li_mask_is_grounded_ice(cellMask(cell1))) then ! cell2 is the cell outside the hydro domain + hydropotentialBaseSlopeNormal(iEdge) = min(0.0_RKIND, hydropotentialBaseSlopeNormal(iEdge)) + hydropotentialSlopeNormal(iEdge) = min(0.0_RKIND, hydropotentialSlopeNormal(iEdge)) + else ! cell1 is the cell outside the hydro domain + hydropotentialBaseSlopeNormal(iEdge) = max(0.0_RKIND, hydropotentialBaseSlopeNormal(iEdge)) + hydropotentialSlopeNormal(iEdge) = max(0.0_RKIND, hydropotentialSlopeNormal(iEdge)) + endif ! which cell is icefree + endif ! if edge of grounded ice + end do + ! At terrestrial margin, ignore the downslope bed topography gradient. Including it can lead to unrealistically large ! hydropotential gradients and unstable channel growth. ! We also want to do this at marine margins because otherwise the offshore topography can create a barrier to flow, ! but that is unrealistic. - ! So for all boundaries of the hydro system, the hydropotential at the margin should be determined by the geometry - ! at the edge of the cell in a 1-sided sense + ! So for all boundaries of the hydro system where outflow is occuring, + ! the hydropotential at the margin should be determined by the geometry + ! at the edge of the cell in a 1-sided sense. do iEdge = 1, nEdges if ( (li_mask_is_margin(edgeMask(iEdge)) .and. li_mask_is_grounded_ice(edgeMask(iEdge))) .or. & (hydroMarineMarginMask(iEdge)==1)) then @@ -862,35 +879,6 @@ subroutine calc_edge_quantities(block, err) endif ! if edge of grounded ice end do - ! Disallow flow from ocean to glacier, or land to glacier, - ! which can occur under some circumstances - ! For ocean this is invalid because ocean water has a different density! - ! For land this would only happen if there is a supply of water, which is not currently handled. - ! Do this by simply zeroing the hydropotential gradient in those cases. - ! (Do this step only after the other hydropotential special cases are treated above.) - do iEdge = 1, nEdges - ! Find edges along GL or margin to check for 'backwards' flow - if ((hydroMarineMarginMask(iEdge)==1) .or. & - li_mask_is_margin(edgeMask(iEdge)) ) then - ! Now check if flow is backwards - cell1 = cellsOnEdge(1, iEdge) - cell2 = cellsOnEdge(2, iEdge) - if (hydropotentialBaseSlopeNormal(iEdge) > 0.0_RKIND) then - ! flow is from cell2 to cell1 - if (.not. li_mask_is_grounded_ice(cellMask(cell2))) then - hydropotentialBaseSlopeNormal(iEdge) = 0.0_RKIND - hydropotentialSlopeNormal(iEdge) = 0.0_RKIND - endif - elseif (hydropotentialBaseSlopeNormal(iEdge) < 0.0_RKIND) then - ! flow is from cell1 to cell2 - if (.not. li_mask_is_grounded_ice(cellMask(cell1))) then - hydropotentialBaseSlopeNormal(iEdge) = 0.0_RKIND - hydropotentialSlopeNormal(iEdge) = 0.0_RKIND - endif - endif - endif ! GL edge or grounded margin - end do - ! zero gradients at boundaries of the mesh do iEdge = 1, nEdges cell1 = cellsOnEdge(1, iEdge) From f82cddd6e3f6dd43cb03877cf4897532c3087db7 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Thu, 25 May 2023 17:33:37 -0600 Subject: [PATCH 13/94] Channel gradMagPhiEdge dependent on full water hydropotential Channels now use updated version of gradMagPhiEdge, which is dependent on full hydropotential. This is done to keep channels from filling up lakes even when lake is full and hydropotential is in opposite direction. Distributed system is now dependent on new variable gradMagPhiBaseEdge, which is dependent only on hydropotentialBase and is equivalent to gradMagPhiEdge in previous commits. --- .../src/Registry_subglacial_hydro.xml | 8 ++++- .../mode_forward/mpas_li_subglacial_hydro.F | 36 +++++++++++++++---- 2 files changed, 37 insertions(+), 7 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml index c9087d164def..602b7c11f6d5 100644 --- a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml +++ b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml @@ -196,14 +196,20 @@ description="hydropotential in subglacial hydrology system without water thickness contribution" /> + - + + 0.0_RKIND) then ! Use a thickness weighted conductivity coeff. when water thickness exceeds bump height @@ -959,12 +983,12 @@ subroutine calc_edge_quantities(block, err) conduc_coeff_drowned * max(waterThicknessEdge(iEdge) - bedRoughMax, 0.0_RKIND)) / & (waterThicknessEdge(iEdge) + 1.0e-16_RKIND) ! Regularization only applies where value doesn't matter effectiveConducEdge(iEdge) = conduc_coeff_wtd * waterThicknessEdge(iEdge)**(alpha-1.0_RKIND) * & - (gradMagPhiEdge(iEdge)+1.0e-30_RKIND)**(beta - 2.0_RKIND) ! small value used for regularization + (gradMagPhiBaseEdge(iEdge)+1.0e-30_RKIND)**(beta - 2.0_RKIND) ! small value used for regularization end do else ! Just use a single conductivity coeff. effectiveConducEdge(:) = conduc_coeff * waterThicknessEdge(:)**(alpha-1.0_RKIND) *& - (gradMagPhiEdge(:)+1.0e-30_RKIND)**(beta - 2.0_RKIND) ! small value used for regularization + (gradMagPhiBaseEdge(:)+1.0e-30_RKIND)**(beta - 2.0_RKIND) ! small value used for regularization endif ! calculate diffusivity on edges From dc6b48e5f2659b478278957f8bc952c771f6cf88 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Mon, 12 Jun 2023 11:01:31 -0600 Subject: [PATCH 14/94] Create hydroTerrestrialMarginMask Creates hydroTerrestrialMarginMask variable, which designates the terrestrial margins of the active subglacial hydrology model --- .../src/Registry_subglacial_hydro.xml | 4 +++- .../src/mode_forward/mpas_li_subglacial_hydro.F | 16 ++++++++++++++++ 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml index 602b7c11f6d5..66a4a306bbf3 100644 --- a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml +++ b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml @@ -174,7 +174,9 @@ description="mask indicating how to handle fluxes on each edge: 0=calculate based on hydropotential gradient; 1=allow outflow based on hydropotential gradient, but no inflow (NOT YET IMPLEMENTED); 2=zero flux" /> - + diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index f7118b3fe850..f73177ab3907 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -2183,6 +2183,7 @@ subroutine calc_hydro_mask(domain) type (mpas_pool_type), pointer :: meshPool real (kind=RKIND), dimension(:), pointer :: bedTopography integer, dimension(:), pointer :: hydroMarineMarginMask + integer, dimension(:), pointer :: hydroTerrestrialMarginMask integer, dimension(:,:), pointer :: cellsOnEdge integer, dimension(:), pointer :: cellMask integer, pointer :: nEdgesSolve @@ -2199,6 +2200,7 @@ subroutine calc_hydro_mask(domain) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) call mpas_pool_get_array(hydroPool, 'hydroMarineMarginMask', hydroMarineMarginMask) + call mpas_pool_get_array(hydroPool, 'hydroTerrestrialMarginMask', hydroTerrestrialMarginMask) call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge) call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve) @@ -2218,6 +2220,20 @@ subroutine calc_hydro_mask(domain) endif enddo + hydroTerrestrialMarginMask(:) = 0 + do iEdge = 1, nEdgesSolve + cell1 = cellsOnEdge(1, iEdge) + cell2 = cellsOnEdge(2, iEdge) + !Look for edges with 1 cell on grounding ice and the other cell on land without ice + if ((li_mask_is_grounded_ice(cellMask(cell1))) .and. ( .not. li_mask_is_ice(cellMask(cell2))) & + .and. (bedTopography(cell2) > config_sea_level)) then + hydroTerrestrialMarginMask(iEdge) = 1 + elseif ((li_mask_is_grounded_ice(cellMask(cell2))) .and. ( .not. li_mask_is_ice(cellMask(cell1))) & + .and. (bedTopography(cell1) > config_sea_level)) then + hydroTerrestrialMarginMask(iEdge) = 1 + endif + enddo + block => block % next end do From 69d566d521d125f2cded4c458797e8a874ba7634 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Tue, 20 Jun 2023 17:29:32 -0600 Subject: [PATCH 15/94] Edit SGH_tangent_slope_calculation description Edits description of config_SGH_tangent_slope_calculation in Registry_subglacial_hydro.xml based on detailed testing of 'from_normal_slope' and 'from_vertex_barycentric' options. --- .../mpas-albany-landice/src/Registry_subglacial_hydro.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml index 66a4a306bbf3..b70e885eb592 100644 --- a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml +++ b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml @@ -24,7 +24,7 @@ description="Selection of the method for calculating the tangent component of slope at edges. 'from_vertex_barycentric' interpolates scalar values from cell centers to vertices using the barycentric interpolation routine in operators (mpas_cells_to_points_using_baryweights) and then calculates the slope between vertices. It works for obtuse triangles, but will not work correctly across the edges of periodic meshes. 'from_vertex_barycentric_kiteareas' interpolates scalar values from cell centers to vertices using barycentric interpolation based on kiterea values and then calculates the slope between vertices. It will work across the edges of periodic meshes, but will not work correctly for obtuse triangles. -'from_normal_slope' uses the vector operator mpas_tangential_vector_1d to calculate the tangent slopes from the normal slopes on the edges of the adjacent cells. It will work for any mesh configuration, but is the least accurate method." +'from_normal_slope' uses the vector operator mpas_tangential_vector_1d to calculate the tangent slopes from the normal slopes on the edges of the adjacent cells. It will work for any mesh configuration. 'from_normal_slope' uses a larger stencil, so may therefore produce a smoother 'gradMagPhiEdge' field. Detailed testing yielded nearly identical results between 'from_normal_slope' and 'from_vertex_barycentric' methods, but 'from_normal_slope' seemed to produce slightly more stable results at the grounding line." possible_values="'from_vertex_barycentric', 'from_vertex_barycentric_kiteareas', 'from_normal_slope'" /> Date: Wed, 19 Jul 2023 14:56:46 -0600 Subject: [PATCH 16/94] Zero diffusivity at boundary edges Explicitly sets diffusivity to zero at boundary edges, instead of just waterFluxDiff --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 1 + 1 file changed, 1 insertion(+) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index f73177ab3907..5a4049f146e3 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -1018,6 +1018,7 @@ subroutine calc_edge_quantities(block, err) endif end do where (waterFluxMask == 2) + diffusivity = 0.0_RKIND waterFluxAdvec = 0.0_RKIND waterFluxDiffu = 0.0_RKIND waterVelocity = 0.0_RKIND From 7529d5d5b2042c5212969bd94deca8f0ae6a614b Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Fri, 1 Dec 2023 12:40:09 -0800 Subject: [PATCH 17/94] hydroTerrestrialMarginMask >= sea level Redfines hydroTerrestiralMarineMargin to AT or above sea level, whereas hydroMarineMarginMask is exclusively below sea level. --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 5a4049f146e3..f02e9860e5e4 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -2227,10 +2227,10 @@ subroutine calc_hydro_mask(domain) cell2 = cellsOnEdge(2, iEdge) !Look for edges with 1 cell on grounding ice and the other cell on land without ice if ((li_mask_is_grounded_ice(cellMask(cell1))) .and. ( .not. li_mask_is_ice(cellMask(cell2))) & - .and. (bedTopography(cell2) > config_sea_level)) then + .and. (bedTopography(cell2) >= config_sea_level)) then hydroTerrestrialMarginMask(iEdge) = 1 elseif ((li_mask_is_grounded_ice(cellMask(cell2))) .and. ( .not. li_mask_is_ice(cellMask(cell1))) & - .and. (bedTopography(cell1) > config_sea_level)) then + .and. (bedTopography(cell1) >= config_sea_level)) then hydroTerrestrialMarginMask(iEdge) = 1 endif enddo From 6fb6db5a6c8e29b1c6739538272f06e5115bfdde Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Mon, 5 Feb 2024 14:35:47 -0700 Subject: [PATCH 18/94] channelAreaChangeCell/channelMeltInputCell debug Debugs calculations of channelAreaChangeCell and channelMeltInputCell. Loop where these were being calculated was overwritting cell values each iteration through nEdgesOnCell. Now each cell is the sum of all of its edges as intended. --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index f02e9860e5e4..e823785f251e 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -1930,10 +1930,11 @@ subroutine evolve_channel(block, err) iEdge = edgesOnCell(iEdgeOnCell, iCell) ! add on advective & diffusive fluxes divergenceChannel(iCell) = divergenceChannel(iCell) - channelDischarge(iEdge) * edgeSignOnCell(iEdgeOnCell, iCell) - channelAreaChangeCell(iCell) = channelChangeRate(iEdge) * dcEdge(iEdge) * 0.5_RKIND + channelAreaChangeCell(iCell) = channelChangeRate(iEdge) * dcEdge(iEdge) * 0.5_RKIND + channelAreaChangeCell(iCell) ! < only half of channel is in this cell - channelMeltInputCell(iCell) = 0.5_RKIND * (channelMelt(iEdge) - channelPressureFreeze(iEdge)) * dcEdge(iEdge) / rho_water + channelMeltInputCell(iCell) = 0.5_RKIND * (channelMelt(iEdge) - channelPressureFreeze(iEdge)) * dcEdge(iEdge) / rho_water + channelMeltInputCell(iCell) end do ! edges + end do ! cells divergenceChannel(1:nCellsSolve) = divergenceChannel(1:nCellsSolve) / areaCell(1:nCellsSolve) channelAreaChangeCell(1:nCellsSolve) = channelAreaChangeCell(1:nCellsSolve) / areaCell(1:nCellsSolve) From 489805df75a1054db0f7ee3b3a0e6486b24f6973 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Tue, 13 Feb 2024 13:24:58 -0700 Subject: [PATCH 19/94] fix typo --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index e823785f251e..bbabf2e10ec7 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -900,7 +900,7 @@ subroutine calc_edge_quantities(block, err) ! Calculate hydropotentialBaseVertex if needed call mpas_pool_get_array(hydroPool, 'hydropotentialBaseVertex', hydropotentialBaseVertex) ! < this array could be protected by logic if desired - ! caluculate hydropotentialVertex if needed + ! calculate hydropotentialVertex if needed call mpas_pool_get_array(hydroPool, 'hydropotentialVertex', hydropotentialVertex) ! < this array could be protected by logic if desired select case (trim(config_SGH_tangent_slope_calculation)) From 58b91c193de583cf483b938744d1263e421452e7 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Tue, 13 Feb 2024 16:32:42 -0700 Subject: [PATCH 20/94] Add halo updates on two channel variables This is necessary to get BFB results on different decompositions. This addition was made necessary by c9c13aa5d4abb80e398ba361fb362ececb82b478. There may be a way to adjust halo updates to avoid needing to add these both, as they are both local calculations. But it is likely complex, so this solution is adequate in that it works. --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 2 ++ 1 file changed, 2 insertions(+) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index bbabf2e10ec7..ba5a359301e1 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -465,6 +465,8 @@ subroutine li_SGH_solve(domain, err) call mpas_timer_start("halo updates") call mpas_dmpar_field_halo_exch(domain, 'channelChangeRate') call mpas_dmpar_field_halo_exch(domain, 'channelDischarge') + call mpas_dmpar_field_halo_exch(domain, 'channelMelt') + call mpas_dmpar_field_halo_exch(domain, 'channelPressureFreeze') call mpas_timer_stop("halo updates") endif From 37062fe4288ceccb7b759d8651fd490ca9cf26bc Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Fri, 16 Feb 2024 12:08:42 -0700 Subject: [PATCH 21/94] Move pressure calc so it uses consistent time levels of variables As previously ordered, the operations in evolving waterThickness and pressure variables were out of sync, resulting in the full hydropotential variable using the old waterThickness in the term calculating the water layer elevation head. This was causing restarts with the channel model to fail and channel hydropotential gradients to be inaccurate (unknown how significant that was). This commit moves the pressure calculation to eliminate this issue. Code comments explain in more detail. --- .../mode_forward/mpas_li_subglacial_hydro.F | 44 ++++++++++++------- 1 file changed, 29 insertions(+), 15 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index ba5a359301e1..1878f4ecec7e 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -543,19 +543,6 @@ subroutine li_SGH_solve(domain, err) endif - ! ============= - ! Calculate pressure field - ! ============= - block => domain % blocklist - do while (associated(block)) - - call calc_pressure(block, err_tmp) - err = ior(err, err_tmp) - - block => block % next - end do - - ! ============= ! Update water layer thickness ! ============= @@ -592,6 +579,33 @@ subroutine li_SGH_solve(domain, err) block => block % next end do + ! ============= + ! Calculate pressure field + ! ============= + ! Note: In Bueler and van Pelt, pressure is updated before waterThickness + ! (step vii on page 1625). It does not matter which order they are calculated + ! because the update calculations are formulated on intermediate variables + ! such that neither depend directly on the other in the actual update. + ! However, calc_pressure also calculates the full hydropotential (including + ! the water thickness elevation head) which *is* a direct function of water thickness, + ! making the ordering of that calculation important. + ! Because the pressure variables calculated here are meant to be used on the + ! following timestep (forward Euler), the full hydropotential should be using + ! the updated waterThickness, not the old one. To achieve that, calc_pressure + ! is called here, after waterThickness has been updated. + ! Note that the full hydropotential is only used by the channel model, so this + ! ordering choice is only needed to support channels. Without it, runs with + ! channels would use an out of date waterThickness in the hydropotential and + ! do not restart correctly due to the order of operations mismatch. + block => domain % blocklist + do while (associated(block)) + + call calc_pressure(block, err_tmp) + err = ior(err, err_tmp) + + block => block % next + end do + ! ============= ! ============= @@ -972,11 +986,11 @@ subroutine calc_edge_quantities(block, err) ! calculate magnitude of gradient of Phi gradMagPhiEdge = sqrt(hydropotentialSlopeNormal**2 + hydropotentialSlopeTangent**2) - + ! calculate magnitude of gradient of hydropotentialBase gradMagPhiBaseEdge = sqrt(hydropotentialBaseSlopeNormal**2 +& hydropotentialBaseSlopeTangent**2) - + ! calculate effective conductivity on edges if (conduc_coeff_drowned > 0.0_RKIND) then ! Use a thickness weighted conductivity coeff. when water thickness exceeds bump height From 80aa98fed9bb23f7d69b70982d82f744d0cd58eb Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Fri, 16 Feb 2024 12:24:09 -0700 Subject: [PATCH 22/94] Initialize deltatSGH only on a cold start & make it a restart variable This is needed for BFB restarts with the till model. We never use the till model, but I identified this issue while debugging channel restarts. --- components/mpas-albany-landice/src/Registry.xml | 3 ++- .../src/mode_forward/mpas_li_subglacial_hydro.F | 15 ++++++++++++--- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index 1a8523d39138..a1ddaf744018 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -869,7 +869,8 @@ - + + diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 1878f4ecec7e..cffd631f00b5 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -108,6 +108,7 @@ subroutine li_SGH_init(domain, err) integer, dimension(:), pointer :: cellMask real (kind=RKIND), pointer :: tillMax real (kind=RKIND), pointer :: rhoi, rhoo + logical, pointer :: config_do_restart real (kind=RKIND), pointer :: config_sea_level integer, pointer :: config_num_halos integer :: err_tmp @@ -138,6 +139,7 @@ subroutine li_SGH_init(domain, err) err = ior(err, 1) endif + call mpas_pool_get_config(liConfigs, 'config_do_restart', config_do_restart) call mpas_pool_get_config(liConfigs, 'config_SGH_till_max', tillMax) call mpas_pool_get_config(liConfigs, 'config_ice_density', rhoi) call mpas_pool_get_config(liConfigs, 'config_ocean_density', rhoo) @@ -152,9 +154,16 @@ subroutine li_SGH_init(domain, err) call mpas_pool_get_array(hydroPool, 'deltatSGH', deltatSGH) - ! Until init is done properly, make this tiny. It will be updated at the end of the first subcycle. - ! TODO: Set time step appropriately on first subcycle of init - deltatSGH = 1.0e-4_RKIND ! in seconds + if (.not. config_do_restart) then + ! On cold start, set initial timestep to a small value. + ! On a restart we will use the value from the last subcycle of the previous + ! master timestep to make restarts BFB. + ! Note the value here is only used for the first update of thetill model; + ! the sheet and channel models calculate the adaptive timestep, but that is not + ! available for the till model as the code is currently organized. + ! TODO: Move till update until after adaptive timestep has been set + deltatSGH = 1.0e-4_RKIND ! in seconds + endif ! Mask needs to be initialized for pressure calcs to be correct call li_calculate_mask(meshPool, velocityPool, geometryPool, err_tmp) From 6715104cd22fe9c8d238a801f53caa64d57e3f39 Mon Sep 17 00:00:00 2001 From: Courtney Shafer Date: Tue, 27 Jun 2023 14:58:40 -0600 Subject: [PATCH 23/94] Add SGH analysis members to global stats - Add "totalSubglacialWaterVolume" - Add "totalLakeVolume" - Add "totalBasalMeltInput" - Add "totalExternalWaterInput" - Add "totalChannelMelt" - Add "totalGLMeltFlux" - Add "totalTerrestrialMeltFlux" - Add "totalChannelGLMeltFlux" - Add "totalChannelTerrestrialMeltFlux" - Add "totalFlotationFraction" - Add "avgFlotationFraction" --- .../Registry_global_stats.xml | 37 ++++ .../analysis_members/mpas_li_global_stats.F | 159 +++++++++++++++++- 2 files changed, 191 insertions(+), 5 deletions(-) mode change 100644 => 100755 components/mpas-albany-landice/src/analysis_members/Registry_global_stats.xml mode change 100644 => 100755 components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F diff --git a/components/mpas-albany-landice/src/analysis_members/Registry_global_stats.xml b/components/mpas-albany-landice/src/analysis_members/Registry_global_stats.xml old mode 100644 new mode 100755 index 622d33933cc0..74e5875d4dde --- a/components/mpas-albany-landice/src/analysis_members/Registry_global_stats.xml +++ b/components/mpas-albany-landice/src/analysis_members/Registry_global_stats.xml @@ -100,6 +100,43 @@ + + + + + + + + + + + + + domain % blocklist @@ -278,6 +326,7 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) call mpas_pool_get_subpool(block % structs, 'globalStatsAM', globalStatsAMPool) call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) call mpas_pool_get_subpool(block % structs, 'velocity', velocityPool) + call mpas_pool_get_subpool(block % structs, 'hydro', hydroPool) ! get values and arrays from standard pools call mpas_pool_get_dimension(block % dimensions, 'nCellsSolve', nCellsSolve) @@ -285,6 +334,7 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) call mpas_pool_get_array(meshPool, 'deltat', deltat) call mpas_pool_get_array(meshPool, 'areaCell', areaCell) call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge) + call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge) call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) @@ -299,11 +349,21 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) call mpas_pool_get_array(velocityPool, 'surfaceSpeed', surfaceSpeed) call mpas_pool_get_array(velocityPool, 'basalSpeed', basalSpeed) call mpas_pool_get_array(velocityPool, 'fluxAcrossGroundingLine', fluxAcrossGroundingLine) + call mpas_pool_get_array(hydroPool, 'waterThickness', waterThickness) + call mpas_pool_get_array(hydroPool, 'basalMeltInput', basalMeltInput) + call mpas_pool_get_array(hydroPool, 'externalWaterInput', externalWaterInput) + call mpas_pool_get_array(hydroPool, 'channelMelt', channelMelt) + call mpas_pool_get_array(hydroPool, 'hydroMarineMarginMask', hydroMarineMarginMask) + call mpas_pool_get_array(hydroPool, 'hydroTerrestrialMarginMask', hydroTerrestrialMarginMask) + call mpas_pool_get_array(hydroPool, 'waterFlux', waterFlux) + call mpas_pool_get_array(hydroPool, 'channelDischarge', channelDischarge) + call mpas_pool_get_array(hydroPool, 'waterPressure', waterPressure) + ! loop over cells do iCell = 1,nCellsSolve - ! sums of ice area and volume over cells (m^2 and m^3) + ! sums of ice area and volume over cells (m^2 and m^3)i blockSumIceArea = blockSumIceArea + real(li_mask_is_ice_int(cellMask(iCell)),RKIND) & * areaCell(iCell) blockSumIceVolume = blockSumIceVolume + real(li_mask_is_ice_int(cellMask(iCell)),RKIND) & @@ -314,11 +374,13 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) blockSumGroundedIceArea = blockSumGroundedIceArea + real(li_mask_is_grounded_ice_int(cellMask(iCell)),RKIND) & * areaCell(iCell) + blockSumGroundedIceVolume = blockSumGroundedIceVolume + real(li_mask_is_grounded_ice_int(cellMask(iCell)),RKIND) & * areaCell(iCell) * thickness(iCell) blockSumFloatingIceArea = blockSumFloatingIceArea + real(li_mask_is_floating_ice_int(cellMask(iCell)),RKIND) & * areaCell(iCell) + blockSumFloatingIceVolume = blockSumFloatingIceVolume + real(li_mask_is_floating_ice_int(cellMask(iCell)),RKIND) & * areaCell(iCell) * thickness(iCell) @@ -335,6 +397,7 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) blockSumGroundedSfcMassBal = blockSumGroundedSfcMassBal + areaCell(iCell) * groundedSfcMassBalApplied(iCell) * scyr blockSumFloatingSfcMassBal = blockSumFloatingSfcMassBal + & (sfcMassBalApplied(iCell) - groundedSfcMassBalApplied(iCell)) * areaCell(iCell) * scyr + ! BMB (kg yr-1) blockSumBasalMassBal = blockSumBasalMassBal + areaCell(iCell) * basalMassBalApplied(iCell) * scyr blockSumGroundedBasalMassBal = blockSumGroundedBasalMassBal + areaCell(iCell) * groundedBasalMassBalApplied(iCell) * scyr @@ -362,13 +425,57 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) blockGLMigrationFlux = blockGLMigrationFlux + groundedToFloatingThickness(iCell) * areaCell(iCell) & * rhoi / (deltat / scyr) ! convert from m to kg/yr + !! Subglacial Hydrology Calculations + + ! Subglacial Water Volume + blockSumSubglacialWaterVolume = blockSumSubglacialWaterVolume + waterThickness(iCell) * areaCell(iCell) + + ! Basal melt input + blockSumBasalMeltInput = blockSumBasalMeltInput + basalMeltInput(iCell) * areaCell(iCell) + + ! External water input + blockSumExternalWaterInput = blockSumExternalWaterInput + externalWaterInput(iCell) * areaCell(iCell) + + ! Lake Volume + if (waterThickness(iCell) > bedBumpMax) then + blockSumLakeVolume = blockSumLakeVolume + (waterThickness(iCell) - bedBumpMax) * areaCell(iCell) + endif + + ! Lake Area + if (waterThickness(iCell) > bedBumpMax) then + blockSumLakeArea = blockSumLakeArea + areaCell(iCell) + endif + + ! Area-weighted flotation fraction for grounded ice + if (li_mask_is_grounded_ice(cellMask(iCell))) then + blockSumFlotationFraction = blockSumFlotationFraction + ( waterPressure(iCell) / rhow / gravity / thickness(iCell) ) * areaCell(iCell) + endif + + end do ! end loop over cells ! Loop over edges do iEdge = 1, nEdgesSolve + ! Flux across GL, units = kg/yr blockGLflux = blockGLflux + fluxAcrossGroundingLine(iEdge) * dvEdge(iEdge) & * scyr * rhoi ! convert from m^2/s to kg/yr + + ! Channel Melt + blockSumChannelMelt = blockSumChannelMelt + abs(channelMelt(iEdge) * dcEdge(iEdge)) + + ! Meltwater Flux across the grounding line + blockSumGLMeltFlux = blockSumGLMeltFlux + abs(hydroMarineMarginMask(iEdge) * waterFlux(iEdge) * dvEdge(iEdge) * rho_water) + + ! Meltwater Flux across terrestrial margins + blockSumTerrestrialMeltFlux = blockSumTerrestrialMeltFlux + abs(hydroTerrestrialMarginMask(iEdge) * waterFlux(iEdge) * dvEdge(iEdge) * rho_water) + + ! Meltwater Discharge in channels across grounding line + blockSumChannelGLMeltFlux = blockSumChannelGLMeltFlux + abs(hydroMarineMarginMask(iEdge) * channelDischarge(iEdge) * rho_water) + + ! Meltwater discharge in channels across terrestrial margin + blockSumChannelTerrestrialMeltFlux = blockSumChannelTerrestrialMeltFlux + abs( hydroTerrestrialMarginMask(iEdge) * channelDischarge(iEdge) * rho_water) + end do ! end loop over edges block => block % next @@ -409,7 +516,6 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) sums(7) = blockSumSfcMassBal sums(8) = blockSumGroundedSfcMassBal sums(9) = blockSumFloatingSfcMassBal - sums(10) = blockSumBasalMassBal sums(11) = blockSumGroundedBasalMassBal sums(12) = blockSumFloatingBasalMassBal @@ -418,7 +524,18 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) sums(15) = blockSumVAF sums(16) = blockGLflux sums(17) = blockGLMigrationflux - nVars = 17 + sums(18) = blockSumSubglacialWaterVolume + sums(19) = blockSumBasalMeltInput + sums(20) = blockSumExternalWaterInput + sums(21) = blockSumChannelMelt + sums(22) = blockSumLakeVolume + sums(23) = blockSumLakeArea + sums(24) = blockSumGLMeltFlux + sums(25) = blockSumTerrestrialMeltFlux + sums(26) = blockSumChannelGLMeltFlux + sums(27) = blockSumChannelTerrestrialMeltFlux + sums(28) = blockSumFlotationFraction + nVars = 28 call mpas_dmpar_sum_real_array(dminfo, nVars, sums(1:nVars), reductions(1:nVars)) @@ -447,6 +564,18 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) call mpas_pool_get_array(globalStatsAMPool, 'totalFaceMeltingFlux', totalFaceMeltingFlux) call mpas_pool_get_array(globalStatsAMPool, 'groundingLineFlux', groundingLineFlux) call mpas_pool_get_array(globalStatsAMPool, 'groundingLineMigrationFlux', groundingLineMigrationFlux) + call mpas_pool_get_array(globalStatsAMPool, 'totalSubglacialWaterVolume', totalSubglacialWaterVolume) + call mpas_pool_get_array(globalStatsAMPool, 'totalBasalMeltInput', totalBasalMeltInput) + call mpas_pool_get_array(globalStatsAMPool, 'totalExternalWaterInput', totalExternalWaterInput) + call mpas_pool_get_array(globalStatsAMPool, 'totalChannelMelt', totalChannelMelt) + call mpas_pool_get_array(globalStatsAMPool, 'totalLakeVolume', totalLakeVolume) + call mpas_pool_get_array(globalStatsAMPool, 'totalLakeArea', totalLakeArea) + call mpas_pool_get_array(globalStatsAMPool, 'totalGLMeltFlux',totalGLMeltFlux) + call mpas_pool_get_array(globalStatsAMPool, 'totalTerrestrialMeltFlux', totalTerrestrialMeltFlux) + call mpas_pool_get_array(globalStatsAMPool, 'totalChannelGLMeltFlux',totalChannelGLMeltFlux) + call mpas_pool_get_array(globalStatsAMPool, 'totalChannelTerrestrialMeltFlux', totalChannelTerrestrialMeltFlux) + call mpas_pool_get_array(globalStatsAMPool, 'totalFlotationFraction', totalFlotationFraction) + call mpas_pool_get_array(globalStatsAMPool, 'avgFlotationFraction', avgFlotationFraction) totalIceArea = reductions(1) totalIceVolume = reductions(2) @@ -465,6 +594,18 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) volumeAboveFloatation = reductions(15) groundingLineFlux = reductions(16) groundingLineMigrationFlux = reductions(17) + totalSubglacialWaterVolume = reductions(18) + totalBasalMeltInput = reductions(19) + totalExternalWaterInput = reductions(20) + totalChannelMelt = reductions(21) + totalLakevolume = reductions(22) + totalLakeArea = reductions(23) + totalGLMeltFlux = reductions(24) + totalTerrestrialMeltFlux = reductions(25) + totalChannelGLMeltFlux = reductions(26) + totalChannelTerrestrialMeltFlux = reductions(27) + totalFlotationFraction = reductions(28) + if (totalIceArea > 0.0_RKIND) then iceThicknessMean = totalIceVolume / totalIceArea @@ -473,17 +614,25 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) iceThicknessMean = 0.0_RKIND avgNetAccumulation = 0.0_RKIND endif + if (groundedIceArea > 0.0_RKIND) then avgGroundedBasalMelt = -1.0_RKIND * totalGroundedBasalMassBal / groundedIceArea / rhoi else avgGroundedBasalMelt = 0.0_RKIND endif + if (floatingIceArea > 0.0_RKIND) then avgSubshelfMelt = -1.0_RKIND * totalFloatingBasalMassBal / floatingIceArea / rhoi else avgSubshelfMelt = 0.0_RKIND endif + if (groundedIceArea > 0.0_RKIND) then + avgFlotationFraction = totalFlotationFraction / groundedIceArea + else + avgFlotationFraction = 0.0_RKIND + endif + block => block % next end do From f6f653c24192fbfbc2acf80419540f205db0131d Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Tue, 18 Jul 2023 18:22:18 -0600 Subject: [PATCH 24/94] Fix hydro globalStats bug - protect global stats calcs if SGH disabled Adds conditional statements in mpas_li_global_stats.F to prevent calculating SGH global stats when SGH model is deactivated. --- .../analysis_members/mpas_li_global_stats.F | 209 ++++++++++-------- 1 file changed, 112 insertions(+), 97 deletions(-) diff --git a/components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F b/components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F index eccc6ff36a00..2f9b75440ac4 100755 --- a/components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F +++ b/components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F @@ -183,6 +183,7 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) real (kind=RKIND), dimension(:), pointer :: basalSpeed real (kind=RKIND), dimension(:), pointer :: fluxAcrossGroundingLine real (kind=RKIND), dimension(:), pointer :: groundedToFloatingThickness + real (kind=RKIND), dimension(:), pointer :: waterThickness real (kind=RKIND), dimension(:), pointer :: basalMeltInput real (kind=RKIND), dimension(:), pointer :: externalWaterInput @@ -202,6 +203,7 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) real (kind=RKIND), pointer :: rhoi ! config_ice_density real (kind=RKIND), pointer :: rhow ! config_ocean_density real (kind=RKIND), pointer :: bedBumpMax ! config_SGH_bed_roughness_max + logical, pointer :: config_SGH ! Local counters integer :: k, iCell, iEdge, nCellsGrounded @@ -316,6 +318,7 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) call mpas_pool_get_config(liConfigs, 'config_ice_density', rhoi) call mpas_pool_get_config(liConfigs, 'config_ocean_density', rhow) call mpas_pool_get_config(liConfigs, 'config_SGH_bed_roughness_max', bedBumpMax) + call mpas_pool_get_config(liConfigs, 'config_SGH', config_SGH) ! loop over blocks block => domain % blocklist @@ -349,16 +352,17 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) call mpas_pool_get_array(velocityPool, 'surfaceSpeed', surfaceSpeed) call mpas_pool_get_array(velocityPool, 'basalSpeed', basalSpeed) call mpas_pool_get_array(velocityPool, 'fluxAcrossGroundingLine', fluxAcrossGroundingLine) - call mpas_pool_get_array(hydroPool, 'waterThickness', waterThickness) - call mpas_pool_get_array(hydroPool, 'basalMeltInput', basalMeltInput) - call mpas_pool_get_array(hydroPool, 'externalWaterInput', externalWaterInput) - call mpas_pool_get_array(hydroPool, 'channelMelt', channelMelt) - call mpas_pool_get_array(hydroPool, 'hydroMarineMarginMask', hydroMarineMarginMask) - call mpas_pool_get_array(hydroPool, 'hydroTerrestrialMarginMask', hydroTerrestrialMarginMask) - call mpas_pool_get_array(hydroPool, 'waterFlux', waterFlux) - call mpas_pool_get_array(hydroPool, 'channelDischarge', channelDischarge) - call mpas_pool_get_array(hydroPool, 'waterPressure', waterPressure) - + if (config_SGH) then + call mpas_pool_get_array(hydroPool, 'waterThickness', waterThickness) + call mpas_pool_get_array(hydroPool, 'basalMeltInput', basalMeltInput) + call mpas_pool_get_array(hydroPool, 'externalWaterInput', externalWaterInput) + call mpas_pool_get_array(hydroPool, 'channelMelt', channelMelt) + call mpas_pool_get_array(hydroPool, 'hydroMarineMarginMask', hydroMarineMarginMask) + call mpas_pool_get_array(hydroPool, 'hydroTerrestrialMarginMask', hydroTerrestrialMarginMask) + call mpas_pool_get_array(hydroPool, 'waterFlux', waterFlux) + call mpas_pool_get_array(hydroPool, 'channelDischarge', channelDischarge) + call mpas_pool_get_array(hydroPool, 'waterPressure', waterPressure) + endif ! loop over cells do iCell = 1,nCellsSolve @@ -426,58 +430,61 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) * rhoi / (deltat / scyr) ! convert from m to kg/yr !! Subglacial Hydrology Calculations - - ! Subglacial Water Volume - blockSumSubglacialWaterVolume = blockSumSubglacialWaterVolume + waterThickness(iCell) * areaCell(iCell) - - ! Basal melt input - blockSumBasalMeltInput = blockSumBasalMeltInput + basalMeltInput(iCell) * areaCell(iCell) - - ! External water input - blockSumExternalWaterInput = blockSumExternalWaterInput + externalWaterInput(iCell) * areaCell(iCell) - - ! Lake Volume - if (waterThickness(iCell) > bedBumpMax) then - blockSumLakeVolume = blockSumLakeVolume + (waterThickness(iCell) - bedBumpMax) * areaCell(iCell) - endif - - ! Lake Area - if (waterThickness(iCell) > bedBumpMax) then - blockSumLakeArea = blockSumLakeArea + areaCell(iCell) + if (config_SGH) then + + ! Subglacial Water Volume + blockSumSubglacialWaterVolume = blockSumSubglacialWaterVolume + waterThickness(iCell) * areaCell(iCell) + + ! Basal melt input + blockSumBasalMeltInput = blockSumBasalMeltInput + basalMeltInput(iCell) * areaCell(iCell) + + ! External water input + blockSumExternalWaterInput = blockSumExternalWaterInput + externalWaterInput(iCell) * areaCell(iCell) + + ! Lake Volume + if (waterThickness(iCell) > bedBumpMax) then + blockSumLakeVolume = blockSumLakeVolume + (waterThickness(iCell) - bedBumpMax) * areaCell(iCell) + endif + + ! Lake Area + if (waterThickness(iCell) > bedBumpMax) then + blockSumLakeArea = blockSumLakeArea + areaCell(iCell) + endif + + ! Area-weighted flotation fraction for grounded ice + if (li_mask_is_grounded_ice(cellMask(iCell))) then + blockSumFlotationFraction = blockSumFlotationFraction + ( waterPressure(iCell) / rhow / gravity / thickness(iCell) ) * areaCell(iCell) + endif endif - ! Area-weighted flotation fraction for grounded ice - if (li_mask_is_grounded_ice(cellMask(iCell))) then - blockSumFlotationFraction = blockSumFlotationFraction + ( waterPressure(iCell) / rhow / gravity / thickness(iCell) ) * areaCell(iCell) - endif - end do ! end loop over cells - ! Loop over edges - do iEdge = 1, nEdgesSolve - - ! Flux across GL, units = kg/yr - blockGLflux = blockGLflux + fluxAcrossGroundingLine(iEdge) * dvEdge(iEdge) & - * scyr * rhoi ! convert from m^2/s to kg/yr + if (config_SGH) then + ! Loop over edges + do iEdge = 1, nEdgesSolve - ! Channel Melt - blockSumChannelMelt = blockSumChannelMelt + abs(channelMelt(iEdge) * dcEdge(iEdge)) + ! Flux across GL, units = kg/yr + blockGLflux = blockGLflux + fluxAcrossGroundingLine(iEdge) * dvEdge(iEdge) & + * scyr * rhoi ! convert from m^2/s to kg/yr - ! Meltwater Flux across the grounding line - blockSumGLMeltFlux = blockSumGLMeltFlux + abs(hydroMarineMarginMask(iEdge) * waterFlux(iEdge) * dvEdge(iEdge) * rho_water) + ! Channel Melt + blockSumChannelMelt = blockSumChannelMelt + abs(channelMelt(iEdge) * dcEdge(iEdge)) - ! Meltwater Flux across terrestrial margins - blockSumTerrestrialMeltFlux = blockSumTerrestrialMeltFlux + abs(hydroTerrestrialMarginMask(iEdge) * waterFlux(iEdge) * dvEdge(iEdge) * rho_water) + ! Meltwater Flux across the grounding line + blockSumGLMeltFlux = blockSumGLMeltFlux + abs(hydroMarineMarginMask(iEdge) * waterFlux(iEdge) * dvEdge(iEdge) * rho_water) - ! Meltwater Discharge in channels across grounding line - blockSumChannelGLMeltFlux = blockSumChannelGLMeltFlux + abs(hydroMarineMarginMask(iEdge) * channelDischarge(iEdge) * rho_water) + ! Meltwater Flux across terrestrial margins + blockSumTerrestrialMeltFlux = blockSumTerrestrialMeltFlux + abs(hydroTerrestrialMarginMask(iEdge) * waterFlux(iEdge) * dvEdge(iEdge) * rho_water) - ! Meltwater discharge in channels across terrestrial margin - blockSumChannelTerrestrialMeltFlux = blockSumChannelTerrestrialMeltFlux + abs( hydroTerrestrialMarginMask(iEdge) * channelDischarge(iEdge) * rho_water) + ! Meltwater Discharge in channels across grounding line + blockSumChannelGLMeltFlux = blockSumChannelGLMeltFlux + abs(hydroMarineMarginMask(iEdge) * channelDischarge(iEdge) * rho_water) - end do ! end loop over edges + ! Meltwater discharge in channels across terrestrial margin + blockSumChannelTerrestrialMeltFlux = blockSumChannelTerrestrialMeltFlux + abs( hydroTerrestrialMarginMask(iEdge) * channelDischarge(iEdge) * rho_water) + end do ! end loop over edges + endif block => block % next end do ! end loop over blocks @@ -522,20 +529,24 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) sums(13) = blockSumCalvingFlux sums(14) = blockSumFaceMeltingFlux sums(15) = blockSumVAF - sums(16) = blockGLflux - sums(17) = blockGLMigrationflux - sums(18) = blockSumSubglacialWaterVolume - sums(19) = blockSumBasalMeltInput - sums(20) = blockSumExternalWaterInput - sums(21) = blockSumChannelMelt - sums(22) = blockSumLakeVolume - sums(23) = blockSumLakeArea - sums(24) = blockSumGLMeltFlux - sums(25) = blockSumTerrestrialMeltFlux - sums(26) = blockSumChannelGLMeltFlux - sums(27) = blockSumChannelTerrestrialMeltFlux - sums(28) = blockSumFlotationFraction - nVars = 28 + if (config_SGH) then + sums(16) = blockGLflux + sums(17) = blockGLMigrationflux + sums(18) = blockSumSubglacialWaterVolume + sums(19) = blockSumBasalMeltInput + sums(20) = blockSumExternalWaterInput + sums(21) = blockSumChannelMelt + sums(22) = blockSumLakeVolume + sums(23) = blockSumLakeArea + sums(24) = blockSumGLMeltFlux + sums(25) = blockSumTerrestrialMeltFlux + sums(26) = blockSumChannelGLMeltFlux + sums(27) = blockSumChannelTerrestrialMeltFlux + sums(28) = blockSumFlotationFraction + nVars = 28 + else + nVars = 15 + endif call mpas_dmpar_sum_real_array(dminfo, nVars, sums(1:nVars), reductions(1:nVars)) @@ -562,20 +573,22 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) call mpas_pool_get_array(globalStatsAMPool, 'avgSubshelfMelt', avgSubshelfMelt) call mpas_pool_get_array(globalStatsAMPool, 'totalCalvingFlux', totalCalvingFlux) call mpas_pool_get_array(globalStatsAMPool, 'totalFaceMeltingFlux', totalFaceMeltingFlux) - call mpas_pool_get_array(globalStatsAMPool, 'groundingLineFlux', groundingLineFlux) - call mpas_pool_get_array(globalStatsAMPool, 'groundingLineMigrationFlux', groundingLineMigrationFlux) - call mpas_pool_get_array(globalStatsAMPool, 'totalSubglacialWaterVolume', totalSubglacialWaterVolume) - call mpas_pool_get_array(globalStatsAMPool, 'totalBasalMeltInput', totalBasalMeltInput) - call mpas_pool_get_array(globalStatsAMPool, 'totalExternalWaterInput', totalExternalWaterInput) - call mpas_pool_get_array(globalStatsAMPool, 'totalChannelMelt', totalChannelMelt) - call mpas_pool_get_array(globalStatsAMPool, 'totalLakeVolume', totalLakeVolume) - call mpas_pool_get_array(globalStatsAMPool, 'totalLakeArea', totalLakeArea) - call mpas_pool_get_array(globalStatsAMPool, 'totalGLMeltFlux',totalGLMeltFlux) - call mpas_pool_get_array(globalStatsAMPool, 'totalTerrestrialMeltFlux', totalTerrestrialMeltFlux) - call mpas_pool_get_array(globalStatsAMPool, 'totalChannelGLMeltFlux',totalChannelGLMeltFlux) - call mpas_pool_get_array(globalStatsAMPool, 'totalChannelTerrestrialMeltFlux', totalChannelTerrestrialMeltFlux) - call mpas_pool_get_array(globalStatsAMPool, 'totalFlotationFraction', totalFlotationFraction) - call mpas_pool_get_array(globalStatsAMPool, 'avgFlotationFraction', avgFlotationFraction) + if (config_SGH) then + call mpas_pool_get_array(globalStatsAMPool, 'groundingLineFlux', groundingLineFlux) + call mpas_pool_get_array(globalStatsAMPool, 'groundingLineMigrationFlux', groundingLineMigrationFlux) + call mpas_pool_get_array(globalStatsAMPool, 'totalSubglacialWaterVolume', totalSubglacialWaterVolume) + call mpas_pool_get_array(globalStatsAMPool, 'totalBasalMeltInput', totalBasalMeltInput) + call mpas_pool_get_array(globalStatsAMPool, 'totalExternalWaterInput', totalExternalWaterInput) + call mpas_pool_get_array(globalStatsAMPool, 'totalChannelMelt', totalChannelMelt) + call mpas_pool_get_array(globalStatsAMPool, 'totalLakeVolume', totalLakeVolume) + call mpas_pool_get_array(globalStatsAMPool, 'totalLakeArea', totalLakeArea) + call mpas_pool_get_array(globalStatsAMPool, 'totalGLMeltFlux',totalGLMeltFlux) + call mpas_pool_get_array(globalStatsAMPool, 'totalTerrestrialMeltFlux', totalTerrestrialMeltFlux) + call mpas_pool_get_array(globalStatsAMPool, 'totalChannelGLMeltFlux',totalChannelGLMeltFlux) + call mpas_pool_get_array(globalStatsAMPool, 'totalChannelTerrestrialMeltFlux', totalChannelTerrestrialMeltFlux) + call mpas_pool_get_array(globalStatsAMPool, 'totalFlotationFraction', totalFlotationFraction) + call mpas_pool_get_array(globalStatsAMPool, 'avgFlotationFraction', avgFlotationFraction) + endif totalIceArea = reductions(1) totalIceVolume = reductions(2) @@ -592,20 +605,21 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) totalCalvingFlux = reductions(13) totalFaceMeltingFlux = reductions(14) volumeAboveFloatation = reductions(15) - groundingLineFlux = reductions(16) - groundingLineMigrationFlux = reductions(17) - totalSubglacialWaterVolume = reductions(18) - totalBasalMeltInput = reductions(19) - totalExternalWaterInput = reductions(20) - totalChannelMelt = reductions(21) - totalLakevolume = reductions(22) - totalLakeArea = reductions(23) - totalGLMeltFlux = reductions(24) - totalTerrestrialMeltFlux = reductions(25) - totalChannelGLMeltFlux = reductions(26) - totalChannelTerrestrialMeltFlux = reductions(27) - totalFlotationFraction = reductions(28) - + if (config_SGH) then + groundingLineFlux = reductions(16) + groundingLineMigrationFlux = reductions(17) + totalSubglacialWaterVolume = reductions(18) + totalBasalMeltInput = reductions(19) + totalExternalWaterInput = reductions(20) + totalChannelMelt = reductions(21) + totalLakevolume = reductions(22) + totalLakeArea = reductions(23) + totalGLMeltFlux = reductions(24) + totalTerrestrialMeltFlux = reductions(25) + totalChannelGLMeltFlux = reductions(26) + totalChannelTerrestrialMeltFlux = reductions(27) + totalFlotationFraction = reductions(28) + endif if (totalIceArea > 0.0_RKIND) then iceThicknessMean = totalIceVolume / totalIceArea @@ -626,11 +640,12 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) else avgSubshelfMelt = 0.0_RKIND endif - - if (groundedIceArea > 0.0_RKIND) then - avgFlotationFraction = totalFlotationFraction / groundedIceArea - else - avgFlotationFraction = 0.0_RKIND + if (config_SGH) then + if (groundedIceArea > 0.0_RKIND) then + avgFlotationFraction = totalFlotationFraction / groundedIceArea + else + avgFlotationFraction = 0.0_RKIND + endif endif block => block % next From d31ecb0dddd700b18134ed0d81e1bdc0bcaa472a Mon Sep 17 00:00:00 2001 From: Courtney Shafer Date: Tue, 11 Jul 2023 13:53:38 -0600 Subject: [PATCH 25/94] Add grounded ice mask to BasalMeltInput term The basalMeltInput term was including non-grounded ice in the calculation of the totalBasalMeltInput and giving wrong answers. The mask ensures that only basal melt occurring under grounded ice is considered. --- .../src/analysis_members/mpas_li_global_stats.F | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F b/components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F index 2f9b75440ac4..0579ebe7cde7 100755 --- a/components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F +++ b/components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F @@ -436,7 +436,8 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) blockSumSubglacialWaterVolume = blockSumSubglacialWaterVolume + waterThickness(iCell) * areaCell(iCell) ! Basal melt input - blockSumBasalMeltInput = blockSumBasalMeltInput + basalMeltInput(iCell) * areaCell(iCell) + blockSumBasalMeltInput = blockSumBasalMeltInput + real(li_mask_is_grounded_ice_int(cellMask(iCell)),RKIND) * & + basalMeltInput(iCell) * areaCell(iCell) ! External water input blockSumExternalWaterInput = blockSumExternalWaterInput + externalWaterInput(iCell) * areaCell(iCell) @@ -648,6 +649,8 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) endif endif + + block => block % next end do From 48b1edb27c1a489d991b55ff4c8d78b68ded1bbe Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Sat, 17 Feb 2024 12:49:20 -0700 Subject: [PATCH 26/94] Update variable names and other code review edits --- .../Registry_global_stats.xml | 32 +++++------ .../analysis_members/mpas_li_global_stats.F | 55 +++++++++---------- 2 files changed, 42 insertions(+), 45 deletions(-) diff --git a/components/mpas-albany-landice/src/analysis_members/Registry_global_stats.xml b/components/mpas-albany-landice/src/analysis_members/Registry_global_stats.xml index 74e5875d4dde..50ad79158354 100755 --- a/components/mpas-albany-landice/src/analysis_members/Registry_global_stats.xml +++ b/components/mpas-albany-landice/src/analysis_members/Registry_global_stats.xml @@ -100,14 +100,15 @@ + - - - - - - - - + bedBumpMax) then blockSumLakeVolume = blockSumLakeVolume + (waterThickness(iCell) - bedBumpMax) * areaCell(iCell) endif - + ! Lake Area if (waterThickness(iCell) > bedBumpMax) then blockSumLakeArea = blockSumLakeArea + areaCell(iCell) @@ -581,13 +581,12 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) call mpas_pool_get_array(globalStatsAMPool, 'totalBasalMeltInput', totalBasalMeltInput) call mpas_pool_get_array(globalStatsAMPool, 'totalExternalWaterInput', totalExternalWaterInput) call mpas_pool_get_array(globalStatsAMPool, 'totalChannelMelt', totalChannelMelt) - call mpas_pool_get_array(globalStatsAMPool, 'totalLakeVolume', totalLakeVolume) - call mpas_pool_get_array(globalStatsAMPool, 'totalLakeArea', totalLakeArea) - call mpas_pool_get_array(globalStatsAMPool, 'totalGLMeltFlux',totalGLMeltFlux) - call mpas_pool_get_array(globalStatsAMPool, 'totalTerrestrialMeltFlux', totalTerrestrialMeltFlux) - call mpas_pool_get_array(globalStatsAMPool, 'totalChannelGLMeltFlux',totalChannelGLMeltFlux) - call mpas_pool_get_array(globalStatsAMPool, 'totalChannelTerrestrialMeltFlux', totalChannelTerrestrialMeltFlux) - call mpas_pool_get_array(globalStatsAMPool, 'totalFlotationFraction', totalFlotationFraction) + call mpas_pool_get_array(globalStatsAMPool, 'totalSubglacialLakeVolume', totalSubglacialLakeVolume) + call mpas_pool_get_array(globalStatsAMPool, 'totalSubglacialLakeArea', totalSubglacialLakeArea) + call mpas_pool_get_array(globalStatsAMPool, 'totalDistWaterFluxMarineMargin',totalDistWaterFluxMarineMargin) + call mpas_pool_get_array(globalStatsAMPool, 'totalDistWaterFluxTerrestrialMargin', totalDistWaterFluxTerrestrialMargin) + call mpas_pool_get_array(globalStatsAMPool, 'totalChnlWaterFluxMarineMargin',totalChnlWaterFluxMarineMargin) + call mpas_pool_get_array(globalStatsAMPool, 'totalChnlWaterFluxTerrestrialMargin', totalChnlWaterFluxTerrestrialMargin) call mpas_pool_get_array(globalStatsAMPool, 'avgFlotationFraction', avgFlotationFraction) endif @@ -613,12 +612,12 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) totalBasalMeltInput = reductions(19) totalExternalWaterInput = reductions(20) totalChannelMelt = reductions(21) - totalLakevolume = reductions(22) - totalLakeArea = reductions(23) - totalGLMeltFlux = reductions(24) - totalTerrestrialMeltFlux = reductions(25) - totalChannelGLMeltFlux = reductions(26) - totalChannelTerrestrialMeltFlux = reductions(27) + totalSubglacialLakeVolume = reductions(22) + totalSubglacialLakeArea = reductions(23) + totalDistWaterFluxMarineMargin = reductions(24) + totalDistWaterFluxTerrestrialMargin = reductions(25) + totalChnlWaterFluxMarineMargin = reductions(26) + totalChnlWaterFluxTerrestrialMargin = reductions(27) totalFlotationFraction = reductions(28) endif From 32f22cf5dfd67807a3becdf43e550f17bb918fb0 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Sat, 17 Feb 2024 13:13:39 -0700 Subject: [PATCH 27/94] Correct flotation fraction globalStat to use ice density --- .../src/analysis_members/mpas_li_global_stats.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F b/components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F index fae830930175..2e1d05cbc390 100755 --- a/components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F +++ b/components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F @@ -454,7 +454,7 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) ! Area-weighted flotation fraction for grounded ice if (li_mask_is_grounded_ice(cellMask(iCell))) then - blockSumFlotationFraction = blockSumFlotationFraction + ( waterPressure(iCell) / rhow / gravity / thickness(iCell) ) * areaCell(iCell) + blockSumFlotationFraction = blockSumFlotationFraction + ( waterPressure(iCell) / rhoi / gravity / thickness(iCell) ) * areaCell(iCell) endif endif From 087aace29c8a941147fdedc76a6f00808a9ff06c Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 21 Feb 2024 10:22:35 -0700 Subject: [PATCH 28/94] Improve synchronization of timesteps between MALI and SLM This PR updates handling of timesteps between MALI and the SLM in a few ways: * switch config_slm_coupling_interval to be an integer in years because we only allow integer year values * On init, check that config_adaptive_timestep_force_interval divides evenly into config_slm_coupling_interval * On init, check that restart interval is an even multiple of config_slm_coupling_interval * On a restart, calculate which SLM time level to use based on the elapsed time from the start of the original simulation and config_slm_coupling_interval and make sure these divide cleanly --- .../mpas-albany-landice/src/Registry.xml | 10 +- .../src/mode_forward/mpas_li_bedtopo.F | 232 ++++++++++++++---- 2 files changed, 188 insertions(+), 54 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index c4cd6df05bb9..1c6e0f632985 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -145,13 +145,9 @@ description="Selection of the method for bedrock uplift calculation." possible_values="'none', 'data', 'sealevelmodel'" /> - - \brief Perform various checks on the SLM coupling interval setting +!> \author Matt Hoffman +!> \date Feb 2024 +!> \details +!> This routine checks that the SLM coupling interval is an even multiple +!> of the adaptive timestep force inverval and divides evenly into the +!> restart interval. It also checks that the coupling interval in the MALI +!> matches the value in the SLM namelist. +! +!----------------------------------------------------------------------- + + subroutine check_SLM_coupling_interval(slm_dt1, streamManager, err) + + use mpas_timekeeping + use mpas_stream_manager + use mpas_derived_types, only : MPAS_STREAM_PROPERTY_RECORD_INTV + + integer, intent (in) :: slm_dt1 + type (MPAS_streamManager_type), intent(inout) :: streamManager + integer, intent(out) :: err + + ! local variables + integer, pointer :: config_slm_coupling_interval + character (len=StrKIND), pointer :: config_adaptive_timestep_force_interval + type (MPAS_Time_Type) :: force_interval, restart_interval + character(len=StrKIND) :: restart_interval_str + integer :: YYYY, MM, DD, H, M, S ! time components + type (MPAS_stream_list_type), pointer :: stream_cursor + integer :: err_tmp + + err = 0 + + ! First, check consistency in coupling interval set up in MALI and SLM + call mpas_pool_get_config(liConfigs, "config_slm_coupling_interval", config_slm_coupling_interval) + if (config_slm_coupling_interval /= slm_dt1) then + call mpas_log_write("The coupling interval in MALI and SLM settings are inconsistent", MPAS_LOG_ERR) + err = ior(err,1) + endif + + ! Check that config_adaptive_timestep_force_interval divides evenly into config_slm_coupling_interval + call mpas_pool_get_config(liConfigs, "config_adaptive_timestep_force_interval", config_adaptive_timestep_force_interval) + ! Note: Using mpas_set_time instead of mpas_set_time_interval, even though this is an interval + ! This is because mpas_get_time_interval requires a reference time, which is not relevant + ! to these checks, and mpas_get_time allows us to get the component pieces that we want to check. + call mpas_set_time(force_interval, dateTimeString=config_adaptive_timestep_force_interval, ierr=err_tmp) + err = ior(err, err_tmp) + call mpas_get_time(force_interval, YYYY=YYYY, MM=MM, DD=DD, H=H, M=M, S=S) + if ((MM /= 0) .or. (DD /= 0) .or. (H /= 0) .or. (M /= 0) .or. (S /= 0)) then + call mpas_log_write("config_adaptive_timestep_force_interval currently not supported " // & + "to have nonzero values for months, days, hours, minutes, or seconds when sea-level model " // & + "is coupled. config_adaptive_timestep_force_interval=" //trim(config_adaptive_timestep_force_interval), MPAS_LOG_ERR) + ! Note: the actual requirement is that adapt dt force interval divides evenly into coupling interval + ! but that is tricky to check, and wanting anything but even years for that option is a rare use case. + err = ior(err, 1) + endif + ! Next check the number of years divides evenly into SLM coupling interval + if (mod(config_slm_coupling_interval, YYYY) /= 0) then + call mpas_log_write("config_adaptive_timestep_force_interval does not divide evenly into config_slm_coupling_interval" // & + "config_adaptive_timestep_force_interval=" // trim(config_adaptive_timestep_force_interval) // & + "; config_slm_coupling_interval=$i", MPAS_LOG_ERR, intArgs=(/config_slm_coupling_interval/)) + err = ior(err, 1) + endif + + ! Now check that restart interval is an even multiple of coupling interval + stream_cursor => streamManager % streams % head + do while (associated(stream_cursor)) + if ( trim(stream_cursor % name) == 'restart' .and. (stream_cursor % valid) ) then + call MPAS_stream_mgr_get_property(streamManager, 'restart', MPAS_STREAM_PROPERTY_RECORD_INTV, & + restart_interval_str, ierr=err_tmp) + err = ior(err, err_tmp) + + call mpas_log_write('restart interval is: ' //trim(restart_interval_str)) + + call mpas_set_time(restart_interval, dateTimeString=restart_interval_str, ierr=err_tmp) + err = ior(err, err_tmp) + call mpas_get_time(restart_interval, YYYY=YYYY, MM=MM, DD=DD, H=H, M=M, S=S) + if ((MM /= 0) .or. (DD /= 0) .or. (H /= 0) .or. (M /= 0) .or. (S /= 0)) then + call mpas_log_write("If Sea Level Model is active, restart output_interval cannot include " // & + "nonzero months, days, hours, minutes or seconds. restart output_interval=" // & + trim(restart_interval_str), MPAS_LOG_ERR) + endif + err = ior(err, 1) + + if (mod(YYYY, config_slm_coupling_interval) /= 0) then + call mpas_log_write("restart output_interval must be a multiple of config_slm_coupling_interval", MPAS_LOG_ERR) + err = ior(err, 1) + endif + + endif + enddo + + !-------------------------------------------------------------------- + end subroutine check_SLM_coupling_interval + + +!*********************************************************************** +! +! routine find_slm_restart_timestep +! +!> \brief Perform various checks on the SLM coupling interval setting +!> \author Matt Hoffman +!> \date Feb 2024 +!> \details +!> This routine checks that the SLM coupling interval is an even multiple +!> of the adaptive timestep force inverval and divides evenly into the +!> restart interval. It also checks that the coupling interval in the MALI +!> matches the value in the SLM namelist. +! +!----------------------------------------------------------------------- + + subroutine find_slm_restart_timestep(meshPool, slmTimeStep, err) + + use mpas_timekeeping + + type (mpas_pool_type), intent(in) :: meshPool !< mesh information + integer, intent(out) :: slmTimeStep + integer, intent(out) :: err + + ! local vars + integer, pointer :: config_slm_coupling_interval + character (len=StrKIND), pointer :: xtime, simulationStartTime + character (len=StrKIND) :: elapsed_time_str + type (MPAS_Time_Type) :: start_time, curr_time + type (MPAS_Time_Type) :: elapsed_time ! should be a time interval but not possible to get years that way + integer :: YYYY, MM, DD, H, M, S ! time components + integer :: err_tmp + + err = 0 + + slmTimeStep = -999 ! initialize to bad number + + call mpas_pool_get_config(liConfigs, "config_slm_coupling_interval", config_slm_coupling_interval) + + call mpas_pool_get_array(meshPool, 'simulationStartTime', simulationStartTime) + call mpas_pool_get_array(meshPool, 'xtime', xtime) + call mpas_set_time(start_time, dateTimeString=simulationStartTime, ierr=err_tmp) + err = ior(err, err_tmp) + call mpas_set_time(curr_time, dateTimeString=xtime, ierr=err_tmp) + err = ior(err, err_tmp) + call mpas_get_timeInterval(curr_time - start_time, start_time, timeString=elapsed_time_str, ierr=err_tmp) + err = ior(err, err_tmp) + + ! convert elapsed time string to its units. Using the intermediate string format because mpas_get_timeInterval doesn't return + ! years, and figuring out years from days depends on the calendar + call mpas_set_time(elapsed_time, dateTimeString=elapsed_time_str, ierr=err_tmp) + err = ior(err, err_tmp) + call mpas_get_time(elapsed_time, YYYY=YYYY, MM=MM, DD=DD, H=H, M=M, S=S) + + ! make sure the elapsed time is an even year + if ((MM /= 0) .or. (DD /= 0) .or. (H /= 0) .or. (M /= 0) .or. (S /= 0)) then + call mpas_log_write("Elapsed time since simulationStartTime include nonzero months, days, hours, minutes, " // & + "or seconds.", MPAS_LOG_ERR) + err = ior(err, 1) + endif + + if (mod(YYYY, config_slm_coupling_interval) == 0) then + ! We can restart cleanly + slmTimeStep = YYYY / config_slm_coupling_interval + else + call mpas_log_write("Elapsed years since simulationStartTime is not evenly divisible by config_slm_coupling_interval." // & + " Unable to restart Sea Level Model cleanly.", MPAS_LOG_ERR) + err = ior(err, 1) + endif + + !-------------------------------------------------------------------- + end subroutine find_slm_restart_timestep + !*********************************************************************** end module li_bedtopo From 55e579bfe8ade495499de24aa3922bc3f4c59989 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 21 Feb 2024 12:19:20 -0700 Subject: [PATCH 29/94] Improve error handling, correct other usage of config_uplift_method Also add missing =>next pointer assignment to keep code from hanging --- .../src/mode_forward/mpas_li_bedtopo.F | 42 +++++++++++++------ .../src/mode_forward/mpas_li_core.F | 11 ++--- 2 files changed, 35 insertions(+), 18 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F index 9a5cc0ad32aa..b9a09ed5f9ce 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F @@ -115,6 +115,7 @@ subroutine li_bedtopo_init(domain, err) !----------------------------------------------------------------- character (len=StrKIND), pointer :: config_uplift_method + integer :: err_tmp ! No init is needed. err = 0 @@ -122,7 +123,12 @@ subroutine li_bedtopo_init(domain, err) call mpas_pool_get_config(liConfigs, 'config_uplift_method', config_uplift_method) if (trim(config_uplift_method)=='sealevelmodel') then ! initialize the 1D sea-level model if fresh start - call slmodel_init(domain, err) + call slmodel_init(domain, err_tmp) + err = ior(err, err_tmp) + + if (err /= 0) then + call mpas_log_write('Error in li_bedtopo_init', MPAS_LOG_ERR) + endif endif !-------------------------------------------------------------------- @@ -445,7 +451,7 @@ subroutine slmodel_init(domain, err) call check_SLM_coupling_interval(dtime, domain % streamManager, err_tmp) err = ior(err, err_tmp) if (err /= 0) then - return + call mpas_log_write("Error occurred in check_SLM_coupling_interval.", MPAS_LOG_ERR) endif ! Set Displacement variable for GATHERV command @@ -473,8 +479,10 @@ subroutine slmodel_init(domain, err) call find_slm_restart_timestep(meshPool, slmTimeStep, err_tmp) err = ior(err, err_tmp) - call mpas_log_write("Calling the SLM. SLM timestep $i", intArgs=(/slmTimeStep/)) - call slmodel_solve(slmTimeStep, domain) + if (err == 0) then + call mpas_log_write("Calling the SLM. SLM timestep $i", intArgs=(/slmTimeStep/)) + call slmodel_solve(slmTimeStep, domain) + endif else @@ -532,11 +540,13 @@ subroutine slmodel_init(domain, err) slmTimeStep = 0 ! series of calling SLM routines - call sl_call_readnl - call sl_solver_checkpoint(itersl, dtime) - call sl_timewindow(slmTimeStep) - call sl_solver_init(itersl, starttime, ismIceload, ismBedtopo, ismMask) - call sl_deallocate_array + if (err == 0) then + call sl_call_readnl + call sl_solver_checkpoint(itersl, dtime) + call sl_timewindow(slmTimeStep) + call sl_solver_init(itersl, starttime, ismIceload, ismBedtopo, ismMask) + call sl_deallocate_array + endif endif deallocate(globalArrayThickness) @@ -995,12 +1005,14 @@ subroutine check_SLM_coupling_interval(slm_dt1, streamManager, err) integer :: err_tmp err = 0 + err_tmp = 0 ! First, check consistency in coupling interval set up in MALI and SLM call mpas_pool_get_config(liConfigs, "config_slm_coupling_interval", config_slm_coupling_interval) if (config_slm_coupling_interval /= slm_dt1) then - call mpas_log_write("The coupling interval in MALI and SLM settings are inconsistent", MPAS_LOG_ERR) - err = ior(err,1) + call mpas_log_write("The coupling interval in MALI ($i) and SLM ($i) are inconsistent", MPAS_LOG_ERR, & + intArgs=(/config_slm_coupling_interval, slm_dt1/)) + err = ior(err, 1) endif ! Check that config_adaptive_timestep_force_interval divides evenly into config_slm_coupling_interval @@ -1015,6 +1027,7 @@ subroutine check_SLM_coupling_interval(slm_dt1, streamManager, err) call mpas_log_write("config_adaptive_timestep_force_interval currently not supported " // & "to have nonzero values for months, days, hours, minutes, or seconds when sea-level model " // & "is coupled. config_adaptive_timestep_force_interval=" //trim(config_adaptive_timestep_force_interval), MPAS_LOG_ERR) + call mpas_log_write(" MM=$i, DD=$i, H=$i, M=$i, S=$i", intArgs=(/MM, DD, H, M, S/)) ! Note: the actual requirement is that adapt dt force interval divides evenly into coupling interval ! but that is tricky to check, and wanting anything but even years for that option is a rare use case. err = ior(err, 1) @@ -1030,7 +1043,8 @@ subroutine check_SLM_coupling_interval(slm_dt1, streamManager, err) ! Now check that restart interval is an even multiple of coupling interval stream_cursor => streamManager % streams % head do while (associated(stream_cursor)) - if ( trim(stream_cursor % name) == 'restart' .and. (stream_cursor % valid) ) then + if ( trim(stream_cursor % name) == 'restart' .and. (stream_cursor % active_stream) ) then + call mpas_log_write("Checking restart interval against SLM coulping interval") call MPAS_stream_mgr_get_property(streamManager, 'restart', MPAS_STREAM_PROPERTY_RECORD_INTV, & restart_interval_str, ierr=err_tmp) err = ior(err, err_tmp) @@ -1044,8 +1058,8 @@ subroutine check_SLM_coupling_interval(slm_dt1, streamManager, err) call mpas_log_write("If Sea Level Model is active, restart output_interval cannot include " // & "nonzero months, days, hours, minutes or seconds. restart output_interval=" // & trim(restart_interval_str), MPAS_LOG_ERR) + err = ior(err, 1) endif - err = ior(err, 1) if (mod(YYYY, config_slm_coupling_interval) /= 0) then call mpas_log_write("restart output_interval must be a multiple of config_slm_coupling_interval", MPAS_LOG_ERR) @@ -1053,6 +1067,8 @@ subroutine check_SLM_coupling_interval(slm_dt1, streamManager, err) endif endif + + stream_cursor => stream_cursor % next enddo !-------------------------------------------------------------------- diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_core.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_core.F index 10ee1e94b305..146b4e36d805 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_core.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_core.F @@ -338,8 +338,8 @@ function li_core_init(domain, startTimeStamp) result(err) ! === call li_velocity_external_write_albany_mesh(domain) - call mpas_dmpar_max_int(domain % dminfo, err, globalErr) ! Find out if any blocks got an error - if (globalErr > 0) then + call mpas_dmpar_max_int(domain % dminfo, abs(err), globalErr) ! Find out if any blocks got an error + if (globalErr /= 0) then call mpas_log_write("An error has occurred in li_core_init. Aborting...", MPAS_LOG_CRIT) endif @@ -1111,7 +1111,8 @@ subroutine li_simulation_clock_init(core_clock, configs, ierr) character (len=StrKIND), pointer :: config_dt ! MPAS LI-specific config option character (len=StrKIND), pointer :: config_adaptive_timestep_force_interval ! MPAS LI-specific config option character (len=StrKIND), pointer :: config_restart_timestamp_name - character (len=StrKIND), pointer :: config_uplift_method, config_slm_coupling_interval + character (len=StrKIND), pointer :: config_uplift_method + integer, pointer :: config_slm_coupling_interval character (len=StrKIND) :: restartTimeStamp !< string to be read from file integer, pointer :: config_year_digits integer :: err_tmp @@ -1197,7 +1198,7 @@ subroutine li_simulation_clock_init(core_clock, configs, ierr) ! Set up the coupling time interval if MALI is coupled to sea-level model if (trim(config_uplift_method) == "sealevelmodel") then - call mpas_set_timeInterval(slm_coupling_interval, timeString=config_slm_coupling_interval, ierr=err_tmp) + call mpas_set_timeInterval(slm_coupling_interval, YY=config_slm_coupling_interval, ierr=err_tmp) ierr = ior(ierr,err_tmp) call mpas_add_clock_alarm(core_clock, 'slmCouplingInterval', alarmTime=startTime, & alarmTimeInterval=slm_coupling_interval, ierr=err_tmp) @@ -1210,7 +1211,7 @@ subroutine li_simulation_clock_init(core_clock, configs, ierr) endif ! === error check - if (ierr > 0) then + if (ierr /= 0) then call mpas_log_write("An error has occurred in li_simulation_clock_init.", MPAS_LOG_ERR) endif From 32ff9f8e24f32a2b4a768d526397751e41f25357 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 21 Feb 2024 13:17:55 -0700 Subject: [PATCH 30/94] Update checks using interval division Trying to cast intervals into dateTimeStrings did not work. --- .../src/mode_forward/mpas_li_bedtopo.F | 75 ++++++++----------- 1 file changed, 33 insertions(+), 42 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F index b9a09ed5f9ce..dbdcb43d3aa5 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F @@ -448,7 +448,7 @@ subroutine slmodel_init(domain, err) call sl_drive_readnl(itersl, dtime, starttime) !SLM subroutine ! First, check consistency in coupling interval set up in MALI and SLM - call check_SLM_coupling_interval(dtime, domain % streamManager, err_tmp) + call check_SLM_coupling_interval(dtime, meshPool, domain % streamManager, err_tmp) err = ior(err, err_tmp) if (err /= 0) then call mpas_log_write("Error occurred in check_SLM_coupling_interval.", MPAS_LOG_ERR) @@ -985,23 +985,27 @@ end subroutine check ! !----------------------------------------------------------------------- - subroutine check_SLM_coupling_interval(slm_dt1, streamManager, err) + subroutine check_SLM_coupling_interval(slm_dt1, meshPool, streamManager, err) use mpas_timekeeping use mpas_stream_manager use mpas_derived_types, only : MPAS_STREAM_PROPERTY_RECORD_INTV integer, intent (in) :: slm_dt1 + type (mpas_pool_type), intent(in) :: meshPool !< mesh information type (MPAS_streamManager_type), intent(inout) :: streamManager integer, intent(out) :: err ! local variables integer, pointer :: config_slm_coupling_interval character (len=StrKIND), pointer :: config_adaptive_timestep_force_interval - type (MPAS_Time_Type) :: force_interval, restart_interval - character(len=StrKIND) :: restart_interval_str + type (MPAS_TimeInterval_Type) :: coupling_interval, force_interval, restart_interval, zero_interval + type (MPAS_Time_Type) :: start_time + character (len=StrKIND), pointer :: simulationStartTime integer :: YYYY, MM, DD, H, M, S ! time components type (MPAS_stream_list_type), pointer :: stream_cursor + integer (kind=I8KIND) :: n_intervals + type (MPAS_TimeInterval_type) :: remainder integer :: err_tmp err = 0 @@ -1015,28 +1019,26 @@ subroutine check_SLM_coupling_interval(slm_dt1, streamManager, err) err = ior(err, 1) endif + ! define zero interval for comparing against below + call mpas_set_timeInterval(zero_interval, dt = 0.0_RKIND) + ! get start time as a reference time + call mpas_pool_get_array(meshPool, 'simulationStartTime', simulationStartTime) + call mpas_set_time(start_time, dateTimeString=simulationStartTime) + ! define SLM coupling interval as a timeInterval type + call mpas_set_timeInterval(coupling_interval, YY=config_slm_coupling_interval, MM=0, DD=0, H=0, M=0, S=0, ierr=err_tmp) + err = ior(err, err_tmp) + ! Check that config_adaptive_timestep_force_interval divides evenly into config_slm_coupling_interval call mpas_pool_get_config(liConfigs, "config_adaptive_timestep_force_interval", config_adaptive_timestep_force_interval) - ! Note: Using mpas_set_time instead of mpas_set_time_interval, even though this is an interval - ! This is because mpas_get_time_interval requires a reference time, which is not relevant - ! to these checks, and mpas_get_time allows us to get the component pieces that we want to check. - call mpas_set_time(force_interval, dateTimeString=config_adaptive_timestep_force_interval, ierr=err_tmp) + call mpas_set_timeInterval(force_interval, timeString=config_adaptive_timestep_force_interval, ierr=err_tmp) err = ior(err, err_tmp) - call mpas_get_time(force_interval, YYYY=YYYY, MM=MM, DD=DD, H=H, M=M, S=S) - if ((MM /= 0) .or. (DD /= 0) .or. (H /= 0) .or. (M /= 0) .or. (S /= 0)) then - call mpas_log_write("config_adaptive_timestep_force_interval currently not supported " // & - "to have nonzero values for months, days, hours, minutes, or seconds when sea-level model " // & - "is coupled. config_adaptive_timestep_force_interval=" //trim(config_adaptive_timestep_force_interval), MPAS_LOG_ERR) - call mpas_log_write(" MM=$i, DD=$i, H=$i, M=$i, S=$i", intArgs=(/MM, DD, H, M, S/)) - ! Note: the actual requirement is that adapt dt force interval divides evenly into coupling interval - ! but that is tricky to check, and wanting anything but even years for that option is a rare use case. - err = ior(err, 1) - endif - ! Next check the number of years divides evenly into SLM coupling interval - if (mod(config_slm_coupling_interval, YYYY) /= 0) then - call mpas_log_write("config_adaptive_timestep_force_interval does not divide evenly into config_slm_coupling_interval" // & - "config_adaptive_timestep_force_interval=" // trim(config_adaptive_timestep_force_interval) // & - "; config_slm_coupling_interval=$i", MPAS_LOG_ERR, intArgs=(/config_slm_coupling_interval/)) + call mpas_interval_division(start_time, coupling_interval, force_interval, n_intervals, remainder) + if (remainder .EQ. zero_interval) then + call mpas_log_write("config_adaptive_timestep_force_interval divides into config_slm_coupling_interval $i times " // & + "with no remainder - check passes", intArgs=(/int(n_intervals)/)) + else + call mpas_log_write("config_adaptive_timestep_force_interval divides into config_slm_coupling_interval $i times " // & + "with nonzero remainder", MPAS_LOG_ERR, intArgs=(/int(n_intervals)/)) err = ior(err, 1) endif @@ -1045,27 +1047,16 @@ subroutine check_SLM_coupling_interval(slm_dt1, streamManager, err) do while (associated(stream_cursor)) if ( trim(stream_cursor % name) == 'restart' .and. (stream_cursor % active_stream) ) then call mpas_log_write("Checking restart interval against SLM coulping interval") - call MPAS_stream_mgr_get_property(streamManager, 'restart', MPAS_STREAM_PROPERTY_RECORD_INTV, & - restart_interval_str, ierr=err_tmp) - err = ior(err, err_tmp) - - call mpas_log_write('restart interval is: ' //trim(restart_interval_str)) - - call mpas_set_time(restart_interval, dateTimeString=restart_interval_str, ierr=err_tmp) + restart_interval = MPAS_stream_mgr_get_stream_interval(streamManager, 'restart', MPAS_STREAM_OUTPUT, ierr=err_tmp) err = ior(err, err_tmp) - call mpas_get_time(restart_interval, YYYY=YYYY, MM=MM, DD=DD, H=H, M=M, S=S) - if ((MM /= 0) .or. (DD /= 0) .or. (H /= 0) .or. (M /= 0) .or. (S /= 0)) then - call mpas_log_write("If Sea Level Model is active, restart output_interval cannot include " // & - "nonzero months, days, hours, minutes or seconds. restart output_interval=" // & - trim(restart_interval_str), MPAS_LOG_ERR) - err = ior(err, 1) + call mpas_interval_division(start_time, restart_interval, coupling_interval, n_intervals, remainder) + if (remainder .EQ. zero_interval) then + call mpas_log_write("config_slm_coupling_interval divides into restart interval $i times " // & + "with no remainder - check passes", intArgs=(/int(n_intervals)/)) + else + call mpas_log_write("config_slm_coupling_interval divides into restart interval $i times " // & + "with nonzero remainder", MPAS_LOG_ERR, intArgs=(/int(n_intervals)/)) endif - - if (mod(YYYY, config_slm_coupling_interval) /= 0) then - call mpas_log_write("restart output_interval must be a multiple of config_slm_coupling_interval", MPAS_LOG_ERR) - err = ior(err, 1) - endif - endif stream_cursor => stream_cursor % next From 869f944989932fb7b33822a2735fd70d5cf61cae Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 21 Feb 2024 13:35:41 -0700 Subject: [PATCH 31/94] Adjust check if adaptive dt is on or not --- .../src/mode_forward/mpas_li_bedtopo.F | 50 ++++++++++++++----- 1 file changed, 37 insertions(+), 13 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F index dbdcb43d3aa5..facbf8e9d6d7 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F @@ -998,8 +998,9 @@ subroutine check_SLM_coupling_interval(slm_dt1, meshPool, streamManager, err) ! local variables integer, pointer :: config_slm_coupling_interval - character (len=StrKIND), pointer :: config_adaptive_timestep_force_interval - type (MPAS_TimeInterval_Type) :: coupling_interval, force_interval, restart_interval, zero_interval + logical, pointer :: config_adaptive_timestep + character (len=StrKIND), pointer :: config_adaptive_timestep_force_interval, config_dt + type (MPAS_TimeInterval_Type) :: coupling_interval, force_interval, dt_interval, restart_interval, zero_interval type (MPAS_Time_Type) :: start_time character (len=StrKIND), pointer :: simulationStartTime integer :: YYYY, MM, DD, H, M, S ! time components @@ -1011,10 +1012,15 @@ subroutine check_SLM_coupling_interval(slm_dt1, meshPool, streamManager, err) err = 0 err_tmp = 0 + call mpas_log_write("") + call mpas_log_write("-- Checking consistency of config_slm_coupling_interval and other settings --") + ! First, check consistency in coupling interval set up in MALI and SLM call mpas_pool_get_config(liConfigs, "config_slm_coupling_interval", config_slm_coupling_interval) - if (config_slm_coupling_interval /= slm_dt1) then - call mpas_log_write("The coupling interval in MALI ($i) and SLM ($i) are inconsistent", MPAS_LOG_ERR, & + if (config_slm_coupling_interval == slm_dt1) then + call mpas_log_write("The coupling interval in MALI ($i yr) and SLM ($i yr) are consistent - check passes") + else + call mpas_log_write("The coupling interval in MALI ($i yr) and SLM ($i yr) are inconsistent", MPAS_LOG_ERR, & intArgs=(/config_slm_coupling_interval, slm_dt1/)) err = ior(err, 1) endif @@ -1028,18 +1034,35 @@ subroutine check_SLM_coupling_interval(slm_dt1, meshPool, streamManager, err) call mpas_set_timeInterval(coupling_interval, YY=config_slm_coupling_interval, MM=0, DD=0, H=0, M=0, S=0, ierr=err_tmp) err = ior(err, err_tmp) - ! Check that config_adaptive_timestep_force_interval divides evenly into config_slm_coupling_interval - call mpas_pool_get_config(liConfigs, "config_adaptive_timestep_force_interval", config_adaptive_timestep_force_interval) - call mpas_set_timeInterval(force_interval, timeString=config_adaptive_timestep_force_interval, ierr=err_tmp) - err = ior(err, err_tmp) - call mpas_interval_division(start_time, coupling_interval, force_interval, n_intervals, remainder) - if (remainder .EQ. zero_interval) then - call mpas_log_write("config_adaptive_timestep_force_interval divides into config_slm_coupling_interval $i times " // & + call mpas_pool_get_config(liConfigs, "config_adaptive_timestep", config_adaptive_timestep) + if (config_adaptive_timestep) then + ! for adaptive dt, check that config_adaptive_timestep_force_interval divides evenly into config_slm_coupling_interval + call mpas_pool_get_config(liConfigs, "config_adaptive_timestep_force_interval", config_adaptive_timestep_force_interval) + call mpas_set_timeInterval(force_interval, timeString=config_adaptive_timestep_force_interval, ierr=err_tmp) + err = ior(err, err_tmp) + call mpas_interval_division(start_time, coupling_interval, force_interval, n_intervals, remainder) + if (remainder .EQ. zero_interval) then + call mpas_log_write("config_adaptive_timestep_force_interval divides into config_slm_coupling_interval $i times " // & "with no remainder - check passes", intArgs=(/int(n_intervals)/)) + else + call mpas_log_write("config_adaptive_timestep_force_interval divides into config_slm_coupling_interval $i times " // & + "with nonzero remainder", MPAS_LOG_ERR, intArgs=(/int(n_intervals)/)) + err = ior(err, 1) + endif else - call mpas_log_write("config_adaptive_timestep_force_interval divides into config_slm_coupling_interval $i times " // & + ! For fixed dt, check that dt divides evenly into config_slm_coupling_interval + call mpas_pool_get_config(liConfigs, "config_dt", config_dt) + call mpas_set_timeInterval(dt_interval, timeString=config_dt, ierr=err_tmp) + err = ior(err, err_tmp) + call mpas_interval_division(start_time, coupling_interval, dt_interval, n_intervals, remainder) + if (remainder .EQ. zero_interval) then + call mpas_log_write("config_dt divides into config_slm_coupling_interval $i times " // & + "with no remainder - check passes", intArgs=(/int(n_intervals)/)) + else + call mpas_log_write("config_dt divides into config_slm_coupling_interval $i times " // & "with nonzero remainder", MPAS_LOG_ERR, intArgs=(/int(n_intervals)/)) - err = ior(err, 1) + err = ior(err, 1) + endif endif ! Now check that restart interval is an even multiple of coupling interval @@ -1061,6 +1084,7 @@ subroutine check_SLM_coupling_interval(slm_dt1, meshPool, streamManager, err) stream_cursor => stream_cursor % next enddo + call mpas_log_write("") !-------------------------------------------------------------------- end subroutine check_SLM_coupling_interval From a4d0d68995bcc4ca94d12c4b780640e874a3ad66 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 21 Feb 2024 13:48:16 -0700 Subject: [PATCH 32/94] Update restart check to also use time interval division --- .../src/mode_forward/mpas_li_bedtopo.F | 43 ++++++++----------- 1 file changed, 18 insertions(+), 25 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F index facbf8e9d6d7..24fee4d71a22 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F @@ -1116,17 +1116,20 @@ subroutine find_slm_restart_timestep(meshPool, slmTimeStep, err) ! local vars integer, pointer :: config_slm_coupling_interval character (len=StrKIND), pointer :: xtime, simulationStartTime - character (len=StrKIND) :: elapsed_time_str + type (MPAS_TimeInterval_Type) :: coupling_interval, zero_interval type (MPAS_Time_Type) :: start_time, curr_time - type (MPAS_Time_Type) :: elapsed_time ! should be a time interval but not possible to get years that way - integer :: YYYY, MM, DD, H, M, S ! time components + integer (kind=I8KIND) :: n_intervals + type (MPAS_TimeInterval_type) :: remainder integer :: err_tmp err = 0 - - slmTimeStep = -999 ! initialize to bad number + err_tmp = 0 call mpas_pool_get_config(liConfigs, "config_slm_coupling_interval", config_slm_coupling_interval) + ! define SLM coupling interval as a timeInterval type + call mpas_set_timeInterval(coupling_interval, YY=config_slm_coupling_interval, MM=0, DD=0, H=0, M=0, S=0, ierr=err_tmp) + err = ior(err, err_tmp) + call mpas_pool_get_array(meshPool, 'simulationStartTime', simulationStartTime) call mpas_pool_get_array(meshPool, 'xtime', xtime) @@ -1134,30 +1137,20 @@ subroutine find_slm_restart_timestep(meshPool, slmTimeStep, err) err = ior(err, err_tmp) call mpas_set_time(curr_time, dateTimeString=xtime, ierr=err_tmp) err = ior(err, err_tmp) - call mpas_get_timeInterval(curr_time - start_time, start_time, timeString=elapsed_time_str, ierr=err_tmp) - err = ior(err, err_tmp) - - ! convert elapsed time string to its units. Using the intermediate string format because mpas_get_timeInterval doesn't return - ! years, and figuring out years from days depends on the calendar - call mpas_set_time(elapsed_time, dateTimeString=elapsed_time_str, ierr=err_tmp) - err = ior(err, err_tmp) - call mpas_get_time(elapsed_time, YYYY=YYYY, MM=MM, DD=DD, H=H, M=M, S=S) - - ! make sure the elapsed time is an even year - if ((MM /= 0) .or. (DD /= 0) .or. (H /= 0) .or. (M /= 0) .or. (S /= 0)) then - call mpas_log_write("Elapsed time since simulationStartTime include nonzero months, days, hours, minutes, " // & - "or seconds.", MPAS_LOG_ERR) - err = ior(err, 1) - endif - if (mod(YYYY, config_slm_coupling_interval) == 0) then - ! We can restart cleanly - slmTimeStep = YYYY / config_slm_coupling_interval + call mpas_interval_division(start_time, curr_time - start_time, coupling_interval, n_intervals, remainder) + call mpas_set_timeInterval(zero_interval, dt = 0.0_RKIND) + if (remainder .EQ. zero_interval) then + call mpas_log_write("SLM Restart check: config_slm_coupling_interval divides into elapsed time $i times " // & + "with no remainder - check passes", intArgs=(/int(n_intervals)/)) + slmTimeStep = int(n_intervals) else - call mpas_log_write("Elapsed years since simulationStartTime is not evenly divisible by config_slm_coupling_interval." // & - " Unable to restart Sea Level Model cleanly.", MPAS_LOG_ERR) + call mpas_log_write("SLM Restart check: config_slm_coupling_interval divides into elapsed time $i times " // & + "with nonzero remainder", MPAS_LOG_ERR, intArgs=(/int(n_intervals)/)) err = ior(err, 1) + slmTimeStep = -999 endif + call mpas_log_write("") !-------------------------------------------------------------------- end subroutine find_slm_restart_timestep From a3c43371b118fc9b14ad66e36a4aad1b7b06427a Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Wed, 21 Feb 2024 13:57:09 -0700 Subject: [PATCH 33/94] Add missing arguments to log write statement --- .../mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F index 24fee4d71a22..aacfbed95ad3 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F @@ -1018,7 +1018,8 @@ subroutine check_SLM_coupling_interval(slm_dt1, meshPool, streamManager, err) ! First, check consistency in coupling interval set up in MALI and SLM call mpas_pool_get_config(liConfigs, "config_slm_coupling_interval", config_slm_coupling_interval) if (config_slm_coupling_interval == slm_dt1) then - call mpas_log_write("The coupling interval in MALI ($i yr) and SLM ($i yr) are consistent - check passes") + call mpas_log_write("The coupling interval in MALI ($i yr) and SLM ($i yr) are consistent - check passes", & + intArgs=(/config_slm_coupling_interval, slm_dt1/)) else call mpas_log_write("The coupling interval in MALI ($i yr) and SLM ($i yr) are inconsistent", MPAS_LOG_ERR, & intArgs=(/config_slm_coupling_interval, slm_dt1/)) From c692d660715f555fdb70014cb7febe138b8763ea Mon Sep 17 00:00:00 2001 From: Andrew Nolan Date: Wed, 21 Feb 2024 16:41:27 -0700 Subject: [PATCH 34/94] Add support for subglacial hydro quantities in regional stats. Following the recent addition of subglacial hydro quantities to the global stats analysis member, we've used those additions as template to add the quantitites to the regional stats analysis member. --- .../Registry_regional_stats.xml | 35 +++ .../analysis_members/mpas_li_regional_stats.F | 207 +++++++++++++++++- 2 files changed, 238 insertions(+), 4 deletions(-) diff --git a/components/mpas-albany-landice/src/analysis_members/Registry_regional_stats.xml b/components/mpas-albany-landice/src/analysis_members/Registry_regional_stats.xml index 7ae1f284d1de..8434ff36a818 100644 --- a/components/mpas-albany-landice/src/analysis_members/Registry_regional_stats.xml +++ b/components/mpas-albany-landice/src/analysis_members/Registry_regional_stats.xml @@ -103,6 +103,41 @@ description="maximum basal speed in the domain" /> + + + + + + + + + + + + + diff --git a/components/mpas-albany-landice/src/analysis_members/mpas_li_regional_stats.F b/components/mpas-albany-landice/src/analysis_members/mpas_li_regional_stats.F index 0f544b4b47a6..be9b5c8a2553 100644 --- a/components/mpas-albany-landice/src/analysis_members/mpas_li_regional_stats.F +++ b/components/mpas-albany-landice/src/analysis_members/mpas_li_regional_stats.F @@ -164,12 +164,14 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) type (mpas_pool_type), pointer :: geometryPool type (mpas_pool_type), pointer :: regionsPool type (mpas_pool_type), pointer :: velocityPool + type (mpas_pool_type), pointer :: hydroPool ! arrays, vars needed from other pools for calculations here real (kind=RKIND), pointer :: config_ice_density real (kind=RKIND), pointer :: deltat real (kind=RKIND), dimension(:), pointer :: areaCell real (kind=RKIND), dimension(:), pointer :: dvEdge + real (kind=RKIND), dimension(:), pointer :: dcEdge real (kind=RKIND), dimension(:), pointer :: thickness real (kind=RKIND), dimension(:), pointer :: bedTopography real (kind=RKIND), dimension(:), pointer :: sfcMassBalApplied @@ -185,15 +187,27 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) real (kind=RKIND), dimension(:), pointer :: groundedToFloatingThickness real (kind=RKIND), dimension(:,:), pointer :: normalVelocity + real (kind=RKIND), dimension(:), pointer :: waterThickness + real (kind=RKIND), dimension(:), pointer :: basalMeltInput + real (kind=RKIND), dimension(:), pointer :: externalWaterInput + real (kind=RKIND), dimension(:), pointer :: channelMelt + real (kind=RKIND), dimension(:), pointer :: waterFlux + real (kind=RKIND), dimension(:), pointer :: channelDischarge + real (kind=RKIND), dimension(:), pointer :: waterPressure + ! config options needed real (kind=RKIND), pointer :: config_sea_level real (kind=RKIND), pointer :: rhoi ! config_ice_density real (kind=RKIND), pointer :: rhow ! config_ocean_density + real (kind=RKIND), pointer :: bedBumpMax ! config_SGH_bed_roughness_max + logical, pointer :: config_SGH integer, dimension(:,:), pointer :: regionCellMasks integer, dimension(:), pointer :: cellMask integer, dimension(:), pointer :: edgeMask integer, dimension(:,:), pointer :: cellsOnEdge + integer, dimension(:), pointer :: hydroMarineMarginMask + integer, dimension(:), pointer :: hydroTerrestrialMarginMask integer, pointer :: nRegions, nRegionGroups !, maxRegionsInGroup !! maxRegionsInGroup not needed / used yet integer, pointer :: nCellsSolve, nEdgesSolve, nVertLevels integer :: k, iCell, iEdge @@ -218,6 +232,17 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) real (kind=RKIND), dimension(:), pointer :: regionalAvgSubshelfMelt real (kind=RKIND), dimension(:), pointer :: regionalSurfaceSpeedMax real (kind=RKIND), dimension(:), pointer :: regionalBasalSpeedMax + real (kind=RKIND), dimension(:), pointer :: regionalSumSubglacialWaterVolume + real (kind=RKIND), dimension(:), pointer :: regionalSumBasalMeltInput + real (kind=RKIND), dimension(:), pointer :: regionalSumExternalWaterInput + real (kind=RKIND), dimension(:), pointer :: regionalSumChannelMelt + real (kind=RKIND), dimension(:), pointer :: regionalSumSubglacialLakeVolume + real (kind=RKIND), dimension(:), pointer :: regionalSumSubglacialLakeArea + real (kind=RKIND), dimension(:), pointer :: regionalSumDistWaterFluxMarineMargin + real (kind=RKIND), dimension(:), pointer :: regionalSumDistWaterFluxTerrestrialMargin + real (kind=RKIND), dimension(:), pointer :: regionalSumChnlWaterFluxMarineMargin + real (kind=RKIND), dimension(:), pointer :: regionalSumChnlWaterFluxTerrestrialMargin + real (kind=RKIND), dimension(:), pointer :: regionalAvgFlotationFraction ! storage for sums over blocks real (kind=RKIND), dimension(:), allocatable :: blockSumRegionIceArea, blockSumRegionIceVolume @@ -234,12 +259,25 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) real (kind=RKIND), dimension(:), allocatable :: blockRegionGLMigrationFlux real (kind=RKIND), dimension(:), allocatable :: blockRegionMaxSurfaceSpeed real (kind=RKIND), dimension(:), allocatable :: blockRegionMaxBasalSpeed + real (kind=RKIND), dimension(:), allocatable :: blockSumRegionSubglacialWaterVolume + real (kind=RKIND), dimension(:), allocatable :: blockSumRegionBasalMeltInput + real (kind=RKIND), dimension(:), allocatable :: blockSumRegionExternalWaterInput + real (kind=RKIND), dimension(:), allocatable :: blockSumRegionChannelMelt + real (kind=RKIND), dimension(:), allocatable :: blockSumRegionLakeVolume + real (kind=RKIND), dimension(:), allocatable :: blockSumRegionLakeArea + real (kind=RKIND), dimension(:), allocatable :: blockSumRegionGLMeltFlux + real (kind=RKIND), dimension(:), allocatable :: blockSumRegionTerrestrialMeltFlux + real (kind=RKIND), dimension(:), allocatable :: blockSumRegionChannelGLMeltFlux + real (kind=RKIND), dimension(:), allocatable :: blockSumRegionChannelTerrestrialMeltFlux + real (kind=RKIND), dimension(:), allocatable :: blockSumRegionFlotationFraction + ! local variable needed calculating average floation fraction in a region + real (kind=RKIND), dimension(:), allocatable:: regionalSumFlotationFraction ! local variables real (kind=RKIND) :: fluxSign ! variables for processing stats - integer, parameter :: kMaxVariables = 32 ! Increase if number of stats increase + integer, parameter :: kMaxVariables = 43 ! Increase if number of stats increase integer :: nVars real (kind=RKIND), dimension(kMaxVariables) :: reductions, sums, mins, maxes @@ -251,6 +289,8 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) call mpas_pool_get_config(liConfigs, 'config_sea_level', config_sea_level) call mpas_pool_get_config(liConfigs, 'config_ice_density', rhoi) call mpas_pool_get_config(liConfigs, 'config_ocean_density', rhow) + call mpas_pool_get_config(liConfigs, 'config_SGH_bed_roughness_max', bedBumpMax) + call mpas_pool_get_config(liConfigs, 'config_SGH', config_SGH) ! loop over blocks block => domain % blocklist @@ -265,7 +305,8 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) call mpas_pool_get_subpool(block % structs, 'velocity', velocityPool) call mpas_pool_get_subpool(block % structs, 'regions', regionsPool) -! call mpas_pool_get_subpool(block % structs, 'regionalStatsAM', regionalStatsAMPool) + call mpas_pool_get_subpool(block % structs, 'hydro', hydroPool) +! call mpas_pool_get_subpool(block % structs, 'regionalStatsAM', regionalStatsAMPool) ! get values and arrays from standard pools call mpas_pool_get_config(liConfigs, 'config_ice_density', config_ice_density) @@ -292,6 +333,18 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) call mpas_pool_get_array(velocityPool, 'basalSpeed', basalSpeed) call mpas_pool_get_array(velocityPool, 'fluxAcrossGroundingLine', fluxAcrossGroundingLine) call mpas_pool_get_array(velocityPool, 'normalVelocity', normalVelocity) + if (config_SGH) then + call mpas_pool_get_array(meshPool, 'dcEdge', dcEdge) + call mpas_pool_get_array(hydroPool, 'waterThickness', waterThickness) + call mpas_pool_get_array(hydroPool, 'basalMeltInput', basalMeltInput) + call mpas_pool_get_array(hydroPool, 'externalWaterInput', externalWaterInput) + call mpas_pool_get_array(hydroPool, 'channelMelt', channelMelt) + call mpas_pool_get_array(hydroPool, 'hydroMarineMarginMask', hydroMarineMarginMask) + call mpas_pool_get_array(hydroPool, 'hydroTerrestrialMarginMask', hydroTerrestrialMarginMask) + call mpas_pool_get_array(hydroPool, 'waterFlux', waterFlux) + call mpas_pool_get_array(hydroPool, 'channelDischarge', channelDischarge) + call mpas_pool_get_array(hydroPool, 'waterPressure', waterPressure) + endif ! get region cell masks from regionMasks.nc input file call mpas_pool_get_array(regionsPool, 'regionCellMasks', regionCellMasks) @@ -310,6 +363,20 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) allocate(blockSumRegionFaceMeltingFlux(nRegions)) allocate(blockSumRegionGLflux(nRegions)) allocate(blockRegionGLMigrationFlux(nRegions)) + if (config_SGH) then + allocate(blockSumRegionSubglacialWaterVolume(nRegions)) + allocate(blockSumRegionBasalMeltInput(nRegions)) + allocate(blockSumRegionExternalWaterInput(nRegions)) + allocate(blockSumRegionChannelMelt(nRegions)) + allocate(blockSumRegionLakeVolume(nRegions)) + allocate(blockSumRegionLakeArea(nRegions)) + allocate(blockSumRegionGLMeltFlux(nRegions)) + allocate(blockSumRegionTerrestrialMeltFlux(nRegions)) + allocate(blockSumRegionChannelGLMeltFlux(nRegions)) + allocate(blockSumRegionChannelTerrestrialMeltFlux(nRegions)) + allocate(blockSumRegionFlotationFraction(nRegions)) + allocate(regionalSumFlotationFraction(nRegions)) + endif blockSumRegionIceArea = 0.0_RKIND; blockSumRegionIceVolume = 0.0_RKIND blockSumRegionVAF = 0.0_RKIND @@ -324,6 +391,21 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) blockSumRegionFaceMeltingFlux = 0.0_RKIND blockSumRegionGLflux = 0.0_RKIND blockRegionGLMigrationFlux = 0.0_RKIND + + if (config_SGH) then + blockSumRegionSubglacialWaterVolume = 0.0_RKIND + blockSumRegionBasalMeltInput = 0.0_RKIND + blockSumRegionExternalWaterInput = 0.0_RKIND + blockSumRegionChannelMelt = 0.0_RKIND + blockSumRegionLakeVolume = 0.0_RKIND + blockSumRegionLakeArea = 0.0_RKIND + blockSumRegionGLMeltFlux = 0.0_RKIND + blockSumRegionTerrestrialMeltFlux = 0.0_RKIND + blockSumRegionChannelGLMeltFlux = 0.0_RKIND + blockSumRegionChannelTerrestrialMeltFlux = 0.0_RKIND + blockSumRegionFlotationFraction = 0.0_RKIND + regionalSumFlotationFraction = 0.0_RKIND + endif do iCell = 1,nCellsSolve ! loop over cells ! do iGroup = 1,nRegionGroups ! loop over groups @@ -425,8 +507,39 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) real(regionCellMasks(iRegion,iCell),RKIND) * & groundedToFloatingThickness(iCell) * areaCell(iCell) * rhoi / (deltat / scyr) + !! Subglacial Hydrology Calculations + if (config_SGH) then + + ! Subglacial Water Volume + blockSumRegionSubglacialWaterVolume(iRegion) = blockSumRegionSubglacialWaterVolume(iRegion) + & + waterThickness(iCell) * areaCell(iCell) + + ! Basal melt input + blockSumRegionBasalMeltInput(iRegion) = blockSumRegionBasalMeltInput(iRegion) + & + real(li_mask_is_grounded_ice_int(cellMask(iCell)),RKIND) * basalMeltInput(iCell) * areaCell(iCell) + + ! External water input + blockSumRegionExternalWaterInput(iRegion) = blockSumRegionExternalWaterInput(iRegion) + & + externalWaterInput(iCell) * areaCell(iCell) + + ! Lake Volume + if (waterThickness(iCell) > bedBumpMax) then + blockSumRegionLakeVolume(iRegion) = blockSumRegionLakeVolume(iRegion) + & + (waterThickness(iCell) - bedBumpMax) * areaCell(iCell) + endif + + ! Lake Area + if (waterThickness(iCell) > bedBumpMax) then + blockSumRegionLakeArea(iRegion) = blockSumRegionLakeArea(iRegion) + areaCell(iCell) + endif + + ! Area-weighted flotation fraction for grounded ice + if (li_mask_is_grounded_ice(cellMask(iCell))) then + blockSumRegionFlotationFraction(iRegion) = blockSumRegionFlotationFraction(iRegion) + & + ( waterPressure(iCell) / rhoi / gravity / thickness(iCell) ) * areaCell(iCell) + endif + endif end do ! end loop over regions - ! end do ! end loop over groups end do ! end loop over cells @@ -450,6 +563,29 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) end if ! if edge is on cell in region of interest end do ! end loop over regions end if ! if GL + + if (config_SGH) then + ! Channel Melt + blockSumRegionChannelMelt(iRegion) = blockSumRegionChannelMelt(iRegion) + & + abs(channelMelt(iEdge) * dcEdge(iEdge)) + + ! Meltwater Flux across the grounding line + blockSumRegionGLMeltFlux(iRegion) = blockSumRegionGLMeltFlux(iRegion) + & + abs(hydroMarineMarginMask(iEdge) * waterFlux(iEdge) * dvEdge(iEdge) * rho_water) + + ! Meltwater Flux across terrestrial margins + blockSumRegionTerrestrialMeltFlux(iRegion) = blockSumRegionTerrestrialMeltFlux(iRegion) + & + abs(hydroTerrestrialMarginMask(iEdge) * waterFlux(iEdge) * dvEdge(iEdge) * rho_water) + + ! Meltwater Discharge in channels across grounding line + blockSumRegionChannelGLMeltFlux(iRegion) = blockSumRegionChannelGLMeltFlux(iRegion) + & + abs(hydroMarineMarginMask(iEdge) * channelDischarge(iEdge) * rho_water) + + ! Meltwater discharge in channels across terrestrial margin + blockSumRegionChannelTerrestrialMeltFlux(iRegion) = blockSumRegionChannelTerrestrialMeltFlux(iRegion) + & + abs( hydroTerrestrialMarginMask(iEdge) * channelDischarge(iEdge) * rho_water) + endif ! if SGH is on + end do ! end loop over edges block => block % next @@ -494,7 +630,22 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) sums(15) = blockSumRegionVAF(iRegion) sums(16) = blockSumRegionGLflux(iRegion) sums(17) = blockRegionGLMigrationFlux(iRegion) - nVars = 17 + if (config_SGH) then + sums(18) = blockSumRegionSubglacialWaterVolume(iRegion) + sums(19) = blockSumRegionBasalMeltInput(iRegion) + sums(20) = blockSumRegionExternalWaterInput(iRegion) + sums(21) = blockSumRegionChannelMelt(iRegion) + sums(22) = blockSumRegionLakeVolume(iRegion) + sums(23) = blockSumRegionLakeArea(iRegion) + sums(24) = blockSumRegionGLMeltFlux(iRegion) + sums(25) = blockSumRegionTerrestrialMeltFlux(iRegion) + sums(26) = blockSumRegionChannelGLMeltFlux(iRegion) + sums(27) = blockSumRegionChannelTerrestrialMeltFlux(iRegion) + sums(28) = blockSumRegionFlotationFraction(iRegion) + nVars = 28 + else + nVars = 17 + endif call mpas_dmpar_sum_real_array(dminfo, nVars, sums(1:nVars), reductions(1:nVars)) @@ -526,6 +677,19 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) call mpas_pool_get_array(regionalStatsAMPool, 'regionalSumGroundingLineFlux', regionalSumGroundingLineFlux) call mpas_pool_get_array(regionalStatsAMPool, 'regionalSumGroundingLineMigrationFlux', & regionalSumGroundingLineMigrationFlux) + if (config_SGH) then + call mpas_pool_get_array(regionalStatsAMPool, 'regionalSumSubglacialWaterVolume', regionalSumSubglacialWaterVolume) + call mpas_pool_get_array(regionalStatsAMPool, 'regionalSumBasalMeltInput', regionalSumBasalMeltInput) + call mpas_pool_get_array(regionalStatsAMPool, 'regionalSumExternalWaterInput', regionalSumExternalWaterInput) + call mpas_pool_get_array(regionalStatsAMPool, 'regionalSumChannelMelt', regionalSumChannelMelt) + call mpas_pool_get_array(regionalStatsAMPool, 'regionalSumSubglacialLakeVolume', regionalSumSubglacialLakeVolume) + call mpas_pool_get_array(regionalStatsAMPool, 'regionalSumSubglacialLakeArea', regionalSumSubglacialLakeArea) + call mpas_pool_get_array(regionalStatsAMPool, 'regionalSumDistWaterFluxMarineMargin',regionalSumDistWaterFluxMarineMargin) + call mpas_pool_get_array(regionalStatsAMPool, 'regionalSumDistWaterFluxTerrestrialMargin', regionalSumDistWaterFluxTerrestrialMargin) + call mpas_pool_get_array(regionalStatsAMPool, 'regionalSumChnlWaterFluxMarineMargin',regionalSumChnlWaterFluxMarineMargin) + call mpas_pool_get_array(regionalStatsAMPool, 'regionalSumChnlWaterFluxTerrestrialMargin', regionalSumChnlWaterFluxTerrestrialMargin) + call mpas_pool_get_array(regionalStatsAMPool, 'regionalAvgFlotationFraction', regionalAvgFlotationFraction) + endif regionalIceArea(iRegion) = reductions(1) regionalIceVolume(iRegion) = reductions(2) @@ -544,6 +708,19 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) regionalVolumeAboveFloatation(iRegion) = reductions(15) regionalSumGroundingLineFlux(iRegion) = reductions(16) regionalSumGroundingLineMigrationFlux(iRegion) = reductions(17) + if (config_SGH) then + regionalSumSubglacialWaterVolume(iRegion) = reductions(18) + regionalSumBasalMeltInput(iRegion) = reductions(19) + regionalSumExternalWaterInput(iRegion) = reductions(20) + regionalSumChannelMelt(iRegion) = reductions(21) + regionalSumSubglacialLakeVolume(iRegion) = reductions(22) + regionalSumSubglacialLakeArea(iRegion) = reductions(23) + regionalSumDistWaterFluxMarineMargin(iRegion) = reductions(24) + regionalSumDistWaterFluxTerrestrialMargin(iRegion) = reductions(25) + regionalSumChnlWaterFluxMarineMargin(iRegion) = reductions(26) + regionalSumChnlWaterFluxTerrestrialMargin(iRegion) = reductions(27) + regionalSumFlotationFraction(iRegion) = reductions(28) + endif if (regionalIceArea(iRegion) > 0.0_RKIND) then regionalIceThicknessMean(iRegion) = regionalIceVolume(iRegion) / regionalIceArea(iRegion) @@ -565,6 +742,15 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) regionalAvgSubshelfMelt(iRegion) = 0.0_RKIND endif + if (config_SGH) then + if (regionalIceArea(iRegion) > 0.0_RKIND) then + ! WHAT SHOULD totalFLoationFraction equivalent be? + regionalAvgFlotationFraction(iRegion) = regionalSumFlotationFraction(iRegion) / regionalIceArea(iRegion) + else + regionalAvgFlotationFraction(iRegion) = 0.0_RKIND + endif + endif + block => block % next end do @@ -624,6 +810,19 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) deallocate(blockSumRegionFaceMeltingFlux) deallocate(blockSumRegionGLflux) deallocate(blockRegionGLMigrationflux) + if (config_SGH) then + deallocate(blockSumRegionSubglacialWaterVolume) + deallocate(blockSumRegionBasalMeltInput) + deallocate(blockSumRegionExternalWaterInput) + deallocate(blockSumRegionChannelMelt) + deallocate(blockSumRegionLakeVolume) + deallocate(blockSumRegionLakeArea) + deallocate(blockSumRegionGLMeltFlux) + deallocate(blockSumRegionTerrestrialMeltFlux) + deallocate(blockSumRegionChannelGLMeltFlux) + deallocate(blockSumRegionChannelTerrestrialMeltFlux) + deallocate(blockSumRegionFlotationFraction) + endif end subroutine li_compute_regional_stats From dd10e47bed3ac329fc89b6188f5f8958fd178e0b Mon Sep 17 00:00:00 2001 From: Andrew Nolan Date: Wed, 21 Feb 2024 16:53:27 -0700 Subject: [PATCH 35/94] Move reduction of `fluxAcrossGroundingLine` outside SGH condition. The reduction of `fluxAcrossGroundingLine` was accidently moved within a `config_SGH` condition, so that `groundingLineFlux` would only be calculated if `config_SGH` was turned on. Moved the reduction back to where it was to ensure it's calculated in all situations it's needed. --- .../analysis_members/mpas_li_global_stats.F | 32 ++++++++++--------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F b/components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F index 2e1d05cbc390..c21b4a2cb861 100755 --- a/components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F +++ b/components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F @@ -461,13 +461,14 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) end do ! end loop over cells - if (config_SGH) then - ! Loop over edges - do iEdge = 1, nEdgesSolve + ! Loop over edges + do iEdge = 1, nEdgesSolve + + ! Flux across GL, units = kg/yr + blockGLflux = blockGLflux + fluxAcrossGroundingLine(iEdge) * dvEdge(iEdge) & + * scyr * rhoi ! convert from m^2/s to kg/yr - ! Flux across GL, units = kg/yr - blockGLflux = blockGLflux + fluxAcrossGroundingLine(iEdge) * dvEdge(iEdge) & - * scyr * rhoi ! convert from m^2/s to kg/yr + if (config_SGH) then ! Channel Melt blockSumChannelMelt = blockSumChannelMelt + abs(channelMelt(iEdge) * dcEdge(iEdge)) @@ -484,8 +485,9 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) ! Meltwater discharge in channels across terrestrial margin blockSumChannelTerrestrialMeltFlux = blockSumChannelTerrestrialMeltFlux + abs( hydroTerrestrialMarginMask(iEdge) * channelDischarge(iEdge) * rho_water) - end do ! end loop over edges - endif + endif ! is SGH is turned on + end do ! end loop over edges + block => block % next end do ! end loop over blocks @@ -530,9 +532,9 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) sums(13) = blockSumCalvingFlux sums(14) = blockSumFaceMeltingFlux sums(15) = blockSumVAF + sums(16) = blockGLflux + sums(17) = blockGLMigrationflux if (config_SGH) then - sums(16) = blockGLflux - sums(17) = blockGLMigrationflux sums(18) = blockSumSubglacialWaterVolume sums(19) = blockSumBasalMeltInput sums(20) = blockSumExternalWaterInput @@ -546,7 +548,7 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) sums(28) = blockSumFlotationFraction nVars = 28 else - nVars = 15 + nVars = 17 endif call mpas_dmpar_sum_real_array(dminfo, nVars, sums(1:nVars), reductions(1:nVars)) @@ -574,9 +576,9 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) call mpas_pool_get_array(globalStatsAMPool, 'avgSubshelfMelt', avgSubshelfMelt) call mpas_pool_get_array(globalStatsAMPool, 'totalCalvingFlux', totalCalvingFlux) call mpas_pool_get_array(globalStatsAMPool, 'totalFaceMeltingFlux', totalFaceMeltingFlux) + call mpas_pool_get_array(globalStatsAMPool, 'groundingLineFlux', groundingLineFlux) + call mpas_pool_get_array(globalStatsAMPool, 'groundingLineMigrationFlux', groundingLineMigrationFlux) if (config_SGH) then - call mpas_pool_get_array(globalStatsAMPool, 'groundingLineFlux', groundingLineFlux) - call mpas_pool_get_array(globalStatsAMPool, 'groundingLineMigrationFlux', groundingLineMigrationFlux) call mpas_pool_get_array(globalStatsAMPool, 'totalSubglacialWaterVolume', totalSubglacialWaterVolume) call mpas_pool_get_array(globalStatsAMPool, 'totalBasalMeltInput', totalBasalMeltInput) call mpas_pool_get_array(globalStatsAMPool, 'totalExternalWaterInput', totalExternalWaterInput) @@ -605,9 +607,9 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) totalCalvingFlux = reductions(13) totalFaceMeltingFlux = reductions(14) volumeAboveFloatation = reductions(15) + groundingLineFlux = reductions(16) + groundingLineMigrationFlux = reductions(17) if (config_SGH) then - groundingLineFlux = reductions(16) - groundingLineMigrationFlux = reductions(17) totalSubglacialWaterVolume = reductions(18) totalBasalMeltInput = reductions(19) totalExternalWaterInput = reductions(20) From 18147b3b0fa4641e2464575386852cbec5f2302a Mon Sep 17 00:00:00 2001 From: Andrew Nolan Date: Thu, 22 Feb 2024 15:09:06 -0700 Subject: [PATCH 36/94] Add grounded ice mask to `externalWaterInput` term The grounded ice mask is used in the calculation of the `basalMeltInput` term but was excluded from `externalWaterInput`, which could cause problems in closing budgets. The grounded ice mask was not added to any of the calculations dependent on `waterThickness` b/c SGH model explicitly sets the `waterThickness` to zero outside of the grounded ice area. --- .../src/analysis_members/mpas_li_global_stats.F | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F b/components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F index c21b4a2cb861..10350fa9d235 100755 --- a/components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F +++ b/components/mpas-albany-landice/src/analysis_members/mpas_li_global_stats.F @@ -440,7 +440,8 @@ subroutine li_compute_global_stats(domain, memberName, timeLevel, err) basalMeltInput(iCell) * areaCell(iCell) ! External water input - blockSumExternalWaterInput = blockSumExternalWaterInput + externalWaterInput(iCell) * areaCell(iCell) + blockSumExternalWaterInput = blockSumExternalWaterInput + & + real(li_mask_is_grounded_ice_int(cellMask(iCell)),RKIND) * externalWaterInput(iCell) * areaCell(iCell) ! Lake Volume if (waterThickness(iCell) > bedBumpMax) then From 219b5ab9d58ef201dd052b274ee9369e1464b530 Mon Sep 17 00:00:00 2001 From: Andrew Nolan Date: Thu, 22 Feb 2024 15:17:16 -0700 Subject: [PATCH 37/94] Add missing `regionCellMasks` call from SGH regional stats terms Masking by `regionCellMasks` in SGH regional stats terms was missing, which meant all cell centered SGH values would have been uniform across the regions and match the global stats value. Still not determined how the edge centered SGH value should be mask by region (e.g. using upwind cells region or by the `regionEdgeMasks`), but once that is decided the matching region masking needs to be done for the SGH edge quantities. --- .../analysis_members/mpas_li_regional_stats.F | 33 ++++++++++++------- 1 file changed, 22 insertions(+), 11 deletions(-) diff --git a/components/mpas-albany-landice/src/analysis_members/mpas_li_regional_stats.F b/components/mpas-albany-landice/src/analysis_members/mpas_li_regional_stats.F index be9b5c8a2553..b93d9ad39c28 100644 --- a/components/mpas-albany-landice/src/analysis_members/mpas_li_regional_stats.F +++ b/components/mpas-albany-landice/src/analysis_members/mpas_li_regional_stats.F @@ -512,31 +512,37 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) ! Subglacial Water Volume blockSumRegionSubglacialWaterVolume(iRegion) = blockSumRegionSubglacialWaterVolume(iRegion) + & - waterThickness(iCell) * areaCell(iCell) - - ! Basal melt input - blockSumRegionBasalMeltInput(iRegion) = blockSumRegionBasalMeltInput(iRegion) + & - real(li_mask_is_grounded_ice_int(cellMask(iCell)),RKIND) * basalMeltInput(iCell) * areaCell(iCell) + (real(regionCellMasks(iRegion,iCell),RKIND) * waterThickness(iCell) * areaCell(iCell)) + + if (li_mask_is_grounded_ice(cellMask(iCell))) then + ! Basal melt input + blockSumRegionBasalMeltInput(iRegion) = blockSumRegionBasalMeltInput(iRegion) + & + (real(regionCellMasks(iRegion,iCell),RKIND) * basalMeltInput(iCell) * areaCell(iCell)) + endif ! External water input blockSumRegionExternalWaterInput(iRegion) = blockSumRegionExternalWaterInput(iRegion) + & - externalWaterInput(iCell) * areaCell(iCell) + (real(regionCellMasks(iRegion,iCell),RKIND) * & + real(li_mask_is_grounded_ice_int(cellMask(iCell)),RKIND) * & + externalWaterInput(iCell) * areaCell(iCell)) ! Lake Volume if (waterThickness(iCell) > bedBumpMax) then blockSumRegionLakeVolume(iRegion) = blockSumRegionLakeVolume(iRegion) + & - (waterThickness(iCell) - bedBumpMax) * areaCell(iCell) + (real(regionCellMasks(iRegion,iCell),RKIND) * (waterThickness(iCell) - bedBumpMax) * areaCell(iCell)) endif ! Lake Area if (waterThickness(iCell) > bedBumpMax) then - blockSumRegionLakeArea(iRegion) = blockSumRegionLakeArea(iRegion) + areaCell(iCell) + blockSumRegionLakeArea(iRegion) = blockSumRegionLakeArea(iRegion) + & + (real(regionCellMasks(iRegion,iCell),RKIND) * areaCell(iCell)) endif ! Area-weighted flotation fraction for grounded ice if (li_mask_is_grounded_ice(cellMask(iCell))) then blockSumRegionFlotationFraction(iRegion) = blockSumRegionFlotationFraction(iRegion) + & - ( waterPressure(iCell) / rhoi / gravity / thickness(iCell) ) * areaCell(iCell) + (real(regionCellMasks(iRegion,iCell),RKIND) * & + ( waterPressure(iCell) / rhoi / gravity / thickness(iCell) ) * areaCell(iCell)) endif endif end do ! end loop over regions @@ -564,6 +570,12 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) end do ! end loop over regions end if ! if GL + ! TO DO: Need to define our own condition on how to decide which region to put the edge quantities + ! TO DO: Make sure SGH terms are masked based on region (using regionEdgeMasks?) b/c calculations are + ! currently unmasked and therefore global values + + + ! assign the SGH stats this edge quantities to the region of the upwind cell if (config_SGH) then ! Channel Melt blockSumRegionChannelMelt(iRegion) = blockSumRegionChannelMelt(iRegion) + & @@ -584,8 +596,7 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) ! Meltwater discharge in channels across terrestrial margin blockSumRegionChannelTerrestrialMeltFlux(iRegion) = blockSumRegionChannelTerrestrialMeltFlux(iRegion) + & abs( hydroTerrestrialMarginMask(iEdge) * channelDischarge(iEdge) * rho_water) - endif ! if SGH is on - + endif ! if SGH is on end do ! end loop over edges block => block % next From fae4e15379b7650f1c2d497b7d6f9119be89f90c Mon Sep 17 00:00:00 2001 From: Andrew Nolan Date: Thu, 22 Feb 2024 15:27:29 -0700 Subject: [PATCH 38/94] Deallocate `regionalSumFlotationFraction`. Was missing the deallocation of `regionalSumFlotationFraction`, which is a local variable needed for calculating the numerator of `regionalAvgFlotationFraction`. --- .../src/analysis_members/mpas_li_regional_stats.F | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/analysis_members/mpas_li_regional_stats.F b/components/mpas-albany-landice/src/analysis_members/mpas_li_regional_stats.F index b93d9ad39c28..912eca2a5024 100644 --- a/components/mpas-albany-landice/src/analysis_members/mpas_li_regional_stats.F +++ b/components/mpas-albany-landice/src/analysis_members/mpas_li_regional_stats.F @@ -270,7 +270,7 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) real (kind=RKIND), dimension(:), allocatable :: blockSumRegionChannelGLMeltFlux real (kind=RKIND), dimension(:), allocatable :: blockSumRegionChannelTerrestrialMeltFlux real (kind=RKIND), dimension(:), allocatable :: blockSumRegionFlotationFraction - ! local variable needed calculating average floation fraction in a region + ! local variable needed calculating numerator of regionalAvgFlotationFraction real (kind=RKIND), dimension(:), allocatable:: regionalSumFlotationFraction ! local variables @@ -833,6 +833,8 @@ subroutine li_compute_regional_stats(domain, memberName, timeLevel, err) deallocate(blockSumRegionChannelGLMeltFlux) deallocate(blockSumRegionChannelTerrestrialMeltFlux) deallocate(blockSumRegionFlotationFraction) + ! local variable needed for calculating numerator of regionalAvgFlotationFraction + deallocate(regionalSumFlotationFraction) endif end subroutine li_compute_regional_stats From abaa6cae48047fb4d4759fbd8d25d66f096c0a18 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Fri, 23 Feb 2024 19:34:45 -0700 Subject: [PATCH 39/94] Add missing error flag so model actually dies when error occurs --- .../mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F | 1 + 1 file changed, 1 insertion(+) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F index aacfbed95ad3..f1cc7aceed22 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F @@ -1080,6 +1080,7 @@ subroutine check_SLM_coupling_interval(slm_dt1, meshPool, streamManager, err) else call mpas_log_write("config_slm_coupling_interval divides into restart interval $i times " // & "with nonzero remainder", MPAS_LOG_ERR, intArgs=(/int(n_intervals)/)) + err = ior(err, 1) endif endif From 6bb3000ce6caa7769555b4f20bc6130f60d2fe1e Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Fri, 23 Feb 2024 19:59:03 -0700 Subject: [PATCH 40/94] Allow restarts at any interval when using SLM This commit changes how restarts are handled when the SLM is active to allow MALI to be restarted at any arbitrary restart interval and have the SLM restart correctly. This is done by changing the SLM coupling alarm to be based off of the original simulationStartTime (instead of the start time of the current execution). This required moving the creation of the coupling alarm to later in initialization so that the variable simulationStartTime is available. With this change, it was also necessary to change the way the SLM time level is calculated on a restart to take the floor of the elapsed time divided by the coupling interval, rather than requiring that there be no remainder. This adds a little fragility because there is no way to double check that is the correct SLM time level, but if this is set up correctly, it should be handled properly. Finally, as part of these changes, I also removed the check on init that the coupling interval divides evenly into the restart interval, because that's no longer a requirement. That's sort of too bad, because it was a lot of work to figure out how to make that check! But it's nicer to not have that restriction. --- .../src/mode_forward/mpas_li_bedtopo.F | 69 +++++++++---------- .../src/mode_forward/mpas_li_core.F | 17 ----- 2 files changed, 32 insertions(+), 54 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F index f1cc7aceed22..4ead2074546f 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F @@ -407,6 +407,10 @@ subroutine slmodel_init(domain, err) integer :: itersl, dtime ! SLM variable real :: starttime ! SLM variable integer, dimension(:), pointer :: cellMask ! integer bitmask for cells + integer, pointer :: config_slm_coupling_interval + type (MPAS_TimeInterval_type) :: slm_coupling_interval + character (len=StrKIND), pointer :: simulationStartTime + type (MPAS_Time_type) :: simulationStartTime_timeType ! MPI variables integer, dimension(:), pointer :: indexToCellID @@ -415,12 +419,30 @@ subroutine slmodel_init(domain, err) err = 0 err_tmp = 0 + + call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool) + + ! Set up the alarm for the coupling time interval + call mpas_pool_get_config(liConfigs, 'config_slm_coupling_interval', config_slm_coupling_interval) + call mpas_set_timeInterval(slm_coupling_interval, YY=config_slm_coupling_interval, ierr=err_tmp) + err = ior(err,err_tmp) + call mpas_pool_get_array(meshPool, 'simulationStartTime', simulationStartTime) + call mpas_set_time(simulationStartTime_timeType, dateTimeString=simulationStartTime, ierr=err_tmp) + err = ior(err,err_tmp) + call mpas_add_clock_alarm(domain%clock, 'slmCouplingInterval', alarmTime=simulationStartTime_timeType, & + alarmTimeInterval=slm_coupling_interval, ierr=err_tmp) + err = ior(err,err_tmp) + if (mpas_is_alarm_ringing(domain%clock, 'slmCouplingInterval', ierr=err_tmp)) then + err = ior(err, err_tmp) + call mpas_reset_clock_alarm(domain%clock, 'slmCouplingInterval', ierr=err_tmp) + err = ior(err, err_tmp) + endif + ! initialize interpolation call interpolate_init(domain, err_tmp) err = ior(err, err_tmp) ! Set needed variables for using MPI - call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool) call mpas_pool_get_dimension(meshPool, 'nCells', nCellsAll) call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsOwned) call mpas_pool_get_array(meshPool, 'indexToCellID', indexToCellID) @@ -448,7 +470,7 @@ subroutine slmodel_init(domain, err) call sl_drive_readnl(itersl, dtime, starttime) !SLM subroutine ! First, check consistency in coupling interval set up in MALI and SLM - call check_SLM_coupling_interval(dtime, meshPool, domain % streamManager, err_tmp) + call check_SLM_coupling_interval(dtime, meshPool, err_tmp) err = ior(err, err_tmp) if (err /= 0) then call mpas_log_write("Error occurred in check_SLM_coupling_interval.", MPAS_LOG_ERR) @@ -985,7 +1007,7 @@ end subroutine check ! !----------------------------------------------------------------------- - subroutine check_SLM_coupling_interval(slm_dt1, meshPool, streamManager, err) + subroutine check_SLM_coupling_interval(slm_dt1, meshPool, err) use mpas_timekeeping use mpas_stream_manager @@ -993,18 +1015,16 @@ subroutine check_SLM_coupling_interval(slm_dt1, meshPool, streamManager, err) integer, intent (in) :: slm_dt1 type (mpas_pool_type), intent(in) :: meshPool !< mesh information - type (MPAS_streamManager_type), intent(inout) :: streamManager integer, intent(out) :: err ! local variables integer, pointer :: config_slm_coupling_interval logical, pointer :: config_adaptive_timestep character (len=StrKIND), pointer :: config_adaptive_timestep_force_interval, config_dt - type (MPAS_TimeInterval_Type) :: coupling_interval, force_interval, dt_interval, restart_interval, zero_interval + type (MPAS_TimeInterval_Type) :: coupling_interval, force_interval, dt_interval, zero_interval type (MPAS_Time_Type) :: start_time character (len=StrKIND), pointer :: simulationStartTime integer :: YYYY, MM, DD, H, M, S ! time components - type (MPAS_stream_list_type), pointer :: stream_cursor integer (kind=I8KIND) :: n_intervals type (MPAS_TimeInterval_type) :: remainder integer :: err_tmp @@ -1066,26 +1086,9 @@ subroutine check_SLM_coupling_interval(slm_dt1, meshPool, streamManager, err) endif endif - ! Now check that restart interval is an even multiple of coupling interval - stream_cursor => streamManager % streams % head - do while (associated(stream_cursor)) - if ( trim(stream_cursor % name) == 'restart' .and. (stream_cursor % active_stream) ) then - call mpas_log_write("Checking restart interval against SLM coulping interval") - restart_interval = MPAS_stream_mgr_get_stream_interval(streamManager, 'restart', MPAS_STREAM_OUTPUT, ierr=err_tmp) - err = ior(err, err_tmp) - call mpas_interval_division(start_time, restart_interval, coupling_interval, n_intervals, remainder) - if (remainder .EQ. zero_interval) then - call mpas_log_write("config_slm_coupling_interval divides into restart interval $i times " // & - "with no remainder - check passes", intArgs=(/int(n_intervals)/)) - else - call mpas_log_write("config_slm_coupling_interval divides into restart interval $i times " // & - "with nonzero remainder", MPAS_LOG_ERR, intArgs=(/int(n_intervals)/)) - err = ior(err, 1) - endif - endif + ! No need to compare restart interval and coupling interval because restarts with SLM are supported for + ! any restart interval now - stream_cursor => stream_cursor % next - enddo call mpas_log_write("") !-------------------------------------------------------------------- @@ -1118,7 +1121,7 @@ subroutine find_slm_restart_timestep(meshPool, slmTimeStep, err) ! local vars integer, pointer :: config_slm_coupling_interval character (len=StrKIND), pointer :: xtime, simulationStartTime - type (MPAS_TimeInterval_Type) :: coupling_interval, zero_interval + type (MPAS_TimeInterval_Type) :: coupling_interval type (MPAS_Time_Type) :: start_time, curr_time integer (kind=I8KIND) :: n_intervals type (MPAS_TimeInterval_type) :: remainder @@ -1141,17 +1144,9 @@ subroutine find_slm_restart_timestep(meshPool, slmTimeStep, err) err = ior(err, err_tmp) call mpas_interval_division(start_time, curr_time - start_time, coupling_interval, n_intervals, remainder) - call mpas_set_timeInterval(zero_interval, dt = 0.0_RKIND) - if (remainder .EQ. zero_interval) then - call mpas_log_write("SLM Restart check: config_slm_coupling_interval divides into elapsed time $i times " // & - "with no remainder - check passes", intArgs=(/int(n_intervals)/)) - slmTimeStep = int(n_intervals) - else - call mpas_log_write("SLM Restart check: config_slm_coupling_interval divides into elapsed time $i times " // & - "with nonzero remainder", MPAS_LOG_ERR, intArgs=(/int(n_intervals)/)) - err = ior(err, 1) - slmTimeStep = -999 - endif + slmTimeStep = int(n_intervals) + call mpas_log_write("SLM Restart check: Using SLM time level $i because config_slm_coupling_interval divides into " // & + "elapsed time that many times ", intArgs=(/int(slmTimeStep)/)) call mpas_log_write("") !-------------------------------------------------------------------- diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_core.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_core.F index 146b4e36d805..16c7c7807200 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_core.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_core.F @@ -1105,13 +1105,11 @@ subroutine li_simulation_clock_init(core_clock, configs, ierr) type (MPAS_Time_Type) :: startTime, stopTime, alarmStartTime type (MPAS_TimeInterval_type) :: runDuration, timeStep, alarmTimeStep type (MPAS_TimeInterval_type) :: adaptDtForceInterval - type (MPAS_TimeInterval_type) :: slm_coupling_interval character (len=StrKIND), pointer :: config_start_time, config_run_duration, config_stop_time, & config_output_interval, config_restart_interval ! MPAS standard configs character (len=StrKIND), pointer :: config_dt ! MPAS LI-specific config option character (len=StrKIND), pointer :: config_adaptive_timestep_force_interval ! MPAS LI-specific config option character (len=StrKIND), pointer :: config_restart_timestamp_name - character (len=StrKIND), pointer :: config_uplift_method integer, pointer :: config_slm_coupling_interval character (len=StrKIND) :: restartTimeStamp !< string to be read from file integer, pointer :: config_year_digits @@ -1131,7 +1129,6 @@ subroutine li_simulation_clock_init(core_clock, configs, ierr) call mpas_pool_get_config(configs, 'config_stop_time', config_stop_time) call mpas_pool_get_config(configs, 'config_restart_timestamp_name', config_restart_timestamp_name) call mpas_pool_get_config(configs, 'config_adaptive_timestep_force_interval', config_adaptive_timestep_force_interval) - call mpas_pool_get_config(configs, 'config_uplift_method', config_uplift_method) call mpas_pool_get_config(configs, 'config_slm_coupling_interval', config_slm_coupling_interval) @@ -1196,20 +1193,6 @@ subroutine li_simulation_clock_init(core_clock, configs, ierr) endif ierr = ior(ierr, err_tmp) - ! Set up the coupling time interval if MALI is coupled to sea-level model - if (trim(config_uplift_method) == "sealevelmodel") then - call mpas_set_timeInterval(slm_coupling_interval, YY=config_slm_coupling_interval, ierr=err_tmp) - ierr = ior(ierr,err_tmp) - call mpas_add_clock_alarm(core_clock, 'slmCouplingInterval', alarmTime=startTime, & - alarmTimeInterval=slm_coupling_interval, ierr=err_tmp) - ierr = ior(ierr,err_tmp) - if (mpas_is_alarm_ringing(core_clock, 'slmCouplingInterval', ierr=err_tmp)) then - ierr = ior(ierr, err_tmp) - call mpas_reset_clock_alarm(core_clock, 'slmCouplingInterval', ierr=err_tmp) - ierr = ior(ierr, err_tmp) - endif - endif - ! === error check if (ierr /= 0) then call mpas_log_write("An error has occurred in li_simulation_clock_init.", MPAS_LOG_ERR) From be5f341ce4d50beb4393df4f1dc386b4e6fb59df Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Fri, 23 Feb 2024 20:17:19 -0700 Subject: [PATCH 41/94] Add addl info on restart about the calculated time since last SLM call This doesn't serve any internal purpose, but it could help a user detect an error in their configuration. --- .../src/mode_forward/mpas_li_bedtopo.F | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F index 4ead2074546f..b3461a52ae41 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F @@ -1125,6 +1125,7 @@ subroutine find_slm_restart_timestep(meshPool, slmTimeStep, err) type (MPAS_Time_Type) :: start_time, curr_time integer (kind=I8KIND) :: n_intervals type (MPAS_TimeInterval_type) :: remainder + character (len=StrKIND) :: remainder_string integer :: err_tmp err = 0 @@ -1135,7 +1136,6 @@ subroutine find_slm_restart_timestep(meshPool, slmTimeStep, err) call mpas_set_timeInterval(coupling_interval, YY=config_slm_coupling_interval, MM=0, DD=0, H=0, M=0, S=0, ierr=err_tmp) err = ior(err, err_tmp) - call mpas_pool_get_array(meshPool, 'simulationStartTime', simulationStartTime) call mpas_pool_get_array(meshPool, 'xtime', xtime) call mpas_set_time(start_time, dateTimeString=simulationStartTime, ierr=err_tmp) @@ -1145,8 +1145,12 @@ subroutine find_slm_restart_timestep(meshPool, slmTimeStep, err) call mpas_interval_division(start_time, curr_time - start_time, coupling_interval, n_intervals, remainder) slmTimeStep = int(n_intervals) - call mpas_log_write("SLM Restart check: Using SLM time level $i because config_slm_coupling_interval divides into " // & + call mpas_get_timeInterval(remainder, start_time, timeString=remainder_string, ierr=err_tmp) + err = ior(err, err_tmp) + call mpas_log_write("SLM Restart: Using SLM time level $i because config_slm_coupling_interval divides into " // & "elapsed time that many times ", intArgs=(/int(slmTimeStep)/)) + call mpas_log_write(" That calculation implies it has been " // trim(remainder_string) // " since last SLM coupling. " // & + "If that interval seems wrong, there may be an error in your configuration.") call mpas_log_write("") !-------------------------------------------------------------------- From 052b15de927db57d213bdc8e4eeba57237e9a8e6 Mon Sep 17 00:00:00 2001 From: Matthew Hoffman Date: Fri, 23 Feb 2024 20:46:11 -0700 Subject: [PATCH 42/94] Don't call SLM on init of a restart It's not needed, and if the restart time is not a coupling interval, it will make the SLM get out of sync. --- .../src/mode_forward/mpas_li_bedtopo.F | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F index b3461a52ae41..d5aaf12672bd 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_bedtopo.F @@ -501,10 +501,13 @@ subroutine slmodel_init(domain, err) call find_slm_restart_timestep(meshPool, slmTimeStep, err_tmp) err = ior(err, err_tmp) - if (err == 0) then - call mpas_log_write("Calling the SLM. SLM timestep $i", intArgs=(/slmTimeStep/)) - call slmodel_solve(slmTimeStep, domain) - endif + + ! Note: no need to call slmodel_solve on init of a restart. + ! If this time level happens to be a coupling interval, SLM would have been solved already + ! in the previous run that generated the restart file. + ! While it would not hurt (other than unneeded execution time) to call SLM again if the + ! restart time level happens to be a coupling interval, if the restart time is in between + ! coupling intervals calling SLM here will make things out of sync. else From 40a442cbb3a3a5ab4cf1c570be56dadaed2d66ea Mon Sep 17 00:00:00 2001 From: Andrew Nolan Date: Tue, 5 Mar 2024 08:47:11 -0800 Subject: [PATCH 43/94] Use `regionEdgeMask` to calculate SGH regional stats defined on edges. Addes `regionEdgeMask` and `regionVertexMask` to the registry so the additional mask variables can be included in the `regionsInput` stream. --- .../mpas-albany-landice/src/Registry.xml | 10 +++- .../analysis_members/mpas_li_regional_stats.F | 58 +++++++++++-------- 2 files changed, 42 insertions(+), 26 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry.xml b/components/mpas-albany-landice/src/Registry.xml index a1ddaf744018..4fc54d8c2390 100644 --- a/components/mpas-albany-landice/src/Registry.xml +++ b/components/mpas-albany-landice/src/Registry.xml @@ -1,4 +1,4 @@ - +/?xml version="1.0"?> @@ -936,6 +936,8 @@ input_interval="initial_only" runtime_format="single_file"> + + @@ -937,10 +938,9 @@ runtime_format="single_file"> - + + + - + diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index cffd631f00b5..88c2e4f4cd31 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -1718,7 +1718,6 @@ subroutine update_channel(block, err) ! local variables !----------------------------------------------------------------- ! Pools pointers -!! type (mpas_pool_type), pointer :: geometryPool type (mpas_pool_type), pointer :: hydroPool type (mpas_pool_type), pointer :: meshPool type (mpas_pool_type), pointer :: velocityPool @@ -1730,7 +1729,8 @@ subroutine update_channel(block, err) real (kind=RKIND), pointer :: rhoi real (kind=RKIND), pointer :: config_SGH_incipient_channel_width logical, pointer :: config_SGH_include_pressure_melt - + real (kind=RKIND), pointer :: config_SGH_bed_roughness_max + real (kind=RKIND), pointer :: config_sea_level real (kind=RKIND), dimension(:), pointer :: channelArea real (kind=RKIND), dimension(:), pointer :: channelMelt real (kind=RKIND), dimension(:), pointer :: channelPressureFreeze @@ -1747,26 +1747,37 @@ subroutine update_channel(block, err) real (kind=RKIND), dimension(:), pointer :: channelEffectivePressure real (kind=RKIND), dimension(:), pointer :: effectivePressure real (kind=RKIND), dimension(:), pointer :: channelDiffusivity + real (kind=RKIND), dimension(:), pointer :: waterThickness + real (kind=RKIND), dimension(:), pointer :: waterPressure + real (kind=RKIND), dimension(:), pointer :: iceThicknessHydro + real (kind=RKIND), dimension(:), pointer :: totalGroundingLineDischargeCell + real (kind=RKIND), dimension(:), pointer :: totalGroundingLineDischargeEdge + real (kind=RKIND), dimension(:), pointer :: dvEdge + real (kind=RKIND), dimension(:), pointer :: bedTopography integer, dimension(:), pointer :: waterFluxMask integer, dimension(:), pointer :: hydroMarineMarginMask integer, dimension(:), pointer :: edgeMask real (kind=RKIND), dimension(:,:), pointer :: flowParamA integer, dimension(:,:), pointer :: cellsOnEdge integer, pointer :: nVertLevels - - integer, pointer :: nEdgesSolve + real (kind=RKIND), pointer :: config_SGH_max_chnl_lake_depth + character (len=StrKIND), pointer :: config_SGH_inhibit_chnls_on_lakes + real (kind=RKIND), dimension(:), pointer :: xCell + real (kind=RKIND), dimension(:), pointer :: yCell + real (kind=RKIND), dimension(:), pointer :: xEdge + real (kind=RKIND), dimension(:), pointer :: yEdge + integer, dimension(:), pointer :: cellMask + integer, pointer :: nEdgesSolve, nEdges integer :: iEdge, cell1, cell2 - err = 0 ! Get pools things call mpas_pool_get_subpool(block % structs, 'hydro', hydroPool) -! call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) call mpas_pool_get_subpool(block % structs, 'velocity', velocityPool) call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) - + call mpas_pool_get_config(liConfigs, 'config_sea_level', config_sea_level) call mpas_pool_get_config(liConfigs, 'config_ice_density', rhoi) call mpas_pool_get_config(liConfigs, 'config_SGH_chnl_conduc_coeff', Kc) call mpas_pool_get_config(liConfigs, 'config_SGH_chnl_alpha', alpha_c) @@ -1774,10 +1785,8 @@ subroutine update_channel(block, err) call mpas_pool_get_config(liConfigs, 'config_SGH_chnl_creep_coefficient', creep_coeff) call mpas_pool_get_config(liConfigs, 'config_SGH_incipient_channel_width', config_SGH_incipient_channel_width) call mpas_pool_get_config(liConfigs, 'config_SGH_include_pressure_melt', config_SGH_include_pressure_melt) - call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve) call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels) - call mpas_pool_get_array(hydroPool, 'channelArea', channelArea) call mpas_pool_get_array(hydroPool, 'channelMelt', channelMelt) call mpas_pool_get_array(hydroPool, 'channelPressureFreeze', channelPressureFreeze) @@ -1799,7 +1808,15 @@ subroutine update_channel(block, err) call mpas_pool_get_array(hydroPool, 'hydroMarineMarginMask', hydroMarineMarginMask) call mpas_pool_get_array(hydroPool, 'channelDiffusivity', channelDiffusivity) call mpas_pool_get_array(geometryPool, 'edgeMask', edgeMask) - + call mpas_pool_get_array(meshPool, 'xCell', xCell) + call mpas_pool_get_array(meshPool, 'yCell', yCell) + call mpas_pool_get_array(meshPool, 'xEdge', xEdge) + call mpas_pool_get_array(meshPool, 'yEdge', yEdge) + call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge) + call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) + call mpas_pool_get_array(hydroPool, 'totalGroundingLineDischargeCell', totalGroundingLineDischargeCell) + call mpas_pool_get_array(hydroPool, 'totalGroundingLineDischargeEdge', totalGroundingLineDischargeEdge) + call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) ! Calculate terms needed for opening (melt) rate where(gradMagPhiEdge < 0.01_RKIND) @@ -1867,9 +1884,31 @@ subroutine update_channel(block, err) channelOpeningRate = 0.0_RKIND channelClosingRate = 0.0_RKIND end where + channelChangeRate = channelOpeningRate - channelClosingRate - - + + totalGroundingLineDischargeCell(:) = 0.0_RKIND + totalGroundingLineDischargeEdge(:) = 0.0_RKIND + do iEdge = 1, nEdgesSolve + cell1 = cellsOnEdge(1, iEdge) + cell2 = cellsOnEdge(2, iEdge) + + if (hydroMarineMarginMask(iEdge) == 1) then + ! We are looking for edges with 1 cell grounded ice and the + ! other cell floating ice or open ocean + if ( (li_mask_is_grounded_ice(cellMask(cell1))) .and. & + (li_mask_is_floating_ice(cellMask(cell2)) .or. & + ((bedTopography(cell2) < config_sea_level) .and. (.not. li_mask_is_ice(cellMask(cell2)))) ) ) then + totalGroundingLineDischargeEdge(iEdge) = abs(channelDischarge(iEdge)) +abs( waterFlux(iEdge) * dvEdge(iEdge)) + totalGroundingLineDischargeCell(cell2) = totalGroundingLineDischargeCell(cell2) + totalGroundingLineDischargeEdge(iEdge) + elseif ( (li_mask_is_grounded_ice(cellMask(cell2))) .and. & + (li_mask_is_floating_ice(cellMask(cell1)) .or. & + ((bedTopography(cell1) < config_sea_level) .and. (.not. li_mask_is_ice(cellMask(cell1)))) ) ) then + totalGroundingLineDischargeEdge(iEdge) = abs(channelDischarge(iEdge)) + abs(waterFlux(iEdge) * dvEdge(iEdge)) + totalGroundingLineDischargeCell(cell1) = totalGroundingLineDischargeCell(cell1) + totalGroundingLineDischargeEdge(iEdge) + endif + endif + enddo !-------------------------------------------------------------------- end subroutine update_channel From 7cfb3dd7d6fc8d2b9b1c85f06d61c2481fa5b963 Mon Sep 17 00:00:00 2001 From: Trevor Hillebrand Date: Wed, 3 Apr 2024 19:06:13 -0700 Subject: [PATCH 62/94] Add mask updates between calving routines Update masks before mask calving, between mask calving and iceberg removal, and between iceberg removal and small island removal. --- .../src/mode_forward/mpas_li_calving.F | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F index a86612ad00ea..1df2391cdb2c 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F @@ -305,6 +305,12 @@ subroutine li_calve_ice(domain, err, solveVeloAfterCalving) endif + call mpas_pool_get_subpool(domain % blocklist % structs, 'geometry', geometryPool) + call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool) + call mpas_pool_get_subpool(domain % blocklist % structs, 'velocity', velocityPool) + + call li_calculate_mask(meshPool, velocityPool, geometryPool, err_tmp) + ! Consider mask calving as a possible additional step ! Mask calving can occur by itself or in conjunction with a physical calving law if (config_apply_calving_mask) then @@ -312,15 +318,20 @@ subroutine li_calve_ice(domain, err, solveVeloAfterCalving) err = ior(err, err_tmp) endif + call li_calculate_mask(meshPool, velocityPool, geometryPool, err_tmp) + ! now also remove any icebergs call remove_icebergs(domain) + call li_calculate_mask(meshPool, velocityPool, geometryPool, err_tmp) + ! Final operations after calving has been applied, including removal ! of small islands block => domain % blocklist do while (associated(block)) call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) + call mpas_pool_get_subpool(block % structs, 'velocity', velocityPool) call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'calvingThickness', calvingThickness) call mpas_pool_get_dimension(meshPool, 'nCells', nCells) @@ -350,7 +361,6 @@ subroutine li_calve_ice(domain, err, solveVeloAfterCalving) endif ! config_print_calving_info ! Update mask and geometry - call mpas_pool_get_subpool(block % structs, 'velocity', velocityPool) call li_calculate_mask(meshPool, velocityPool, geometryPool, err_tmp) err = ior(err, err_tmp) call li_update_geometry(geometryPool) From 57a370e11206e87d7a27d5d253147fd58d61c4dd Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Wed, 27 Mar 2024 09:04:28 -0700 Subject: [PATCH 63/94] Move totalGroundingLineDischargeCell/Edge to subroutine This commit establishes a separate subroutine for calculating totalGroundingLineDischargeCell/Edge --- .../mode_forward/mpas_li_subglacial_hydro.F | 129 +++++++++++++++--- 1 file changed, 107 insertions(+), 22 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 88c2e4f4cd31..3da17bdcd986 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -551,6 +551,21 @@ subroutine li_SGH_solve(domain, err) call mpas_timer_stop("halo updates") endif + ! ============= + ! Calculate total grounding line discharges + ! ============= + block => domain % blocklist + do while (associated(block)) + + call calc_gl_totals(block, err_tmp) + err = ior(err, err_tmp) + + block => block % next + end do + call mpas_timer_start("halo updates") + call mpas_dmpar_field_halo_exch(domain, 'totalGroundingLineDischargeCell') + call mpas_dmpar_field_halo_exch(domain, 'totalGroundingLineDischargeEdge') + call mpas_timer_stop("halo updates") ! ============= ! Update water layer thickness @@ -1887,28 +1902,6 @@ subroutine update_channel(block, err) channelChangeRate = channelOpeningRate - channelClosingRate - totalGroundingLineDischargeCell(:) = 0.0_RKIND - totalGroundingLineDischargeEdge(:) = 0.0_RKIND - do iEdge = 1, nEdgesSolve - cell1 = cellsOnEdge(1, iEdge) - cell2 = cellsOnEdge(2, iEdge) - - if (hydroMarineMarginMask(iEdge) == 1) then - ! We are looking for edges with 1 cell grounded ice and the - ! other cell floating ice or open ocean - if ( (li_mask_is_grounded_ice(cellMask(cell1))) .and. & - (li_mask_is_floating_ice(cellMask(cell2)) .or. & - ((bedTopography(cell2) < config_sea_level) .and. (.not. li_mask_is_ice(cellMask(cell2)))) ) ) then - totalGroundingLineDischargeEdge(iEdge) = abs(channelDischarge(iEdge)) +abs( waterFlux(iEdge) * dvEdge(iEdge)) - totalGroundingLineDischargeCell(cell2) = totalGroundingLineDischargeCell(cell2) + totalGroundingLineDischargeEdge(iEdge) - elseif ( (li_mask_is_grounded_ice(cellMask(cell2))) .and. & - (li_mask_is_floating_ice(cellMask(cell1)) .or. & - ((bedTopography(cell1) < config_sea_level) .and. (.not. li_mask_is_ice(cellMask(cell1)))) ) ) then - totalGroundingLineDischargeEdge(iEdge) = abs(channelDischarge(iEdge)) + abs(waterFlux(iEdge) * dvEdge(iEdge)) - totalGroundingLineDischargeCell(cell1) = totalGroundingLineDischargeCell(cell1) + totalGroundingLineDischargeEdge(iEdge) - endif - endif - enddo !-------------------------------------------------------------------- end subroutine update_channel @@ -2310,4 +2303,96 @@ subroutine calc_hydro_mask(domain) !-------------------------------------------------------------------- end subroutine calc_hydro_mask +!*********************************************************************** +! +! routine calc_gl_total +! +!> \brief Calculate total grounding line discharge on edges and +! adjacent cells +!> \author Alex Hager +!> \date 27 March 2024 +!> \details +!----------------------------------------------------------------------- + subroutine calc_gl_totals(block, err) + + !----------------------------------------------------------------- + ! input variables + !----------------------------------------------------------------- + + !----------------------------------------------------------------- + ! input/output variables + !----------------------------------------------------------------- + type (block_type), intent(inout) :: block !< Input/Output: block object + + !----------------------------------------------------------------- + ! output variables + !----------------------------------------------------------------- + integer, intent(out) :: err !< Output: error flag + + !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! output variables + !----------------------------------------------------------------- + + !----------------------------------------------------------------- + ! local variables + !----------------------------------------------------------------- + type (mpas_pool_type), pointer :: hydroPool + type (mpas_pool_type), pointer :: geometryPool + type (mpas_pool_type), pointer :: meshPool + + real (kind=RKIND), dimension(:), pointer :: totalGroundingLineDischargeCell + real (kind=RKIND), dimension(:), pointer :: totalGroundingLineDischargeEdge + real (kind=RKIND), dimension(:), pointer :: bedTopography + real (kind=RKIND), dimension(:), pointer :: channelDischarge + real (kind=RKIND), dimension(:), pointer :: waterFlux + real (kind=RKIND), dimension(:), pointer :: dvEdge + integer iEdge, cell1, cell2 + integer, pointer :: nEdgesSolve + integer, dimension(:,:), pointer :: cellsOnEdge + integer, dimension(:), pointer :: hydroMarineMarginMask + integer, dimension(:), pointer :: cellMask + real (kind=RKIND), pointer :: config_sea_level + + call mpas_pool_get_subpool(block % structs, 'hydro', hydroPool) + call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) + call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) + + call mpas_pool_get_array(hydroPool, 'totalGroundingLineDischargeCell', totalGroundingLineDischargeCell) + call mpas_pool_get_array(hydroPool, 'totalGroundingLineDischargeEdge', totalGroundingLineDischargeEdge) + call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) + call mpas_pool_get_array(hydroPool, 'channelDischarge', channelDischarge) + call mpas_pool_get_array(hydroPool, 'waterFlux', waterFlux) + call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge) + call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve) + call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge) + call mpas_pool_get_array(hydroPool, 'hydroMarineMarginMask', hydroMarineMarginMask) + call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) + call mpas_pool_get_config(liConfigs, 'config_sea_level', config_sea_level) + + totalGroundingLineDischargeCell(:) = 0.0_RKIND + totalGroundingLineDischargeEdge(:) = 0.0_RKIND + + do iEdge = 1, nEdgesSolve + cell1 = cellsOnEdge(1, iEdge) + cell2 = cellsOnEdge(2, iEdge) + + if (hydroMarineMarginMask(iEdge) == 1) then + ! We are looking for edges with 1 cell grounded ice and the + ! other cell floating ice or open ocean + if ( (li_mask_is_grounded_ice(cellMask(cell1))) .and. & + (li_mask_is_floating_ice(cellMask(cell2)) .or. & + ((bedTopography(cell2) < config_sea_level) .and. (.not. li_mask_is_ice(cellMask(cell2)))) ) ) then + totalGroundingLineDischargeEdge(iEdge) = abs(channelDischarge(iEdge)) +abs( waterFlux(iEdge) * dvEdge(iEdge)) + totalGroundingLineDischargeCell(cell2) = totalGroundingLineDischargeCell(cell2) + totalGroundingLineDischargeEdge(iEdge) + elseif ( (li_mask_is_grounded_ice(cellMask(cell2))) .and. & + (li_mask_is_floating_ice(cellMask(cell1)) .or. & + ((bedTopography(cell1) < config_sea_level) .and. (.not. li_mask_is_ice(cellMask(cell1)))) ) ) then + totalGroundingLineDischargeEdge(iEdge) = abs(channelDischarge(iEdge)) + abs(waterFlux(iEdge) * dvEdge(iEdge)) + totalGroundingLineDischargeCell(cell1) = totalGroundingLineDischargeCell(cell1) + totalGroundingLineDischargeEdge(iEdge) + endif + endif + enddo + end subroutine calc_gl_totals + end module li_subglacial_hydro From 39da4a6344b42b04ab49036dfed78770f07b79b6 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Fri, 5 Apr 2024 14:07:12 -0600 Subject: [PATCH 64/94] Cleanup PR This commit makes minor formatting adjustments to address comments in PR review. --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 4067e2951437..e8fa19ff51f8 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -56,8 +56,8 @@ module li_subglacial_hydro ! Private module variables ! !-------------------------------------------------------------------- -! Minimum gradMagPhiBaseEdge and gradMagPhiEdge allowed before all dependent variables are zeroed out -real(kind=RKIND), parameter :: SMALL_GRADPHI = 1.0e-6_RKIND + ! Minimum gradMagPhiBaseEdge and gradMagPhiEdge allowed before all dependent variables are zeroed out + real(kind=RKIND), parameter :: SMALL_GRADPHI = 1.0e-6_RKIND !*********************************************************************** contains @@ -773,7 +773,6 @@ subroutine calc_edge_quantities(block, err) integer, dimension(:), pointer :: edgeMask integer, dimension(:,:), pointer :: cellsOnEdge integer, dimension(:,:), pointer :: verticesOnEdge - integer, dimension(:,:), pointer :: cellsOnVertex integer, dimension(:,:), pointer :: baryCellsOnVertex real (kind=RKIND), dimension(:,:), pointer :: baryWeightsOnVertex real (kind=RKIND), pointer :: alpha, beta @@ -1019,7 +1018,7 @@ subroutine calc_edge_quantities(block, err) effectiveConducEdge(iEdge) = 0.0_RKIND else effectiveConducEdge(iEdge) = conduc_coeff * waterThicknessEdge(iEdge)**(alpha-1.0_RKIND) *& - gradMagPhiBaseEdge(iEdge)**(beta - 2.0_RKIND) + gradMagPhiBaseEdge(iEdge)**(beta - 2.0_RKIND) endif enddo endif @@ -2192,7 +2191,8 @@ end subroutine ocean_connection_N !> \author Matt Hoffman !> \date 24 October 2022 !> \details -!> This routine calculates a mask of the boundaries of the active hydrology domain +!> This routine calculates a mask of the boundaries of the active hydrology domain. +!> If there no waterFluxMask around domain boundaries, then calc_hydro_mask creates one. !----------------------------------------------------------------------- subroutine calc_hydro_mask(domain) @@ -2291,7 +2291,7 @@ subroutine calc_hydro_mask(domain) end do if (wfmWarning == 1) then - call mpas_log_write('WARNING: Changing waterFluxMask to enforce no-flow conditions at domain boundaries') + call mpas_log_write('Changing waterFluxMask to enforce no-flow conditions at domain boundaries', MPAS_LOG_WARN) endif call mpas_timer_start("halo updates") call mpas_dmpar_field_halo_exch(domain, 'hydroMarineMarginMask') From c3ad2365025dc7ff8f86b26bdda0ac9ce7a9374b Mon Sep 17 00:00:00 2001 From: Matt Hoffman Date: Fri, 5 Apr 2024 14:20:46 -0600 Subject: [PATCH 65/94] Update components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index e8fa19ff51f8..76fdc8c0432c 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -2192,7 +2192,7 @@ end subroutine ocean_connection_N !> \date 24 October 2022 !> \details !> This routine calculates a mask of the boundaries of the active hydrology domain. -!> If there no waterFluxMask around domain boundaries, then calc_hydro_mask creates one. +!> If there is no waterFluxMask set around domain boundaries, then calc_hydro_mask creates one. !----------------------------------------------------------------------- subroutine calc_hydro_mask(domain) From 3ed937dfd495b81916fcdf391d77fa38c40b7f06 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Fri, 5 Apr 2024 15:34:11 -0600 Subject: [PATCH 66/94] Clean up PR Makes a series of minor changes cleaning up the PR in accordance to review comments. Biggest change is the removal of superfluous variable totalGroundingLineDischargeEdge. --- .../src/Registry_subglacial_hydro.xml | 3 - .../mode_forward/mpas_li_subglacial_hydro.F | 60 ++++--------------- 2 files changed, 13 insertions(+), 50 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml index 5aa5d66e7bb6..9199facf7412 100644 --- a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml +++ b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml @@ -232,8 +232,6 @@ description="time step used for evolving subglacial hydrology system" /> - @@ -267,7 +265,6 @@ description="rate of channel melt production within each cell, averaged over cell area" /> - diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 3da17bdcd986..3a6a36a698ed 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -1744,8 +1744,6 @@ subroutine update_channel(block, err) real (kind=RKIND), pointer :: rhoi real (kind=RKIND), pointer :: config_SGH_incipient_channel_width logical, pointer :: config_SGH_include_pressure_melt - real (kind=RKIND), pointer :: config_SGH_bed_roughness_max - real (kind=RKIND), pointer :: config_sea_level real (kind=RKIND), dimension(:), pointer :: channelArea real (kind=RKIND), dimension(:), pointer :: channelMelt real (kind=RKIND), dimension(:), pointer :: channelPressureFreeze @@ -1762,27 +1760,13 @@ subroutine update_channel(block, err) real (kind=RKIND), dimension(:), pointer :: channelEffectivePressure real (kind=RKIND), dimension(:), pointer :: effectivePressure real (kind=RKIND), dimension(:), pointer :: channelDiffusivity - real (kind=RKIND), dimension(:), pointer :: waterThickness - real (kind=RKIND), dimension(:), pointer :: waterPressure - real (kind=RKIND), dimension(:), pointer :: iceThicknessHydro - real (kind=RKIND), dimension(:), pointer :: totalGroundingLineDischargeCell - real (kind=RKIND), dimension(:), pointer :: totalGroundingLineDischargeEdge - real (kind=RKIND), dimension(:), pointer :: dvEdge - real (kind=RKIND), dimension(:), pointer :: bedTopography integer, dimension(:), pointer :: waterFluxMask integer, dimension(:), pointer :: hydroMarineMarginMask integer, dimension(:), pointer :: edgeMask real (kind=RKIND), dimension(:,:), pointer :: flowParamA integer, dimension(:,:), pointer :: cellsOnEdge integer, pointer :: nVertLevels - real (kind=RKIND), pointer :: config_SGH_max_chnl_lake_depth - character (len=StrKIND), pointer :: config_SGH_inhibit_chnls_on_lakes - real (kind=RKIND), dimension(:), pointer :: xCell - real (kind=RKIND), dimension(:), pointer :: yCell - real (kind=RKIND), dimension(:), pointer :: xEdge - real (kind=RKIND), dimension(:), pointer :: yEdge - integer, dimension(:), pointer :: cellMask - integer, pointer :: nEdgesSolve, nEdges + integer, pointer :: nEdgesSolve integer :: iEdge, cell1, cell2 err = 0 @@ -1792,7 +1776,6 @@ subroutine update_channel(block, err) call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) call mpas_pool_get_subpool(block % structs, 'velocity', velocityPool) call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) - call mpas_pool_get_config(liConfigs, 'config_sea_level', config_sea_level) call mpas_pool_get_config(liConfigs, 'config_ice_density', rhoi) call mpas_pool_get_config(liConfigs, 'config_SGH_chnl_conduc_coeff', Kc) call mpas_pool_get_config(liConfigs, 'config_SGH_chnl_alpha', alpha_c) @@ -1800,8 +1783,8 @@ subroutine update_channel(block, err) call mpas_pool_get_config(liConfigs, 'config_SGH_chnl_creep_coefficient', creep_coeff) call mpas_pool_get_config(liConfigs, 'config_SGH_incipient_channel_width', config_SGH_incipient_channel_width) call mpas_pool_get_config(liConfigs, 'config_SGH_include_pressure_melt', config_SGH_include_pressure_melt) - call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve) call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels) + call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve) call mpas_pool_get_array(hydroPool, 'channelArea', channelArea) call mpas_pool_get_array(hydroPool, 'channelMelt', channelMelt) call mpas_pool_get_array(hydroPool, 'channelPressureFreeze', channelPressureFreeze) @@ -1823,17 +1806,8 @@ subroutine update_channel(block, err) call mpas_pool_get_array(hydroPool, 'hydroMarineMarginMask', hydroMarineMarginMask) call mpas_pool_get_array(hydroPool, 'channelDiffusivity', channelDiffusivity) call mpas_pool_get_array(geometryPool, 'edgeMask', edgeMask) - call mpas_pool_get_array(meshPool, 'xCell', xCell) - call mpas_pool_get_array(meshPool, 'yCell', yCell) - call mpas_pool_get_array(meshPool, 'xEdge', xEdge) - call mpas_pool_get_array(meshPool, 'yEdge', yEdge) - call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge) - call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) - call mpas_pool_get_array(hydroPool, 'totalGroundingLineDischargeCell', totalGroundingLineDischargeCell) - call mpas_pool_get_array(hydroPool, 'totalGroundingLineDischargeEdge', totalGroundingLineDischargeEdge) - call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) + ! Calculate terms needed for opening (melt) rate - where(gradMagPhiEdge < 0.01_RKIND) channelDischarge(:) = 0.0_RKIND elsewhere @@ -2307,11 +2281,11 @@ end subroutine calc_hydro_mask ! ! routine calc_gl_total ! -!> \brief Calculate total grounding line discharge on edges and -! adjacent cells +!> \brief Calculate total grounding line discharge on +! adjacent ocean cell !> \author Alex Hager !> \date 27 March 2024 -!> \details +!> \details Find the total amount of freshwater entering the first ocean cell from the grounding line. !----------------------------------------------------------------------- subroutine calc_gl_totals(block, err) @@ -2342,7 +2316,6 @@ subroutine calc_gl_totals(block, err) type (mpas_pool_type), pointer :: meshPool real (kind=RKIND), dimension(:), pointer :: totalGroundingLineDischargeCell - real (kind=RKIND), dimension(:), pointer :: totalGroundingLineDischargeEdge real (kind=RKIND), dimension(:), pointer :: bedTopography real (kind=RKIND), dimension(:), pointer :: channelDischarge real (kind=RKIND), dimension(:), pointer :: waterFlux @@ -2352,6 +2325,7 @@ subroutine calc_gl_totals(block, err) integer, dimension(:,:), pointer :: cellsOnEdge integer, dimension(:), pointer :: hydroMarineMarginMask integer, dimension(:), pointer :: cellMask + real (kind=RKIND) :: totalGroundingLineDischargeEdge real (kind=RKIND), pointer :: config_sea_level call mpas_pool_get_subpool(block % structs, 'hydro', hydroPool) @@ -2359,7 +2333,6 @@ subroutine calc_gl_totals(block, err) call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) call mpas_pool_get_array(hydroPool, 'totalGroundingLineDischargeCell', totalGroundingLineDischargeCell) - call mpas_pool_get_array(hydroPool, 'totalGroundingLineDischargeEdge', totalGroundingLineDischargeEdge) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(hydroPool, 'channelDischarge', channelDischarge) call mpas_pool_get_array(hydroPool, 'waterFlux', waterFlux) @@ -2371,25 +2344,18 @@ subroutine calc_gl_totals(block, err) call mpas_pool_get_config(liConfigs, 'config_sea_level', config_sea_level) totalGroundingLineDischargeCell(:) = 0.0_RKIND - totalGroundingLineDischargeEdge(:) = 0.0_RKIND do iEdge = 1, nEdgesSolve cell1 = cellsOnEdge(1, iEdge) cell2 = cellsOnEdge(2, iEdge) if (hydroMarineMarginMask(iEdge) == 1) then - ! We are looking for edges with 1 cell grounded ice and the - ! other cell floating ice or open ocean - if ( (li_mask_is_grounded_ice(cellMask(cell1))) .and. & - (li_mask_is_floating_ice(cellMask(cell2)) .or. & - ((bedTopography(cell2) < config_sea_level) .and. (.not. li_mask_is_ice(cellMask(cell2)))) ) ) then - totalGroundingLineDischargeEdge(iEdge) = abs(channelDischarge(iEdge)) +abs( waterFlux(iEdge) * dvEdge(iEdge)) - totalGroundingLineDischargeCell(cell2) = totalGroundingLineDischargeCell(cell2) + totalGroundingLineDischargeEdge(iEdge) - elseif ( (li_mask_is_grounded_ice(cellMask(cell2))) .and. & - (li_mask_is_floating_ice(cellMask(cell1)) .or. & - ((bedTopography(cell1) < config_sea_level) .and. (.not. li_mask_is_ice(cellMask(cell1)))) ) ) then - totalGroundingLineDischargeEdge(iEdge) = abs(channelDischarge(iEdge)) + abs(waterFlux(iEdge) * dvEdge(iEdge)) - totalGroundingLineDischargeCell(cell1) = totalGroundingLineDischargeCell(cell1) + totalGroundingLineDischargeEdge(iEdge) + if (li_mask_is_grounded_ice(cellMask(cell1))) then + totalGroundingLineDischargeEdge = abs(channelDischarge(iEdge)) +abs( waterFlux(iEdge) * dvEdge(iEdge)) + totalGroundingLineDischargeCell(cell2) = totalGroundingLineDischargeCell(cell2) + totalGroundingLineDischargeEdge + elseif (li_mask_is_grounded_ice(cellMask(cell2))) then + totalGroundingLineDischargeEdge = abs(channelDischarge(iEdge)) + abs(waterFlux(iEdge) * dvEdge(iEdge)) + totalGroundingLineDischargeCell(cell1) = totalGroundingLineDischargeCell(cell1) + totalGroundingLineDischargeEdge endif endif enddo From f2325d3849b51cbc62715afcdcba3b10f7bb2b34 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Fri, 5 Apr 2024 16:52:36 -0600 Subject: [PATCH 67/94] dist. and chnl. grounding line totals Calculates the distributed and channelized contributions to totalGroundingLineDischargeCell --- .../src/Registry_subglacial_hydro.xml | 8 +++++-- .../mode_forward/mpas_li_subglacial_hydro.F | 21 +++++++++++++++++-- 2 files changed, 25 insertions(+), 4 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml index 9199facf7412..61d8fa7f6812 100644 --- a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml +++ b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml @@ -229,10 +229,14 @@ + description="time step used for evolving subglacial hydrology system" /> + + description="total (channel + dist.) discharge across the grounding line, extrapolated from edge to adjacent ungrounded cell. Values from all edges are summed if multiple grounding line edges border a single ungrounded cell" /> + Date: Mon, 8 Apr 2024 14:41:54 -0700 Subject: [PATCH 68/94] Improve remove_small_islands Remove small islands that are one or two grounded cells with or without a one-cell-wide floating dynamic ice shelf. --- .../src/mode_forward/mpas_li_calving.F | 210 +++++++++++++----- 1 file changed, 158 insertions(+), 52 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F index 1df2391cdb2c..7d4b7799520e 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F @@ -320,6 +320,10 @@ subroutine li_calve_ice(domain, err, solveVeloAfterCalving) call li_calculate_mask(meshPool, velocityPool, geometryPool, err_tmp) + call remove_small_islands(meshPool, geometryPool, domain) + + call li_calculate_mask(meshPool, velocityPool, geometryPool, err_tmp) + ! now also remove any icebergs call remove_icebergs(domain) @@ -336,7 +340,6 @@ subroutine li_calve_ice(domain, err, solveVeloAfterCalving) call mpas_pool_get_array(geometryPool, 'calvingThickness', calvingThickness) call mpas_pool_get_dimension(meshPool, 'nCells', nCells) - call remove_small_islands(meshPool, geometryPool) ! In data calving mode we just calculate what should be calved but don't actually calve it. ! So set thickness back to original value. if (config_data_calving) then @@ -1023,20 +1026,23 @@ end subroutine floating_calving ! routine remove_small_islands ! !> \brief Remove very small islands that lead to velocity solver problems -!> \author Matthew Hoffman -!> \date Summer 2018 +!> \author Matthew Hoffman, Trevor Hillebrand +!> \date Summer 2018, re-written Apr 2024 !> \details This routine finds and eliminates very small islands that lead to !> unrealistic velocities in the Albany velocity solver. Specifically, this -!> finds one- and two-cell masses of ice that are surrounded by open ocean -!> and eliminates them by sending them to the calving flux. +!> finds one- and two-cell masses of grounded ice that are surrounded by dynamic +!> floating ice ice shelves ≥1 cell wide. It eliminates the dynamic cells +!> (both grounded and floating) in these islands by sending them to the +!> and then cleans up stranded non-dynamic cells using a flood-fill routine. !----------------------------------------------------------------------- - subroutine remove_small_islands(meshPool, geometryPool) + subroutine remove_small_islands(meshPool, geometryPool, domain) type (mpas_pool_type), pointer, intent(in) :: meshPool !< Input: Mesh pool type (mpas_pool_type), pointer, intent(inout) :: geometryPool !< Input: Geometry pool + type (domain_type), intent(inout) :: domain !< Input/Output: domain object + type (mpas_pool_type), pointer :: scratchPool logical, pointer :: config_remove_small_islands - real(kind=RKIND), pointer :: config_sea_level real (kind=RKIND), dimension(:), pointer :: calvingThickness ! thickness of ice that calves (computed in this subroutine) real (kind=RKIND), dimension(:), pointer :: calvingThicknessFromThreshold ! thickness of ice that calves (computed in this subroutine) real (kind=RKIND), dimension(:), pointer :: thickness @@ -1044,73 +1050,173 @@ subroutine remove_small_islands(meshPool, geometryPool) integer, dimension(:), pointer :: cellMask integer, dimension(:,:), pointer :: cellsOnCell ! list of cells that neighbor each cell integer, dimension(:), pointer :: nEdgesOnCell ! number of cells that border each cell - integer, pointer :: nCellsSolve - integer :: iCell, jCell, n, nIceNeighbors, nIceNeighbors2, neighborWithIce - integer :: nOpenOceanNeighbors, nOpenOceanNeighbors2 + integer, pointer :: nCells, maxEdges + logical :: removeIsland + integer :: iCell, jCell, kCell, m, n, count + integer :: nGroundedNeighbors, nGroundedNeighborsJCell + integer, dimension(:), allocatable :: connectedCellsList + integer, dimension(:), allocatable :: islandMask + type (field1dInteger), pointer :: seedMaskField + type (field1dInteger), pointer :: growMaskField + integer, dimension(:), pointer :: seedMask, growMask !masks to pass to flood-fill routine call mpas_pool_get_config(liConfigs, 'config_remove_small_islands', config_remove_small_islands) if (.not. config_remove_small_islands) then return ! skip this entire routine if disabled endif - call mpas_pool_get_config(liConfigs, 'config_sea_level', config_sea_level) - call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCellsSolve) + call mpas_pool_get_subpool(domain % blocklist % structs, 'scratch', scratchPool) + + call mpas_pool_get_dimension(meshPool, 'nCells', nCells) + call mpas_pool_get_dimension(meshPool, 'maxEdges', maxEdges) call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) call mpas_pool_get_array(geometryPool, 'calvingThickness', calvingThickness) call mpas_pool_get_array(geometryPool, 'calvingThicknessFromThreshold', calvingThicknessFromThreshold) call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) - call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) - do iCell = 1, nCellsSolve - if (li_mask_is_ice(cellMask(iCell))) then ! might as well do for both grounded or floating - ! (1 or 2 cell floating masses are icebergs) - nIceNeighbors = 0 - nOpenOceanNeighbors = 0 + allocate(connectedCellsList((maxEdges+1)**2), & + islandMask(nCells+1)) + + islandMask(:) = 0 + + ! Allocate scratch fields for flood-fill + call mpas_pool_get_field(scratchPool, 'seedMask', seedMaskField) + call mpas_allocate_scratch_field(seedMaskField, single_block_in = .true.) + seedMask => seedMaskField % array + seedMask(:) = 0 + + call mpas_pool_get_field(scratchPool, 'growMask', growMaskField) + call mpas_allocate_scratch_field(growMaskField, single_block_in = .true.) + growMask => growMaskField % array + growMask(:) = 0 + + ! Loop over cells to find one- and two-cell regions of grounded ice, + ! which are potentially islands that need to be removed. + do iCell = 1, nCells + if (li_mask_is_grounded_ice(cellMask(iCell))) then + + nGroundedNeighbors = 0 + ! Count grounded neighbors do n = 1, nEdgesOnCell(iCell) jCell = cellsOnCell(n, iCell) - if (li_mask_is_ice(cellMask(jCell))) then - nIceNeighbors = nIceNeighbors + 1 - neighborWithIce = jCell + if (li_mask_is_grounded_ice(cellMask(jCell))) then + nGroundedNeighbors = nGroundedNeighbors + 1 endif - if (.not. li_mask_is_ice(cellMask(jCell)) .and. bedTopography(jCell) < config_sea_level) then - nOpenOceanNeighbors = nOpenOceanNeighbors + 1 + nGroundedNeighborsJCell = 0 + ! If the neighbor contains dynamic ice, check whether + ! it has other grounded neighbors. If it does, then we + ! will not consider this an island. + if (li_mask_is_dynamic_ice(cellMask(jCell))) then + do m = 1, nEdgesOnCell(jCell) + kCell = cellsOnCell(m, jCell) + if (li_mask_is_grounded_ice(cellMask(kCell))) then + nGroundedNeighborsJCell = nGroundedNeighborsJCell + 1 + endif + enddo + endif + ! If this grounded cell is dynamically connected to 1 or + ! fewer other grounded cells, then it should potentially + ! be removed. If its dynamic neighbors have other grounded + ! neighbors, then it is not an island. + if ( (nGroundedNeighborsJCell .le. 1) .and. & + (nGroundedNeighbors .le. 1) ) then + islandMask(iCell) = 1 + else + islandMask(iCell) = 0 endif enddo - if ((nIceNeighbors == 0) .and. (nOpenOceanNeighbors == nEdgesOnCell(iCell))) then - ! If this is a single cell of ice surrounded by open ocean, kill this location + endif + enddo + + ! Determine whether to remove each island. First, make a list of the + ! dynamic neighbors of the cells in islandMask. If the grounded island + ! cell has a grounded neighbour, add that neighbor's dynamic neighbors + ! to the list. Then, check that all the dynamic neighbors of the cells + ! in the list are also in the list. If so, then this is considered an + ! island and is removed. If not, then leave it alone. + do iCell = 1, nCells + connectedCellsList(:) = -1 + if (islandMask(iCell) == 1) then + removeIsland = .true. ! evalulated and updated below + ! Make a list of the grounded island cell and its + ! dynamic neighbors. + count = 1 + connectedCellsList(count) = iCell + do n = 1, nEdgesOnCell(iCell) + jCell = cellsOnCell(n, iCell) + if (li_mask_is_dynamic_ice(cellMask(jCell))) then + count = count + 1 + connectedCellsList(count) = jCell + endif + ! If there is a grounded neighbor, list its dynamic neighbors as well + if (li_mask_is_grounded_ice(cellMask(jCell))) then + do m = 1, nEdgesOnCell(jCell) + kCell = cellsOnCell(m, jCell) + if (li_mask_is_dynamic_ice(cellMask(kCell))) then + count = count + 1 + connectedCellsList(count) = kCell + endif + enddo + endif + enddo + ! Check that all the dynamic neighbors of neighbors are + ! in the list. If not, then do not remove the island. + do n = 1, (maxEdges+1)**2 + if (connectedCellsList(n) == -1) then + exit ! We've reached the end of the list. + else + jCell = connectedCellsList(n) + do m = 1, nEdgesOnCell(jCell) + kCell = cellsOnCell(m, jCell) + if ( li_mask_is_dynamic_ice(cellMask(kCell)) .and. & + (.not. any(connectedCellsList == kCell)) ) then + removeIsland = .false. + exit + endif + enddo + endif + enddo + ! Actually remove island + ! TODO: halo update needed? Would need to change logic. + if ( removeIsland ) then + do n = 1, count + calvingThickness(connectedCellsList(n)) = calvingThickness(connectedCellsList(n)) + & + thickness(connectedCellsList(n)) + calvingThicknessFromThreshold(connectedCellsList(n)) = & + calvingThicknessFromThreshold(connectedCellsList(n)) + thickness(connectedCellsList(n)) + thickness(connectedCellsList(n)) = 0.0_RKIND + enddo + endif + endif + enddo + + ! Clean up by removing non-dynamic ice that may have been left behind + ! after islands where removed. + where (li_mask_is_grounded_ice(cellMask)) + seedMask = 1 + end where + + where (li_mask_is_ice(cellMask)) + growMask = 1 + end where + + call mpas_log_write("***Cleaning up stranded cells after removing small islands***") + call li_flood_fill(seedMask, growMask, domain) + do iCell = 1, nCells + if (li_mask_is_floating_ice(cellMask(iCell)) .and. seedMask(iCell) == 0) then calvingThickness(iCell) = calvingThickness(iCell) + thickness(iCell) calvingThicknessFromThreshold(iCell) = calvingThicknessFromThreshold(iCell) + thickness(iCell) thickness(iCell) = 0.0_RKIND - elseif (nIceNeighbors == 1) then - ! check if this neighbor has any additional neighbors with ice - nIceNeighbors2 = 0 - nOpenOceanNeighbors2 = 0 - do n = 1, nEdgesOnCell(neighborWithIce) - jCell = cellsOnCell(n, neighborWithIce) - if (li_mask_is_ice(cellMask(jCell))) then - nIceNeighbors2 = nIceNeighbors2 + 1 - endif - if (.not. li_mask_is_ice(cellMask(jCell)) .and. bedTopography(jCell) < config_sea_level) then - nOpenOceanNeighbors2 = nOpenOceanNeighbors2 + 1 - endif - enddo - if ((nIceNeighbors2 == 1) .and. (nOpenOceanNeighbors2 == nEdgesOnCell(iCell)-1)) then - ! <- only neighbor with ice must have been iCell - ! kill both cells - calvingThickness(iCell) = calvingThickness(iCell) + thickness(iCell) - calvingThicknessFromThreshold(iCell) = calvingThicknessFromThreshold(iCell) + thickness(iCell) - thickness(iCell) = 0.0_RKIND - calvingThickness(neighborWithIce) = calvingThickness(neighborWithIce) + thickness(neighborWithIce) - calvingThicknessFromThreshold(neighborWithIce) = calvingThicknessFromThreshold(neighborWithIce) + thickness(neighborWithIce) - thickness(neighborWithIce) = 0.0_RKIND - endif - - endif ! check on nIceNeighbors + endif + enddo + call mpas_log_write("***Finished cleaning up after removing small islands***") - endif ! check if iCell has ice - end do ! loop over cells + deallocate(connectedCellsList, & + islandMask) + call mpas_deallocate_scratch_field(seedMaskField, single_block_in=.true.) + call mpas_deallocate_scratch_field(growMaskField, single_block_in=.true.) end subroutine remove_small_islands From 5e8b488dce3c4eab15346db343dcc8f92395c474 Mon Sep 17 00:00:00 2001 From: Trevor Hillebrand Date: Tue, 9 Apr 2024 14:18:12 -0700 Subject: [PATCH 69/94] Fix small bug in setting islandMask Fix small bug in setting islandMask. Also apply suggestions from code review. --- .../src/mode_forward/mpas_li_calving.F | 98 +++++++++++-------- 1 file changed, 55 insertions(+), 43 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F index 7d4b7799520e..6997af422493 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F @@ -320,7 +320,7 @@ subroutine li_calve_ice(domain, err, solveVeloAfterCalving) call li_calculate_mask(meshPool, velocityPool, geometryPool, err_tmp) - call remove_small_islands(meshPool, geometryPool, domain) + call remove_small_islands(domain, err_tmp) call li_calculate_mask(meshPool, velocityPool, geometryPool, err_tmp) @@ -1032,16 +1032,14 @@ end subroutine floating_calving !> unrealistic velocities in the Albany velocity solver. Specifically, this !> finds one- and two-cell masses of grounded ice that are surrounded by dynamic !> floating ice ice shelves ≥1 cell wide. It eliminates the dynamic cells -!> (both grounded and floating) in these islands by sending them to the -!> and then cleans up stranded non-dynamic cells using a flood-fill routine. +!> (both grounded and floating) in these islands by sending them to the calving +!> flux and then cleans up stranded non-dynamic cells using a flood-fill routine. !----------------------------------------------------------------------- - subroutine remove_small_islands(meshPool, geometryPool, domain) - type (mpas_pool_type), pointer, intent(in) :: meshPool !< Input: Mesh pool - type (mpas_pool_type), pointer, intent(inout) :: geometryPool !< Input: Geometry pool + subroutine remove_small_islands(domain, err) type (domain_type), intent(inout) :: domain !< Input/Output: domain object - - type (mpas_pool_type), pointer :: scratchPool + integer, intent(inout) :: err + type (mpas_pool_type), pointer :: scratchPool, meshPool, geometryPool, velocityPool logical, pointer :: config_remove_small_islands real (kind=RKIND), dimension(:), pointer :: calvingThickness ! thickness of ice that calves (computed in this subroutine) real (kind=RKIND), dimension(:), pointer :: calvingThicknessFromThreshold ! thickness of ice that calves (computed in this subroutine) @@ -1053,6 +1051,7 @@ subroutine remove_small_islands(meshPool, geometryPool, domain) integer, pointer :: nCells, maxEdges logical :: removeIsland integer :: iCell, jCell, kCell, m, n, count + integer :: nIslandCellsLocal, nIslandCellsGlobal integer :: nGroundedNeighbors, nGroundedNeighborsJCell integer, dimension(:), allocatable :: connectedCellsList integer, dimension(:), allocatable :: islandMask @@ -1066,6 +1065,9 @@ subroutine remove_small_islands(meshPool, geometryPool, domain) endif call mpas_pool_get_subpool(domain % blocklist % structs, 'scratch', scratchPool) + call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool) + call mpas_pool_get_subpool(domain % blocklist % structs, 'geometry', geometryPool) + call mpas_pool_get_subpool(domain % blocklist % structs, 'velocity', velocityPool) call mpas_pool_get_dimension(meshPool, 'nCells', nCells) call mpas_pool_get_dimension(meshPool, 'maxEdges', maxEdges) @@ -1080,7 +1082,8 @@ subroutine remove_small_islands(meshPool, geometryPool, domain) islandMask(nCells+1)) islandMask(:) = 0 - + nIslandCellsLocal = 0 + nIslandCellsGlobal = 0 ! Allocate scratch fields for flood-fill call mpas_pool_get_field(scratchPool, 'seedMask', seedMaskField) call mpas_allocate_scratch_field(seedMaskField, single_block_in = .true.) @@ -1096,7 +1099,7 @@ subroutine remove_small_islands(meshPool, geometryPool, domain) ! which are potentially islands that need to be removed. do iCell = 1, nCells if (li_mask_is_grounded_ice(cellMask(iCell))) then - + islandMask(iCell) = 1 ! Potentially an island. Further evaluated below. nGroundedNeighbors = 0 ! Count grounded neighbors do n = 1, nEdgesOnCell(iCell) @@ -1120,11 +1123,10 @@ subroutine remove_small_islands(meshPool, geometryPool, domain) ! fewer other grounded cells, then it should potentially ! be removed. If its dynamic neighbors have other grounded ! neighbors, then it is not an island. - if ( (nGroundedNeighborsJCell .le. 1) .and. & - (nGroundedNeighbors .le. 1) ) then - islandMask(iCell) = 1 - else + if ( (nGroundedNeighborsJCell > 1) .or. & + (nGroundedNeighbors > 1) ) then islandMask(iCell) = 0 + exit endif enddo endif @@ -1166,53 +1168,63 @@ subroutine remove_small_islands(meshPool, geometryPool, domain) do n = 1, (maxEdges+1)**2 if (connectedCellsList(n) == -1) then exit ! We've reached the end of the list. - else - jCell = connectedCellsList(n) - do m = 1, nEdgesOnCell(jCell) - kCell = cellsOnCell(m, jCell) - if ( li_mask_is_dynamic_ice(cellMask(kCell)) .and. & - (.not. any(connectedCellsList == kCell)) ) then - removeIsland = .false. - exit - endif - enddo endif + jCell = connectedCellsList(n) + do m = 1, nEdgesOnCell(jCell) + kCell = cellsOnCell(m, jCell) + if ( li_mask_is_dynamic_ice(cellMask(kCell)) .and. & + (.not. any(connectedCellsList == kCell)) ) then + removeIsland = .false. + exit + endif + enddo enddo ! Actually remove island - ! TODO: halo update needed? Would need to change logic. if ( removeIsland ) then + nIslandCellsLocal = nIslandCellsLocal + count do n = 1, count calvingThickness(connectedCellsList(n)) = calvingThickness(connectedCellsList(n)) + & thickness(connectedCellsList(n)) calvingThicknessFromThreshold(connectedCellsList(n)) = & calvingThicknessFromThreshold(connectedCellsList(n)) + thickness(connectedCellsList(n)) thickness(connectedCellsList(n)) = 0.0_RKIND + ! No need to evaluate any cells in this list again. + if (islandMask(connectedCellsList(n)) == 1) islandMask(connectedCellsList(n)) = 0 enddo endif endif enddo - ! Clean up by removing non-dynamic ice that may have been left behind - ! after islands where removed. - where (li_mask_is_grounded_ice(cellMask)) - seedMask = 1 - end where + call mpas_timer_start("halo updates") + call mpas_dmpar_field_halo_exch(domain, 'thickness') + call mpas_dmpar_field_halo_exch(domain, 'calvingThickness') + call mpas_timer_stop("halo updates") + call li_calculate_mask(meshPool, velocityPool, geometryPool, err) - where (li_mask_is_ice(cellMask)) - growMask = 1 - end where + call mpas_dmpar_sum_int(domain % dminfo, nIslandCellsLocal, nIslandCellsGlobal) - call mpas_log_write("***Cleaning up stranded cells after removing small islands***") - call li_flood_fill(seedMask, growMask, domain) - do iCell = 1, nCells - if (li_mask_is_floating_ice(cellMask(iCell)) .and. seedMask(iCell) == 0) then - calvingThickness(iCell) = calvingThickness(iCell) + thickness(iCell) - calvingThicknessFromThreshold(iCell) = calvingThicknessFromThreshold(iCell) + thickness(iCell) - thickness(iCell) = 0.0_RKIND - endif - enddo - call mpas_log_write("***Finished cleaning up after removing small islands***") + if ( nIslandCellsGlobal > 0 ) then + ! Clean up by removing non-dynamic ice that may have been left behind + ! after islands where removed. + where (li_mask_is_grounded_ice(cellMask)) + seedMask = 1 + end where + + where (li_mask_is_ice(cellMask)) + growMask = 1 + end where + call mpas_log_write("***Cleaning up stranded cells after removing small islands***") + call li_flood_fill(seedMask, growMask, domain) + do iCell = 1, nCells + if (li_mask_is_floating_ice(cellMask(iCell)) .and. seedMask(iCell) == 0) then + calvingThickness(iCell) = calvingThickness(iCell) + thickness(iCell) + calvingThicknessFromThreshold(iCell) = calvingThicknessFromThreshold(iCell) + thickness(iCell) + thickness(iCell) = 0.0_RKIND + endif + enddo + call mpas_log_write("***Finished cleaning up after removing small islands***") + endif deallocate(connectedCellsList, & islandMask) call mpas_deallocate_scratch_field(seedMaskField, single_block_in=.true.) From 338d3e693e8aeabbb0e6126941eb91ef8c4501a1 Mon Sep 17 00:00:00 2001 From: alexolinhager <131483939+alexolinhager@users.noreply.github.com> Date: Tue, 9 Apr 2024 17:10:36 -0700 Subject: [PATCH 70/94] Apply suggestions from code review Co-authored-by: Matt Hoffman --- .../mpas-albany-landice/src/Registry_subglacial_hydro.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml index 61d8fa7f6812..12c669d9093d 100644 --- a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml +++ b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml @@ -231,12 +231,12 @@ + description="distributed discharge across the grounding line, summed from grounding line edges to adjacent ungrounded cell. Values from all edges are summed if multiple grounding line edges border a single ungrounded cell" /> + description="total (channel + dist.) discharge across the grounding line, summed from grounding line edges to adjacent ungrounded cell. Values from all edges are summed if multiple grounding line edges border a single ungrounded cell" /> + description="channel discharge across the grounding line, summed from grounding line edges to adjacent ungrounded cell. Values from all edges are summed if multiple grounding line edges border a single ungrounded cell" /> Date: Tue, 9 Apr 2024 18:15:49 -0600 Subject: [PATCH 71/94] Minor PR Review Edits Minor edits to code following PR review --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 009a4e4f2ec9..0028e75086eb 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -562,10 +562,6 @@ subroutine li_SGH_solve(domain, err) block => block % next end do - call mpas_timer_start("halo updates") - call mpas_dmpar_field_halo_exch(domain, 'totalGroundingLineDischargeCell') - call mpas_dmpar_field_halo_exch(domain, 'totalGroundingLineDischargeEdge') - call mpas_timer_stop("halo updates") ! ============= ! Update water layer thickness @@ -2318,7 +2314,6 @@ subroutine calc_gl_totals(block, err) real (kind=RKIND), dimension(:), pointer :: distGroundingLineDischargeCell real (kind=RKIND), dimension(:), pointer :: chnlGroundingLineDischargeCell real (kind=RKIND), dimension(:), pointer :: totalGroundingLineDischargeCell - real (kind=RKIND), dimension(:), pointer :: bedTopography real (kind=RKIND), dimension(:), pointer :: channelDischarge real (kind=RKIND), dimension(:), pointer :: waterFlux real (kind=RKIND), dimension(:), pointer :: dvEdge @@ -2330,7 +2325,6 @@ subroutine calc_gl_totals(block, err) real (kind=RKIND) :: distGroundingLineDischargeEdge real (kind=RKIND) :: chnlGroundingLineDischargeEdge real (kind=RKIND) :: totalGroundingLineDischargeEdge - real (kind=RKIND), pointer :: config_sea_level call mpas_pool_get_subpool(block % structs, 'hydro', hydroPool) call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) @@ -2339,7 +2333,6 @@ subroutine calc_gl_totals(block, err) call mpas_pool_get_array(hydroPool, 'distGroundingLineDischargeCell', distGroundingLineDischargeCell) call mpas_pool_get_array(hydroPool, 'chnlGroundingLineDischargeCell', chnlGroundingLineDischargeCell) call mpas_pool_get_array(hydroPool, 'totalGroundingLineDischargeCell', totalGroundingLineDischargeCell) - call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(hydroPool, 'channelDischarge', channelDischarge) call mpas_pool_get_array(hydroPool, 'waterFlux', waterFlux) call mpas_pool_get_array(meshPool, 'dvEdge', dvEdge) @@ -2347,18 +2340,18 @@ subroutine calc_gl_totals(block, err) call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge) call mpas_pool_get_array(hydroPool, 'hydroMarineMarginMask', hydroMarineMarginMask) call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) - call mpas_pool_get_config(liConfigs, 'config_sea_level', config_sea_level) distGroundingLineDischargeCell(:) = 0.0_RKIND chnlGroundingLineDischargeCell(:) = 0.0_RKIND totalGroundingLineDischargeCell(:) = 0.0_RKIND do iEdge = 1, nEdgesSolve - cell1 = cellsOnEdge(1, iEdge) - cell2 = cellsOnEdge(2, iEdge) if (hydroMarineMarginMask(iEdge) == 1) then + cell1 = cellsOnEdge(1, iEdge) + cell2 = cellsOnEdge(2, iEdge) + !calculate totals at each grounding line edge distGroundingLineDischargeEdge = abs(waterFlux(iEdge) * dvEdge(iEdge)) chnlGroundingLineDischargeEdge = abs(channelDischarge(iEdge)) From 40c5a75790c972a0458ad73a2eabb4f14a7b03c5 Mon Sep 17 00:00:00 2001 From: Matt Hoffman Date: Tue, 9 Apr 2024 20:20:06 -0600 Subject: [PATCH 72/94] Remove whitespace addition --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 1 - 1 file changed, 1 deletion(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 0028e75086eb..d54d87356c82 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -1802,7 +1802,6 @@ subroutine update_channel(block, err) call mpas_pool_get_array(hydroPool, 'hydroMarineMarginMask', hydroMarineMarginMask) call mpas_pool_get_array(hydroPool, 'channelDiffusivity', channelDiffusivity) call mpas_pool_get_array(geometryPool, 'edgeMask', edgeMask) - ! Calculate terms needed for opening (melt) rate where(gradMagPhiEdge < 0.01_RKIND) channelDischarge(:) = 0.0_RKIND From c7cbee480925f25e5a4945f2993eeaba806e99b6 Mon Sep 17 00:00:00 2001 From: Trevor Hillebrand Date: Wed, 10 Apr 2024 12:19:23 -0600 Subject: [PATCH 73/94] Apply suggestions from code review Add more descriptive comments. Co-authored-by: Matt Hoffman --- .../src/mode_forward/mpas_li_calving.F | 22 ++++++++++++++----- 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F index 6997af422493..5de1d6f5c7e3 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F @@ -1095,8 +1095,12 @@ subroutine remove_small_islands(domain, err) growMask => growMaskField % array growMask(:) = 0 - ! Loop over cells to find one- and two-cell regions of grounded ice, - ! which are potentially islands that need to be removed. + ! Loop over cells to find one- and two-cell regions of grounded ice + ! that are not dynamically connected to other grounded regions, + ! which are "islands" that potentially need to be removed. + ! In this first phase we identify islands that meet these + ! criteria. In phase 2 below we check if islands are dynamically + ! connected to floating ice, which will disqualify them for removal. do iCell = 1, nCells if (li_mask_is_grounded_ice(cellMask(iCell))) then islandMask(iCell) = 1 ! Potentially an island. Further evaluated below. @@ -1132,12 +1136,14 @@ subroutine remove_small_islands(domain, err) endif enddo - ! Determine whether to remove each island. First, make a list of the - ! dynamic neighbors of the cells in islandMask. If the grounded island - ! cell has a grounded neighbour, add that neighbor's dynamic neighbors + ! Determine whether to remove each island based on if it is dynamically + ! connected to other regions. For each cell in islandMask, + ! first make a list of its dynamic neighbors. If the grounded island + ! cell has a grounded neighbor, add that neighbor's dynamic neighbors ! to the list. Then, check that all the dynamic neighbors of the cells ! in the list are also in the list. If so, then this is considered an - ! island and is removed. If not, then leave it alone. + ! isolated island and is removed. If not, then it is dynamically connected + ! to other regions, so we leave it alone. do iCell = 1, nCells connectedCellsList(:) = -1 if (islandMask(iCell) == 1) then @@ -1182,6 +1188,10 @@ subroutine remove_small_islands(domain, err) ! Actually remove island if ( removeIsland ) then nIslandCellsLocal = nIslandCellsLocal + count + ! Note: nIslandCellsLocal may be inaccurate as neighbors or neighbors of neighbors to iCell + ! may get tallied multiple times from different members of islandMask. However, we only need + ! to know if nIslandCells>0, so this is ok. If we ever need an accurate value of nIslandCells, + ! some additional steps must be taken to avoid potential double counting. do n = 1, count calvingThickness(connectedCellsList(n)) = calvingThickness(connectedCellsList(n)) + & thickness(connectedCellsList(n)) From 0f9b78db2f4f77db99a0d43b889f65408bbb3394 Mon Sep 17 00:00:00 2001 From: Trevor Hillebrand Date: Wed, 10 Apr 2024 12:26:06 -0600 Subject: [PATCH 74/94] Apply more suggestions from code review Add another verbose comment. Co-authored-by: Matt Hoffman --- .../src/mode_forward/mpas_li_calving.F | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F index 5de1d6f5c7e3..054bc897574e 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F @@ -1123,10 +1123,15 @@ subroutine remove_small_islands(domain, err) endif enddo endif - ! If this grounded cell is dynamically connected to 1 or - ! fewer other grounded cells, then it should potentially - ! be removed. If its dynamic neighbors have other grounded - ! neighbors, then it is not an island. + ! Two checks that a grounded cell is NOT a 1 or 2 cell island: + ! 1. If a grounded cell has more than 1 grounded neighbor, it is not an island + ! This is the nGroundedNeighbors criterion. It gets re-evaluated with every + ! neighbor each time through the loop. It may not trigger on early checks + ! but it will trigger eventually if this cell has more than 1 grounded neighbor. + ! 2. If its dynamic neighbors have other grounded neighbors, then we do not + ! consider it an island. This is the nGroundedNeighborsJCell criterion. + ! Any grounded cells that survive these two checks are considered islands + ! and are further evaluated in the next phase. if ( (nGroundedNeighborsJCell > 1) .or. & (nGroundedNeighbors > 1) ) then islandMask(iCell) = 0 From e30be2d77f627c8fed81ffadf35a927cd430a5b2 Mon Sep 17 00:00:00 2001 From: Trevor Hillebrand Date: Wed, 10 Apr 2024 12:27:48 -0700 Subject: [PATCH 75/94] Add some further clarifying comments Add some further clarifying comments, and label phases 1 and 2. --- .../src/mode_forward/mpas_li_calving.F | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F index 054bc897574e..de2a523e9339 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F @@ -1095,12 +1095,14 @@ subroutine remove_small_islands(domain, err) growMask => growMaskField % array growMask(:) = 0 - ! Loop over cells to find one- and two-cell regions of grounded ice - ! that are not dynamically connected to other grounded regions, - ! which are "islands" that potentially need to be removed. + ! Phase 1: Loop over cells to find one- and two-cell regions of + ! grounded ice that are not dynamically connected to other grounded + ! regions, which are "islands" that potentially need to be removed. ! In this first phase we identify islands that meet these - ! criteria. In phase 2 below we check if islands are dynamically - ! connected to floating ice, which will disqualify them for removal. + ! criteria. In phase 2 below we check if islands are dynamically + ! connected to more extensive floating ice, which will disqualify + ! them for removal to avoid removing pinning points from ice + ! shelves, for example. do iCell = 1, nCells if (li_mask_is_grounded_ice(cellMask(iCell))) then islandMask(iCell) = 1 ! Potentially an island. Further evaluated below. @@ -1141,8 +1143,8 @@ subroutine remove_small_islands(domain, err) endif enddo - ! Determine whether to remove each island based on if it is dynamically - ! connected to other regions. For each cell in islandMask, + ! Phase 2: Determine whether to remove each island based on if it is + ! dynamically connected to other regions. For each cell in islandMask, ! first make a list of its dynamic neighbors. If the grounded island ! cell has a grounded neighbor, add that neighbor's dynamic neighbors ! to the list. Then, check that all the dynamic neighbors of the cells From 289951d1eb76f89b40a77fde44d1ea46ce153b61 Mon Sep 17 00:00:00 2001 From: Trevor Hillebrand Date: Sat, 13 Apr 2024 08:53:43 -0700 Subject: [PATCH 76/94] Remove icebergs in each RK stage Remove icebergs in each RK stage. When ice-shelves melt through in during an intermedite RK stage, they can leave behind icebergs that will cause the velocity solver to fail. So, we need to remove icebergs before each call to the velocity solver. --- .../src/mode_forward/mpas_li_calving.F | 9 +++++---- .../src/mode_forward/mpas_li_time_integration_fe_rk.F | 9 ++++++++- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F index de2a523e9339..a460c3224a0e 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_calving.F @@ -45,7 +45,8 @@ module li_calving !-------------------------------------------------------------------- public :: li_calve_ice, li_restore_calving_front, li_apply_front_ablation_velocity, & - li_calculate_damage, li_finalize_damage_after_advection, li_flood_fill + li_calculate_damage, li_finalize_damage_after_advection, li_flood_fill, & + li_remove_icebergs !-------------------------------------------------------------------- ! @@ -325,7 +326,7 @@ subroutine li_calve_ice(domain, err, solveVeloAfterCalving) call li_calculate_mask(meshPool, velocityPool, geometryPool, err_tmp) ! now also remove any icebergs - call remove_icebergs(domain) + call li_remove_icebergs(domain) call li_calculate_mask(meshPool, velocityPool, geometryPool, err_tmp) @@ -4208,7 +4209,7 @@ subroutine calculate_calving_front_mask(meshPool, geometryPool, calvingFrontMask end subroutine calculate_calving_front_mask - subroutine remove_icebergs(domain) + subroutine li_remove_icebergs(domain) !----------------------------------------------------------------- ! input/output variables !----------------------------------------------------------------- @@ -4362,7 +4363,7 @@ subroutine remove_icebergs(domain) call mpas_deallocate_scratch_field(growMaskField, single_block_in=.false.) call mpas_log_write("Iceberg-detection flood-fill complete. Removed $i iceberg cells.", intArgs=(/globalIcebergCellCount/)) call mpas_timer_stop("iceberg detection") - end subroutine remove_icebergs + end subroutine li_remove_icebergs !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| ! diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F index 6ca13f8deb0d..e4c58cc42b11 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_time_integration_fe_rk.F @@ -29,7 +29,9 @@ module li_time_integration_fe_rk use mpas_log use li_advection - use li_calving, only: li_calve_ice, li_restore_calving_front, li_calculate_damage, li_finalize_damage_after_advection + use li_calving, only: li_calve_ice, li_restore_calving_front, & + li_remove_icebergs, li_calculate_damage, & + li_finalize_damage_after_advection use li_thermal, only: li_thermal_solver, li_enthalpy_to_temperature_kelvin use li_iceshelf_melt use li_diagnostic_vars @@ -481,6 +483,11 @@ subroutine li_time_integrator_forwardeuler_rungekutta(domain, err) call li_restore_calving_front(domain, err_tmp) err = ior(err, err_tmp) endif + ! We need to remove icebergs between RK stages because the + ! main calving routine is not called until after the RK loop. + ! This frequently results in icebergs that causes intermediate + ! RK stage velocity solves to fail. + call li_remove_icebergs(domain) call li_velocity_solve(domain, solveVelo=.true., err=err_tmp) err = ior(err, err_tmp) From 4d9c01bb8483c053fa9bdd9fc7817872a65087f6 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Thu, 8 Jun 2023 11:15:55 -0600 Subject: [PATCH 77/94] Add iceThicknessHydro to replace thickness thickness field is replaced by iceThicknessHydro, which makes changes along the boundaries where the surface evelation of a boundary cell is a local minimum. In this case the surface elevation of that cell is replaced by the minimum of its non-boundary neighbors, and the ice thickness is then recalculated from the updated surface elevation. The intent of this commit is to inhibit the formation of subglacial lakes forming on the domain boundaries, which causes instabilities in the channel model. Physically, lakes should not form at the boundary as it is intended to be a high in hydropotential (a watershed boundary). --- .../src/Registry_subglacial_hydro.xml | 4 +- .../mode_forward/mpas_li_subglacial_hydro.F | 116 ++++++++++++++++-- .../src/shared/mpas_li_mask.F | 66 +++++++++- 3 files changed, 174 insertions(+), 12 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml index 083c92bcfbe4..2fae65a0de14 100644 --- a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml +++ b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml @@ -140,7 +140,9 @@ - + diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 60cd6e5ca795..53e2edc9ee9f 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -106,6 +106,7 @@ subroutine li_SGH_init(domain, err) real (kind=RKIND), dimension(:), pointer :: waterPressure real (kind=RKIND), dimension(:), pointer :: thickness real (kind=RKIND), dimension(:), pointer :: bedTopography + real (kind=RKIND), dimension(:), pointer :: iceThicknessHydro integer, dimension(:), pointer :: cellMask real (kind=RKIND), pointer :: tillMax real (kind=RKIND), pointer :: rhoi, rhoo @@ -182,8 +183,12 @@ subroutine li_SGH_init(domain, err) call mpas_pool_get_array(hydroPool, 'waterPressure', waterPressure) call mpas_pool_get_array(geometryPool, 'thickness', thickness) + call mpas_pool_get_array(hydroPool, 'iceThicknessHydro', iceThicknessHydro) + call calc_iceThicknessHydro(block, err_tmp) !adjust ice thickness along boundaries + err = ior(err,err_tmp) + waterPressure = max(0.0_RKIND, waterPressure) - waterPressure = min(waterPressure, rhoi * gravity * thickness) + waterPressure = min(waterPressure, rhoi * gravity * iceThicknessHydro) ! set pressure correctly under floating ice and open ocean call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) @@ -325,6 +330,9 @@ subroutine li_SGH_solve(domain, err) call mpas_pool_get_array(velocityPool, 'flowParamA', flowParamA) call mpas_pool_get_array(geometryPool, 'thickness', thickness) + call calc_iceThicknessHydro(block, err_tmp) + err = ior(err, err_tmp) + call li_calculate_flowParamA(meshPool, temperature, thickness, flowParamA, err_tmp) err = ior(err, err_tmp) @@ -1480,6 +1488,7 @@ subroutine calc_pressure(block, err) real (kind=RKIND), dimension(:), pointer :: divergenceChannel real (kind=RKIND), dimension(:), pointer :: channelAreaChangeCell real (kind=RKIND), dimension(:), pointer :: bedTopography + real (kind=RKIND), dimension(:), pointer :: iceThicknessHydro integer, dimension(:), pointer :: hydroMarineMarginMask integer, dimension(:), pointer :: cellMask integer, dimension(:), pointer :: nEdgesOnCell @@ -1546,6 +1555,7 @@ subroutine calc_pressure(block, err) call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) + call mpas_pool_get_array(hydroPool, 'iceThicknessHydro', iceThicknessHydro) openingRate(:) = bedRough * basalSpeed(:) * (bedRoughMax - waterThickness(:)) !openingRate(:) = bedRough * basalSpeed(:) * (bedRoughMax - waterThickness(:)) + & @@ -1566,7 +1576,7 @@ subroutine calc_pressure(block, err) case ('cavity') where (li_mask_is_floating_ice(cellMask)) - waterPressure = rhoi * gravity * thickness + waterPressure = rhoi * gravity * iceThicknessHydro elsewhere (.not. li_mask_is_ice(cellMask)) waterPressure = 0.0_RKIND elsewhere @@ -1576,11 +1586,11 @@ subroutine calc_pressure(block, err) case ('overburden') where (li_mask_is_floating_ice(cellMask)) - waterPressure = rhoi * gravity * thickness + waterPressure = rhoi * gravity * iceThicknessHydro elsewhere (.not. li_mask_is_ice(cellMask)) waterPressure = 0.0_RKIND elsewhere - waterPressure = rhoi * gravity * thickness + waterPressure = rhoi * gravity * iceThicknessHydro end where case default @@ -1589,7 +1599,7 @@ subroutine calc_pressure(block, err) end select waterPressure = max(0.0_RKIND, waterPressure) - waterPressure = min(waterPressure, rhoi * gravity * thickness) + waterPressure = min(waterPressure, rhoi * gravity * iceThicknessHydro) do iCell = 1, nCells if ( li_mask_is_floating_ice(cellMask(iCell)) .or. & @@ -1638,7 +1648,6 @@ subroutine calc_pressure_diag_vars(block, err) !----------------------------------------------------------------- ! input variables !----------------------------------------------------------------- - !----------------------------------------------------------------- ! input/output variables !----------------------------------------------------------------- @@ -1663,6 +1672,7 @@ subroutine calc_pressure_diag_vars(block, err) real (kind=RKIND), dimension(:), pointer :: waterThickness real (kind=RKIND), dimension(:), pointer :: hydropotential real (kind=RKIND), dimension(:), pointer :: effectivePressure + real (kind=RKIND), dimension(:), pointer :: iceThicknessHydro integer, dimension(:), pointer :: cellMask real (kind=RKIND), pointer :: config_sea_level @@ -1683,9 +1693,10 @@ subroutine calc_pressure_diag_vars(block, err) call mpas_pool_get_array(hydroPool, 'hydropotentialBase', hydropotentialBase) call mpas_pool_get_array(hydroPool, 'waterThickness', waterThickness) call mpas_pool_get_array(hydroPool, 'hydropotential', hydropotential) + call mpas_pool_get_array(hydroPool, 'iceThicknessHydro', iceThicknessHydro) call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) - effectivePressure = rhoi * gravity * thickness - waterPressure + effectivePressure = rhoi * gravity * iceThicknessHydro - waterPressure ! < this should evalute to 0 for floating ice if Pw set correctly there. where (.not. li_mask_is_grounded_ice(cellmask)) effectivePressure = 0.0_RKIND ! zero effective pressure where no ice to avoid confusion @@ -2161,6 +2172,7 @@ subroutine ocean_connection_N(domain) real (kind=RKIND), dimension(:), pointer :: thickness real (kind=RKIND), dimension(:), pointer :: bedTopography real (kind=RKIND), dimension(:), pointer :: effectivePressure + real (kind=RKIND), dimension(:), pointer :: iceThicknessHydro real (kind=RKIND), pointer :: rhoi, rhoo ! Calculate N assuming perfect ocean connection @@ -2175,7 +2187,9 @@ subroutine ocean_connection_N(domain) call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(hydroPool, 'effectivePressure', effectivePressure) - effectivePressure = rhoi * gravity * thickness - rhoi * gravity * max(0.0_RKIND, -1.0_RKIND * rhoo/rhoi * bedTopography) + call mpas_pool_get_array(hydroPool, 'iceThicknessHydro', iceThicknessHydro) + + effectivePressure = rhoi * gravity * iceThicknessHydro - rhoi * gravity * max(0.0_RKIND, -1.0_RKIND * rhoo/rhoi * bedTopography) effectivePressure = max(effectivePressure, 0.0_RKIND) ! This is just to zero out N in the open ocean to avoid confusion block => block % next @@ -2303,6 +2317,92 @@ subroutine calc_hydro_mask(domain) !-------------------------------------------------------------------- end subroutine calc_hydro_mask + + +!*********************************************************************** +! +! routine calc_iceThicknessHydro +! +!> \brief Calculate version of ice thickness used by hydrology model +!> \author Alex Hager +!> \date 7 June 2023 +!> \details +!> This routine calculates a modified ice thickness that is altered at +! the domain boundaries to avoid local minima in hydropotential +!----------------------------------------------------------------------- + subroutine calc_iceThicknessHydro(block, err) + + !----------------------------------------------------------------- + ! input variables + !----------------------------------------------------------------- + + !----------------------------------------------------------------- + ! input/output variables + !----------------------------------------------------------------- + type (block_type), intent(inout) :: block !< Input/Output: block object + + !----------------------------------------------------------------- + ! output variables + !----------------------------------------------------------------- + integer, intent(out) :: err !< Output: error flag + + !----------------------------------------------------------------- + ! local variables + !----------------------------------------------------------------- + ! Pools pointers + type (mpas_pool_type), pointer :: geometryPool + type (mpas_pool_type), pointer :: hydroPool + type (mpas_pool_type), pointer :: meshPool + real (kind=RKIND), dimension(:), pointer :: thickness + real (kind=RKIND), dimension(:), pointer :: bedTopography + real (kind=RKIND), dimension(:), pointer :: iceThicknessHydro + real (kind=RKIND), dimension(:), pointer :: upperSurface + integer, dimension(:,:), pointer :: cellsOnCell + integer, dimension(:), pointer :: cellMask + integer, pointer :: nCells + integer :: iCell + integer :: jCell + real (kind=RKIND) :: minNeighborHeight + real (kind=RKIND), parameter :: bigValue = 1.0_RKIND + integer, dimension(:), pointer :: nEdgesOnCell + err = 0 + + ! Get pools things + call mpas_pool_get_subpool(block % structs, 'hydro', hydroPool) + call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) + call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) + + call mpas_pool_get_array(geometryPool, 'thickness', thickness) + call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) + call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) + call mpas_pool_get_array(hydroPool, 'iceThicknessHydro', iceThicknessHydro) + call mpas_pool_get_array(geometryPool, 'upperSurface', upperSurface) + call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) + call mpas_pool_get_dimension(meshPool, 'nCells', nCells) + call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) + + iceThicknessHydro = thickness + + do iCell = 1, nCells + if ((li_mask_is_boundary(cellMask(iCell))) .and. (li_mask_is_grounded_ice(cellMask(iCell)))) then !identify domain boundaries + minNeighborHeight = bigValue !allocate + + do jCell = 1, nEdgesOnCell(iCell) + if ( .not. li_mask_is_boundary(cellMask(cellsOnCell(jCell,iCell)))) then + minNeighborHeight = min(minNeighborHeight, upperSurface(cellsOnCell(jCell,iCell))) + endif + end do + + !only adjust surface elevation if cell is local minimum + if ((upperSurface(iCell) < minNeighborHeight) .and. (minNeighborHeight < bigValue)) then + iceThicknessHydro(iCell) = minNeighborHeight - bedTopography(iCell) + endif + + endif + enddo + +!------------------------------------------------------------------------- + end subroutine calc_iceThicknessHydro !*********************************************************************** ! diff --git a/components/mpas-albany-landice/src/shared/mpas_li_mask.F b/components/mpas-albany-landice/src/shared/mpas_li_mask.F index 673ed8186e47..64050cb83adf 100644 --- a/components/mpas-albany-landice/src/shared/mpas_li_mask.F +++ b/components/mpas-albany-landice/src/shared/mpas_li_mask.F @@ -45,6 +45,7 @@ module li_mask integer, parameter :: li_mask_ValueAlbanyMarginNeighbor = 128 ! This the first cell beyond the last active albany cell integer, parameter :: li_mask_ValueGroundingLine = 256 !< This is grounded cell that has a floating neighbor, or vertex/edge on that boundary + integer, parameter :: li_mask_ValueDomainBoundary = 512 !-------------------------------------------------------------------- ! @@ -143,7 +144,18 @@ module li_mask module procedure li_mask_is_grounding_line_logout_0d end interface - !-------------------------------------------------------------------- + + interface li_mask_is_boundary + module procedure li_mask_is_boundary_logout_1d + module procedure li_mask_is_boundary_logout_0d + end interface + + + interface li_mask_is_boundary_int + module procedure li_mask_is_boundary_intout_1d + module procedure li_mask_is_boundary_intout_0d + end interface +!-------------------------------------------------------------------- ! ! Private module variables ! @@ -294,10 +306,10 @@ subroutine li_calculate_mask(meshPool, velocityPool, geometryPool, err) logical :: isMargin logical :: isAlbanyMarginNeighbor logical :: aCellOnVertexHasIce, aCellOnVertexHasNoIce, aCellOnVertexHasDynamicIce, aCellOnVertexHasNoDynamicIce, & - aCellOnVertexIsFloating, aCellOnVertexIsFloatingAndDynamic, aCellOnVertexIsAlbanyActive + aCellOnVertexIsFloating, aCellOnVertexIsFloatingAndDynamic, aCellOnVertexIsAlbanyActive, aCellOnVertexIsDomainBoundary logical :: aCellOnVertexIsGrounded logical :: aCellOnEdgeHasIce, aCellOnEdgeHasNoIce, aCellOnEdgeHasDynamicIce, aCellOnEdgeHasNoDynamicIce, & - aCellOnEdgeIsFloating, aCellOnEdgeIsFloatingAndDynamic + aCellOnEdgeIsFloating, aCellOnEdgeIsFloatingAndDynamic, aCellOnEdgeIsDomainBoundary logical :: aCellOnEdgeIsGrounded logical :: aCellOnEdgeIsOpenOcean integer :: numCellsOnVertex @@ -473,6 +485,16 @@ subroutine li_calculate_mask(meshPool, velocityPool, geometryPool, err) endif enddo + !identify domain boundaries + do i=1,nCells + do j=1,nEdgesOnCell(i) + iCellNeighbor = cellsOnCell(j,i) + if (iCellNeighbor == nCells+1) then + cellMask(i) = ior(cellMask(i), li_mask_ValueDomainBoundary) + endif + enddo + enddo + !call mpas_timer_stop('calculate mask cell') ! ==== @@ -503,6 +525,7 @@ subroutine li_calculate_mask(meshPool, velocityPool, geometryPool, err) aCellOnVertexIsFloating = .false. aCellOnVertexIsGrounded = .false. aCellOnVertexIsFloatingAndDynamic = .false. + aCellOnVertexIsDomainBoundary = .false. do j = 1, vertexDegree ! vertexDegree is usually 3 (e.g. CVT mesh) but could be something else (e.g. 4 for quad mesh) iCell = cellsOnVertex(j,i) aCellOnVertexHasIce = (aCellOnVertexHasIce .or. li_mask_is_ice(cellMask(iCell))) @@ -514,7 +537,9 @@ subroutine li_calculate_mask(meshPool, velocityPool, geometryPool, err) (li_mask_is_floating_ice(cellMask(iCell)) .and. & li_mask_is_dynamic_ice(cellMask(iCell))) ) aCellOnVertexIsGrounded = (aCellOnVertexIsGrounded .or. li_mask_is_grounded_ice(cellMask(iCell))) + aCellOnVertexIsDomainBoundary = (aCellOnVertexIsDomainBoundary .or. li_mask_is_boundary(cellMask(iCell))) end do + if (aCellOnVertexHasIce) then vertexMask(i) = ior(vertexMask(i), li_mask_ValueIce) endif @@ -535,6 +560,9 @@ subroutine li_calculate_mask(meshPool, velocityPool, geometryPool, err) vertexMask(i) = ior(vertexMask(i), li_mask_ValueDynamicMargin) ! vertex with both 1+ dynamic ice cell(s) and 1+ non-dynamic cell(s) as neighbors endif + if (aCellOnVertexIsDomainBoundary) then + vertexMask(i) = ior(vertexMask(i), li_mask_ValueDomainBoundary) + endif end do @@ -607,6 +635,7 @@ subroutine li_calculate_mask(meshPool, velocityPool, geometryPool, err) aCellOnEdgeIsGrounded = .false. aCellOnEdgeIsOpenOcean = .false. aCellOnEdgeIsFloatingAndDynamic = .false. + aCellOnEdgeIsDomainBoundary = .false. do j = 1, 2 iCell = cellsOnEdge(j,i) aCellOnEdgeHasIce = (aCellOnEdgeHasIce .or. li_mask_is_ice(cellMask(iCell))) @@ -620,6 +649,7 @@ subroutine li_calculate_mask(meshPool, velocityPool, geometryPool, err) aCellOnEdgeIsGrounded = (aCellOnEdgeIsGrounded .or. li_mask_is_grounded_ice(cellMask(iCell))) aCellOnEdgeIsOpenOcean = aCellOnEdgeIsOpenOcean .or. & ((bedTopography(iCell) < config_sea_level) .and. (.not. li_mask_is_ice(cellMask(iCell)))) + aCellOnEdgeIsDomainBoundary = (aCellOnEdgeIsDomainBoundary .or. li_mask_is_boundary(cellMask(iCell))) end do if (aCellOnEdgeHasIce) then edgeMask(i) = ior(edgeMask(i), li_mask_ValueIce) @@ -641,6 +671,9 @@ subroutine li_calculate_mask(meshPool, velocityPool, geometryPool, err) if (aCellOnEdgeHasDynamicIce .and. aCellOnEdgeHasNoDynamicIce) then edgeMask(i) = ior(edgeMask(i), li_mask_ValueDynamicMargin) endif + if (aCellOnEdgeIsDomainBoundary) then + edgeMask(i) = ior(edgeMask(i), li_mask_ValueDomainBoundary) + endif end do !call mpas_timer_stop('calculate mask edge') @@ -905,8 +938,35 @@ function li_mask_is_initial_ice_logout_0d(mask) li_mask_is_initial_ice_logout_0d = (iand(mask, li_mask_ValueInitialIceExtent) == li_mask_ValueInitialIceExtent) end function li_mask_is_initial_ice_logout_0d + ! -- Functions that check for domain boundary -- + function li_mask_is_boundary_logout_1d(mask) + integer, dimension(:), intent(in) :: mask + logical, dimension(size(mask)) :: li_mask_is_boundary_logout_1d + + li_mask_is_boundary_logout_1d = (iand(mask, li_mask_ValueDomainBoundary) == li_mask_ValueDomainBoundary) + end function li_mask_is_boundary_logout_1d + + function li_mask_is_boundary_logout_0d(mask) + integer, intent(in) :: mask + logical :: li_mask_is_boundary_logout_0d + + li_mask_is_boundary_logout_0d = (iand(mask, li_mask_ValueDomainBoundary) == li_mask_ValueDomainBoundary) + end function li_mask_is_boundary_logout_0d + function li_mask_is_boundary_intout_1d(mask) + integer, dimension(:), intent(in) :: mask + integer, dimension(size(mask)) :: li_mask_is_boundary_intout_1d + + li_mask_is_boundary_intout_1d = iand(mask, li_mask_ValueDomainBoundary) / li_mask_ValueDomainBoundary + end function li_mask_is_boundary_intout_1d + + function li_mask_is_boundary_intout_0d(mask) + integer, intent(in) :: mask + integer :: li_mask_is_boundary_intout_0d + + li_mask_is_boundary_intout_0d = iand(mask, li_mask_ValueDomainBoundary) / li_mask_ValueDomainBoundary + end function li_mask_is_boundary_intout_0d !*********************************************************************** ! Private subroutines: !*********************************************************************** From dfa69eeeea3d08eeca86b090f07efc7c0f8f25c8 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Wed, 14 Jun 2023 17:38:01 -0600 Subject: [PATCH 78/94] Fix bug in iceThicknessHydro Commit Fixes bug in previous commit that introduces iceThicknessHydro --- .../mode_forward/mpas_li_subglacial_hydro.F | 35 +++++++++++++++---- 1 file changed, 28 insertions(+), 7 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 53e2edc9ee9f..c67a3996f051 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -204,6 +204,11 @@ subroutine li_SGH_init(domain, err) block => block % next end do + !update halo for iceThicknessHydro + call mpas_timer_start("halo updates") + call mpas_dmpar_field_halo_exch(domain, 'iceThicknessHydro') + call mpas_timer_stop("halo updates") + ! === error check if (err > 0) then call mpas_log_write("An error has occurred in li_SGH_init.", MPAS_LOG_ERR) @@ -339,6 +344,11 @@ subroutine li_SGH_solve(domain, err) block => block % next end do + !update halo for iceThicknessHydro + call mpas_timer_start("halo updates") + call mpas_dmpar_field_halo_exch(domain, 'iceThicknessHydro') + call mpas_timer_stop("halo updates") + ! initialize while loop call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', meshPool) ! can get from any block call mpas_pool_get_array(meshPool, 'deltat', masterDeltat) @@ -2362,8 +2372,10 @@ subroutine calc_iceThicknessHydro(block, err) integer, pointer :: nCells integer :: iCell integer :: jCell + integer :: numCellsChanged + integer :: iNeighbor real (kind=RKIND) :: minNeighborHeight - real (kind=RKIND), parameter :: bigValue = 1.0_RKIND + real (kind=RKIND), parameter :: bigValue = 1.0e6_RKIND integer, dimension(:), pointer :: nEdgesOnCell err = 0 @@ -2382,27 +2394,36 @@ subroutine calc_iceThicknessHydro(block, err) call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) iceThicknessHydro = thickness + numCellsChanged = 0 do iCell = 1, nCells - if ((li_mask_is_boundary(cellMask(iCell))) .and. (li_mask_is_grounded_ice(cellMask(iCell)))) then !identify domain boundaries - minNeighborHeight = bigValue !allocate + if ((li_mask_is_boundary(cellMask(iCell))) .and. & + (li_mask_is_grounded_ice(cellMask(iCell)))) then !identify domain boundaries + + minNeighborHeight = bigValue !allocate do jCell = 1, nEdgesOnCell(iCell) - if ( .not. li_mask_is_boundary(cellMask(cellsOnCell(jCell,iCell)))) then - minNeighborHeight = min(minNeighborHeight, upperSurface(cellsOnCell(jCell,iCell))) + iNeighbor = cellsOnCell(jCell,iCell) + if ( .not. li_mask_is_boundary(cellMask(iNeighbor)) .and. & + (iNeighbor < nCells + 1)) then + minNeighborHeight = min(minNeighborHeight, upperSurface(iNeighbor)) endif end do !only adjust surface elevation if cell is local minimum if ((upperSurface(iCell) < minNeighborHeight) .and. (minNeighborHeight < bigValue)) then + call mpas_log_write("Changed ice thickness of cell $i", intArgs=(/iCell/)) + numCellsChanged = numCellsChanged + 1 iceThicknessHydro(iCell) = minNeighborHeight - bedTopography(iCell) endif endif enddo -!------------------------------------------------------------------------- - end subroutine calc_iceThicknessHydro + call mpas_log_write("Number of Cells Changed in iceThicknessHydro: $i", intArgs=(/numCellsChanged/)) + call mpas_log_write("Minimum Neighbor Height: $r", realArgs=(/minNeighborHeight/)) + + end subroutine calc_iceThicknessHydro !*********************************************************************** ! From c56a8a5cdea3a2db6f6820a499b6dcd69f58f561 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Mon, 19 Jun 2023 17:20:30 -0600 Subject: [PATCH 79/94] iceThicknessHydro additionally adjusts elev. highs 'iceThicknessHydro' now adjusts the ice thicknesses of boundary cells so that there are also no local maxima in surface elevation on the boundaries (in addition to the previous removal of local minima). This will make the surface elevation of all boundary cells equal to either the minimum or maximum of their non-boundary neighbors. This is done to avoid diffusivity instabilities when using the 'from_vertex_barycentric' tangent slope calculation. Currently, this implementation will change *all* grounded boundary cells, so this commit also introduces a new namelist option, 'config_SGH_use_iceThicknessHydro' that enables the 'iceThicknessHydro' calculation if set to '.true.'. 'iceThicknessHydro' is equivalent to 'thickness' when 'config_SGH_use_iceThicknessHydro' is false. 'config_SGH_use_iceThicknessHydro' has a default value of '.true.' --- .../src/Registry_subglacial_hydro.xml | 8 ++- .../mode_forward/mpas_li_subglacial_hydro.F | 66 ++++++++++++------- 2 files changed, 48 insertions(+), 26 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml index 2fae65a0de14..ba9f0948d46f 100644 --- a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml +++ b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml @@ -77,7 +77,13 @@ description="notional englacial porosity" possible_values="positive real number" /> - + + + + maxNeighborHeight) .and. & + (maxNeighborHeight > bigNegativeValue)) then + numCellsChanged = numCellsChanged + 1 + iceThicknessHydro(iCell) = maxNeighborHeight - bedTopography(iCell) + endif - endif - enddo + endif + enddo - call mpas_log_write("Number of Cells Changed in iceThicknessHydro: $i", intArgs=(/numCellsChanged/)) - call mpas_log_write("Minimum Neighbor Height: $r", realArgs=(/minNeighborHeight/)) - + call mpas_log_write("Number of Cells Changed in iceThicknessHydro: $i", intArgs=(/numCellsChanged/)) + endif + end subroutine calc_iceThicknessHydro !*********************************************************************** From 45b1bf304e590c2b1a86fd3485756283eab9abb8 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Wed, 5 Jul 2023 10:01:32 -0600 Subject: [PATCH 80/94] iceThicknessHydro as mean of neighboring cells iceThicknessHydro now smooths the entire ice thickness field used by the subglacial hydrology model, instead of only smoothing along the boundaries. In the subglacial hydrology model, each cell's surface elevation is now a mean of its neighbors. As done previously, an additional requirement prohibits the surface elevation used by the subglacial hydrology model from being a local minimum or maximum. The purpose of this commit is to address issues arising from single-cell subglacial lakes that form when the surface elevation of a cell is lower than all of its neighbors, particularly when coupling to ice dynamics. --- .../mode_forward/mpas_li_subglacial_hydro.F | 72 +++++++++++++------ 1 file changed, 50 insertions(+), 22 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index bd94e2357afe..20da6bf73e99 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -2372,10 +2372,12 @@ subroutine calc_iceThicknessHydro(block, err) integer, pointer :: nCells integer :: iCell integer :: jCell - integer :: numCellsChanged integer :: iNeighbor real (kind=RKIND) :: minNeighborHeight real (kind=RKIND) :: maxNeighborHeight + real (kind=RKIND) :: meanNeighborHeight + real (kind=RKIND) :: totNeighborHeight + real (kind=RKIND) :: numCells real (kind=RKIND), parameter :: bigValue = 1.0e6_RKIND real (kind=RKIND), parameter :: bigNegativeValue = -1.0e6_RKIND integer, dimension(:), pointer :: nEdgesOnCell @@ -2396,6 +2398,7 @@ subroutine calc_iceThicknessHydro(block, err) call mpas_pool_get_dimension(meshPool, 'nCells', nCells) call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) call mpas_pool_get_config(liConfigs, 'config_SGH_use_iceThicknessHydro', config_SGH_use_iceThicknessHydro) + iceThicknessHydro = thickness !iceThicknessHydro is equivalent to thickness if @@ -2403,42 +2406,67 @@ subroutine calc_iceThicknessHydro(block, err) !ice thickness along boundaries. if (config_SGH_use_iceThicknessHydro) then - - numCellsChanged = 0 do iCell = 1, nCells - if ((li_mask_is_boundary(cellMask(iCell))) .and. & - (li_mask_is_grounded_ice(cellMask(iCell)))) then !identify domain boundaries - + if (li_mask_is_grounded_ice(cellMask(iCell))) then !identify domain boundaries + !Smooth by making each cell equal to the mean of its + !neighbors. + + do jCell = 1, nEdgesOnCell(iCell) + iNeighbor = cellsOnCell(jCell,iCell) + if (iNeighbor < nCells + 1) then + if (jCell == 1) then + totNeighborHeight = upperSurface(iNeighbor) + numCells = 1 + else + totNeighborHeight = totNeighborHeight + upperSurface(iNeighbor) + numCells = numCells + 1 + endif + endif + + meanNeighborHeight = totNeighborHeight / numCells + end do + + iceThicknessHydro(iCell) = meanNeighborHeight - bedTopography(iCell) + + !Above averaging is not sequential with respect to flow + !direction, so cells can still be local minima or maxima + !after smoothing. Find and correct cells where this is the case + minNeighborHeight = bigValue !allocate maxNeighborHeight = bigNegativeValue - + do jCell = 1, nEdgesOnCell(iCell) iNeighbor = cellsOnCell(jCell,iCell) - if (.not. li_mask_is_boundary(cellMask(iNeighbor)) .and. & - (iNeighbor < nCells + 1)) then - minNeighborHeight = min(minNeighborHeight, upperSurface(iNeighbor)) - maxNeighborHeight = max(maxNeighborHeight, upperSurface(iNeighbor)) - endif + if (iNeighbor < nCells + 1) then + + minNeighborHeight = min(minNeighborHeight, iceThicknessHydro(iNeighbor) + & + bedTopography(iNeighbor)) + + maxNeighborHeight = max(maxNeighborHeight, iceThicknessHydro(iNeighbor) + & + bedTopography(iNeighbor)) + + endif end do - + !only adjust surface elevation if cell is local minimum or !maximum - if ((upperSurface(iCell) < minNeighborHeight) .and. (minNeighborHeight < bigValue)) then - numCellsChanged = numCellsChanged + 1 - iceThicknessHydro(iCell) = minNeighborHeight - bedTopography(iCell) - elseif ((upperSurface(iCell) > maxNeighborHeight) .and. & - (maxNeighborHeight > bigNegativeValue)) then - numCellsChanged = numCellsChanged + 1 + if (((iceThicknessHydro(iCell) + bedTopography(iCell)) < minNeighborHeight) & + .and. (minNeighborHeight < bigValue)) then + + iceThicknessHydro(iCell) = minNeighborHeight - bedTopography(iCell) + + elseif (((iceThicknessHydro(iCell) + bedTopography(iCell)) > maxNeighborHeight) & + .and. (maxNeighborHeight > bigNegativeValue)) then + iceThicknessHydro(iCell) = maxNeighborHeight - bedTopography(iCell) + endif endif enddo - - call mpas_log_write("Number of Cells Changed in iceThicknessHydro: $i", intArgs=(/numCellsChanged/)) endif - + end subroutine calc_iceThicknessHydro !*********************************************************************** From 9407999931416f47b28d24070170031b2ef62508 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Fri, 7 Jul 2023 15:46:23 -0600 Subject: [PATCH 81/94] Limit iceThicknessHydro to non-margin cells Disallow iceThicknessHydro modification at ice margins. Avoids bug where iceThicknessHydro can be negative at certain ice margin cells --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 20da6bf73e99..6c0c000dee19 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -1610,7 +1610,7 @@ subroutine calc_pressure(block, err) waterPressure = max(0.0_RKIND, waterPressure) waterPressure = min(waterPressure, rhoi * gravity * iceThicknessHydro) - + do iCell = 1, nCells if ( li_mask_is_floating_ice(cellMask(iCell)) .or. & ((.not. li_mask_is_ice(cellMask(iCell))) .and. (bedTopography(iCell) < config_sea_level) ) ) then @@ -1711,7 +1711,7 @@ subroutine calc_pressure_diag_vars(block, err) where (.not. li_mask_is_grounded_ice(cellmask)) effectivePressure = 0.0_RKIND ! zero effective pressure where no ice to avoid confusion end where - + hydropotentialBase = rho_water * gravity * bedTopography + waterPressure ! This is still correct under ice shelves/open ocean because waterPressure has been set appropriately there already. ! Note this leads to a nonuniform hydropotential at sea level that is a function of the ocean depth. @@ -2408,7 +2408,7 @@ subroutine calc_iceThicknessHydro(block, err) if (config_SGH_use_iceThicknessHydro) then do iCell = 1, nCells - if (li_mask_is_grounded_ice(cellMask(iCell))) then !identify domain boundaries + if ((li_mask_is_grounded_ice(cellMask(iCell))) .and. (.not. li_mask_is_margin(cellMask(iCell)))) then !identify domain boundaries !Smooth by making each cell equal to the mean of its !neighbors. From 0c3e53e62b13905a2b438db4a516a458d7e94dc9 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Tue, 18 Jul 2023 14:34:26 -0600 Subject: [PATCH 82/94] iceThicknessHydro limited to local min/max Changes calculation of iceThicknessHydro and limits its affect to only local min/max. Previously iceThicknessHydro smoothed every cell by making it a mean of its neighbors, but this unrealistically flattened hydropotential gradients for ice sheet wide simulations. iceThicknessHydro is now adjusts the ice thickness of only local min/max so that their surface elevation is equal to the mean of their neighbors. This commit also introduces upperSurfaceHydro as an output variable in the hydro pool. --- .../src/Registry_subglacial_hydro.xml | 2 + .../mode_forward/mpas_li_subglacial_hydro.F | 57 ++++++++----------- 2 files changed, 25 insertions(+), 34 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml index ba9f0948d46f..32efc089c743 100644 --- a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml +++ b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml @@ -148,6 +148,8 @@ + maxNeighborHeight) & + elseif ((upperSurface(iCell) > maxNeighborHeight) & .and. (maxNeighborHeight > bigNegativeValue)) then - iceThicknessHydro(iCell) = maxNeighborHeight - bedTopography(iCell) + iceThicknessHydro(iCell) = meanNeighborHeight - bedTopography(iCell) endif @@ -2467,6 +2454,8 @@ subroutine calc_iceThicknessHydro(block, err) enddo endif + upperSurfaceHydro = iceThicknessHydro + bedTopography + end subroutine calc_iceThicknessHydro !*********************************************************************** From 2e1400f91edc4c63adf028ac63ce0b0fb3ea4928 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Thu, 20 Jul 2023 16:21:26 -0600 Subject: [PATCH 83/94] Debug iceThicknessHydro Addresses a couple small bugs found in iceThicknessHydro. --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 97cc2d1ebfd0..c4912d9e0453 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -2412,19 +2412,19 @@ subroutine calc_iceThicknessHydro(block, err) do iCell = 1, nCells if ((li_mask_is_grounded_ice(cellMask(iCell))) .and. (.not. li_mask_is_margin(cellMask(iCell)))) then !identify domain boundaries - maxNeighborHeight = bigValue !allocate - minNeighborHeight = bigNegativeValue + maxNeighborHeight = bigNegativeValue !allocate + minNeighborHeight = bigValue do jCell = 1, nEdgesOnCell(iCell) iNeighbor = cellsOnCell(jCell,iCell) - if (jCell == 1) then - totNeighborHeight = upperSurface(iNeighbor) - numCells = 1 - endif - if (iNeighbor < nCells + 1) then + if (jCell == 1) then + totNeighborHeight = upperSurface(iNeighbor) + numCells = 1 + endif + minNeighborHeight = min(minNeighborHeight, upperSurface(iNeighbor)) maxNeighborHeight = max(maxNeighborHeight, upperSurface(iNeighbor)) From 0ad0388946f705192d723c2890b8c6398baca855 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Fri, 8 Sep 2023 10:08:49 -0700 Subject: [PATCH 84/94] avoid negative iceThicknessHydro Defaults iceThicknessHydro to original thickness if below zero --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index c4912d9e0453..3675f1185e1e 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -2450,6 +2450,11 @@ subroutine calc_iceThicknessHydro(block, err) endif + !avoid negatives, default to original thickness + if (iceThicknessHydro(iCell) < 0.0_RKIND) then + iceThicknessHydro(iCell) = thickness(iCell) + endif + endif enddo endif From 88beec159d3900b48336d3429919b57fc307f5af Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Tue, 26 Sep 2023 12:49:37 -0700 Subject: [PATCH 85/94] no iceThicknessHydro at GL Disables iceThicknessHydro at grounding line so not ocean properties are included in calculation --- .../mode_forward/mpas_li_subglacial_hydro.F | 88 ++++++++++++------- 1 file changed, 54 insertions(+), 34 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 3675f1185e1e..4e402062cc8e 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -2368,12 +2368,19 @@ subroutine calc_iceThicknessHydro(block, err) real (kind=RKIND), dimension(:), pointer :: iceThicknessHydro real (kind=RKIND), dimension(:), pointer :: upperSurfaceHydro real (kind=RKIND), dimension(:), pointer :: upperSurface + integer, dimension(:), pointer :: hydroMarineMarginMask integer, dimension(:,:), pointer :: cellsOnCell + integer, dimension(:,:), pointer :: edgesOnCell integer, dimension(:), pointer :: cellMask + integer, dimension(:), pointer :: edgeMask integer, pointer :: nCells + integer :: edgeNum + integer, dimension(:), pointer :: nEdgesOnCell + integer :: iEdge integer :: iCell integer :: jCell integer :: iNeighbor + integer :: isMarineMargin real (kind=RKIND) :: maxNeighborHeight real (kind=RKIND) :: minNeighborHeight real (kind=RKIND) :: meanNeighborHeight @@ -2381,7 +2388,6 @@ subroutine calc_iceThicknessHydro(block, err) real (kind=RKIND) :: numCells real (kind=RKIND), parameter :: bigValue = 1.0e6_RKIND real (kind=RKIND), parameter :: bigNegativeValue = -1.0e6_RKIND - integer, dimension(:), pointer :: nEdgesOnCell logical, pointer :: config_SGH_use_iceThicknessHydro err = 0 @@ -2393,12 +2399,16 @@ subroutine calc_iceThicknessHydro(block, err) call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) + call mpas_pool_get_array(geometryPool, 'edgeMask', edgeMask) call mpas_pool_get_array(hydroPool, 'iceThicknessHydro', iceThicknessHydro) call mpas_pool_get_array(hydroPool, 'upperSurfaceHydro', upperSurfaceHydro) call mpas_pool_get_array(geometryPool, 'upperSurface', upperSurface) call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) call mpas_pool_get_dimension(meshPool, 'nCells', nCells) call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) + call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell) + call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) + call mpas_pool_get_array(hydroPool, 'hydroMarineMarginMask', hydroMarineMarginMask) call mpas_pool_get_config(liConfigs, 'config_SGH_use_iceThicknessHydro', config_SGH_use_iceThicknessHydro) iceThicknessHydro = thickness @@ -2408,53 +2418,63 @@ subroutine calc_iceThicknessHydro(block, err) !ice thickness if (config_SGH_use_iceThicknessHydro) then - do iCell = 1, nCells - if ((li_mask_is_grounded_ice(cellMask(iCell))) .and. (.not. li_mask_is_margin(cellMask(iCell)))) then !identify domain boundaries - maxNeighborHeight = bigNegativeValue !allocate - minNeighborHeight = bigValue + if ((li_mask_is_grounded_ice(cellMask(iCell))) .and. (.not. li_mask_is_margin(cellMask(iCell)))) then !identify domain boundaries - do jCell = 1, nEdgesOnCell(iCell) - iNeighbor = cellsOnCell(jCell,iCell) + isMarineMargin = 0 + do edgeNum = 1, nEdgesOnCell(iCell) + iEdge = edgesOnCell(edgeNum,iCell) + if (hydroMarineMarginMask(iEdge) == 1) then + isMarineMargin = 1 + exit + endif + enddo - if (iNeighbor < nCells + 1) then + if (isMarineMargin == 0) then + maxNeighborHeight = bigNegativeValue !allocate + minNeighborHeight = bigValue + + do jCell = 1, nEdgesOnCell(iCell) + iNeighbor = cellsOnCell(jCell,iCell) - if (jCell == 1) then - totNeighborHeight = upperSurface(iNeighbor) - numCells = 1 - endif - - minNeighborHeight = min(minNeighborHeight, upperSurface(iNeighbor)) + if (iNeighbor < nCells + 1) then - maxNeighborHeight = max(maxNeighborHeight, upperSurface(iNeighbor)) + if (jCell == 1) then + totNeighborHeight = upperSurface(iNeighbor) + numCells = 1 + endif + + minNeighborHeight = min(minNeighborHeight, upperSurface(iNeighbor)) - totNeighborHeight = totNeighborHeight + upperSurface(iNeighbor) - numCells = numCells + 1 - endif - end do + maxNeighborHeight = max(maxNeighborHeight, upperSurface(iNeighbor)) - meanNeighborHeight = totNeighborHeight / numCells + totNeighborHeight = totNeighborHeight + upperSurface(iNeighbor) + numCells = numCells + 1 + endif + end do - !only adjust surface elevation if cell is local minimum or - !maximum - if ((upperSurface(iCell) < minNeighborHeight) & - .and. (minNeighborHeight < bigValue)) then + meanNeighborHeight = totNeighborHeight / numCells - iceThicknessHydro(iCell) = meanNeighborHeight - bedTopography(iCell) + !only adjust surface elevation if cell is local minimum or + !maximum + if ((upperSurface(iCell) < minNeighborHeight) & + .and. (minNeighborHeight < bigValue)) then - elseif ((upperSurface(iCell) > maxNeighborHeight) & - .and. (maxNeighborHeight > bigNegativeValue)) then + iceThicknessHydro(iCell) = meanNeighborHeight - bedTopography(iCell) - iceThicknessHydro(iCell) = meanNeighborHeight - bedTopography(iCell) + elseif ((upperSurface(iCell) > maxNeighborHeight) & + .and. (maxNeighborHeight > bigNegativeValue)) then - endif + iceThicknessHydro(iCell) = meanNeighborHeight - bedTopography(iCell) - !avoid negatives, default to original thickness - if (iceThicknessHydro(iCell) < 0.0_RKIND) then - iceThicknessHydro(iCell) = thickness(iCell) - endif - + endif + + !avoid negatives, default to original thickness + if (iceThicknessHydro(iCell) < 0.0_RKIND) then + iceThicknessHydro(iCell) = thickness(iCell) + endif + endif endif enddo endif From f728bb34c8c4ec468cfe16b381dda49fc329c1c6 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Thu, 4 Jan 2024 15:05:04 -0800 Subject: [PATCH 86/94] Add waterPressureSmooth Adds smoothed water pressure field, waterPressureSmooth, that is used only for calculation of waterPressureSlopeNormal and channelPressureFreeze. Option config_SGH_iter_smooth_waterPressureSlopeNormal specifies number of times to smooth waterPressure over when calculating waterPressureSlopeNormal --- .../src/Registry_subglacial_hydro.xml | 13 ++- .../mode_forward/mpas_li_subglacial_hydro.F | 92 +++++++++++++++++-- 2 files changed, 95 insertions(+), 10 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml index 32efc089c743..ecbcb89a48bb 100644 --- a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml +++ b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml @@ -125,6 +125,10 @@ possible_values="'file', 'thermal', 'basal_heat'" /> + @@ -162,7 +166,9 @@ description="water layer thickness in subglacial till from previous time step" /> - + @@ -239,7 +245,7 @@ + description="time step used for evolving subglacial hydrology system" /> + + 0) then + do iter = 1, nTimesSmooth !May need to iterate to smooth properly + if (iter == 1) then + waterPressureSmooth = waterPressure + pressureField = waterPressure + else + pressureField = waterPressureSmooth + endif + + do iCell = 1, nCells + if ((li_mask_is_grounded_ice(cellMask(iCell))) .and. (.not. li_mask_is_margin(cellMask(iCell)))) then + + isMarineMargin = 0 + do edgeNum = 1, nEdgesOnCell(iCell) + iEdge = edgesOnCell(edgeNum,iCell) + if (hydroMarineMarginMask(iEdge) == 1) then + isMarineMargin = 1 + exit + endif + enddo + + if (isMarineMargin == 0) then + + totNeighborPressure = pressureField(iCell) + numCells = 1 + + do jCell = 1, nEdgesOnCell(iCell) + iNeighbor = cellsOnCell(jCell,iCell) + + if (iNeighbor < nCells + 1) then + totNeighborPressure = totNeighborPressure + pressureField(iNeighbor) + numCells = numCells + 1 + endif + end do + + !waterPressureSmooth is average of neighboring cells + waterPressureSmooth(iCell) = totNeighborPressure / numCells + endif + endif + end do + end do + elseif (nTimesSmooth == 0) then + waterPressureSmooth = waterPressure + endif + + do iEdge = 1, nEdges + cell1 = cellsOnEdge(1, iEdge) + cell2 = cellsOnEdge(2, iEdge) + + waterPressureSlopeNormal(iEdge) = (waterPressureSmooth(cell2) - waterPressureSmooth(cell1)) / dcEdge(iEdge) end do ! At boundaries of hydro domain, disallow inflow. Allow outflow if hydropotential gradient requires it. From e7fba6bdedb0a016846db8cef834543167678179 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Wed, 28 Feb 2024 15:03:37 -0700 Subject: [PATCH 87/94] Adjust iceThicknessHydro logic + implementation Addresses comments in original PR about iceThicknessHydro. iceThickness hydro is now calculated for all grounded ice cells, including ice margins and the grounding line, but neighboring cells are only included in averaging calculation if they are also grounded cells. iceThicknessHydro is now an area-weighted average of neighboring cells that replaces local minima and maxima. --- .../src/Registry_subglacial_hydro.xml | 2 +- .../mode_forward/mpas_li_subglacial_hydro.F | 48 +++++++++---------- 2 files changed, 23 insertions(+), 27 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml index ecbcb89a48bb..143497036c10 100644 --- a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml +++ b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml @@ -79,7 +79,7 @@ /> diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 2b0986249c1b..d708f79eca5e 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -2449,6 +2449,7 @@ subroutine calc_iceThicknessHydro(block, err) integer, dimension(:,:), pointer :: edgesOnCell integer, dimension(:), pointer :: cellMask integer, dimension(:), pointer :: edgeMask + real (kind=RKIND), dimension(:), pointer :: areaCell integer, pointer :: nCells integer :: edgeNum integer, dimension(:), pointer :: nEdgesOnCell @@ -2456,12 +2457,11 @@ subroutine calc_iceThicknessHydro(block, err) integer :: iCell integer :: jCell integer :: iNeighbor - integer :: isMarineMargin real (kind=RKIND) :: maxNeighborHeight real (kind=RKIND) :: minNeighborHeight real (kind=RKIND) :: meanNeighborHeight - real (kind=RKIND) :: totNeighborHeight - real (kind=RKIND) :: numCells + real (kind=RKIND) :: totalNeighborHeight + real (kind=RKIND) :: totalArea real (kind=RKIND), parameter :: bigValue = 1.0e6_RKIND real (kind=RKIND), parameter :: bigNegativeValue = -1.0e6_RKIND logical, pointer :: config_SGH_use_iceThicknessHydro @@ -2484,6 +2484,7 @@ subroutine calc_iceThicknessHydro(block, err) call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell) call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) + call mpas_pool_get_array(meshPool, 'areaCell', areaCell) call mpas_pool_get_array(hydroPool, 'hydroMarineMarginMask', hydroMarineMarginMask) call mpas_pool_get_config(liConfigs, 'config_SGH_use_iceThicknessHydro', config_SGH_use_iceThicknessHydro) @@ -2496,41 +2497,37 @@ subroutine calc_iceThicknessHydro(block, err) if (config_SGH_use_iceThicknessHydro) then do iCell = 1, nCells - if ((li_mask_is_grounded_ice(cellMask(iCell))) .and. (.not. li_mask_is_margin(cellMask(iCell)))) then !identify domain boundaries + if (li_mask_is_grounded_ice(cellMask(iCell))) then !identify domain boundaries - isMarineMargin = 0 - do edgeNum = 1, nEdgesOnCell(iCell) - iEdge = edgesOnCell(edgeNum,iCell) - if (hydroMarineMarginMask(iEdge) == 1) then - isMarineMargin = 1 - exit - endif - enddo - - if (isMarineMargin == 0) then - maxNeighborHeight = bigNegativeValue !allocate + maxNeighborHeight = bigNegativeValue !initialize minNeighborHeight = bigValue + totalNeighborHeight = 0.0_RKIND + totalArea = 0.0_RKIND + do jCell = 1, nEdgesOnCell(iCell) + iNeighbor = cellsOnCell(jCell,iCell) - if (iNeighbor < nCells + 1) then + !Only include neighbor cell in averaging if it contains grounded ice + if ((li_mask_is_grounded_ice(cellMask(iNeighbor)))) then - if (jCell == 1) then - totNeighborHeight = upperSurface(iNeighbor) - numCells = 1 - endif - minNeighborHeight = min(minNeighborHeight, upperSurface(iNeighbor)) maxNeighborHeight = max(maxNeighborHeight, upperSurface(iNeighbor)) - totNeighborHeight = totNeighborHeight + upperSurface(iNeighbor) - numCells = numCells + 1 + totalNeighborHeight = totalNeighborHeight + upperSurface(iNeighbor)*areaCell(iNeighbor) + + totalArea = totalArea + areaCell(iNeighbor) + endif end do - - meanNeighborHeight = totNeighborHeight / numCells + + if ((totalNeighborHeight == 0.0_RKIND) .or. (totalArea == 0.0_RKIND)) then + meanNeighborHeight = upperSurface(iCell) !no smoothing in single-cell islands + else + meanNeighborHeight = totalNeighborHeight / totalArea !area-weighted average height + endif !only adjust surface elevation if cell is local minimum or !maximum @@ -2550,7 +2547,6 @@ subroutine calc_iceThicknessHydro(block, err) if (iceThicknessHydro(iCell) < 0.0_RKIND) then iceThicknessHydro(iCell) = thickness(iCell) endif - endif endif enddo endif From e76d9a96abc804430fb78f8adf7fa625eebf6c98 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Mon, 4 Mar 2024 10:17:42 -0700 Subject: [PATCH 88/94] waterPressure area-weighted mean subroutine Addresses PR comments regarding waterPressureSmooth, namely, moving waterPressureSmooth calculation to its own subroutine, making waterPressureSmooth an area-weighted mean of the current cell and its neighbors, and adding halo updates. Please enter the commit message for your changes. Lines starting --- .../src/Registry_subglacial_hydro.xml | 3 - .../mode_forward/mpas_li_subglacial_hydro.F | 200 +++++++++++------- 2 files changed, 123 insertions(+), 80 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml index 143497036c10..87af56eee82b 100644 --- a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml +++ b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml @@ -253,9 +253,6 @@ - - block % next end do @@ -302,8 +310,6 @@ subroutine li_SGH_solve(domain, err) integer :: numSubCycles ! number of subcycles integer :: err_tmp - - err = 0 err_tmp = 0 @@ -641,6 +647,14 @@ subroutine li_SGH_solve(domain, err) call calc_pressure(block, err_tmp) err = ior(err, err_tmp) + + call calc_waterPressureSmooth(block, err_tmp) !adjust ice thickness along boundaries + err = ior(err,err_tmp) + + !updates halos for waterPressure + call mpas_timer_start("halo updates") + call mpas_dmpar_field_halo_exch(domain, 'waterPressureSlopeNormal') + call mpas_timer_stop("halo updates") block => block % next end do @@ -777,7 +791,6 @@ subroutine calc_edge_quantities(block, err) real (kind=RKIND), dimension(:), pointer :: hydropotentialBaseVertex real (kind=RKIND), dimension(:), pointer :: hydropotentialVertex real (kind=RKIND), dimension(:), pointer :: waterPressure - real (kind=RKIND), dimension(:), pointer :: waterPressureSmooth real (kind=RKIND), dimension(:), pointer :: waterThicknessEdge real (kind=RKIND), dimension(:), pointer :: waterThicknessEdgeUpwind real (kind=RKIND), dimension(:), pointer :: waterThickness @@ -796,8 +809,7 @@ subroutine calc_edge_quantities(block, err) real (kind=RKIND), dimension(:), pointer :: waterFlux real (kind=RKIND), dimension(:), pointer :: waterFluxAdvec real (kind=RKIND), dimension(:), pointer :: waterFluxDiffu - real (kind=RKIND), dimension(:), pointer :: channelDebugMask - real (kind=RKIND), dimension(:), pointer :: pressureField + real (kind=RKIND), dimension(:), pointer :: waterPressureSmooth integer, dimension(:), pointer :: hydroMarineMarginMask integer, dimension(:), pointer :: waterFluxMask integer, dimension(:,:), pointer :: edgeSignOnCell @@ -832,7 +844,6 @@ subroutine calc_edge_quantities(block, err) integer :: iNeighbor integer :: numCells integer :: iter - real (kind=RKIND) :: totNeighborPressure err = 0 err_tmp = 0 @@ -858,7 +869,6 @@ subroutine calc_edge_quantities(block, err) call mpas_pool_get_array(hydroPool, 'waterThickness', waterThickness) call mpas_pool_get_array(hydroPool, 'waterPressure', waterPressure) - call mpas_pool_get_array(hydroPool, 'waterPressureSmooth', waterPressureSmooth) call mpas_pool_get_array(hydroPool, 'hydropotentialBase', hydropotentialBase) call mpas_pool_get_array(hydroPool, 'hydropotential', hydropotential) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) @@ -888,9 +898,8 @@ subroutine calc_edge_quantities(block, err) call mpas_pool_get_array(hydroPool, 'waterFluxMask', waterFluxMask) call mpas_pool_get_array(hydroPool, 'hydroMarineMarginMask', hydroMarineMarginMask) call mpas_pool_get_array(geometryPool, 'edgeMask', edgeMask) - call mpas_pool_get_array(hydroPool, 'channelDebugMask', channelDebugMask) call mpas_pool_get_array(hydroPool, 'hydroMarineMarginMask', hydroMarineMarginMask) - call mpas_pool_get_array(hydroPool, 'pressureField', pressureField) + call mpas_pool_get_array(hydroPool, 'waterPressureSmooth', waterPressureSmooth) do iEdge = 1, nEdges cell1 = cellsOnEdge(1, iEdge) @@ -908,63 +917,7 @@ subroutine calc_edge_quantities(block, err) hydropotentialBaseSlopeNormal(iEdge) = (hydropotentialBase(cell2) - hydropotentialBase(cell1)) / dcEdge(iEdge) hydropotentialSlopeNormal(iEdge) = (hydropotential(cell2) - hydropotential(cell1)) / dcEdge(iEdge) - !waterPressureSlopeNormal(iEdge) = (waterPressure(cell2) - waterPressure(cell1)) / dcEdge(iEdge) - end do - - ! Create a smoothed waterPressure product used only for - ! calculating waterPressureSlopeNormal - to avoid channelPressureFreeze - ! instabilities - - if (nTimesSmooth > 0) then - do iter = 1, nTimesSmooth !May need to iterate to smooth properly - if (iter == 1) then - waterPressureSmooth = waterPressure - pressureField = waterPressure - else - pressureField = waterPressureSmooth - endif - - do iCell = 1, nCells - if ((li_mask_is_grounded_ice(cellMask(iCell))) .and. (.not. li_mask_is_margin(cellMask(iCell)))) then - - isMarineMargin = 0 - do edgeNum = 1, nEdgesOnCell(iCell) - iEdge = edgesOnCell(edgeNum,iCell) - if (hydroMarineMarginMask(iEdge) == 1) then - isMarineMargin = 1 - exit - endif - enddo - - if (isMarineMargin == 0) then - - totNeighborPressure = pressureField(iCell) - numCells = 1 - - do jCell = 1, nEdgesOnCell(iCell) - iNeighbor = cellsOnCell(jCell,iCell) - - if (iNeighbor < nCells + 1) then - totNeighborPressure = totNeighborPressure + pressureField(iNeighbor) - numCells = numCells + 1 - endif - end do - - !waterPressureSmooth is average of neighboring cells - waterPressureSmooth(iCell) = totNeighborPressure / numCells - endif - endif - end do - end do - elseif (nTimesSmooth == 0) then - waterPressureSmooth = waterPressure - endif - - do iEdge = 1, nEdges - cell1 = cellsOnEdge(1, iEdge) - cell2 = cellsOnEdge(2, iEdge) - waterPressureSlopeNormal(iEdge) = (waterPressureSmooth(cell2) - waterPressureSmooth(cell1)) / dcEdge(iEdge) end do @@ -1751,7 +1704,6 @@ subroutine calc_pressure_diag_vars(block, err) type (mpas_pool_type), pointer :: geometryPool type (mpas_pool_type), pointer :: hydroPool real (kind=RKIND), pointer :: rhoi, rhoo - real (kind=RKIND), dimension(:), pointer :: thickness real (kind=RKIND), dimension(:), pointer :: waterPressure real (kind=RKIND), dimension(:), pointer :: bedTopography real (kind=RKIND), dimension(:), pointer :: hydropotentialBase @@ -1773,7 +1725,6 @@ subroutine calc_pressure_diag_vars(block, err) call mpas_pool_get_config(liConfigs, 'config_ocean_density', rhoo) call mpas_pool_get_array(hydroPool, 'effectivePressure', effectivePressure) - call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(hydroPool, 'waterPressure', waterPressure) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(hydroPool, 'hydropotentialBase', hydropotentialBase) @@ -2255,7 +2206,6 @@ subroutine ocean_connection_N(domain) type (block_type), pointer :: block type (mpas_pool_type), pointer :: hydroPool type (mpas_pool_type), pointer :: geometryPool - real (kind=RKIND), dimension(:), pointer :: thickness real (kind=RKIND), dimension(:), pointer :: bedTopography real (kind=RKIND), dimension(:), pointer :: effectivePressure real (kind=RKIND), dimension(:), pointer :: iceThicknessHydro @@ -2270,7 +2220,6 @@ subroutine ocean_connection_N(domain) do while (associated(block)) call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) call mpas_pool_get_subpool(block % structs, 'hydro', hydroPool) - call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(hydroPool, 'effectivePressure', effectivePressure) call mpas_pool_get_array(hydroPool, 'iceThicknessHydro', iceThicknessHydro) @@ -2413,8 +2362,8 @@ end subroutine calc_hydro_mask !> \author Alex Hager !> \date 7 June 2023 !> \details -!> This routine calculates a modified ice thickness that is altered at -! the domain boundaries to avoid local minima in hydropotential +!> This routine calculates a modified ice thickness that is altered to +!> avoid local minima in hydropotential !----------------------------------------------------------------------- subroutine calc_iceThicknessHydro(block, err) @@ -2566,7 +2515,6 @@ end subroutine calc_iceThicknessHydro !> \details Find the total amount of freshwater entering the first ocean cell from the grounding line. !----------------------------------------------------------------------- subroutine calc_gl_totals(block, err) - !----------------------------------------------------------------- ! input variables !----------------------------------------------------------------- @@ -2581,11 +2529,6 @@ subroutine calc_gl_totals(block, err) !----------------------------------------------------------------- integer, intent(out) :: err !< Output: error flag - !----------------------------------------------------------------- - !----------------------------------------------------------------- - ! output variables - !----------------------------------------------------------------- - !----------------------------------------------------------------- ! local variables !----------------------------------------------------------------- @@ -2653,4 +2596,107 @@ subroutine calc_gl_totals(block, err) enddo end subroutine calc_gl_totals +!*********************************************************************** +! +! routine calc_waterPressureSmooth +! +!> \brief Calculate smoothed version of waterPressure used for calculation +!> of waterPressureSlopeNormal +!> \author Alex Hager +!> \date 29 February 2024 +!> \details Creates a smoothed version of waterPressure, called waterPressureSmooth, +!> that is used for calculation of waterPressureSlopeNormal. +!> This is necessary to increase stability with channelPressureFreeze +!> with spatially variable bedTopography and upperSurface. waterPressureSmooth +!> an area-weighted average of the current cells and its neighbors. Possible to +!> perform multiple iterations of smoothing by adjusting +!> config_SGH_iter_smooth_waterPressureSlopeNormal +!----------------------------------------------------------------------- + subroutine calc_waterPressureSmooth(block,err) + !----------------------------------------------------------------- + ! input variables + !----------------------------------------------------------------- + + !----------------------------------------------------------------- + ! input/output variables + !----------------------------------------------------------------- + type (block_type), intent(inout) :: block !< Input/Output: block object + + !----------------------------------------------------------------- + ! output variables + !----------------------------------------------------------------- + integer, intent(out) :: err !< Output: error flag + + !----------------------------------------------------------------- + ! local variables + !----------------------------------------------------------------- + + type (mpas_pool_type), pointer :: meshPool + type (mpas_pool_type), pointer :: geometryPool + type (mpas_pool_type), pointer :: hydroPool + real (kind=RKIND), dimension(:), pointer :: bedTopography + real (kind=RKIND), dimension(:), pointer :: waterPressure + real (kind=RKIND), dimension(:), pointer :: waterPressureSmooth + real (kind=RKIND), dimension(:), pointer :: areaCell + real (kind=RKIND), dimension(:), allocatable :: pressureField + real(kind=RKIND) :: totalPressure + real(kind=RKIND) :: totalArea + integer, dimension(:), pointer :: cellMask + integer, dimension(:,:), pointer :: cellsOnCell + integer, dimension(:), pointer :: nEdgesOnCell + integer, pointer :: nTimesSmooth + integer, pointer :: nCells + integer :: iCell, jCell + integer :: iNeighbor + integer :: iter + + err = 0 + + ! Get pools things + call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) + call mpas_pool_get_subpool(block % structs, 'hydro', hydroPool) + call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) + call mpas_pool_get_dimension(meshPool, 'nCells', nCells) + call mpas_pool_get_config(liConfigs, 'config_SGH_iter_smooth_waterPressureSlopeNormal', nTimesSmooth) + call mpas_pool_get_array(hydroPool, 'waterPressure', waterPressure) + call mpas_pool_get_array(hydroPool, 'waterPressureSmooth', waterPressureSmooth) + call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) + call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) + call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) + call mpas_pool_get_array(meshPool, 'areaCell', areaCell) + allocate(pressureField(nCells+1)) + + waterPressureSmooth = waterPressure + pressureField = waterPressure + + do iter = 1, nTimesSmooth !May need to iterate to smooth properly + + do iCell = 1, nCells + if (li_mask_is_grounded_ice(cellMask(iCell))) then !smooth over all grounded cells + + totalPressure = pressureField(iCell) + totalArea = areaCell(iCell) + + do jCell = 1, nEdgesOnCell(iCell) + iNeighbor = cellsOnCell(jCell,iCell) + + if ((li_mask_is_grounded_ice(cellMask(iNeighbor)))) then + + totalPressure = totalPressure + pressureField(iNeighbor)*areaCell(iNeighbor) + + totalArea = totalArea + areaCell(iNeighbor) + endif + end do + + waterPressureSmooth(iCell) = totalPressure / totalArea !area-weighted average height + endif + end do + + pressureField = waterPressureSmooth + + end do + + deallocate(pressureField) + end subroutine calc_waterPressureSmooth + end module li_subglacial_hydro From 1f94eb5e39f32f136c6b4e0579817d3fdde2e10b Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Mon, 4 Mar 2024 11:00:18 -0700 Subject: [PATCH 89/94] Debug waterPressureSmooth fixes minor bug in waterPRessureSmooth calculation --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index f74351f14ae8..a7f39e2c8308 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -2674,7 +2674,7 @@ subroutine calc_waterPressureSmooth(block,err) do iCell = 1, nCells if (li_mask_is_grounded_ice(cellMask(iCell))) then !smooth over all grounded cells - totalPressure = pressureField(iCell) + totalPressure = pressureField(iCell)*areaCell(iCell) totalArea = areaCell(iCell) do jCell = 1, nEdgesOnCell(iCell) @@ -2688,7 +2688,7 @@ subroutine calc_waterPressureSmooth(block,err) endif end do - waterPressureSmooth(iCell) = totalPressure / totalArea !area-weighted average height + waterPressureSmooth(iCell) = totalPressure / totalArea !area-weighted average pressure endif end do From 435acd54def3fe98bbc8d714058859bc0841f34f Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Fri, 8 Mar 2024 11:39:42 -0700 Subject: [PATCH 90/94] PR cleanup Implements minor edits to PR to clean up code and debug halo updates --- .../mode_forward/mpas_li_subglacial_hydro.F | 77 +++++++++---------- 1 file changed, 37 insertions(+), 40 deletions(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index a7f39e2c8308..2724921170d4 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -181,12 +181,29 @@ subroutine li_SGH_init(domain, err) tillWaterThickness = max(0.0_RKIND, tillWaterThickness) tillWaterThickness = min(tillMax, tillWaterThickness) - call mpas_pool_get_array(hydroPool, 'waterPressure', waterPressure) call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(hydroPool, 'iceThicknessHydro', iceThicknessHydro) call calc_iceThicknessHydro(block, err_tmp) !adjust ice thickness along boundaries err = ior(err,err_tmp) + block => block % next + end do + + !update halo for iceThicknessHydro + call mpas_timer_start("halo updates") + call mpas_dmpar_field_halo_exch(domain, 'iceThicknessHydro') + call mpas_timer_stop("halo updates") + + block => domain % blocklist + do while (associated(block)) + call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) + call mpas_pool_get_subpool(block % structs, 'hydro', hydroPool) + call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) + call mpas_pool_get_subpool(block % structs, 'velocity', velocityPool) + call mpas_pool_get_array(hydroPool, 'waterPressure', waterPressure) + call mpas_pool_get_array(hydroPool, 'deltatSGH', deltatSGH) + call mpas_pool_get_array(hydroPool, 'iceThicknessHydro', iceThicknessHydro) + waterPressure = max(0.0_RKIND, waterPressure) waterPressure = min(waterPressure, rhoi * gravity * iceThicknessHydro) ! set pressure correctly under floating ice and open ocean @@ -201,22 +218,18 @@ subroutine li_SGH_init(domain, err) call calc_pressure_diag_vars(block, err_tmp) err = ior(err, err_tmp) - call calc_waterPressureSmooth(block, err_tmp) !adjust ice thickness along boundaries + !smooth water pressure for calculation of waterPressureSlopeNormal + call calc_waterPressureSmooth(block, err_tmp) err = ior(err,err_tmp) - !updates halos for waterPressure - call mpas_timer_start("halo updates") - call mpas_dmpar_field_halo_exch(domain, 'waterPressureSlopeNormal') - call mpas_timer_stop("halo updates") - block => block % next end do - !update halo for iceThicknessHydro + !updates halos for waterPressure call mpas_timer_start("halo updates") - call mpas_dmpar_field_halo_exch(domain, 'iceThicknessHydro') + call mpas_dmpar_field_halo_exch(domain, 'waterPressureSmooth') call mpas_timer_stop("halo updates") - + ! === error check if (err > 0) then call mpas_log_write("An error has occurred in li_SGH_init.", MPAS_LOG_ERR) @@ -651,14 +664,14 @@ subroutine li_SGH_solve(domain, err) call calc_waterPressureSmooth(block, err_tmp) !adjust ice thickness along boundaries err = ior(err,err_tmp) - !updates halos for waterPressure - call mpas_timer_start("halo updates") - call mpas_dmpar_field_halo_exch(domain, 'waterPressureSlopeNormal') - call mpas_timer_stop("halo updates") - block => block % next end do + !updates halos for waterPressure + call mpas_timer_start("halo updates") + call mpas_dmpar_field_halo_exch(domain, 'waterPressureSmooth') + call mpas_timer_stop("halo updates") + ! ============= ! ============= @@ -818,7 +831,6 @@ subroutine calc_edge_quantities(block, err) integer, dimension(:,:), pointer :: cellsOnEdge integer, dimension(:,:), pointer :: edgesOnCell integer, dimension(:,:), pointer :: cellsOnCell - integer, dimension(:), pointer :: nEdgesOnCell integer, dimension(:,:), pointer :: verticesOnEdge integer, dimension(:,:), pointer :: baryCellsOnVertex real (kind=RKIND), dimension(:,:), pointer :: baryWeightsOnVertex @@ -830,12 +842,11 @@ subroutine calc_edge_quantities(block, err) character (len=StrKIND), pointer :: config_SGH_tangent_slope_calculation real (kind=RKIND), pointer :: config_sea_level real (kind=RKIND), pointer :: rhoo - integer, pointer :: nTimesSmooth integer, pointer :: nEdges integer, pointer :: nCells integer, pointer :: nVertices integer :: iEdge, cell1, cell2 - integer :: i, j, iVertex, iCell, jCell + integer :: i, j, iVertex, iCell real (kind=RKIND) :: velSign integer :: numGroundedCells integer :: err_tmp @@ -843,7 +854,6 @@ subroutine calc_edge_quantities(block, err) integer :: edgeNum integer :: iNeighbor integer :: numCells - integer :: iter err = 0 err_tmp = 0 @@ -865,7 +875,6 @@ subroutine calc_edge_quantities(block, err) call mpas_pool_get_config(liConfigs, 'config_SGH_tangent_slope_calculation', config_SGH_tangent_slope_calculation) call mpas_pool_get_config(liConfigs, 'config_sea_level', config_sea_level) call mpas_pool_get_config(liConfigs, 'config_ocean_density', rhoo) - call mpas_pool_get_config(liConfigs, 'config_SGH_iter_smooth_waterPressureSlopeNormal', nTimesSmooth) call mpas_pool_get_array(hydroPool, 'waterThickness', waterThickness) call mpas_pool_get_array(hydroPool, 'waterPressure', waterPressure) @@ -883,7 +892,6 @@ subroutine calc_edge_quantities(block, err) call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge) call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell) call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) - call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) call mpas_pool_get_array(meshPool, 'edgeSignOnCell', edgeSignOnCell) call mpas_pool_get_array(hydroPool, 'hydropotentialBaseSlopeTangent', hydropotentialBaseSlopeTangent) call mpas_pool_get_array(hydroPool, 'hydropotentialSlopeTangent', hydropotentialSlopeTangent) @@ -898,7 +906,6 @@ subroutine calc_edge_quantities(block, err) call mpas_pool_get_array(hydroPool, 'waterFluxMask', waterFluxMask) call mpas_pool_get_array(hydroPool, 'hydroMarineMarginMask', hydroMarineMarginMask) call mpas_pool_get_array(geometryPool, 'edgeMask', edgeMask) - call mpas_pool_get_array(hydroPool, 'hydroMarineMarginMask', hydroMarineMarginMask) call mpas_pool_get_array(hydroPool, 'waterPressureSmooth', waterPressureSmooth) do iEdge = 1, nEdges @@ -2393,16 +2400,11 @@ subroutine calc_iceThicknessHydro(block, err) real (kind=RKIND), dimension(:), pointer :: iceThicknessHydro real (kind=RKIND), dimension(:), pointer :: upperSurfaceHydro real (kind=RKIND), dimension(:), pointer :: upperSurface - integer, dimension(:), pointer :: hydroMarineMarginMask integer, dimension(:,:), pointer :: cellsOnCell - integer, dimension(:,:), pointer :: edgesOnCell integer, dimension(:), pointer :: cellMask - integer, dimension(:), pointer :: edgeMask real (kind=RKIND), dimension(:), pointer :: areaCell integer, pointer :: nCells - integer :: edgeNum integer, dimension(:), pointer :: nEdgesOnCell - integer :: iEdge integer :: iCell integer :: jCell integer :: iNeighbor @@ -2424,17 +2426,14 @@ subroutine calc_iceThicknessHydro(block, err) call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) - call mpas_pool_get_array(geometryPool, 'edgeMask', edgeMask) call mpas_pool_get_array(hydroPool, 'iceThicknessHydro', iceThicknessHydro) call mpas_pool_get_array(hydroPool, 'upperSurfaceHydro', upperSurfaceHydro) call mpas_pool_get_array(geometryPool, 'upperSurface', upperSurface) call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) call mpas_pool_get_dimension(meshPool, 'nCells', nCells) call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) - call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell) call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) call mpas_pool_get_array(meshPool, 'areaCell', areaCell) - call mpas_pool_get_array(hydroPool, 'hydroMarineMarginMask', hydroMarineMarginMask) call mpas_pool_get_config(liConfigs, 'config_SGH_use_iceThicknessHydro', config_SGH_use_iceThicknessHydro) iceThicknessHydro = thickness @@ -2446,7 +2445,7 @@ subroutine calc_iceThicknessHydro(block, err) if (config_SGH_use_iceThicknessHydro) then do iCell = 1, nCells - if (li_mask_is_grounded_ice(cellMask(iCell))) then !identify domain boundaries + if (li_mask_is_grounded_ice(cellMask(iCell))) then !identify grounded ice maxNeighborHeight = bigNegativeValue !initialize minNeighborHeight = bigValue @@ -2646,7 +2645,7 @@ subroutine calc_waterPressureSmooth(block,err) integer, dimension(:), pointer :: nEdgesOnCell integer, pointer :: nTimesSmooth integer, pointer :: nCells - integer :: iCell, jCell + integer :: iCell, jEdge integer :: iNeighbor integer :: iter @@ -2677,8 +2676,8 @@ subroutine calc_waterPressureSmooth(block,err) totalPressure = pressureField(iCell)*areaCell(iCell) totalArea = areaCell(iCell) - do jCell = 1, nEdgesOnCell(iCell) - iNeighbor = cellsOnCell(jCell,iCell) + do jEdge = 1, nEdgesOnCell(iCell) + iNeighbor = cellsOnCell(jEdge,iCell) if ((li_mask_is_grounded_ice(cellMask(iNeighbor)))) then @@ -2690,13 +2689,11 @@ subroutine calc_waterPressureSmooth(block,err) waterPressureSmooth(iCell) = totalPressure / totalArea !area-weighted average pressure endif + end do + pressureField = waterPressureSmooth end do - - pressureField = waterPressureSmooth - - end do - - deallocate(pressureField) + + deallocate(pressureField) end subroutine calc_waterPressureSmooth end module li_subglacial_hydro From b352169bf19a940ffce621608505249c0a6f4340 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Wed, 22 May 2024 14:07:20 -0600 Subject: [PATCH 91/94] PR Cleanup #2 Addresses minor cleaning edits following second round of review --- .../src/Registry_subglacial_hydro.xml | 2 -- .../mode_forward/mpas_li_subglacial_hydro.F | 25 +++++-------------- 2 files changed, 6 insertions(+), 21 deletions(-) diff --git a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml index 87af56eee82b..fdc4cd0b3878 100644 --- a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml +++ b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml @@ -152,8 +152,6 @@ - domain % blocklist do while (associated(block)) - call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) call mpas_pool_get_subpool(block % structs, 'hydro', hydroPool) call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) - call mpas_pool_get_subpool(block % structs, 'velocity', velocityPool) call mpas_pool_get_array(hydroPool, 'waterPressure', waterPressure) - call mpas_pool_get_array(hydroPool, 'deltatSGH', deltatSGH) call mpas_pool_get_array(hydroPool, 'iceThicknessHydro', iceThicknessHydro) waterPressure = max(0.0_RKIND, waterPressure) @@ -225,7 +222,7 @@ subroutine li_SGH_init(domain, err) block => block % next end do - !updates halos for waterPressure + !updates halos for waterPressureSmooth call mpas_timer_start("halo updates") call mpas_dmpar_field_halo_exch(domain, 'waterPressureSmooth') call mpas_timer_stop("halo updates") @@ -661,7 +658,7 @@ subroutine li_SGH_solve(domain, err) call calc_pressure(block, err_tmp) err = ior(err, err_tmp) - call calc_waterPressureSmooth(block, err_tmp) !adjust ice thickness along boundaries + call calc_waterPressureSmooth(block, err_tmp) !compute smoothed version of waterPressure err = ior(err,err_tmp) block => block % next @@ -830,7 +827,6 @@ subroutine calc_edge_quantities(block, err) integer, dimension(:), pointer :: edgeMask integer, dimension(:,:), pointer :: cellsOnEdge integer, dimension(:,:), pointer :: edgesOnCell - integer, dimension(:,:), pointer :: cellsOnCell integer, dimension(:,:), pointer :: verticesOnEdge integer, dimension(:,:), pointer :: baryCellsOnVertex real (kind=RKIND), dimension(:,:), pointer :: baryWeightsOnVertex @@ -850,10 +846,6 @@ subroutine calc_edge_quantities(block, err) real (kind=RKIND) :: velSign integer :: numGroundedCells integer :: err_tmp - integer :: isMarineMargin - integer :: edgeNum - integer :: iNeighbor - integer :: numCells err = 0 err_tmp = 0 @@ -891,7 +883,6 @@ subroutine calc_edge_quantities(block, err) call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) call mpas_pool_get_array(meshPool, 'cellsOnEdge', cellsOnEdge) call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell) - call mpas_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) call mpas_pool_get_array(meshPool, 'edgeSignOnCell', edgeSignOnCell) call mpas_pool_get_array(hydroPool, 'hydropotentialBaseSlopeTangent', hydropotentialBaseSlopeTangent) call mpas_pool_get_array(hydroPool, 'hydropotentialSlopeTangent', hydropotentialSlopeTangent) @@ -2215,7 +2206,7 @@ subroutine ocean_connection_N(domain) type (mpas_pool_type), pointer :: geometryPool real (kind=RKIND), dimension(:), pointer :: bedTopography real (kind=RKIND), dimension(:), pointer :: effectivePressure - real (kind=RKIND), dimension(:), pointer :: iceThicknessHydro + real (kind=RKIND), dimension(:), pointer :: thickness real (kind=RKIND), pointer :: rhoi, rhoo ! Calculate N assuming perfect ocean connection @@ -2229,9 +2220,9 @@ subroutine ocean_connection_N(domain) call mpas_pool_get_subpool(block % structs, 'hydro', hydroPool) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(hydroPool, 'effectivePressure', effectivePressure) - call mpas_pool_get_array(hydroPool, 'iceThicknessHydro', iceThicknessHydro) + call mpas_pool_get_array(hydroPool, 'iceThicknessHydro', thickness) - effectivePressure = rhoi * gravity * iceThicknessHydro - rhoi * gravity * max(0.0_RKIND, -1.0_RKIND * rhoo/rhoi * bedTopography) + effectivePressure = rhoi * gravity * thickness - rhoi * gravity * max(0.0_RKIND, -1.0_RKIND * rhoo/rhoi * bedTopography) effectivePressure = max(effectivePressure, 0.0_RKIND) ! This is just to zero out N in the open ocean to avoid confusion block => block % next @@ -2398,7 +2389,6 @@ subroutine calc_iceThicknessHydro(block, err) real (kind=RKIND), dimension(:), pointer :: thickness real (kind=RKIND), dimension(:), pointer :: bedTopography real (kind=RKIND), dimension(:), pointer :: iceThicknessHydro - real (kind=RKIND), dimension(:), pointer :: upperSurfaceHydro real (kind=RKIND), dimension(:), pointer :: upperSurface integer, dimension(:,:), pointer :: cellsOnCell integer, dimension(:), pointer :: cellMask @@ -2427,7 +2417,6 @@ subroutine calc_iceThicknessHydro(block, err) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(geometryPool, 'cellMask', cellMask) call mpas_pool_get_array(hydroPool, 'iceThicknessHydro', iceThicknessHydro) - call mpas_pool_get_array(hydroPool, 'upperSurfaceHydro', upperSurfaceHydro) call mpas_pool_get_array(geometryPool, 'upperSurface', upperSurface) call mpas_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) call mpas_pool_get_dimension(meshPool, 'nCells', nCells) @@ -2499,8 +2488,6 @@ subroutine calc_iceThicknessHydro(block, err) enddo endif - upperSurfaceHydro = iceThicknessHydro + bedTopography - end subroutine calc_iceThicknessHydro !*********************************************************************** @@ -2679,7 +2666,7 @@ subroutine calc_waterPressureSmooth(block,err) do jEdge = 1, nEdgesOnCell(iCell) iNeighbor = cellsOnCell(jEdge,iCell) - if ((li_mask_is_grounded_ice(cellMask(iNeighbor)))) then + if ((li_mask_is_grounded_ice(cellMask(iNeighbor)))) then !only include GROUNDED neighboring cells in smoothing totalPressure = totalPressure + pressureField(iNeighbor)*areaCell(iNeighbor) From c54c6db758cf9e6cae0e25974c91f4c9335035c5 Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Tue, 21 May 2024 07:57:54 -0600 Subject: [PATCH 92/94] Default waterThickness/Min. effectConducEdge limit Establishes a default waterThickness to be imposed as an initial condition if no waterThickness variable exists. Forces effectiveConducEdge to zero if below 1e-30 to avoid too small of diffusivity/waterVelocity values. --- .../mpas-albany-landice/src/Registry_subglacial_hydro.xml | 2 +- .../src/mode_forward/mpas_li_subglacial_hydro.F | 5 +++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml index fdc4cd0b3878..8b3f07d4750f 100644 --- a/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml +++ b/components/mpas-albany-landice/src/Registry_subglacial_hydro.xml @@ -152,7 +152,7 @@ - diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 344459dae958..26c33ea28498 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -845,6 +845,7 @@ subroutine calc_edge_quantities(block, err) integer :: i, j, iVertex, iCell real (kind=RKIND) :: velSign integer :: numGroundedCells + real(kind=RKIND), parameter :: SMALL_CONDUC = 1.0e-30_RKIND integer :: err_tmp err = 0 @@ -1079,6 +1080,10 @@ subroutine calc_edge_quantities(block, err) enddo endif + where (effectiveConducEdge < SMALL_CONDUC) + effectiveConducEdge = 0.0_RKIND + end where + ! calculate diffusivity on edges diffusivity(:) = rho_water * gravity * effectiveConducEdge(:) * waterThicknessEdge(:) From 8628e1a38c70fd5819b696c235e0bcc22fbc132a Mon Sep 17 00:00:00 2001 From: Alexander Hager Date: Tue, 28 May 2024 07:40:46 -0600 Subject: [PATCH 93/94] Fix typo in PR #106 Fixes typo in PR #106 that accidentally got merged. --- .../src/mode_forward/mpas_li_subglacial_hydro.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F index 26c33ea28498..b722459761eb 100644 --- a/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F +++ b/components/mpas-albany-landice/src/mode_forward/mpas_li_subglacial_hydro.F @@ -2225,7 +2225,7 @@ subroutine ocean_connection_N(domain) call mpas_pool_get_subpool(block % structs, 'hydro', hydroPool) call mpas_pool_get_array(geometryPool, 'bedTopography', bedTopography) call mpas_pool_get_array(hydroPool, 'effectivePressure', effectivePressure) - call mpas_pool_get_array(hydroPool, 'iceThicknessHydro', thickness) + call mpas_pool_get_array(hydroPool, 'thickness', thickness) effectivePressure = rhoi * gravity * thickness - rhoi * gravity * max(0.0_RKIND, -1.0_RKIND * rhoo/rhoi * bedTopography) effectivePressure = max(effectivePressure, 0.0_RKIND) ! This is just to zero out N in the open ocean to avoid confusion From c98564b256b19cff0875b3417f1e1d22ebd6fd44 Mon Sep 17 00:00:00 2001 From: Jon Wolfe Date: Wed, 14 Aug 2024 11:54:06 -0500 Subject: [PATCH 94/94] Update bld files to match Registry --- .../mpas-albany-landice/bld/build-namelist | 2 ++ .../bld/build-namelist-section | 2 ++ .../namelist_files/namelist_defaults_mali.xml | 4 +++- .../namelist_definition_mali.xml | 24 +++++++++++++++---- 4 files changed, 27 insertions(+), 5 deletions(-) diff --git a/components/mpas-albany-landice/bld/build-namelist b/components/mpas-albany-landice/bld/build-namelist index 068363fb98c6..15272f7a2dab 100755 --- a/components/mpas-albany-landice/bld/build-namelist +++ b/components/mpas-albany-landice/bld/build-namelist @@ -663,6 +663,7 @@ add_default($nl, 'config_SGH_bed_roughness'); add_default($nl, 'config_SGH_bed_roughness_max'); add_default($nl, 'config_SGH_creep_coefficient'); add_default($nl, 'config_SGH_englacial_porosity'); +add_default($nl, 'config_SGH_use_iceThicknessHydro'); add_default($nl, 'config_SGH_chnl_active'); add_default($nl, 'config_SGH_chnl_include_DCFL'); add_default($nl, 'config_SGH_chnl_alpha'); @@ -673,6 +674,7 @@ add_default($nl, 'config_SGH_incipient_channel_width'); add_default($nl, 'config_SGH_include_pressure_melt'); add_default($nl, 'config_SGH_shmip_forcing'); add_default($nl, 'config_SGH_basal_melt'); +add_default($nl, 'config_SGH_iter_smooth_waterPressureSlopeNormal'); ################################## # Namelist group: AM_globalStats # diff --git a/components/mpas-albany-landice/bld/build-namelist-section b/components/mpas-albany-landice/bld/build-namelist-section index 8f4bc139c98a..4b5e05ec3cd5 100644 --- a/components/mpas-albany-landice/bld/build-namelist-section +++ b/components/mpas-albany-landice/bld/build-namelist-section @@ -225,6 +225,7 @@ add_default($nl, 'config_SGH_bed_roughness'); add_default($nl, 'config_SGH_bed_roughness_max'); add_default($nl, 'config_SGH_creep_coefficient'); add_default($nl, 'config_SGH_englacial_porosity'); +add_default($nl, 'config_SGH_use_iceThicknessHydro'); add_default($nl, 'config_SGH_chnl_active'); add_default($nl, 'config_SGH_chnl_include_DCFL'); add_default($nl, 'config_SGH_chnl_alpha'); @@ -235,6 +236,7 @@ add_default($nl, 'config_SGH_incipient_channel_width'); add_default($nl, 'config_SGH_include_pressure_melt'); add_default($nl, 'config_SGH_shmip_forcing'); add_default($nl, 'config_SGH_basal_melt'); +add_default($nl, 'config_SGH_iter_smooth_waterPressureSlopeNormal'); ################################## # Namelist group: AM_globalStats # diff --git a/components/mpas-albany-landice/bld/namelist_files/namelist_defaults_mali.xml b/components/mpas-albany-landice/bld/namelist_files/namelist_defaults_mali.xml index 5cebbf9cd136..535fdbdc4d49 100644 --- a/components/mpas-albany-landice/bld/namelist_files/namelist_defaults_mali.xml +++ b/components/mpas-albany-landice/bld/namelist_files/namelist_defaults_mali.xml @@ -26,7 +26,7 @@ 'none' -'0002-00-00_00:00:00' +2 'mpas_to_grid.nc' 'grid_to_mpas.nc' @@ -184,6 +184,7 @@ 0.1 0.04 0.01 +.true. .false. .false. 1.25 @@ -194,6 +195,7 @@ .true. 'none' 'file' +1 .true. diff --git a/components/mpas-albany-landice/bld/namelist_files/namelist_definition_mali.xml b/components/mpas-albany-landice/bld/namelist_files/namelist_definition_mali.xml index c04d52840a6c..e16e7042a2cb 100644 --- a/components/mpas-albany-landice/bld/namelist_files/namelist_definition_mali.xml +++ b/components/mpas-albany-landice/bld/namelist_files/namelist_definition_mali.xml @@ -194,11 +194,11 @@ Valid values: 'none', 'data', 'sealevelmodel' Default: Defined in namelist_defaults.xml - -Time interval at which the sea-level model is called by MALI. The interval has to be an even multiple of the option 'config_adaptive_timestep_force_interval +Time interval at which the sea-level model is called by MALI. Only integer years are currently supported. The user must set 'dt1' in namelist.sealevel to match this value. Note that the user needs to set config_adaptive_timestep_force_interval to divide evenly into config_slm_coupling_interval. Also, restart file output_interval needs to be a multiple of config_slm_coupling_interval. -Valid values: Any time interval of the format 'YYYY-MM-DD_HH:MM:SS' +Valid values: Any positive integer Default: Defined in namelist_defaults.xml @@ -1218,7 +1218,7 @@ Default: Defined in namelist_defaults.xml -Selection of the method for calculating the tangent component of slope at edges. 'from_vertex_barycentric' interpolates scalar values from cell centers to vertices using the barycentric interpolation routine in operators (mpas_cells_to_points_using_baryweights) and then calculates the slope between vertices. It works for obtuse triangles, but will not work correctly across the edges of periodic meshes. 'from_vertex_barycentric_kiteareas' interpolates scalar values from cell centers to vertices using barycentric interpolation based on kiterea values and then calculates the slope between vertices. It will work across the edges of periodic meshes, but will not work correctly for obtuse triangles. 'from_normal_slope' uses the vector operator mpas_tangential_vector_1d to calculate the tangent slopes from the normal slopes on the edges of the adjacent cells. It will work for any mesh configuration, but is the least accurate method. +Selection of the method for calculating the tangent component of slope at edges. 'from_vertex_barycentric' interpolates scalar values from cell centers to vertices using the barycentric interpolation routine in operators (mpas_cells_to_points_using_baryweights) and then calculates the slope between vertices. It works for obtuse triangles, but will not work correctly across the edges of periodic meshes. 'from_vertex_barycentric_kiteareas' interpolates scalar values from cell centers to vertices using barycentric interpolation based on kiterea values and then calculates the slope between vertices. It will work across the edges of periodic meshes, but will not work correctly for obtuse triangles. 'from_normal_slope' uses the vector operator mpas_tangential_vector_1d to calculate the tangent slopes from the normal slopes on the edges of the adjacent cells. It will work for any mesh configuration. 'from_normal_slope' uses a larger stencil, so may therefore produce a smoother 'gradMagPhiEdge' field. Detailed testing yielded nearly identical results between 'from_normal_slope' and 'from_vertex_barycentric' methods, but 'from_normal_slope' seemed to produce slightly more stable results at the grounding line. Valid values: 'from_vertex_barycentric', 'from_vertex_barycentric_kiteareas', 'from_normal_slope' Default: Defined in namelist_defaults.xml @@ -1320,6 +1320,14 @@ Valid values: positive real number Default: Defined in namelist_defaults.xml + +Option to use an altered ice thickness field called iceThicknessHydro that replaces local maxima/minima in upperSurface with a mean of the cells neighbors. This option has no significant effect on the behavior of the model but makes it more stable. + +Valid values: .true. or .false. +Default: Defined in namelist_defaults.xml + + activate channels in subglacial hydrology model @@ -1400,6 +1408,14 @@ Valid values: 'file', 'thermal', 'basal_heat' Default: Defined in namelist_defaults.xml + +number of iterations to smooth waterPressure over when calculating waterPressureSlopeNormal. Used only to keep channelPressureFreeze stable and will not affect other aspects of the model that rely on waterPressure. + +Valid values: positive integer or zero +Default: Defined in namelist_defaults.xml + +