21 implicit none ;
private
23 #include <MOM_memory.h>
25 public iceberg_forces, iceberg_fluxes, marine_ice_init
30 real :: berg_area_threshold
33 real :: latent_heat_fusion
34 real :: density_iceberg
36 type(time_type),
pointer :: time
45 subroutine iceberg_forces(G, forces, use_ice_shelf, sfc_state, time_step, CS)
48 type(
surface),
intent(inout) :: sfc_state
50 logical,
intent(in) :: use_ice_shelf
51 real,
intent(in) :: time_step
55 integer :: i, j, is, ie, js, je
56 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
62 if (.not.
associated(cs))
return
64 if (.not.(
associated(forces%area_berg) .and.
associated(forces%mass_berg) ) )
return
66 if (.not.(
associated(forces%frac_shelf_u) .and.
associated(forces%frac_shelf_v) .and. &
67 associated(forces%rigidity_ice_u) .and.
associated(forces%rigidity_ice_v)) )
return
70 if (.not. use_ice_shelf)
then
71 forces%frac_shelf_u(:,:) = 0.0 ; forces%frac_shelf_v(:,:) = 0.0
73 if (.not. forces%accumulate_rigidity)
then
74 forces%rigidity_ice_u(:,:) = 0.0 ; forces%rigidity_ice_v(:,:) = 0.0
77 call pass_var(forces%area_berg, g%domain, to_all+omit_corners, halo=1, complete=.false.)
78 call pass_var(forces%mass_berg, g%domain, to_all+omit_corners, halo=1, complete=.true.)
79 kv_rho_ice = cs%kv_iceberg / cs%density_iceberg
80 do j=js,je ;
do i=is-1,ie
81 if ((g%areaT(i,j) + g%areaT(i+1,j) > 0.0)) &
82 forces%frac_shelf_u(i,j) = forces%frac_shelf_u(i,j) + &
83 (forces%area_berg(i,j)*g%areaT(i,j) + forces%area_berg(i+1,j)*g%areaT(i+1,j)) / &
84 (g%areaT(i,j) + g%areaT(i+1,j))
85 forces%rigidity_ice_u(i,j) = forces%rigidity_ice_u(i,j) + kv_rho_ice * &
86 min(forces%mass_berg(i,j), forces%mass_berg(i+1,j))
88 do j=js-1,je ;
do i=is,ie
89 if ((g%areaT(i,j) + g%areaT(i,j+1) > 0.0)) &
90 forces%frac_shelf_v(i,j) = forces%frac_shelf_v(i,j) + &
91 (forces%area_berg(i,j)*g%areaT(i,j) + forces%area_berg(i,j+1)*g%areaT(i,j+1)) / &
92 (g%areaT(i,j) + g%areaT(i,j+1))
93 forces%rigidity_ice_v(i,j) = forces%rigidity_ice_v(i,j) + kv_rho_ice * &
94 min(forces%mass_berg(i,j), forces%mass_berg(i,j+1))
97 end subroutine iceberg_forces
101 subroutine iceberg_fluxes(G, US, fluxes, use_ice_shelf, sfc_state, time_step, CS)
104 type(
forcing),
intent(inout) :: fluxes
106 type(
surface),
intent(inout) :: sfc_state
108 logical,
intent(in) :: use_ice_shelf
109 real,
intent(in) :: time_step
114 integer :: i, j, is, ie, js, je, isd, ied, jsd, jed
115 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
116 isd = g%isd ; jsd = g%jsd ; ied = g%ied ; jed = g%jed
122 if (.not.
associated(cs))
return
123 if (.not.(
associated(fluxes%area_berg) .and.
associated(fluxes%ustar_berg) .and. &
124 associated(fluxes%mass_berg) ) )
return
125 if (.not.(
associated(fluxes%frac_shelf_h) .and.
associated(fluxes%ustar_shelf)) )
return
128 if (.not.(
associated(fluxes%area_berg) .and.
associated(fluxes%ustar_berg) .and. &
129 associated(fluxes%mass_berg) ) )
return
130 if (.not. use_ice_shelf)
then
131 fluxes%frac_shelf_h(:,:) = 0.
132 fluxes%ustar_shelf(:,:) = 0.
134 do j=jsd,jed ;
do i=isd,ied ;
if (g%areaT(i,j) > 0.0)
then
135 fluxes%frac_shelf_h(i,j) = fluxes%frac_shelf_h(i,j) + fluxes%area_berg(i,j)
136 fluxes%ustar_shelf(i,j) = fluxes%ustar_shelf(i,j) + fluxes%ustar_berg(i,j)
137 endif ;
enddo ;
enddo
140 if (cs%berg_area_threshold >= 0.)
then
141 i_dt_lhf = 1.0 / (us%s_to_T*time_step * cs%latent_heat_fusion)
142 do j=jsd,jed ;
do i=isd,ied
143 if (fluxes%frac_shelf_h(i,j) > cs%berg_area_threshold)
then
146 if (
associated(fluxes%sw)) fluxes%sw(i,j) = 0.0
147 if (
associated(fluxes%lw)) fluxes%lw(i,j) = 0.0
148 if (
associated(fluxes%latent)) fluxes%latent(i,j) = 0.0
149 if (
associated(fluxes%evap)) fluxes%evap(i,j) = 0.0
155 if (
allocated(sfc_state%frazil))
then
156 fraz = sfc_state%frazil(i,j) * i_dt_lhf
157 if (
associated(fluxes%evap)) fluxes%evap(i,j) = fluxes%evap(i,j) - fraz
159 sfc_state%frazil(i,j) = 0.0
163 if (
associated(fluxes%sens)) fluxes%sens(i,j) = 0.0
164 if (
associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = 0.0
165 if (
associated(fluxes%lprec)) fluxes%lprec(i,j) = 0.0
170 end subroutine iceberg_fluxes
173 subroutine marine_ice_init(Time, G, param_file, diag, CS)
174 type(time_type),
target,
intent(in) :: time
177 type(
diag_ctrl),
target,
intent(inout) :: diag
180 #include "version_variable.h"
181 character(len=40) :: mdl =
"MOM_marine_ice"
183 if (
associated(cs))
then
184 call mom_error(warning,
"marine_ice_init called with an associated control structure.")
186 else ;
allocate(cs) ;
endif
191 call get_param(param_file, mdl,
"KV_ICEBERG", cs%kv_iceberg, &
192 "The viscosity of the icebergs", &
193 units=
"m2 s-1", default=1.0e10, scale=g%US%Z_to_L**2*g%US%m_to_L**2*g%US%T_to_s)
194 call get_param(param_file, mdl,
"DENSITY_ICEBERGS", cs%density_iceberg, &
195 "A typical density of icebergs.", units=
"kg m-3", default=917.0, scale=g%US%kg_m3_to_R)
196 call get_param(param_file, mdl,
"LATENT_HEAT_FUSION", cs%latent_heat_fusion, &
197 "The latent heat of fusion.", units=
"J/kg", default=hlf, scale=g%US%J_kg_to_Q)
198 call get_param(param_file, mdl,
"BERG_AREA_THRESHOLD", cs%berg_area_threshold, &
199 "Fraction of grid cell which iceberg must occupy, so that fluxes "//&
200 "below berg are set to zero. Not applied for negative "//&
201 "values.", units=
"non-dim", default=-1.0)
203 end subroutine marine_ice_init