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 e66f15c0a871..1c2f7c792465 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 @@ -217,7 +217,11 @@ subroutine li_calve_ice(domain, err) do while (associated(block)) call mpas_pool_get_subpool(block % structs, 'geometry', geometryPool) call mpas_pool_get_array(geometryPool, 'calvingThickness', calvingThickness) + call mpas_pool_get_array(geometryPool, 'groundedCalvingThickness', groundedCalvingThickness) + call mpas_pool_get_array(geometryPool, 'floatingCalvingThickness', floatingCalvingThickness) calvingThickness(:) = 0.0_RKIND + groundedCalvingThickness(:) = 0.0_RKIND + floatingCalvingThickness(:) = 0.0_RKIND block => block % next end do @@ -288,27 +292,7 @@ subroutine li_calve_ice(domain, err) ! now also remove any icebergs call remove_icebergs(domain) - block => domain % blocklist - do while (associated(block)) - call mpas_pool_get_array(geometryPool, 'calvingThickness', calvingThickness) - call mpas_pool_get_array(geometryPool, 'groundedCalvingThickness', groundedCalvingThickness) - call mpas_pool_get_array(geometryPool, 'floatingCalvingThickness', floatingCalvingThickness) - call mpas_pool_get_array(geometryPool, 'groundedMaskForMassBudget', groundedMaskForMassBudget) - call mpas_pool_get_array(geometryPool, 'floatingMaskForMassBudget', floatingMaskForMassBudget) - - groundedCalvingThickness(:) = 0.0_RKIND - floatingCalvingThickness(:) = 0.0_RKIND - where (groundedMaskForMassBudget .eq. 1) - groundedCalvingThickness = calvingThickness - elsewhere (floatingMaskForMassBudget .eq. 1) - floatingCalvingThickness = calvingThickness - elsewhere - groundedCalvingThickness = 0.0_RKIND - floatingCalvingThickness = 0.0_RKIND - end where - - block => block % next - end do + call update_calving_budget(domain) ! Final operations after calving has been applied. block => domain % blocklist @@ -317,8 +301,6 @@ subroutine li_calve_ice(domain, err) call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) call mpas_pool_get_array(geometryPool, 'thickness', thickness) call mpas_pool_get_array(geometryPool, 'calvingThickness', calvingThickness) - call mpas_pool_get_array(geometryPool, 'groundedCalvingThickness', groundedCalvingThickness) - call mpas_pool_get_array(geometryPool, 'floatingCalvingThickness', floatingCalvingThickness) call mpas_pool_get_dimension(meshPool, 'nCells', nCells) ! In data calving mode we just calculate what should be calved but don't actually calve it. @@ -596,6 +578,7 @@ subroutine li_restore_calving_front(domain, err) block => block % next enddo + call update_calving_budget(domain) ! Update mask and geometry block => domain % blocklist do while (associated(block)) @@ -895,7 +878,9 @@ subroutine thickness_calving(domain, calvingFraction, err) ! === apply calving === thickness(:) = thickness(:) - calvingThickness(:) + call update_calving_budget(domain) call remove_small_islands(meshPool, geometryPool) + call update_calving_budget(domain) block => block % next enddo @@ -968,7 +953,9 @@ subroutine floating_calving(domain, calvingFraction, err) ! === apply calving === thickness(:) = thickness(:) - calvingThickness(:) + call update_calving_budget(domain) call remove_small_islands(meshPool, geometryPool) + call update_calving_budget(domain) block => block % next enddo @@ -1137,7 +1124,9 @@ subroutine topographic_calving(domain, calvingFraction, err) ! === apply calving === thickness(:) = thickness(:) - calvingThickness(:) + call update_calving_budget(domain) call remove_small_islands(meshPool, geometryPool) + call update_calving_budget(domain) block => block % next enddo @@ -1316,6 +1305,7 @@ subroutine eigencalving(domain, err) call mpas_timer_stop("halo updates") ! === apply calving === thickness(:) = thickness(:) - calvingThickness(:) + call update_calving_budget(domain) ! update mask call li_calculate_mask(meshPool, velocityPool, geometryPool, domain, err_tmp) @@ -1340,7 +1330,7 @@ subroutine eigencalving(domain, err) endif enddo ! TODO: global reduce & reporting on amount of calving generated in this step - + call update_calving_budget(domain) ! update mask call li_calculate_mask(meshPool, velocityPool, geometryPool, domain, err_tmp) err = ior(err, err_tmp) @@ -1365,8 +1355,9 @@ subroutine eigencalving(domain, err) endif enddo ! TODO: global reduce & reporting on amount of calving generated in this step - + call update_calving_budget(domain) call remove_small_islands(meshPool, geometryPool) + call update_calving_budget(domain) block => block % next enddo @@ -1494,7 +1485,7 @@ subroutine specified_calving_velocity(domain, err) ! === apply calving === thickness(:) = thickness(:) - calvingThickness(:) - + call update_calving_budget(domain) ! update mask call li_calculate_mask(meshPool, velocityPool, geometryPool, domain, err_tmp) err = ior(err, err_tmp) @@ -1518,7 +1509,7 @@ subroutine specified_calving_velocity(domain, err) endif enddo ! TODO: global reduce & reporting on amount of calving generated in this step - + call update_calving_budget(domain) ! update mask call li_calculate_mask(meshPool, velocityPool, geometryPool, domain, err_tmp) err = ior(err, err_tmp) @@ -1543,8 +1534,9 @@ subroutine specified_calving_velocity(domain, err) endif enddo ! TODO: global reduce & reporting on amount of calving generated in this step - + call update_calving_budget(domain) call remove_small_islands(meshPool, geometryPool) + call update_calving_budget(domain) block => block % next enddo @@ -1821,13 +1813,14 @@ subroutine von_Mises_calving(domain, err) ! === apply calving === thickness(:) = thickness(:) - calvingThickness(:) - + call update_calving_budget(domain) ! update mask call li_calculate_mask(meshPool, velocityPool, geometryPool, domain, err_tmp) err = ior(err, err_tmp) call remove_small_islands(meshPool, geometryPool) - + call update_calving_budget(domain) + block => block % next enddo ! associated(block) @@ -2086,11 +2079,12 @@ subroutine ismip6_retreat(domain, err) ! === apply calving === thickness(:) = thickness(:) - calvingThickness(:) - + call update_calving_budget(domain) ! update mask call li_calculate_mask(meshPool, velocityPool, geometryPool, domain, err_tmp) err = ior(err, err_tmp) call remove_small_islands(meshPool, geometryPool) + call update_calving_budget(domain) deallocate(submergedArea) @@ -2999,7 +2993,7 @@ subroutine damage_calving(domain, err) ! === apply calving === thickness(:) = thickness(:) - calvingThickness(:) - + call update_calving_budget(domain) ! update mask call li_calculate_mask(meshPool, velocityPool, geometryPool, domain, err_tmp) err = ior(err, err_tmp) @@ -3015,7 +3009,7 @@ subroutine damage_calving(domain, err) thickness(iCell) = 0.0_RKIND endif enddo - + call update_calving_budget(domain) ! update mask call li_calculate_mask(meshPool, velocityPool, geometryPool, domain, err_tmp) err = ior(err, err_tmp) @@ -3040,9 +3034,9 @@ subroutine damage_calving(domain, err) endif enddo ! TODO: global reduce & reporting on amount of calving generated in this step - + call update_calving_budget(domain) call remove_small_islands(meshPool, geometryPool) - + call update_calving_budget(domain) block => block % next enddo @@ -4063,6 +4057,50 @@ subroutine li_flood_fill(seedMask, growMask, domain) end subroutine li_flood_fill + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +! +! routine update_calving_budget +! +!> \brief Keep a running total of calving applied to grounded and floating +!> ice, respectively. +!> \author Trevor Hillebrand +!> \date May 2022 +!> \details This routine should be called after each time time calvingThickness +!> is applied, but before masks are updated which often happens multiple times +!> in a timestep. +!----------------------------------------------------------------------- + subroutine update_calving_budget(domain) + !----------------------------------------------------------------- + ! input/output variables + !----------------------------------------------------------------- + type (domain_type), intent(inout) :: domain + + !----------------------------------------------------------------- + ! local variables + !----------------------------------------------------------------- + type (mpas_pool_type), pointer :: meshPool, geometryPool + integer, dimension(:), pointer :: groundedMaskForMassBudget, & ! binary masks for mass budget + floatingMaskForMassBudget + real (kind=RKIND), dimension(:), pointer :: calvingThickness, & + groundedCalvingThickness, & ! Grounded and floating components for mass budget + floatingCalvingThickness + + call mpas_pool_get_subpool(domain % blocklist % structs, 'geometry', geometryPool) + call mpas_pool_get_array(geometryPool, 'groundedMaskForMassBudget', groundedMaskForMassBudget) + call mpas_pool_get_array(geometryPool, 'floatingMaskForMassBudget', groundedMaskForMassBudget) + call mpas_pool_get_array(geometryPool, 'groundedCalvingThickness', groundedCalvingThickness) + call mpas_pool_get_array(geometryPool, 'floatingCalvingThickness', floatingCalvingThickness) + call mpas_pool_get_array(geometryPool, 'calvingThickness', calvingThickness) + + where (groundedMaskForMassBudget .eq. 1) + groundedCalvingThickness = groundedCalvingThickness + calvingThickness + elsewhere (floatingMaskForMassBudget .eq. 1) + floatingCalvingThickness = floatingCalvingThickness + calvingThickness + end where + + end subroutine update_calving_budget + end module li_calving