From 17e01beaf735697499a3cfb5e8d1a4dde239fe4f Mon Sep 17 00:00:00 2001 From: alex-huth Date: Wed, 28 Feb 2024 14:31:26 -0500 Subject: [PATCH] some renaming variables and cleanup --- src/ice_shelf_calving.F90 | 88 +++++++++++++++----------------------- src/icebergs.F90 | 27 ++++++------ src/icebergs_framework.F90 | 4 +- 3 files changed, 49 insertions(+), 70 deletions(-) diff --git a/src/ice_shelf_calving.F90 b/src/ice_shelf_calving.F90 index 2f8939d..9b47bfa 100644 --- a/src/ice_shelf_calving.F90 +++ b/src/ice_shelf_calving.F90 @@ -19,7 +19,7 @@ module ice_shelf_tabular_calving !! 0: not ready to calve !! >1: ready to calve h_shelf => NULL(), & !< The ice shelf thickness field (m) - frac_shelf_h => NULL(), & !< The fraction of each grid cell covered by ice shelf [nondim] + frac_shelf => NULL(), & !< The fraction of each grid cell covered by ice shelf [nondim] frac_cberg_calved => NULL(), & !< Cell fraction of fully-calved bonded bergs from the ice sheet [nondim] frac_cberg => NULL() !< Cell fraction of partially-calved bonded bergs from the ice sheet [nondim] @@ -50,7 +50,7 @@ subroutine initialize_tabular_calving(TC, grd) allocate(TC%c_id(grd%isd:grd%ied,grd%jsd:grd%jed) , source=0.0 ) allocate(TC%calve_mask(grd%isd:grd%ied,grd%jsd:grd%jed) , source=0.0 ) allocate(TC%h_shelf(grd%isd:grd%ied,grd%jsd:grd%jed) , source=0.0 ) - allocate(TC%frac_shelf_h(grd%isd:grd%ied,grd%jsd:grd%jed) , source=0.0 ) + allocate(TC%frac_shelf(grd%isd:grd%ied,grd%jsd:grd%jed) , source=0.0 ) allocate(TC%frac_cberg_calved(grd%isd:grd%ied,grd%jsd:grd%jed), source=0.0 ) allocate(TC%frac_cberg(grd%isd:grd%ied,grd%jsd:grd%jed) , source=0.0 ) end subroutine initialize_tabular_calving @@ -65,30 +65,19 @@ subroutine ice_shelf_calving_end(TC) if (allocated(TC%c_id)) deallocate(TC%c_id) if (allocated(TC%calve_mask)) deallocate(TC%calve_mask) if (allocated(TC%h_shelf)) deallocate(TC%h_shelf) - if (allocated(TC%frac_shelf_h)) deallocate(TC%frac_shelf_h) + if (allocated(TC%frac_shelf)) deallocate(TC%frac_shelf) if (allocated(TC%frac_cberg_calved)) deallocate(TC%frac_cberg_calved) if (allocated(TC%frac_cberg)) deallocate(TC%frac_cberg) if (allocated(TC)) deallocate(TC) end subroutine ice_shelf_calving_end !> routine to initialize iKID icebergs from a tabular calving mask, called from icebergs_run - subroutine process_tabular_calving(bergs, TC, h_shelf, frac_shelf_h, frac_cberg_calved, frac_cberg) + subroutine process_tabular_calving(bergs) ! Arguments type(icebergs), pointer :: bergs !< Container for all types and memory type(tabular_calving_state), pointer :: TC !< A pointer to the tabular calving structure - type(time_type), intent(in) :: Time !< The current model time - real, dimension(:,:), intent(in) :: h_shelf !< The ice shelf thickness field (m) - real, dimension(:,:), intent(in) :: frac_shelf_h !< The fraction of each grid cell covered by - !! the ice shelf [nondim] - real, dimension(:,:), intent(out) :: frac_cberg_calved !< Cell fraction of fully-calved bonded bergs from - !! the ice sheet [nondim] - real, dimension(:,:), intent(out) :: frac_cberg !< Cell fraction of partially-calved bonded bergs from - !! the ice sheet [nondim] - ! Local variables - integer :: max_TC_mask, i,j - - type(tabular_calving_state) :: TC + TC => bergs%TC if (allocated(TC%berg_list)) deallocate(TC%berg_list) !First, update the tabular calving mask @@ -160,7 +149,7 @@ subroutine process_tabular_calving(bergs, TC, h_shelf, frac_shelf_h, frac_cberg_ call tabular_berg_info(bergs%grd, TC) !4) Initialize iKID icebergs over these bounds, and remove excess particles. Call this from SIS2? - call ice_shelf_to_bonded_bergs(bergs, TC, h_shelf, frac_shelf_h, frac_cberg_calved, frac_cberg) + call ice_shelf_to_bonded_bergs(bergs, TC) end subroutine process_tabular_calving @@ -524,18 +513,10 @@ end subroutine unpack_tabular_buffer_and_update_bounds !! its corresponding gridded iceberg mask. This approach guarantees consistent iceberg initialization across PEs !! Pressure on the ocean is slowly transitioned between ice shelf and iceberg over time, so also returns !! the fraction to reduce shelf pressure - subroutine ice_shelf_to_bonded_bergs(bergs, TC, h_shelf, frac_shelf_h, frac_cberg_calved, frac_cberg) + subroutine ice_shelf_to_bonded_bergs(bergs, TC) type(icebergs), pointer :: bergs !< Container for all types and memory - integer :: bcount !< number of tabular bergs to initialize on this PE - - real, dimension(:,:), intent(in) :: h_shelf !< The ice shelf thickness field (m) - real, dimension(:,:), intent(in) :: frac_shelf_h !< The fraction of a grid cell covered by - !! the ice shelf [nondim]. - real, dimension(:,:), intent(out) :: frac_cberg_calved !< Cell fraction of fully-calved bonded bergs - !! from the ice sheet [nondim] - real, dimension(:,:), intent(out) :: frac_cberg !< Cell fraction of partially-calved bonded bergs - !! from the ice sheet [nondim] type(tabular_calving_state), pointer :: TC !< A pointer to the tabular calving structure + integer :: bcount !< number of tabular bergs to initialize on this PE type(icebergs_gridded), pointer :: grd real :: diameter, dlat, dlon, lon, lat, minlon, maxlon, minlat, maxlat real :: minx, miny, cos_lat_ref @@ -680,7 +661,7 @@ subroutine ice_shelf_to_bonded_bergs(bergs, TC, h_shelf, frac_shelf_h, frac_cber !then save its overlapping area with neighboring cells. Its thickness and scaling will be determined !below in new_tabular_bergs_thickness_and_pressure. call begin_calving_tabular_iceberg_from_shelf(bergs, lon, lat, & - TC%calve_mask, TC%frac_shelf_h, 0.5*diameter) + TC%calve_mask, TC%frac_shelf, 0.5*diameter) endif lon=lon+dlon @@ -723,7 +704,7 @@ subroutine ice_shelf_to_bonded_bergs(bergs, TC, h_shelf, frac_shelf_h, frac_cber !Eliminate bergs that are at the end of this transition time and which have zero thickness. !For calculating ice shelf pressure on the ocean, the fraction of ice shelf in the cell becomes - !modified as frac_shelf_H-frac_cberg, where frac_cberg will be 0 at the start of the transition time between + !modified as frac_shelf-frac_cberg, where frac_cberg will be 0 at the start of the transition time between !ice shelf and iceberg, and 1 at the end. !TODO: ice shelf calving mask could also be fractional over cells that have both calve and no-calve MPs. @@ -733,7 +714,7 @@ subroutine ice_shelf_to_bonded_bergs(bergs, TC, h_shelf, frac_shelf_h, frac_cber !masks on the same PE, but not if they are touching. Simply allow the first calving event to finish before !starting the second... - call new_tabular_bergs_thickness_and_pressure(bergs, h_shelf, frac_shelf_h, frac_cberg_calved, frac_cberg) + call new_tabular_bergs_thickness_and_pressure(bergs, TC%h_shelf, TC%frac_shelf, TC%frac_cberg_calved, TC%frac_cberg) !needed? nbonds=0 @@ -745,10 +726,10 @@ end subroutine ice_shelf_to_bonded_bergs !> Calculates thickness new bonded-particle calved from an ice shelf. Also calculates pressure scaling for particles !! and ice shelf as the calving part of the ice shelf transitions to bonded bergs over time. - subroutine new_tabular_bergs_thickness_and_pressure(bergs, h_shelf, frac_shelf_h, frac_cberg_calved, frac_cberg) + subroutine new_tabular_bergs_thickness_and_pressure(bergs, h_shelf, frac_shelf, frac_cberg_calved, frac_cberg) type(icebergs), pointer :: bergs !< Container for all types and memory real, dimension(:,:), intent(in) :: h_shelf !< The ice shelf thickness field (m) - real, dimension(:,:), intent(in) :: frac_shelf_h !< The fraction of a grid cell covered by + real, dimension(:,:), intent(in) :: frac_shelf !< The fraction of a grid cell covered by !! the ice shelf [nondim]. real, dimension(:,:), intent(out) :: frac_cberg_calved !< Cell fraction of fully-calved bonded bergs from !! the ice sheet [nondim] @@ -768,7 +749,7 @@ subroutine new_tabular_bergs_thickness_and_pressure(bergs, h_shelf, frac_shelf_h !A newly-calving iKID conglomerate may have both edge particles (i.e. with empty bond pairs) and !interior particles (i.e. with no empty bond pairs) that both overlap partially-filled ice-shelf - !cells (where 00) then if (pf_area(grdi,grdj,count) Initialize (begin calving) a tabular iceberg particle from an ice shelf at the given lat/lon coordinates. !! Save its overlapping area withvneighboring cells, which will be used to determine its !! thickness, mass, and mass scaling in subroutine new_tabular_berg_thickness_and_pressure - subroutine begin_calving_tabular_iceberg_from_shelf(bergs, lon, lat, calve_mask, frac_shelf_h, radius) + subroutine begin_calving_tabular_iceberg_from_shelf(bergs, lon, lat, calve_mask, frac_shelf, radius) ! Arguments type(icebergs), pointer :: bergs !< Container for all types and memory real :: lon !< longitude of the new iceberg real :: lat !< latitude of the new iceberg real, dimension(:,:), intent(in) :: calve_mask !< ice shelf calving mask - real, dimension(:,:), intent(in) :: frac_shelf_h !< The fraction of a grid cell covered by + real, dimension(:,:), intent(in) :: frac_shelf !< The fraction of a grid cell covered by !! the ice shelf [nondim]. real :: radius !< radius of the new iceberg ! Local variables @@ -1103,7 +1084,7 @@ subroutine begin_calving_tabular_iceberg_from_shelf(bergs, lon, lat, calve_mask, !Assume that the calve mask spans over the cells that shelf associated with the berg may advect into !Get rid of bergs that clearly do not overlap the calve mask - if (all(frac_shelf_h(i-1:i+1,j-1:j+1)==0) .and. all(calve_mask(i-1:i+1,j-1:j+1)==0)) return + if (all(frac_shelf(i-1:i+1,j-1:j+1)==0) .and. all(calve_mask(i-1:i+1,j-1:j+1)==0)) return lret=pos_within_cell(grd, lon, lat, i, j, xi, yj) if (.not.lret) then @@ -1151,20 +1132,19 @@ subroutine begin_calving_tabular_iceberg_from_shelf(bergs, lon, lat, calve_mask, if (pmask<=0) return !Full particles or particles that overlap a full cell get static_berg=-2 - !Particles that !Partially-full particles that do not overlap a full cell get static_berg=-3 !After these bergs receive their bonds, they get static_berg=abs(static_berg) newberg%static_berg=-2 if (pmask<1) then - if ((yCxC>0 .and. calve_mask(i ,j )>0 .and. frac_shelf_h(i ,j )==1) .or. & - (yUxL>0 .and. calve_mask(i-c1,j+c1)>0 .and. frac_shelf_h(i-c1,j+c1)==1) .or. & - (yDxR>0 .and. calve_mask(i+c1,j-c1)>0 .and. frac_shelf_h(i+c1,j-c1)==1) .or. & - (yUxR>0 .and. calve_mask(i+c1,j+c1)>0 .and. frac_shelf_h(i+c1,j+c1)==1) .or. & - (yDxL>0 .and. calve_mask(i-c1,j-c1)>0 .and. frac_shelf_h(i-c1,j-c1)==1) .or. & - (yUxC>0 .and. calve_mask(i ,j+c1)>0 .and. frac_shelf_h(i ,j+c1)==1) .or. & - (yDxC>0 .and. calve_mask(i ,j-c1)>0 .and. frac_shelf_h(i ,j-c1)==1) .or. & - (yCxL>0 .and. calve_mask(i-c1,j )>0 .and. frac_shelf_h(i-c1,j )==1) .or. & - (yCxR>0 .and. calve_mask(i+c1,j )>0 .and. frac_shelf_h(i+c1,j )==1)) then + if ((yCxC>0 .and. calve_mask(i ,j )>0 .and. frac_shelf(i ,j )==1) .or. & + (yUxL>0 .and. calve_mask(i-c1,j+c1)>0 .and. frac_shelf(i-c1,j+c1)==1) .or. & + (yDxR>0 .and. calve_mask(i+c1,j-c1)>0 .and. frac_shelf(i+c1,j-c1)==1) .or. & + (yUxR>0 .and. calve_mask(i+c1,j+c1)>0 .and. frac_shelf(i+c1,j+c1)==1) .or. & + (yDxL>0 .and. calve_mask(i-c1,j-c1)>0 .and. frac_shelf(i-c1,j-c1)==1) .or. & + (yUxC>0 .and. calve_mask(i ,j+c1)>0 .and. frac_shelf(i ,j+c1)==1) .or. & + (yDxC>0 .and. calve_mask(i ,j-c1)>0 .and. frac_shelf(i ,j-c1)==1) .or. & + (yCxL>0 .and. calve_mask(i-c1,j )>0 .and. frac_shelf(i-c1,j )==1) .or. & + (yCxR>0 .and. calve_mask(i+c1,j )>0 .and. frac_shelf(i+c1,j )==1)) then newberg%static_berg=-2.5 else @@ -1193,7 +1173,7 @@ subroutine begin_calving_tabular_iceberg_from_shelf(bergs, lon, lat, calve_mask, !TODO within this routine, save a list of soon-to-calve tabular bergs for each grid cell, with their area in the cell. !or save area in a cell on the particle... - ! call spread_grid_var_to_particle(bergs, newberg, h_shelf, i, j, xi, yj, newberg%thickness, var_frac=frac_shelf_h) + ! call spread_grid_var_to_particle(bergs, newberg, h_shelf, i, j, xi, yj, newberg%thickness, var_frac=frac_shelf) ! !TODO no need for this until timestep where bergs are released, with the exception of OD, perhaps? ! call interp_flds(grd, newberg%lon, newberg%lat, i, j, xi, yj, rx, ry, newberg%uo, newberg%vo, newberg%ui, & diff --git a/src/icebergs.F90 b/src/icebergs.F90 index 35e7404..efc0882 100644 --- a/src/icebergs.F90 +++ b/src/icebergs.F90 @@ -5250,7 +5250,7 @@ end subroutine calculate_sum_over_bergs_diagnositcs !> The main driver the steps updates icebergs subroutine icebergs_run(bergs, time, calving, uo, vo, ui, vi, tauxa, tauya, ssh, sst, calving_hflx, cn, hi, & stagger, stress_stagger, sss, mass_berg, ustar_berg, area_berg, & - calve_mask, mass_shelf, frac_shelf_h, frac_cberg, frac_cberg_calved) + calve_mask, mass_shelf, area_shelf, frac_cberg, frac_cberg_calved) ! Arguments type(icebergs), pointer :: bergs !< Container for all types and memory type(time_type), intent(in) :: time !< Model time @@ -5273,9 +5273,9 @@ subroutine icebergs_run(bergs, time, calving, uo, vo, ui, vi, tauxa, tauya, ssh, real, dimension(:,:), optional, pointer :: ustar_berg !< Friction velocity on base of bergs (m/s) real, dimension(:,:), optional, pointer :: area_berg !< Area of bergs (m2) real, dimension(:,:), optional, intent(in) :: calve_mask !< Mask for calving of tabular bonded bergs - real, dimension(:,:), optional, intent(in) :: mass_shelf !< The ice shelf mass field (kg) - real, dimension(:,:), optional, intent(in) :: frac_shelf_h !< The fraction of each grid cell covered by - !! the ice shelf [nondim] + real, dimension(:,:), optional, intent(in) :: mass_shelf !< The ice shelf mass/cell area (kg m-2) + real, dimension(:,:), optional, intent(in) :: area_shelf !< The area of each grid cell covered by + !! the ice shelf [m2] real, dimension(:,:), optional, intent(out) :: frac_cberg !< Cell fraction of partially-calved bonded bergs from !! the ice sheet [nondim] real, dimension(:,:), optional, intent(out) :: frac_cberg_calved !< Cell fraction of fully-calved bonded bergs from @@ -5549,29 +5549,28 @@ subroutine icebergs_run(bergs, time, calving, uo, vo, ui, vi, tauxa, tauya, ssh, ! Initialize fields needed for tabular calving of bonded bergs from ice shelves if (bergs%tabular_calving) then - if (.not. (present(calve_mask) .and. present(mass_shelf) .and. present(frac_shelf_h) & + if (.not. (present(calve_mask) .and. present(mass_shelf) .and. present(area_shelf) & .and. present(frac_cberg_calved) .and. present(frac_cberg) )) then call error_mesg('KID, icebergs_run', 'Not all tabular calving variables are not present!', FATAL) else - if (.not. (associated(calve_mask) .and. associated(mass_shelf) .and. associated(frac_shelf_h) & + if (.not. (associated(calve_mask) .and. associated(mass_shelf) .and. associated(area_shelf) & .and. associated(frac_cberg_calved) .and. associated(frac_cberg) )) then write(stderrunit,*) 'KID, icebergs_run', 'associated: calve_mask ', associated(calve_mask), & - ', mass_shelf ',associated(mass_shelf),', frac_shelf_h ',associated(frac_shelf_h),& + ', mass_shelf ',associated(mass_shelf),', area_shelf ',associated(area_shelf),& ', frac_cberg_calved ',associated(frac_cberg_calved),', frac_cberg ',associated(frac_cberg) call error_mesg('KID, icebergs_run', 'Not all tabular calving variables are associated!', FATAL) endif TC=>bergs%TC - TC%calve_mask(grd%isc:grd%iec,grd%jsc:grd%jec) = calve_mask(:,:) + TC%calve_mask(grd%isc:grd%iec,grd%jsc:grd%jec) = calve_mask(:,:) !TC%h_shelf is the ice shelf thickness as calculated from ice shelf mass, but using iceberg density !If ice shelf and iceberg density differ, TC%h_shelf will still produce the same basal elevation !(assuming floatation) as ice shelf thickness calculated using ice shelf density. However, the !respective surface elevations may differ. - TC%h_shelf(grd%isc:grd%iec,grd%jsc:grd%jec) = mass_shelf(:,:)/(frac_shelf_h(:,:) * & - grd%area(grd%isc:grd%iec,grd%jsc:grd%jec) * bergs%rho_bergs) - TC%frac_shelf_h(grd%isc:grd%iec,grd%jsc:grd%jec) = frac_shelf_h(:,:) + TC%frac_shelf(grd%isc:grd%iec,grd%jsc:grd%jec) = area_shelf(:,:)/grd%area(grd%isc:grd%iec,grd%jsc:grd%jec) + TC%h_shelf(grd%isc:grd%iec,grd%jsc:grd%jec) = mass_shelf(:,:)/(TC%frac_shelf(grd%isc:grd%iec,grd%jsc:grd%jec) * bergs%rho_bergs) call mpp_update_domains(TC%calve_mask, grd%domain) call mpp_update_domains(TC%h_shelf, grd%domain) - call mpp_update_domains(TC%frac_shelf_h, grd%domain) + call mpp_update_domains(TC%frac_shelf, grd%domain) TC%frac_cberg_calved(:,:) = 0.0 TC%frac_cberg(:,:) = 0.0 endif @@ -5862,8 +5861,8 @@ subroutine icebergs_run(bergs, time, calving, uo, vo, ui, vi, tauxa, tauya, ssh, lerr=send_data(grd%id_calve_mask, TC%calve_mask(grd%isc:grd%iec,grd%jsc:grd%jec), Time) if (grd%id_h_shelf>0) & lerr=send_data(grd%id_h_shelf, TC%h_shelf(grd%isc:grd%iec,grd%jsc:grd%jec), Time) - if (grd%id_frac_shelf_h>0) & - lerr=send_data(grd%id_frac_shelf_h, TC%frac_shelf_h(grd%isc:grd%iec,grd%jsc:grd%jec), Time) + if (grd%id_frac_shelf>0) & + lerr=send_data(grd%id_frac_shelf, TC%frac_shelf(grd%isc:grd%iec,grd%jsc:grd%jec), Time) if (grd%id_frac_cberg_calved>0) & lerr=send_data(grd%id_frac_cberg_calved, TC%frac_cberg_calved(grd%isc:grd%iec,grd%jsc:grd%jec), Time) if (grd%id_frac_cberg>0) & diff --git a/src/icebergs_framework.F90 b/src/icebergs_framework.F90 index d8d4bbc..c131a9f 100644 --- a/src/icebergs_framework.F90 +++ b/src/icebergs_framework.F90 @@ -227,7 +227,7 @@ module ice_bergs_framework integer :: id_ocean_depth=-1 integer :: id_melt_by_class=-1, id_melt_buoy_fl=-1, id_melt_eros_fl=-1, id_melt_conv_fl=-1 integer :: id_fl_parent_melt=-1, id_fl_child_melt=-1 - integer :: id_calve_mask=-1, id_h_shelf=-1, id_frac_shelf_h=-1, id_frac_cberg_calved=-1, id_frac_cberg=-1 + integer :: id_calve_mask=-1, id_h_shelf=-1, id_frac_shelf=-1, id_frac_cberg_calved=-1, id_frac_cberg=-1 !>@} real :: clipping_depth=0. !< The effective depth at which to clip the weight felt by the ocean [m]. @@ -1708,7 +1708,7 @@ subroutine ice_bergs_framework_init(bergs, & 'Mask for tabular calving (calve if >=1)', 'none') grd%id_h_shelf=register_diag_field('icebergs', 'h_shelf', axes, Time, & 'Ice shelf thickness field', 'm') - grd%id_frac_shelf_h=register_diag_field('icebergs', 'frac_shelf_h', axes, Time, & + grd%id_frac_shelf=register_diag_field('icebergs', 'frac_shelf', axes, Time, & 'Cell fraction covered by ice shelf', 'none') grd%id_frac_cberg_calved=register_diag_field('icebergs', 'frac_cberg_calved', axes, Time, & 'Cell fraction of fully-calved tabular bonded bergs', 'none')