Line data Source code
1 : !=======================================================================
2 :
3 : ! Flux manipulation routines for column package
4 : !
5 : ! author Elizabeth C. Hunke, LANL
6 : !
7 : ! 2014: Moved subroutines merge_fluxes, set_sfcflux from ice_flux.F90
8 :
9 : module icepack_flux
10 :
11 : use icepack_kinds
12 : use icepack_parameters, only: c1, emissivity, snwgrain
13 : use icepack_warnings, only: warnstr, icepack_warnings_add
14 : use icepack_warnings, only: icepack_warnings_setabort, icepack_warnings_aborted
15 : use icepack_tracers, only: tr_iso
16 :
17 : implicit none
18 : private
19 : public :: merge_fluxes, set_sfcflux
20 :
21 : !=======================================================================
22 :
23 : contains
24 :
25 : !=======================================================================
26 :
27 : ! Aggregate flux information from all ice thickness categories
28 : !
29 : ! author: Elizabeth C. Hunke and William H. Lipscomb, LANL
30 :
31 1599186245 : subroutine merge_fluxes (aicen, &
32 : flw, & ! LCOV_EXCL_LINE
33 : strairxn, strairyn, & ! LCOV_EXCL_LINE
34 : Cdn_atm_ratio_n, & ! LCOV_EXCL_LINE
35 : fsurfn, fcondtopn, & ! LCOV_EXCL_LINE
36 : fcondbotn, & ! LCOV_EXCL_LINE
37 : fsensn, flatn, & ! LCOV_EXCL_LINE
38 : fswabsn, flwoutn, & ! LCOV_EXCL_LINE
39 : evapn, & ! LCOV_EXCL_LINE
40 : evapsn, evapin, & ! LCOV_EXCL_LINE
41 : Trefn, Qrefn, & ! LCOV_EXCL_LINE
42 : freshn, fsaltn, & ! LCOV_EXCL_LINE
43 : fhocnn, fswthrun, & ! LCOV_EXCL_LINE
44 : fswthrun_vdr, fswthrun_vdf,& ! LCOV_EXCL_LINE
45 : fswthrun_idr, fswthrun_idf,& ! LCOV_EXCL_LINE
46 : strairxT, strairyT, & ! LCOV_EXCL_LINE
47 : Cdn_atm_ratio, & ! LCOV_EXCL_LINE
48 : fsurf, fcondtop, & ! LCOV_EXCL_LINE
49 : fcondbot, & ! LCOV_EXCL_LINE
50 : fsens, flat, & ! LCOV_EXCL_LINE
51 : fswabs, flwout, & ! LCOV_EXCL_LINE
52 : evap, & ! LCOV_EXCL_LINE
53 : evaps, evapi, & ! LCOV_EXCL_LINE
54 : Tref, Qref, & ! LCOV_EXCL_LINE
55 : fresh, fsalt, & ! LCOV_EXCL_LINE
56 : fhocn, fswthru, & ! LCOV_EXCL_LINE
57 : fswthru_vdr, fswthru_vdf,& ! LCOV_EXCL_LINE
58 : fswthru_idr, fswthru_idf,& ! LCOV_EXCL_LINE
59 : melttn, meltsn, meltbn, congeln, snoicen, & ! LCOV_EXCL_LINE
60 : meltt, melts, & ! LCOV_EXCL_LINE
61 : meltb, dsnow, dsnown,& ! LCOV_EXCL_LINE
62 : congel, snoice, & ! LCOV_EXCL_LINE
63 : meltsliq, meltsliqn, & ! LCOV_EXCL_LINE
64 : Uref, Urefn, & ! LCOV_EXCL_LINE
65 1599186245 : Qref_iso, Qrefn_iso, & ! LCOV_EXCL_LINE
66 1599186245 : fiso_ocn, fiso_ocnn, & ! LCOV_EXCL_LINE
67 1599186245 : fiso_evap, fiso_evapn)
68 :
69 : ! single category fluxes
70 : real (kind=dbl_kind), intent(in) :: &
71 : aicen ! concentration of ice
72 :
73 : real (kind=dbl_kind), optional, intent(in) :: &
74 : flw , & ! downward longwave flux (W/m**2) ! LCOV_EXCL_LINE
75 : strairxn, & ! air/ice zonal strss, (N/m**2) ! LCOV_EXCL_LINE
76 : strairyn, & ! air/ice merdnl strss, (N/m**2) ! LCOV_EXCL_LINE
77 : Cdn_atm_ratio_n, & ! ratio of total drag over neutral drag ! LCOV_EXCL_LINE
78 : fsurfn , & ! net heat flux to top surface (W/m**2) ! LCOV_EXCL_LINE
79 : fcondtopn,& ! downward cond flux at top sfc (W/m**2) ! LCOV_EXCL_LINE
80 : fcondbotn,& ! downward cond flux at bottom sfc (W/m**2) ! LCOV_EXCL_LINE
81 : fsensn , & ! sensible heat flx (W/m**2) ! LCOV_EXCL_LINE
82 : flatn , & ! latent heat flx (W/m**2) ! LCOV_EXCL_LINE
83 : fswabsn , & ! shortwave absorbed heat flx (W/m**2) ! LCOV_EXCL_LINE
84 : flwoutn , & ! upwd lw emitted heat flx (W/m**2) ! LCOV_EXCL_LINE
85 : evapn , & ! evaporation (kg/m2/s) ! LCOV_EXCL_LINE
86 : evapsn , & ! evaporation over snow (kg/m2/s) ! LCOV_EXCL_LINE
87 : evapin , & ! evaporation over ice (kg/m2/s) ! LCOV_EXCL_LINE
88 : Trefn , & ! air tmp reference level (K) ! LCOV_EXCL_LINE
89 : Qrefn , & ! air sp hum reference level (kg/kg) ! LCOV_EXCL_LINE
90 : freshn , & ! fresh water flux to ocean (kg/m2/s) ! LCOV_EXCL_LINE
91 : fsaltn , & ! salt flux to ocean (kg/m2/s) ! LCOV_EXCL_LINE
92 : fhocnn , & ! actual ocn/ice heat flx (W/m**2) ! LCOV_EXCL_LINE
93 : fswthrun, & ! sw radiation through ice bot (W/m**2) ! LCOV_EXCL_LINE
94 : melttn , & ! top ice melt (m) ! LCOV_EXCL_LINE
95 : meltbn , & ! bottom ice melt (m) ! LCOV_EXCL_LINE
96 : meltsn , & ! snow melt (m) ! LCOV_EXCL_LINE
97 : meltsliqn,& ! mass of snow melt (kg/m^2) ! LCOV_EXCL_LINE
98 : dsnown , & ! change in snow depth (m) ! LCOV_EXCL_LINE
99 : congeln , & ! congelation ice growth (m) ! LCOV_EXCL_LINE
100 : snoicen , & ! snow-ice growth (m) ! LCOV_EXCL_LINE
101 : fswthrun_vdr, & ! vis dir sw radiation through ice bot (W/m**2) ! LCOV_EXCL_LINE
102 : fswthrun_vdf, & ! vis dif sw radiation through ice bot (W/m**2) ! LCOV_EXCL_LINE
103 : fswthrun_idr, & ! nir dir sw radiation through ice bot (W/m**2) ! LCOV_EXCL_LINE
104 : fswthrun_idf, & ! nir dif sw radiation through ice bot (W/m**2) ! LCOV_EXCL_LINE
105 : Urefn ! air speed reference level (m/s)
106 :
107 : ! cumulative fluxes
108 : real (kind=dbl_kind), optional, intent(inout) :: &
109 : strairxT, & ! air/ice zonal strss, (N/m**2) ! LCOV_EXCL_LINE
110 : strairyT, & ! air/ice merdnl strss, (N/m**2) ! LCOV_EXCL_LINE
111 : Cdn_atm_ratio, & ! ratio of total drag over neutral drag ! LCOV_EXCL_LINE
112 : fsurf , & ! net heat flux to top surface (W/m**2) ! LCOV_EXCL_LINE
113 : fcondtop, & ! downward cond flux at top sfc (W/m**2) ! LCOV_EXCL_LINE
114 : fcondbot, & ! downward cond flux at bottom sfc (W/m**2) ! LCOV_EXCL_LINE
115 : fsens , & ! sensible heat flx (W/m**2) ! LCOV_EXCL_LINE
116 : flat , & ! latent heat flx (W/m**2) ! LCOV_EXCL_LINE
117 : fswabs , & ! shortwave absorbed heat flx (W/m**2) ! LCOV_EXCL_LINE
118 : flwout , & ! upwd lw emitted heat flx (W/m**2) ! LCOV_EXCL_LINE
119 : evap , & ! evaporation (kg/m2/s) ! LCOV_EXCL_LINE
120 : evaps , & ! evaporation over snow (kg/m2/s) ! LCOV_EXCL_LINE
121 : evapi , & ! evaporation over ice (kg/m2/s) ! LCOV_EXCL_LINE
122 : Tref , & ! air tmp reference level (K) ! LCOV_EXCL_LINE
123 : Qref , & ! air sp hum reference level (kg/kg) ! LCOV_EXCL_LINE
124 : fresh , & ! fresh water flux to ocean (kg/m2/s) ! LCOV_EXCL_LINE
125 : fsalt , & ! salt flux to ocean (kg/m2/s) ! LCOV_EXCL_LINE
126 : fhocn , & ! actual ocn/ice heat flx (W/m**2) ! LCOV_EXCL_LINE
127 : fswthru , & ! sw radiation through ice bot (W/m**2) ! LCOV_EXCL_LINE
128 : meltt , & ! top ice melt (m) ! LCOV_EXCL_LINE
129 : meltb , & ! bottom ice melt (m) ! LCOV_EXCL_LINE
130 : melts , & ! snow melt (m) ! LCOV_EXCL_LINE
131 : meltsliq, & ! mass of snow melt (kg/m^2) ! LCOV_EXCL_LINE
132 : congel , & ! congelation ice growth (m) ! LCOV_EXCL_LINE
133 : snoice , & ! snow-ice growth (m) ! LCOV_EXCL_LINE
134 : fswthru_vdr, & ! vis dir sw radiation through ice bot (W/m**2) ! LCOV_EXCL_LINE
135 : fswthru_vdf, & ! vis dif sw radiation through ice bot (W/m**2) ! LCOV_EXCL_LINE
136 : fswthru_idr, & ! nir dir sw radiation through ice bot (W/m**2) ! LCOV_EXCL_LINE
137 : fswthru_idf, & ! nir dif sw radiation through ice bot (W/m**2) ! LCOV_EXCL_LINE
138 : dsnow, & ! change in snow depth (m) ! LCOV_EXCL_LINE
139 : Uref ! air speed reference level (m/s)
140 :
141 : real (kind=dbl_kind), dimension(:), intent(in), optional :: &
142 : Qrefn_iso, & ! isotope air sp hum ref level (kg/kg) ! LCOV_EXCL_LINE
143 : fiso_ocnn, & ! isotope fluxes to ocean (kg/m2/s) ! LCOV_EXCL_LINE
144 : fiso_evapn ! isotope evaporation (kg/m2/s)
145 :
146 : real (kind=dbl_kind), dimension(:), intent(inout), optional :: &
147 : Qref_iso, & ! isotope air sp hum ref level (kg/kg) ! LCOV_EXCL_LINE
148 : fiso_ocn, & ! isotope fluxes to ocean (kg/m2/s) ! LCOV_EXCL_LINE
149 : fiso_evap ! isotope evaporation (kg/m2/s)
150 :
151 : character(len=*),parameter :: subname='(merge_fluxes)'
152 :
153 : !-----------------------------------------------------------------
154 : ! Merge fluxes
155 : ! NOTE: The albedo is aggregated only in cells where ice exists
156 : ! and (for the delta-Eddington scheme) where the sun is above
157 : ! the horizon.
158 : !-----------------------------------------------------------------
159 :
160 : ! atmo fluxes
161 :
162 1599186245 : if (present(strairxn) .and. present(strairxT)) &
163 1599186245 : strairxT = strairxT + strairxn * aicen
164 1599186245 : if (present(strairyn) .and. present(strairyT)) &
165 1599186245 : strairyT = strairyT + strairyn * aicen
166 1599186245 : if (present(Cdn_atm_ratio_n) .and. present(Cdn_atm_ratio)) &
167 : Cdn_atm_ratio = Cdn_atm_ratio + & ! LCOV_EXCL_LINE
168 1599186245 : Cdn_atm_ratio_n * aicen
169 1599186245 : if (present(fsurfn) .and. present(fsurf)) &
170 1599186245 : fsurf = fsurf + fsurfn * aicen
171 1599186245 : if (present(fcondtopn) .and. present(fcondtop)) &
172 1599186245 : fcondtop = fcondtop + fcondtopn * aicen
173 1599186245 : if (present(fcondbotn) .and. present(fcondbot)) &
174 1599186245 : fcondbot = fcondbot + fcondbotn * aicen
175 1599186245 : if (present(fsensn) .and. present(fsens)) &
176 1599186245 : fsens = fsens + fsensn * aicen
177 1599186245 : if (present(flatn) .and. present(flat)) &
178 1599186245 : flat = flat + flatn * aicen
179 1599186245 : if (present(fswabsn) .and. present(fswabs)) &
180 1599186245 : fswabs = fswabs + fswabsn * aicen
181 1599186245 : if (present(flwoutn) .and. present(flwout) .and. present(flw)) &
182 : flwout = flwout & ! LCOV_EXCL_LINE
183 1599186245 : + (flwoutn - (c1-emissivity)*flw) * aicen
184 1599186245 : if (present(evapn) .and. present(evap)) &
185 1599186245 : evap = evap + evapn * aicen
186 1599186245 : if (present(evapsn) .and. present(evaps)) &
187 1599186245 : evaps = evaps + evapsn * aicen
188 1599186245 : if (present(evapin) .and. present(evapi)) &
189 1599186245 : evapi = evapi + evapin * aicen
190 1599186245 : if (present(Trefn) .and. present(Tref)) &
191 1599186245 : Tref = Tref + Trefn * aicen
192 1599186245 : if (present(Qrefn) .and. present(Qref)) &
193 1599186245 : Qref = Qref + Qrefn * aicen
194 :
195 : ! Isotopes
196 1599186245 : if (tr_iso) then
197 15774367 : if (present(Qrefn_iso) .and. present(Qref_iso)) then
198 63097468 : Qref_iso (:) = Qref_iso (:) + Qrefn_iso (:) * aicen
199 : endif
200 15774367 : if (present(fiso_ocnn) .and. present(fiso_ocn)) then
201 63097468 : fiso_ocn (:) = fiso_ocn (:) + fiso_ocnn (:) * aicen
202 : endif
203 15774367 : if (present(fiso_evapn) .and. present(fiso_evap)) then
204 63097468 : fiso_evap(:) = fiso_evap(:) + fiso_evapn(:) * aicen
205 : endif
206 : endif
207 :
208 : ! ocean fluxes
209 1599186245 : if (present(Urefn) .and. present(Uref)) then
210 1599186245 : Uref = Uref + Urefn * aicen
211 : endif
212 :
213 1599186245 : if (present(freshn) .and. present(fresh)) &
214 1599186245 : fresh = fresh + freshn * aicen
215 1599186245 : if (present(fsaltn) .and. present(fsalt)) &
216 1599186245 : fsalt = fsalt + fsaltn * aicen
217 1599186245 : if (present(fhocnn) .and. present(fhocn)) &
218 1599186245 : fhocn = fhocn + fhocnn * aicen
219 1599186245 : if (present(fswthrun) .and. present(fswthru)) &
220 1599186245 : fswthru = fswthru + fswthrun * aicen
221 :
222 1599186245 : if (present(fswthrun_vdr) .and. present(fswthru_vdr)) &
223 1597131722 : fswthru_vdr = fswthru_vdr + fswthrun_vdr * aicen
224 1599186245 : if (present(fswthrun_vdf) .and. present(fswthru_vdf)) &
225 1597131722 : fswthru_vdf = fswthru_vdf + fswthrun_vdf * aicen
226 1599186245 : if (present(fswthrun_idr) .and. present(fswthru_idr)) &
227 1597131722 : fswthru_idr = fswthru_idr + fswthrun_idr * aicen
228 1599186245 : if (present(fswthrun_idf) .and. present(fswthru_idf)) &
229 1597131722 : fswthru_idf = fswthru_idf + fswthrun_idf * aicen
230 :
231 : ! ice/snow thickness
232 :
233 1599186245 : if (present(melttn) .and. present(meltt)) &
234 1599186245 : meltt = meltt + melttn * aicen
235 1599186245 : if (present(meltbn) .and. present(meltb)) &
236 1599186245 : meltb = meltb + meltbn * aicen
237 1599186245 : if (present(meltsn) .and. present(melts)) &
238 1599186245 : melts = melts + meltsn * aicen
239 1599186245 : if (snwgrain) then
240 33933628 : if (present(meltsliqn) .and. present(meltsliq)) &
241 33933628 : meltsliq = meltsliq + meltsliqn * aicen
242 : endif
243 1599186245 : if (present(dsnown) .and. present(dsnow)) then
244 1599186245 : dsnow = dsnow + dsnown * aicen
245 : endif
246 1599186245 : if (present(congeln) .and. present(congel)) &
247 1599186245 : congel = congel + congeln * aicen
248 1599186245 : if (present(snoicen) .and. present(snoice)) &
249 1599186245 : snoice = snoice + snoicen * aicen
250 :
251 1599186245 : end subroutine merge_fluxes
252 :
253 : !=======================================================================
254 :
255 : ! If model is not calculating surface temperature, set the surface
256 : ! flux values using values read in from forcing data or supplied via
257 : ! coupling (stored in ice_flux).
258 : !
259 : ! If CICE is running in NEMO environment, convert fluxes from GBM values
260 : ! to per unit ice area values. If model is not running in NEMO environment,
261 : ! the forcing is supplied as per unit ice area values.
262 : !
263 : ! authors Alison McLaren, Met Office
264 :
265 24093747 : subroutine set_sfcflux (aicen, &
266 : flatn_f, & ! LCOV_EXCL_LINE
267 : fsensn_f, & ! LCOV_EXCL_LINE
268 : fsurfn_f, & ! LCOV_EXCL_LINE
269 : fcondtopn_f, & ! LCOV_EXCL_LINE
270 : flatn, & ! LCOV_EXCL_LINE
271 : fsensn, & ! LCOV_EXCL_LINE
272 : fsurfn, & ! LCOV_EXCL_LINE
273 : fcondtopn)
274 :
275 : ! ice state variables
276 : real (kind=dbl_kind), intent(in) :: &
277 : aicen , & ! concentration of ice ! LCOV_EXCL_LINE
278 : flatn_f , & ! latent heat flux (W/m^2) ! LCOV_EXCL_LINE
279 : fsensn_f , & ! sensible heat flux (W/m^2) ! LCOV_EXCL_LINE
280 : fsurfn_f , & ! net flux to top surface, not including fcondtopn ! LCOV_EXCL_LINE
281 : fcondtopn_f ! downward cond flux at top surface (W m-2)
282 :
283 : real (kind=dbl_kind), intent(out):: &
284 : flatn , & ! latent heat flux (W/m^2) ! LCOV_EXCL_LINE
285 : fsensn , & ! sensible heat flux (W/m^2) ! LCOV_EXCL_LINE
286 : fsurfn , & ! net flux to top surface, not including fcondtopn ! LCOV_EXCL_LINE
287 : fcondtopn ! downward cond flux at top surface (W m-2)
288 :
289 : ! local variables
290 :
291 : real (kind=dbl_kind) :: &
292 : raicen ! 1 or 1/aicen
293 :
294 : logical (kind=log_kind) :: &
295 : extreme_flag ! flag for extreme forcing values
296 :
297 : logical (kind=log_kind), parameter :: &
298 : extreme_test=.false. ! test and write out extreme forcing data
299 :
300 : character(len=*),parameter :: subname='(set_sfcflux)'
301 :
302 24093747 : raicen = c1
303 :
304 : #ifdef CICE_IN_NEMO
305 : !----------------------------------------------------------------------
306 : ! Convert fluxes from GBM values to per ice area values when
307 : ! running in NEMO environment. (When in standalone mode, fluxes
308 : ! are input as per ice area.)
309 : !----------------------------------------------------------------------
310 : raicen = c1 / aicen
311 : #endif
312 24093747 : fsurfn = fsurfn_f*raicen
313 24093747 : fcondtopn= fcondtopn_f*raicen
314 24093747 : flatn = flatn_f*raicen
315 24093747 : fsensn = fsensn_f*raicen
316 :
317 : !----------------------------------------------------------------
318 : ! Flag up any extreme fluxes
319 : !---------------------------------------------------------------
320 :
321 : if (extreme_test) then
322 : extreme_flag = .false.
323 :
324 : if (fcondtopn < -100.0_dbl_kind &
325 : .or. fcondtopn > 20.0_dbl_kind) then
326 : extreme_flag = .true.
327 : endif
328 :
329 : if (fsurfn < -100.0_dbl_kind &
330 : .or. fsurfn > 80.0_dbl_kind) then
331 : extreme_flag = .true.
332 : endif
333 :
334 : if (flatn < -20.0_dbl_kind &
335 : .or. flatn > 20.0_dbl_kind) then
336 : extreme_flag = .true.
337 : endif
338 :
339 : if (extreme_flag) then
340 :
341 : if (fcondtopn < -100.0_dbl_kind &
342 : .or. fcondtopn > 20.0_dbl_kind) then
343 : write(warnstr,*) subname, &
344 : 'Extreme forcing: -100 > fcondtopn > 20'
345 : call icepack_warnings_add(warnstr)
346 : write(warnstr,*) subname, &
347 : 'aicen,fcondtopn = ', & ! LCOV_EXCL_LINE
348 : aicen,fcondtopn
349 : call icepack_warnings_add(warnstr)
350 : endif
351 :
352 : if (fsurfn < -100.0_dbl_kind &
353 : .or. fsurfn > 80.0_dbl_kind) then
354 : write(warnstr,*) subname, &
355 : 'Extreme forcing: -100 > fsurfn > 40'
356 : call icepack_warnings_add(warnstr)
357 : write(warnstr,*) subname, &
358 : 'aicen,fsurfn = ', & ! LCOV_EXCL_LINE
359 : aicen,fsurfn
360 : call icepack_warnings_add(warnstr)
361 : endif
362 :
363 : if (flatn < -20.0_dbl_kind &
364 : .or. flatn > 20.0_dbl_kind) then
365 : write(warnstr,*) subname, &
366 : 'Extreme forcing: -20 > flatn > 20'
367 : call icepack_warnings_add(warnstr)
368 : write(warnstr,*) subname, &
369 : 'aicen,flatn = ', & ! LCOV_EXCL_LINE
370 : aicen,flatn
371 : call icepack_warnings_add(warnstr)
372 : endif
373 :
374 : endif ! extreme_flag
375 : endif ! extreme_test
376 :
377 24093747 : end subroutine set_sfcflux
378 :
379 : !=======================================================================
380 :
381 : end module icepack_flux
382 :
383 : !=======================================================================
|
