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 33852099 : 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 : Qref_iso, Qrefn_iso, & ! LCOV_EXCL_LINE
66 : fiso_ocn, fiso_ocnn, & ! LCOV_EXCL_LINE
67 33852099 : fiso_evap, fiso_evapn)
68 :
69 : ! single category fluxes
70 : real (kind=dbl_kind), intent(in) :: &
71 : aicen , & ! concentration of ice ! LCOV_EXCL_LINE
72 : flw , & ! downward longwave flux (W/m**2) ! LCOV_EXCL_LINE
73 : strairxn, & ! air/ice zonal strss, (N/m**2) ! LCOV_EXCL_LINE
74 : strairyn, & ! air/ice merdnl strss, (N/m**2) ! LCOV_EXCL_LINE
75 : Cdn_atm_ratio_n, & ! ratio of total drag over neutral drag ! LCOV_EXCL_LINE
76 : fsurfn , & ! net heat flux to top surface (W/m**2) ! LCOV_EXCL_LINE
77 : fcondtopn,& ! downward cond flux at top sfc (W/m**2) ! LCOV_EXCL_LINE
78 : fcondbotn,& ! downward cond flux at bottom sfc (W/m**2) ! LCOV_EXCL_LINE
79 : fsensn , & ! sensible heat flx (W/m**2) ! LCOV_EXCL_LINE
80 : flatn , & ! latent heat flx (W/m**2) ! LCOV_EXCL_LINE
81 : fswabsn , & ! shortwave absorbed heat flx (W/m**2) ! LCOV_EXCL_LINE
82 : flwoutn , & ! upwd lw emitted heat flx (W/m**2) ! LCOV_EXCL_LINE
83 : evapn , & ! evaporation (kg/m2/s) ! LCOV_EXCL_LINE
84 : evapsn , & ! evaporation over snow (kg/m2/s) ! LCOV_EXCL_LINE
85 : evapin , & ! evaporation over ice (kg/m2/s) ! LCOV_EXCL_LINE
86 : Trefn , & ! air tmp reference level (K) ! LCOV_EXCL_LINE
87 : Qrefn , & ! air sp hum reference level (kg/kg) ! LCOV_EXCL_LINE
88 : freshn , & ! fresh water flux to ocean (kg/m2/s) ! LCOV_EXCL_LINE
89 : fsaltn , & ! salt flux to ocean (kg/m2/s) ! LCOV_EXCL_LINE
90 : fhocnn , & ! actual ocn/ice heat flx (W/m**2) ! LCOV_EXCL_LINE
91 : fswthrun, & ! sw radiation through ice bot (W/m**2) ! LCOV_EXCL_LINE
92 : melttn , & ! top ice melt (m) ! LCOV_EXCL_LINE
93 : meltbn , & ! bottom ice melt (m) ! LCOV_EXCL_LINE
94 : meltsn , & ! snow melt (m) ! LCOV_EXCL_LINE
95 : meltsliqn,& ! mass of snow melt (kg/m^2) ! LCOV_EXCL_LINE
96 : dsnown , & ! change in snow depth (m) ! LCOV_EXCL_LINE
97 : congeln , & ! congelation ice growth (m) ! LCOV_EXCL_LINE
98 : snoicen ! snow-ice growth (m)
99 :
100 : real (kind=dbl_kind), optional, intent(in):: &
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), 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)
134 :
135 : real (kind=dbl_kind), intent(inout), optional :: &
136 : fswthru_vdr , & ! vis dir sw radiation through ice bot (W/m**2) ! LCOV_EXCL_LINE
137 : fswthru_vdf , & ! vis dif sw radiation through ice bot (W/m**2) ! LCOV_EXCL_LINE
138 : fswthru_idr , & ! nir dir sw radiation through ice bot (W/m**2) ! LCOV_EXCL_LINE
139 : fswthru_idf ! nir dif sw radiation through ice bot (W/m**2)
140 :
141 : real (kind=dbl_kind), intent(inout), optional :: &
142 : dsnow, & ! change in snow depth (m) ! LCOV_EXCL_LINE
143 : Uref ! air speed reference level (m/s)
144 :
145 : real (kind=dbl_kind), dimension(:), intent(inout), optional :: &
146 : Qref_iso, & ! isotope air sp hum ref level (kg/kg) ! LCOV_EXCL_LINE
147 : fiso_ocn, & ! isotope fluxes to ocean (kg/m2/s) ! LCOV_EXCL_LINE
148 : fiso_evap ! isotope evaporation (kg/m2/s)
149 :
150 : real (kind=dbl_kind), dimension(:), intent(in), optional :: &
151 : Qrefn_iso, & ! isotope air sp hum ref level (kg/kg) ! LCOV_EXCL_LINE
152 : fiso_ocnn, & ! isotope fluxes to ocean (kg/m2/s) ! LCOV_EXCL_LINE
153 : fiso_evapn ! isotope evaporation (kg/m2/s)
154 :
155 : character(len=*),parameter :: subname='(merge_fluxes)'
156 :
157 : !-----------------------------------------------------------------
158 : ! Merge fluxes
159 : ! NOTE: The albedo is aggregated only in cells where ice exists
160 : ! and (for the delta-Eddington scheme) where the sun is above
161 : ! the horizon.
162 : !-----------------------------------------------------------------
163 :
164 : ! atmo fluxes
165 :
166 33852099 : strairxT = strairxT + strairxn * aicen
167 33852099 : strairyT = strairyT + strairyn * aicen
168 : Cdn_atm_ratio = Cdn_atm_ratio + &
169 33852099 : Cdn_atm_ratio_n * aicen
170 33852099 : fsurf = fsurf + fsurfn * aicen
171 33852099 : fcondtop = fcondtop + fcondtopn * aicen
172 33852099 : fcondbot = fcondbot + fcondbotn * aicen
173 33852099 : fsens = fsens + fsensn * aicen
174 33852099 : flat = flat + flatn * aicen
175 33852099 : fswabs = fswabs + fswabsn * aicen
176 : flwout = flwout &
177 33852099 : + (flwoutn - (c1-emissivity)*flw) * aicen
178 33852099 : evap = evap + evapn * aicen
179 33852099 : evaps = evaps + evapsn * aicen
180 33852099 : evapi = evapi + evapin * aicen
181 33852099 : Tref = Tref + Trefn * aicen
182 33852099 : Qref = Qref + Qrefn * aicen
183 :
184 : ! Isotopes
185 33852099 : if (tr_iso) then
186 0 : if (present(Qrefn_iso) .and. present(Qref_iso)) then
187 0 : Qref_iso (:) = Qref_iso (:) + Qrefn_iso (:) * aicen
188 : endif
189 0 : if (present(fiso_ocnn) .and. present(fiso_ocn)) then
190 0 : fiso_ocn (:) = fiso_ocn (:) + fiso_ocnn (:) * aicen
191 : endif
192 0 : if (present(fiso_evapn) .and. present(fiso_evap)) then
193 0 : fiso_evap(:) = fiso_evap(:) + fiso_evapn(:) * aicen
194 : endif
195 : endif
196 :
197 : ! ocean fluxes
198 33852099 : if (present(Urefn) .and. present(Uref)) then
199 33852099 : Uref = Uref + Urefn * aicen
200 : endif
201 :
202 33852099 : fresh = fresh + freshn * aicen
203 33852099 : fsalt = fsalt + fsaltn * aicen
204 33852099 : fhocn = fhocn + fhocnn * aicen
205 33852099 : fswthru = fswthru + fswthrun * aicen
206 33852099 : if (present(fswthru_vdr)) &
207 33852099 : fswthru_vdr = fswthru_vdr + fswthrun_vdr * aicen
208 33852099 : if (present(fswthru_vdf)) &
209 33852099 : fswthru_vdf = fswthru_vdf + fswthrun_vdf * aicen
210 33852099 : if (present(fswthru_idr)) &
211 33852099 : fswthru_idr = fswthru_idr + fswthrun_idr * aicen
212 33852099 : if (present(fswthru_idf)) &
213 33852099 : fswthru_idf = fswthru_idf + fswthrun_idf * aicen
214 :
215 : ! ice/snow thickness
216 :
217 33852099 : meltt = meltt + melttn * aicen
218 33852099 : meltb = meltb + meltbn * aicen
219 33852099 : melts = melts + meltsn * aicen
220 33852099 : if (snwgrain) then
221 0 : meltsliq = meltsliq + meltsliqn * aicen
222 : endif
223 33852099 : if (present(dsnow)) then
224 33852099 : dsnow = dsnow + dsnown * aicen
225 : endif
226 33852099 : congel = congel + congeln * aicen
227 33852099 : snoice = snoice + snoicen * aicen
228 :
229 33852099 : end subroutine merge_fluxes
230 :
231 : !=======================================================================
232 :
233 : ! If model is not calculating surface temperature, set the surface
234 : ! flux values using values read in from forcing data or supplied via
235 : ! coupling (stored in ice_flux).
236 : !
237 : ! If CICE is running in NEMO environment, convert fluxes from GBM values
238 : ! to per unit ice area values. If model is not running in NEMO environment,
239 : ! the forcing is supplied as per unit ice area values.
240 : !
241 : ! authors Alison McLaren, Met Office
242 :
243 0 : subroutine set_sfcflux (aicen, &
244 : flatn_f, & ! LCOV_EXCL_LINE
245 : fsensn_f, & ! LCOV_EXCL_LINE
246 : fsurfn_f, & ! LCOV_EXCL_LINE
247 : fcondtopn_f, & ! LCOV_EXCL_LINE
248 : flatn, & ! LCOV_EXCL_LINE
249 : fsensn, & ! LCOV_EXCL_LINE
250 : fsurfn, & ! LCOV_EXCL_LINE
251 : fcondtopn)
252 :
253 : ! ice state variables
254 : real (kind=dbl_kind), intent(in) :: &
255 : aicen , & ! concentration of ice ! LCOV_EXCL_LINE
256 : flatn_f , & ! latent heat flux (W/m^2) ! LCOV_EXCL_LINE
257 : fsensn_f , & ! sensible heat flux (W/m^2) ! LCOV_EXCL_LINE
258 : fsurfn_f , & ! net flux to top surface, not including fcondtopn ! LCOV_EXCL_LINE
259 : fcondtopn_f ! downward cond flux at top surface (W m-2)
260 :
261 : real (kind=dbl_kind), intent(out):: &
262 : flatn , & ! latent heat flux (W/m^2) ! LCOV_EXCL_LINE
263 : fsensn , & ! sensible heat flux (W/m^2) ! LCOV_EXCL_LINE
264 : fsurfn , & ! net flux to top surface, not including fcondtopn ! LCOV_EXCL_LINE
265 : fcondtopn ! downward cond flux at top surface (W m-2)
266 :
267 : ! local variables
268 :
269 : real (kind=dbl_kind) :: &
270 0 : raicen ! 1 or 1/aicen
271 :
272 : logical (kind=log_kind) :: &
273 : extreme_flag ! flag for extreme forcing values
274 :
275 : logical (kind=log_kind), parameter :: &
276 : extreme_test=.false. ! test and write out extreme forcing data
277 :
278 : character(len=*),parameter :: subname='(set_sfcflux)'
279 :
280 0 : raicen = c1
281 :
282 : #ifdef CICE_IN_NEMO
283 : !----------------------------------------------------------------------
284 : ! Convert fluxes from GBM values to per ice area values when
285 : ! running in NEMO environment. (When in standalone mode, fluxes
286 : ! are input as per ice area.)
287 : !----------------------------------------------------------------------
288 : raicen = c1 / aicen
289 : #endif
290 0 : fsurfn = fsurfn_f*raicen
291 0 : fcondtopn= fcondtopn_f*raicen
292 0 : flatn = flatn_f*raicen
293 0 : fsensn = fsensn_f*raicen
294 :
295 : !----------------------------------------------------------------
296 : ! Flag up any extreme fluxes
297 : !---------------------------------------------------------------
298 :
299 : if (extreme_test) then
300 : extreme_flag = .false.
301 :
302 : if (fcondtopn < -100.0_dbl_kind &
303 : .or. fcondtopn > 20.0_dbl_kind) then
304 : extreme_flag = .true.
305 : endif
306 :
307 : if (fsurfn < -100.0_dbl_kind &
308 : .or. fsurfn > 80.0_dbl_kind) then
309 : extreme_flag = .true.
310 : endif
311 :
312 : if (flatn < -20.0_dbl_kind &
313 : .or. flatn > 20.0_dbl_kind) then
314 : extreme_flag = .true.
315 : endif
316 :
317 : if (extreme_flag) then
318 :
319 : if (fcondtopn < -100.0_dbl_kind &
320 : .or. fcondtopn > 20.0_dbl_kind) then
321 : write(warnstr,*) subname, &
322 : 'Extreme forcing: -100 > fcondtopn > 20'
323 : call icepack_warnings_add(warnstr)
324 : write(warnstr,*) subname, &
325 : 'aicen,fcondtopn = ', & ! LCOV_EXCL_LINE
326 : aicen,fcondtopn
327 : call icepack_warnings_add(warnstr)
328 : endif
329 :
330 : if (fsurfn < -100.0_dbl_kind &
331 : .or. fsurfn > 80.0_dbl_kind) then
332 : write(warnstr,*) subname, &
333 : 'Extreme forcing: -100 > fsurfn > 40'
334 : call icepack_warnings_add(warnstr)
335 : write(warnstr,*) subname, &
336 : 'aicen,fsurfn = ', & ! LCOV_EXCL_LINE
337 : aicen,fsurfn
338 : call icepack_warnings_add(warnstr)
339 : endif
340 :
341 : if (flatn < -20.0_dbl_kind &
342 : .or. flatn > 20.0_dbl_kind) then
343 : write(warnstr,*) subname, &
344 : 'Extreme forcing: -20 > flatn > 20'
345 : call icepack_warnings_add(warnstr)
346 : write(warnstr,*) subname, &
347 : 'aicen,flatn = ', & ! LCOV_EXCL_LINE
348 : aicen,flatn
349 : call icepack_warnings_add(warnstr)
350 : endif
351 :
352 : endif ! extreme_flag
353 : endif ! extreme_test
354 :
355 0 : end subroutine set_sfcflux
356 :
357 : !=======================================================================
358 :
359 : end module icepack_flux
360 :
361 : !=======================================================================
|
