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 765995910 : subroutine merge_fluxes (aicen, &
32 : flw, &
33 : strairxn, strairyn, &
34 : Cdn_atm_ratio_n, &
35 : fsurfn, fcondtopn, &
36 : fcondbotn, &
37 : fsensn, flatn, &
38 : fswabsn, flwoutn, &
39 : evapn, &
40 : evapsn, evapin, &
41 : Trefn, Qrefn, &
42 : freshn, fsaltn, &
43 : fhocnn, fswthrun, &
44 : fswthrun_vdr, fswthrun_vdf,&
45 : fswthrun_idr, fswthrun_idf,&
46 : strairxT, strairyT, &
47 : Cdn_atm_ratio, &
48 : fsurf, fcondtop, &
49 : fcondbot, &
50 : fsens, flat, &
51 : fswabs, flwout, &
52 : evap, &
53 : evaps, evapi, &
54 : Tref, Qref, &
55 : fresh, fsalt, &
56 : fhocn, fswthru, &
57 : fswthru_vdr, fswthru_vdf,&
58 : fswthru_idr, fswthru_idf,&
59 : melttn, meltsn, meltbn, congeln, snoicen, &
60 : meltt, melts, &
61 : meltb, &
62 : congel, snoice, &
63 : Uref, Urefn, &
64 765995910 : Qref_iso, Qrefn_iso, &
65 765995910 : fiso_ocn, fiso_ocnn, &
66 765995910 : fiso_evap, fiso_evapn)
67 :
68 : ! single category fluxes
69 : real (kind=dbl_kind), intent(in) :: &
70 : aicen , & ! concentration of ice
71 : flw , & ! downward longwave flux (W/m**2)
72 : strairxn, & ! air/ice zonal strss, (N/m**2)
73 : strairyn, & ! air/ice merdnl strss, (N/m**2)
74 : Cdn_atm_ratio_n, & ! ratio of total drag over neutral drag
75 : fsurfn , & ! net heat flux to top surface (W/m**2)
76 : fcondtopn,& ! downward cond flux at top sfc (W/m**2)
77 : fcondbotn,& ! downward cond flux at bottom sfc (W/m**2)
78 : fsensn , & ! sensible heat flx (W/m**2)
79 : flatn , & ! latent heat flx (W/m**2)
80 : fswabsn , & ! shortwave absorbed heat flx (W/m**2)
81 : flwoutn , & ! upwd lw emitted heat flx (W/m**2)
82 : evapn , & ! evaporation (kg/m2/s)
83 : evapsn , & ! evaporation over snow (kg/m2/s)
84 : evapin , & ! evaporation over ice (kg/m2/s)
85 : Trefn , & ! air tmp reference level (K)
86 : Qrefn , & ! air sp hum reference level (kg/kg)
87 : freshn , & ! fresh water flux to ocean (kg/m2/s)
88 : fsaltn , & ! salt flux to ocean (kg/m2/s)
89 : fhocnn , & ! actual ocn/ice heat flx (W/m**2)
90 : fswthrun, & ! sw radiation through ice bot (W/m**2)
91 : fswthrun_vdr, & ! vis dir sw radiation through ice bot (W/m**2)
92 : fswthrun_vdf, & ! vis dif sw radiation through ice bot (W/m**2)
93 : fswthrun_idr, & ! nir dir sw radiation through ice bot (W/m**2)
94 : fswthrun_idf, & ! nir dif sw radiation through ice bot (W/m**2)
95 : melttn , & ! top ice melt (m)
96 : meltbn , & ! bottom ice melt (m)
97 : meltsn , & ! snow melt (m)
98 : congeln , & ! congelation ice growth (m)
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)
107 : strairyT, & ! air/ice merdnl strss, (N/m**2)
108 : Cdn_atm_ratio, & ! ratio of total drag over neutral drag
109 : fsurf , & ! net heat flux to top surface (W/m**2)
110 : fcondtop, & ! downward cond flux at top sfc (W/m**2)
111 : fcondbot, & ! downward cond flux at bottom sfc (W/m**2)
112 : fsens , & ! sensible heat flx (W/m**2)
113 : flat , & ! latent heat flx (W/m**2)
114 : fswabs , & ! shortwave absorbed heat flx (W/m**2)
115 : flwout , & ! upwd lw emitted heat flx (W/m**2)
116 : evap , & ! evaporation (kg/m2/s)
117 : evaps , & ! evaporation over snow (kg/m2/s)
118 : evapi , & ! evaporation over ice (kg/m2/s)
119 : Tref , & ! air tmp reference level (K)
120 : Qref , & ! air sp hum reference level (kg/kg)
121 : fresh , & ! fresh water flux to ocean (kg/m2/s)
122 : fsalt , & ! salt flux to ocean (kg/m2/s)
123 : fhocn , & ! actual ocn/ice heat flx (W/m**2)
124 : fswthru , & ! sw radiation through ice bot (W/m**2)
125 : meltt , & ! top ice melt (m)
126 : meltb , & ! bottom ice melt (m)
127 : melts , & ! snow melt (m)
128 : congel , & ! congelation ice growth (m)
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)
133 : fswthru_vdf , & ! vis dif sw radiation through ice bot (W/m**2)
134 : fswthru_idr , & ! nir dir sw radiation through ice bot (W/m**2)
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)
142 : fiso_ocn, & ! isotope fluxes to ocean (kg/m2/s)
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)
147 : fiso_ocnn, & ! isotope fluxes to ocean (kg/m2/s)
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 765995910 : strairxT = strairxT + strairxn * aicen
162 765995910 : strairyT = strairyT + strairyn * aicen
163 : Cdn_atm_ratio = Cdn_atm_ratio + &
164 765995910 : Cdn_atm_ratio_n * aicen
165 765995910 : fsurf = fsurf + fsurfn * aicen
166 765995910 : fcondtop = fcondtop + fcondtopn * aicen
167 765995910 : fcondbot = fcondbot + fcondbotn * aicen
168 765995910 : fsens = fsens + fsensn * aicen
169 765995910 : flat = flat + flatn * aicen
170 765995910 : fswabs = fswabs + fswabsn * aicen
171 : flwout = flwout &
172 765995910 : + (flwoutn - (c1-emissivity)*flw) * aicen
173 765995910 : evap = evap + evapn * aicen
174 765995910 : evaps = evaps + evapsn * aicen
175 765995910 : evapi = evapi + evapin * aicen
176 765995910 : Tref = Tref + Trefn * aicen
177 765995910 : Qref = Qref + Qrefn * aicen
178 :
179 : ! Isotopes
180 765995910 : if (tr_iso) then
181 21958762 : if (present(Qrefn_iso) .and. present(Qref_iso)) then
182 87835048 : Qref_iso (:) = Qref_iso (:) + Qrefn_iso (:) * aicen
183 : endif
184 21958762 : if (present(fiso_ocnn) .and. present(fiso_ocn)) then
185 87835048 : fiso_ocn (:) = fiso_ocn (:) + fiso_ocnn (:) * aicen
186 : endif
187 21958762 : if (present(fiso_evapn) .and. present(fiso_evap)) then
188 87835048 : fiso_evap(:) = fiso_evap(:) + fiso_evapn(:) * aicen
189 : endif
190 : endif
191 :
192 : ! ocean fluxes
193 765995910 : if (present(Urefn) .and. present(Uref)) then
194 765995910 : Uref = Uref + Urefn * aicen
195 : endif
196 :
197 765995910 : fresh = fresh + freshn * aicen
198 765995910 : fsalt = fsalt + fsaltn * aicen
199 765995910 : fhocn = fhocn + fhocnn * aicen
200 765995910 : fswthru = fswthru + fswthrun * aicen
201 765995910 : if (present(fswthru_vdr)) &
202 765995910 : fswthru_vdr = fswthru_vdr + fswthrun_vdr * aicen
203 765995910 : if (present(fswthru_vdf)) &
204 765995910 : fswthru_vdf = fswthru_vdf + fswthrun_vdf * aicen
205 765995910 : if (present(fswthru_idr)) &
206 765995910 : fswthru_idr = fswthru_idr + fswthrun_idr * aicen
207 765995910 : if (present(fswthru_idf)) &
208 765995910 : fswthru_idf = fswthru_idf + fswthrun_idf * aicen
209 :
210 : ! ice/snow thickness
211 :
212 765995910 : meltt = meltt + melttn * aicen
213 765995910 : meltb = meltb + meltbn * aicen
214 765995910 : melts = melts + meltsn * aicen
215 765995910 : congel = congel + congeln * aicen
216 765995910 : snoice = snoice + snoicen * aicen
217 :
218 765995910 : 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 26412869 : subroutine set_sfcflux (aicen, &
233 : flatn_f, &
234 : fsensn_f, &
235 : fsurfn_f, &
236 : fcondtopn_f, &
237 : flatn, &
238 : fsensn, &
239 : fsurfn, &
240 : fcondtopn)
241 :
242 : ! ice state variables
243 : real (kind=dbl_kind), &
244 : intent(in) :: &
245 : aicen , & ! concentration of ice
246 : flatn_f , & ! latent heat flux (W/m^2)
247 : fsensn_f , & ! sensible heat flux (W/m^2)
248 : fsurfn_f , & ! net flux to top surface, not including fcondtopn
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)
253 : fsensn , & ! sensible heat flux (W/m^2)
254 : fsurfn , & ! net flux to top surface, not including fcondtopn
255 : fcondtopn ! downward cond flux at top surface (W m-2)
256 :
257 : ! local variables
258 :
259 : real (kind=dbl_kind) :: &
260 3773267 : 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 26412869 : 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 26412869 : fsurfn = fsurfn_f*raicen
281 26412869 : fcondtopn= fcondtopn_f*raicen
282 26412869 : flatn = flatn_f*raicen
283 26412869 : 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 = ', &
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 = ', &
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 = ', &
338 : aicen,flatn
339 : call icepack_warnings_add(warnstr)
340 : endif
341 :
342 : endif ! extreme_flag
343 : endif ! extreme_test
344 :
345 26412869 : end subroutine set_sfcflux
346 :
347 : !=======================================================================
348 :
349 : end module icepack_flux
350 :
351 : !=======================================================================
|
