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