1 | MODULE icbclv |
---|
2 | !!====================================================================== |
---|
3 | !! *** MODULE icbclv *** |
---|
4 | !! Icebergs: calving routines for iceberg calving |
---|
5 | !!====================================================================== |
---|
6 | !! History : 3.3.1 ! 2010-01 (Martin&Adcroft) Original code |
---|
7 | !! - ! 2011-03 (Madec) Part conversion to NEMO form |
---|
8 | !! - ! Removal of mapping from another grid |
---|
9 | !! - ! 2011-04 (Alderson) Split into separate modules |
---|
10 | !! - ! 2011-05 (Alderson) budgets into separate module |
---|
11 | !!---------------------------------------------------------------------- |
---|
12 | |
---|
13 | !!---------------------------------------------------------------------- |
---|
14 | !! icb_clv_flx : transfer input flux of ice into iceberg classes |
---|
15 | !! icb_clv : calve icebergs from stored ice |
---|
16 | !!---------------------------------------------------------------------- |
---|
17 | USE par_oce ! NEMO parameters |
---|
18 | USE dom_oce ! NEMO ocean domain |
---|
19 | USE phycst ! NEMO physical constants |
---|
20 | USE lib_mpp ! NEMO MPI library, lk_mpp in particular |
---|
21 | USE lbclnk ! NEMO boundary exchanges for gridded data |
---|
22 | |
---|
23 | USE icb_oce ! iceberg variables |
---|
24 | USE icbdia ! iceberg diagnostics |
---|
25 | USE icbutl ! iceberg utility routines |
---|
26 | USE icb_oce ! iceberg parameters |
---|
27 | |
---|
28 | USE sbc_oce ! for icesheet freshwater input variables |
---|
29 | USE in_out_manager |
---|
30 | USE iom |
---|
31 | |
---|
32 | IMPLICIT NONE |
---|
33 | PRIVATE |
---|
34 | |
---|
35 | PUBLIC icb_clv_flx ! routine called in icbstp.F90 module |
---|
36 | PUBLIC icb_clv ! routine called in icbstp.F90 module |
---|
37 | |
---|
38 | !!---------------------------------------------------------------------- |
---|
39 | !! NEMO/OCE 4.0 , NEMO Consortium (2018) |
---|
40 | !! $Id$ |
---|
41 | !! Software governed by the CeCILL license (see ./LICENSE) |
---|
42 | !!---------------------------------------------------------------------- |
---|
43 | CONTAINS |
---|
44 | |
---|
45 | SUBROUTINE icb_clv_flx( kt ) |
---|
46 | !!---------------------------------------------------------------------- |
---|
47 | !! *** ROUTINE icb_clv_flx *** |
---|
48 | !! |
---|
49 | !! ** Purpose : accumulate ice available for calving into class arrays |
---|
50 | !! |
---|
51 | !!---------------------------------------------------------------------- |
---|
52 | INTEGER, INTENT(in) :: kt |
---|
53 | ! |
---|
54 | REAL(wp) :: zcalving_used, zdist, zfact |
---|
55 | REAL(wp), DIMENSION(1) :: zgreenland_calving_sum, zantarctica_calving_sum |
---|
56 | LOGICAL :: ll_write |
---|
57 | INTEGER :: jn, ji, jj ! loop counters |
---|
58 | INTEGER :: imx ! temporary integer for max berg class |
---|
59 | LOGICAL, SAVE :: ll_first_call = .TRUE. |
---|
60 | !!---------------------------------------------------------------------- |
---|
61 | ! |
---|
62 | ! Adapt calving flux and calving heat flux from coupler for use here |
---|
63 | ! Use interior mask: so no bergs in overlap areas and convert from km^3/year to kg/s |
---|
64 | ! this assumes that input is given as equivalent water flux so that pure water density is appropriate |
---|
65 | |
---|
66 | zfact = ( (1000._wp)**3 / ( NINT(rday) * nyear_len(1) ) ) * rn_rho_bergs |
---|
67 | berg_grid%calving(:,:) = src_calving(:,:) * zfact * tmask_i(:,:) * tmask(:,:,1) |
---|
68 | |
---|
69 | ! Heat in units of W/m2, and mask (just in case) |
---|
70 | berg_grid%calving_hflx(:,:) = src_calving_hflx(:,:) * tmask_i(:,:) * tmask(:,:,1) |
---|
71 | |
---|
72 | IF( lk_oasis) THEN |
---|
73 | ! nn_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true |
---|
74 | IF( nn_coupled_iceshelf_fluxes .gt. 0 ) THEN |
---|
75 | ll_write = ((MOD( kt, sn_cfctl%ptimincr ) == 0) .OR. ( kt == nitend )) .AND. lwp .AND. ((nn_print>0)) |
---|
76 | ! Adjust total calving rates so that sum of iceberg calving and iceshelf melting in the northern |
---|
77 | ! and southern hemispheres equals rate of increase of mass of greenland and antarctic ice sheets |
---|
78 | ! to preserve total freshwater conservation in coupled models without an active ice sheet model. |
---|
79 | |
---|
80 | zgreenland_calving_sum(1) = SUM( berg_grid%calving(:,:) * greenland_icesheet_mask(:,:) ) |
---|
81 | IF( lk_mpp ) CALL mpp_sum( 'icbclv', zgreenland_calving_sum ) |
---|
82 | WHERE( greenland_icesheet_mask(:,:) == 1.0 ) & |
---|
83 | & berg_grid%calving(:,:) = berg_grid%calving(:,:) * greenland_icesheet_mass_rate_of_change * rn_greenland_calving_fraction & |
---|
84 | & / ( zgreenland_calving_sum(1) + 1.0e-10_wp ) |
---|
85 | |
---|
86 | ! check |
---|
87 | IF(ll_write) WRITE(numout, *) 'Greenland iceberg calving climatology (kg/s) : ',zgreenland_calving_sum(1) |
---|
88 | zgreenland_calving_sum(1) = SUM( berg_grid%calving(:,:) * greenland_icesheet_mask(:,:) ) |
---|
89 | IF( lk_mpp ) CALL mpp_sum( 'icbclv', zgreenland_calving_sum ) |
---|
90 | IF(ll_write) WRITE(numout, *) 'Greenland iceberg calving adjusted value (kg/s) : ',zgreenland_calving_sum(1) |
---|
91 | |
---|
92 | zantarctica_calving_sum(1) = SUM( berg_grid%calving(:,:) * antarctica_icesheet_mask(:,:) ) |
---|
93 | IF( lk_mpp ) CALL mpp_sum( 'icbclv', zantarctica_calving_sum ) |
---|
94 | WHERE( antarctica_icesheet_mask(:,:) == 1.0 ) & |
---|
95 | berg_grid%calving(:,:) = berg_grid%calving(:,:) * antarctica_icesheet_mass_rate_of_change * rn_antarctica_calving_fraction & |
---|
96 | & / ( zantarctica_calving_sum(1) + 1.0e-10_wp ) |
---|
97 | |
---|
98 | ! check |
---|
99 | IF(ll_write) WRITE(numout, *) 'Antarctica iceberg calving climatology (kg/s) : ',zantarctica_calving_sum(1) |
---|
100 | zantarctica_calving_sum(1) = SUM( berg_grid%calving(:,:) * antarctica_icesheet_mask(:,:) ) |
---|
101 | IF( lk_mpp ) CALL mpp_sum( 'icbclv', zantarctica_calving_sum ) |
---|
102 | IF(ll_write) WRITE(numout, *) 'Antarctica iceberg calving adjusted value (kg/s) : ',zantarctica_calving_sum(1) |
---|
103 | |
---|
104 | ENDIF |
---|
105 | ENDIF |
---|
106 | |
---|
107 | CALL iom_put( 'berg_calve', berg_grid%calving(:,:) ) |
---|
108 | |
---|
109 | |
---|
110 | IF( ll_first_call .AND. .NOT. l_restarted_bergs ) THEN ! This is a hack to simplify initialization |
---|
111 | ll_first_call = .FALSE. |
---|
112 | !do jn=1, nclasses |
---|
113 | ! where (berg_grid%calving==0.) berg_grid%stored_ice(:,:,jn)=0. |
---|
114 | !end do |
---|
115 | DO jj = 2, jpjm1 |
---|
116 | DO ji = 2, jpim1 |
---|
117 | IF( berg_grid%calving(ji,jj) /= 0._wp ) & ! Need units of J |
---|
118 | berg_grid%stored_heat(ji,jj) = SUM( berg_grid%stored_ice(ji,jj,:) ) * & ! initial stored ice in kg |
---|
119 | & berg_grid%calving_hflx(ji,jj) * e1e2t(ji,jj) / berg_grid%calving(ji,jj) ! J/s/m2 x m^2 |
---|
120 | ! ! = J/s/calving in kg/s |
---|
121 | END DO |
---|
122 | END DO |
---|
123 | ENDIF |
---|
124 | |
---|
125 | ! assume that all calving flux must be distributed even if distribution array does not sum |
---|
126 | ! to one - this may not be what is intended, but it's what you've got |
---|
127 | DO jj = 1, jpj |
---|
128 | DO ji = 1, jpi |
---|
129 | imx = berg_grid%maxclass(ji,jj) |
---|
130 | zdist = SUM( rn_distribution(1:nclasses) ) / SUM( rn_distribution(1:imx) ) |
---|
131 | DO jn = 1, imx |
---|
132 | berg_grid%stored_ice(ji,jj,jn) = berg_grid%stored_ice(ji,jj,jn) & |
---|
133 | & + berg_dt * berg_grid%calving(ji,jj) * rn_distribution(jn) * zdist |
---|
134 | END DO |
---|
135 | END DO |
---|
136 | END DO |
---|
137 | |
---|
138 | ! before changing the calving, save the amount we're about to use and do budget |
---|
139 | zcalving_used = SUM( berg_grid%calving(:,:) ) |
---|
140 | berg_grid%tmp(:,:) = berg_dt * berg_grid%calving_hflx(:,:) * e1e2t(:,:) * tmask_i(:,:) |
---|
141 | berg_grid%stored_heat (:,:) = berg_grid%stored_heat (:,:) + berg_grid%tmp(:,:) |
---|
142 | CALL icb_dia_income( kt, zcalving_used, berg_grid%tmp ) |
---|
143 | ! |
---|
144 | END SUBROUTINE icb_clv_flx |
---|
145 | |
---|
146 | |
---|
147 | SUBROUTINE icb_clv( kt ) |
---|
148 | !!---------------------------------------------------------------------- |
---|
149 | !! *** ROUTINE icb_clv *** |
---|
150 | !! |
---|
151 | !! ** Purpose : This routine takes a stored ice field and calves to the ocean, |
---|
152 | !! so the gridded array stored_ice has only non-zero entries at selected |
---|
153 | !! wet points adjacent to known land based calving points |
---|
154 | !! |
---|
155 | !! ** method : - Look at each grid point and see if there's enough for each size class to calve |
---|
156 | !! If there is, a new iceberg is calved. This happens in the order determined by |
---|
157 | !! the class definition arrays (which in the default case is smallest first) |
---|
158 | !! Note that only the non-overlapping part of the processor where icebergs are allowed |
---|
159 | !! is considered |
---|
160 | !!---------------------------------------------------------------------- |
---|
161 | INTEGER, INTENT(in) :: kt |
---|
162 | INTEGER :: ji, jj, jn ! dummy loop indices |
---|
163 | INTEGER :: icnt, icntmax |
---|
164 | TYPE(iceberg) :: newberg |
---|
165 | TYPE(point) :: newpt |
---|
166 | REAL(wp) :: zday, zcalved_to_berg, zheat_to_berg |
---|
167 | !!---------------------------------------------------------------------- |
---|
168 | ! |
---|
169 | icntmax = 0 |
---|
170 | zday = REAL(nday_year,wp) + REAL(nsec_day,wp)/86400.0_wp |
---|
171 | ! |
---|
172 | DO jn = 1, nclasses |
---|
173 | DO jj = nicbdj, nicbej |
---|
174 | DO ji = nicbdi, nicbei |
---|
175 | ! |
---|
176 | icnt = 0 |
---|
177 | ! |
---|
178 | DO WHILE (berg_grid%stored_ice(ji,jj,jn) >= rn_initial_mass(jn) * rn_mass_scaling(jn) ) |
---|
179 | ! |
---|
180 | newpt%lon = glamt(ji,jj) ! at t-point (centre of the cell) |
---|
181 | newpt%lat = gphit(ji,jj) |
---|
182 | newpt%xi = REAL( mig(ji), wp ) |
---|
183 | newpt%yj = REAL( mjg(jj), wp ) |
---|
184 | ! |
---|
185 | newpt%uvel = 0._wp ! initially at rest |
---|
186 | newpt%vvel = 0._wp |
---|
187 | ! ! set berg characteristics |
---|
188 | newpt%mass = rn_initial_mass (jn) |
---|
189 | newpt%thickness = rn_initial_thickness(jn) |
---|
190 | newpt%width = first_width (jn) |
---|
191 | newpt%length = first_length (jn) |
---|
192 | newberg%mass_scaling = rn_mass_scaling (jn) |
---|
193 | newpt%mass_of_bits = 0._wp ! no bergy |
---|
194 | ! |
---|
195 | newpt%year = nyear |
---|
196 | newpt%day = zday |
---|
197 | newpt%heat_density = berg_grid%stored_heat(ji,jj) / berg_grid%stored_ice(ji,jj,jn) ! This is in J/kg |
---|
198 | ! |
---|
199 | CALL icb_utl_incr() |
---|
200 | newberg%number(:) = num_bergs(:) |
---|
201 | ! |
---|
202 | CALL icb_utl_add( newberg, newpt ) |
---|
203 | ! |
---|
204 | zcalved_to_berg = rn_initial_mass(jn) * rn_mass_scaling(jn) ! Units of kg |
---|
205 | ! ! Heat content |
---|
206 | zheat_to_berg = zcalved_to_berg * newpt%heat_density ! Units of J |
---|
207 | berg_grid%stored_heat(ji,jj) = berg_grid%stored_heat(ji,jj) - zheat_to_berg |
---|
208 | ! ! Stored mass |
---|
209 | berg_grid%stored_ice(ji,jj,jn) = berg_grid%stored_ice(ji,jj,jn) - zcalved_to_berg |
---|
210 | ! |
---|
211 | icnt = icnt + 1 |
---|
212 | ! |
---|
213 | CALL icb_dia_calve(ji, jj, jn, zcalved_to_berg, zheat_to_berg ) |
---|
214 | END DO |
---|
215 | icntmax = MAX( icntmax, icnt ) |
---|
216 | END DO |
---|
217 | END DO |
---|
218 | END DO |
---|
219 | ! |
---|
220 | DO jn = 1, nclasses |
---|
221 | CALL lbc_lnk( 'icbclv', berg_grid%stored_ice(:,:,jn), 'T', 1._wp ) |
---|
222 | END DO |
---|
223 | CALL lbc_lnk( 'icbclv', berg_grid%stored_heat, 'T', 1._wp ) |
---|
224 | ! |
---|
225 | IF( nn_verbose_level > 0 .AND. icntmax > 1 ) WRITE(numicb,*) 'icb_clv: icnt=', icnt,' on', narea |
---|
226 | ! |
---|
227 | END SUBROUTINE icb_clv |
---|
228 | |
---|
229 | !!====================================================================== |
---|
230 | END MODULE icbclv |
---|