CCPP SciDoc v7.0.0  v7.0.0
Common Community Physics Package Developed at DTC
 
Loading...
Searching...
No Matches
flake_driver.F90
1
3
6
7 implicit none
8
9 private
10
11 public :: flake_driver_run
12
13 contains
14
18 SUBROUTINE flake_driver_run ( &
19! ---- Inputs
20 im, ps, t1, q1, wind, min_lakeice, &
21 dlwflx, dswsfc, lakedepth, &
22 use_lake_model, snow, xlat, delt, zlvl, elev, &
23 wet, yearlen, julian, imon, &
24 flag_iter, first_time_step, flag_restart, &
25 weasd, &
26! ---- in/outs
27 snwdph, hice, tsurf, t_sfc, fice, hflx, evap, &
28 lflx, gflx, ustar, qsfc, ch, cm, chh, cmm, &
29 h_ML, t_wML, t_mnw, H_B, T_B, t_bot1, &
30 t_bot2, c_t, T_snow, T_ice, tsurf_ice, &
31 errmsg, errflg )
32
33!==============================================================================
34!
35! Declarations
36! use module_flake_ini, only:flake_init
37 use module_flake
38! use flake_albedo_ref
39! use data_parameters
40! use flake_derivedtypes
41! use flake_paramoptic_ref
42! use flake_parameters
43 use machine , only : kind_phys
44! use funcphys, only : fpvs
45! use physcons, only : grav => con_g, cp => con_cp, &
46! & hvap => con_hvap, rd => con_rd, &
47! & eps => con_eps, epsm1 => con_epsm1, &
48! & rvrdm1 => con_fvirt
49
50!==============================================================================
51
52 implicit none
53 integer, intent(in) :: im, imon,yearlen
54! integer, dimension(im), intent(in) :: islmsk
55
56 real (kind=kind_phys), dimension(:), intent(in) :: ps, wind, &
57 & t1, q1, dlwflx, dswsfc, zlvl, elev
58
59 real (kind=kind_phys), intent(in) :: delt, min_lakeice
60
61 real (kind=kind_phys), dimension(:), intent(in) :: &
62 & xlat, lakedepth, snow
63
64 real (kind=kind_phys), dimension(:), intent(in) :: weasd
65
66 real (kind=kind_phys),dimension(:),intent(inout) :: &
67 & snwdph, hice, tsurf, t_sfc, hflx, evap, fice, ustar, qsfc, &
68 & ch, cm, chh, cmm, t_ice, tsurf_ice, lflx, gflx
69 real (kind=kind_phys),dimension(:),intent(inout), optional :: &
70 & h_ml, t_wml, t_mnw, h_b, t_b, t_bot1, t_bot2, c_t, t_snow
71 real (kind=kind_phys), intent(in) :: julian
72
73 logical, dimension(:), intent(in) :: flag_iter, wet
74 integer, dimension(:), intent(in) :: use_lake_model
75 logical, intent(in) :: flag_restart, first_time_step
76
77 character(len=*), intent(out) :: errmsg
78 integer, intent(out) :: errflg
79
80! --- locals
81 real (kind=kind_phys), parameter :: lake_pct_min = 0.1
82
83 real (kind=kind_phys), dimension(im) :: &
84! T_snow , & ! Temperature at the air-snow interface [K]
85! T_ice , & ! Temperature at the snow-ice or air-ice interface [K]
86! T_mnw , & ! Mean temperature of the water column [K]
87! T_wML , & ! Mixed-layer temperature [K]
88! T_bot , & ! Temperature at the water-bottom sediment interface [K]
89! T_B , & ! Temperature at the upper layer of the sediments [K]
90! C_T , & ! Shape factor (thermocline)
91 fetch , & ! Typical wind fetch [m]
92! h_ML , & ! Thickness of the mixed-layer [m]
93! H_B1 , & ! Thickness of the upper layer of bottom sediments [m]
94 w_albedo , & !
95 w_extinc
96
97! Input (procedure arguments)
98
99 REAL (kind = kind_phys) :: &
100
101 dmsnowdt_in , & ! The rate of snow accumulation [kg m^{-2} s^{-1}]
102 i_atm_in , & ! Solar radiation flux at the surface [W m^{-2}]
103 q_atm_lw_in , & ! Long-wave radiation flux from the atmosphere [W m^{-2}]
104 height_u_in , & ! Height above the lake surface where the wind speed is measured [m]
105 height_tq_in , & ! Height where temperature and humidity are measured [m]
106 u_a_in , & ! Wind speed at z=height_u_in [m s^{-1}]
107 t_a_in , & ! Air temperature at z=height_tq_in [K]
108 q_a_in , & ! Air specific humidity at z=height_tq_in
109 p_a_in ! Surface air pressure [N m^{-2} = kg m^{-1} s^{-2}]
110
111 REAL (kind = kind_phys) :: &
112 depth_w , & ! The lake depth [m]
113 fetch_in , & ! Typical wind fetch [m]
114 depth_bs_in , & ! Depth of the thermally active layer of the bottom sediments [m]
115 t_bs_in , & ! Temperature at the outer edge of
116 ! the thermally active layer of the bottom sediments [K]
117 par_coriolis , & ! The Coriolis parameter [s^{-1}]
118 del_time ! The model time step [s]
119
120 REAL (kind = kind_phys) :: &
121 t_snow_in , & ! Temperature at the air-snow interface [K]
122 t_ice_in , & ! Temperature at the snow-ice or air-ice interface [K]
123 t_mnw_in , & ! Mean temperature of the water column [K]
124 t_wml_in , & ! Mixed-layer temperature [K]
125 t_bot_in , & ! Temperature at the water-bottom sediment interface [K]
126 t_b_in , & ! Temperature at the bottom of the upper layer of the sediments [K]
127 c_t_in , & ! Shape factor (thermocline)
128 h_snow_in , & ! Snow thickness [m]
129 h_ice_in , & ! Ice thickness [m]
130 h_ml_in , & ! Thickness of the mixed-layer [m]
131 h_b1_in , & ! Thickness of the upper layer of bottom sediments [m]
132 t_sfc_in , & ! Surface temperature at the previous time step [K]
133 ch_in , &
134 cm_in , &
135 albedo_water , &
136 water_extinc
137
138 REAL (kind = kind_phys) :: &
139 t_snow_out , & ! Temperature at the air-snow interface [K]
140 t_ice_out , & ! Temperature at the snow-ice or air-ice interface [K]
141 t_mnw_out , & ! Mean temperature of the water column [K]
142 t_wml_out , & ! Mixed-layer temperature [K]
143 t_bot_out , & ! Temperature at the water-bottom sediment interface [K]
144 t_b_out , & ! Temperature at the bottom of the upper layer of the sediments [K]
145 c_t_out , & ! Shape factor (thermocline)
146 h_snow_out , & ! Snow thickness [m]
147 h_ice_out , & ! Ice thickness [m]
148 h_ml_out , & ! Thickness of the mixed-layer [m]
149 h_b1_out , & ! Thickness of the upper layer of bottom sediments [m]
150 t_sfc_out , & ! surface temperature [K]
151 t_sfc_n , & ! Updated surface temperature [K]
152 u_star , &
153 q_sfc , &
154 chh_out , &
155 cmm_out
156
157 REAL (kind = kind_phys) :: &
158 q_momentum , & ! Momentum flux [N m^{-2}]
159 q_sht_flx , & ! Sensible heat flux [W m^{-2}]
160 q_lht_flx , & ! Latent heat flux [W m^{-2}]
161 q_watvap , & ! Flux of water vapour [kg m^{-2} s^{-1}]
162 q_gflx , & ! Flux from ice to water [W m^{-2}]
163 q_lflx ! latent fluxes [W m^{-2}]
164
165 REAL (kind = kind_phys) :: &
166 lake_depth_max, t_bot_2_in, t_bot_2_out, dlat,tb,tr,tt,temp,temp2
167
168 real (kind=kind_phys), parameter :: pi=4.0_kind_phys*atan(1.0_kind_phys)
169 real (kind=kind_phys), parameter :: degrad=180.0_kind_phys/pi
170 real (kind=kind_phys), parameter :: kbar = 3.5_kind_phys, delk = 3.0_kind_phys, &
171 kbarodelk = kbar / delk
172
173 REAL (kind = kind_phys) :: x, y, w !temperarory variables used for Tbot and Tsfc
174 !initilizations
175
176 INTEGER :: i,ipr,iter
177
178 LOGICAL :: lflk_botsed_use, do_flake
179 logical :: flag(im)
180! CHARACTER(LEN=*), PARAMETER :: FMT2 = "(1x,8(F12.4,1x))"
181
182!==============================================================================
183! Start calculations
184!------------------------------------------------------------------------------
185! FLake_write need to assign original value to make the model somooth
186 ! Initialize CCPP error handling variables
187 errmsg = ''
188 errflg = 0
189
190! --- ... set flag for lake points
191
192 do_flake = .false.
193 do i = 1, im
194 flag(i) = flag_iter(i) .and. use_lake_model(i) .gt. 0
195 do_flake = flag(i) .or. do_flake
196 enddo
197 if (.not. do_flake) return
198
199 lake_depth_max = 60.0
200 ipr = min(im,10)
201
202 x = 0.03279*julian
203 y = ((((0.0034*x-0.1241)*x+1.6231)*x-8.8666)*x+17.206)*x-4.2929
204
205 temp = (pi+pi)*(julian-1)/float(yearlen)
206 temp = 0.006918-0.399912*cos(temp)+0.070257*sin(temp) &
207 - 0.006758*cos(2.0*temp)+0.000907*sin(2.0*temp) &
208 - 0.002697*cos(3.0*temp)+0.00148*sin(3.0*temp)
209
210 temp2 = sin((pi+pi)*(julian-151)/244)
211
212 do i = 1, im
213 if (flag(i) .and. lakedepth(i) >1.0) then
214 if(.not.flag_restart .and. first_time_step) then
215 t_ice(i) = 273.15
216 t_snow(i) = 273.15
217 c_t(i) = 0.50
218 dlat = abs(xlat(i))
219 if(dlat .lt. 1.40) then
220 tt = (((21.181*dlat-51.376)*dlat+20.808)*dlat-3.8408)*dlat+29.554
221 tt = tt -0.0038*elev(i)+273.15
222 tb = (((-29.794*dlat+96.91)*dlat-86.129)*dlat-7.1921)*dlat+28.176
223 tb = tb -0.0038*elev(i)+273.15
224 w = (((2.5467*dlat-7.4683)*dlat+5.2465)*dlat+0.4360)*dlat+0.0643
225 else
226 tt = 4.0+273.15-0.0038*elev(i)
227 tb = 0.05+273.15-0.0038*elev(i)
228 w = 0.207312
229 endif
230 if(tsurf(i) > 400.00) then
231 write(0,*) tsurf(i)
232 write(0,*) 'Surface temperature initial is bad'
233 tsurf(i) = tt
234 write(0,*) tsurf(i)
235 endif
236 t_sfc(i) = 0.05*tt + 0.95* tsurf(i)
237
238! Add empirical climatology of lake Tsfc and Tbot to the current Tsfc and Tbot
239! to make sure Tsfc and Tbot are warmer than Tair in Winter or colder than Tair
240! in Summer
241
242 if (xlat(i) >= 0.0) then
243 t_sfc(i) = t_sfc(i) + 0.05*y*w
244 tb = tb + 0.005*y*w
245 else
246 t_sfc(i) = t_sfc(i) - 0.5*y*w
247 tb = tb - 0.005*y*w
248 endif
249
250 t_bot1(i) = tb
251 t_bot2(i) = tb
252 t_b(i) = tb
253
254 t_mnw(i) = c_t(i)*t_sfc(i) + (1-c_t(i))*t_bot1(i)
255 t_wml(i) = c_t(i)*t_sfc(i) + (1-c_t(i))*t_bot1(i)
256 h_ml(i) = c_t(i)* min( lakedepth(i), lake_depth_max )
257 h_b(i) = min( lakedepth(i),4.0)
258 hflx(i) = 0.0
259 lflx(i) = 0.0
260 evap(i) = 0.0
261 chh = ch(i) * wind(i) * 1.225 !(kg/m3)
262 cmm = cm(i) * wind(i)
263 endif !end of .not.flag_restart
264
265 fetch(i) = 2.0e+03
266! compute albedo as a function of julian day and latitude
267! write(0,*) ' xlat= ',xlat(i), temp
268 w_albedo(i) = 0.06/cos((xlat(i)-temp)/1.2)
269! w_albedo(I) = 0.06
270! compute water extinction coefficient as a function of julian day
271 if (julian < 90 .or. julian > 333) then
272 w_extinc(i) = kbar - kbarodelk
273 else
274 w_extinc(i) = kbar + kbarodelk*temp2
275 endif
276! w_extinc(i) = 3.0
277
278! write(0,1002) julian,xlat(i),w_albedo(I),w_extinc(i),elev(i),tsurf(i),T_sfc(i),t_bot1(i)
279! write(0,1003) use_lake_model(i),i,lakedepth(i), snwdph(i), hice(i), fice(i)
280! write(0,1004) ps(i), wind(i), t1(i), q1(i), dlwflx(i), dswsfc(i), zlvl(i)
281
282 endif !flag
283 enddo
284 1002 format ( 'julian=',f6.2,1x,f8.3,1x,2(e7.2,1x),e7.2,1x,3(e7.2,1x))
285 1003 format ( 'use_lake_model=',i2,1x,i3,1x,f6.4,1x,f9.4,1x,2(f8.4,1x),f7.4)
286 1004 format ( 'pressure',f12.2,1x,f6.2,1x,f7.2,1x,f7.4,1x,2(f8.2,1x),f8.4)
287!
288! call lake interface
289 do i=1,im
290 if (flag(i) .and. lakedepth(i) > 1.0) then
291! write(0,*) 'flag(i)= ', i, flag(i)
292! if(weasd(i) < 0.0 .or. hice(i) < 0.0) weasd(i) =0.0
293 if(snwdph(i) < 0.0) snwdph(i) =0.0
294! dMsnowdt_in = 10.0*0.001*weasd(i)/delt
295! dMsnowdt_in = snow(i)/delt
296 dmsnowdt_in = snow(i)*0.001
297 if(dmsnowdt_in < 0.0) dmsnowdt_in=0.0
298 i_atm_in = dswsfc(i)
299 q_atm_lw_in = dlwflx(i)
300 height_u_in = zlvl(i)
301 height_tq_in = zlvl(i)
302 u_a_in = wind(i)
303 t_a_in = t1(i)
304 q_a_in = q1(i)
305 p_a_in = ps(i)
306 ch_in = ch(i)
307 cm_in = cm(i)
308 albedo_water = w_albedo(i)
309 water_extinc = w_extinc(i)
310
311 depth_w = min( lakedepth(i), lake_depth_max )
312 depth_bs_in = max( 4.0, min( depth_w * 0.2, 10.0 ) )
313 fetch_in = fetch(i)
314 t_bs_in = t_bot1(i)
315 par_coriolis = 2 * 7.2921 / 100000. * sin( xlat(i) )
316 del_time = delt
317
318! if(lakedepth(i).lt.10) then
319! T_sfc(i) = t1(i)
320! T_bs_in = T_sfc(i)
321! T_B(i) = T_bs_in
322! endif
323
324 do iter=1,5 !interation loop
325 t_snow_in = t_snow(i)
326 t_ice_in = t_ice(i)
327 t_mnw_in = t_mnw(i)
328 t_wml_in = t_wml(i)
329 t_bot_in = t_bot1(i)
330 t_b_in = t_b(i)
331 c_t_in = c_t(i)
332 h_snow_in = snwdph(i)
333 h_ice_in = hice(i)
334 h_ml_in = h_ml(i)
335 h_b1_in = h_b(i)
336 t_sfc_in = t_sfc(i)
337 tsurf_ice(i)= t_ice(i)
338
339 t_bot_2_in = t_bot2(i)
340 q_sht_flx = hflx(i)
341 q_watvap = evap(i)
342 q_gflx = 0.0
343 q_lflx = 0.0
344
345!------------------------------------------------------------------------------
346! Set the rate of snow accumulation
347!------------------------------------------------------------------------------
348
349 CALL flake_interface(dmsnowdt_in, i_atm_in, q_atm_lw_in, height_u_in, &
350 height_tq_in, u_a_in, t_a_in, q_a_in, p_a_in, &
351
352 depth_w, fetch_in, depth_bs_in, t_bs_in, par_coriolis, del_time, &
353 t_snow_in, t_ice_in, t_mnw_in, t_wml_in, t_bot_in, t_b_in, &
354 c_t_in, h_snow_in, h_ice_in, h_ml_in, h_b1_in, t_sfc_in, &
355 ch_in, cm_in, albedo_water, water_extinc, &
356!
357 t_snow_out, t_ice_out, t_mnw_out, t_wml_out, t_bot_out, &
358 t_b_out, c_t_out, h_snow_out, h_ice_out, h_ml_out, &
359 h_b1_out, t_sfc_out, q_sht_flx, q_watvap, q_gflx, q_lflx, &
360!
361 t_bot_2_in, t_bot_2_out,u_star, q_sfc,chh_out,cmm_out )
362
363!------------------------------------------------------------------------------
364! Update output and values for previous time step
365!
366 t_snow(i) = t_snow_out
367 t_ice(i) = t_ice_out
368 t_mnw(i) = t_mnw_out
369 t_wml(i) = t_wml_out
370 t_sfc(i) = t_sfc_out
371 tsurf(i) = t_sfc_out
372 tsurf_ice(i) = t_ice(i)
373 t_bot1(i) = t_bot_out
374 t_bot2(i) = t_bot_2_out
375 t_b(i) = t_b_out
376 c_t(i) = c_t_out
377 h_ml(i) = h_ml_out
378 h_b(i) = h_b1_out
379 ustar(i) = u_star
380 qsfc(i) = q_sfc
381 chh(i) = chh_out
382 cmm(i) = cmm_out
383 snwdph(i) = h_snow_out
384 hice(i) = h_ice_out
385 evap(i) = q_watvap
386 hflx(i) = q_sht_flx
387 gflx(i) = q_gflx
388 lflx(i) = q_lflx
389! if(lflx(i) > 2500.00 .or. Tsurf(i) > 350.00) then
390! write(0,125) i,lflx(i), Tsurf(i),ps(i), wind(i), &
391! & t1(i), q1(i), dlwflx(i), dswsfc(i),hflx(i)
392! endif
393! fice(i) = fice(i)+0.01*(h_ice_out-h_ice_in)
394! if(fice(i) .lt. min_lakeice ) then
395! fice(i) = 0.0
396! elseif(fice(i) .gt. 1.0) then
397! fice(i) = 1.0
398! endif
399 enddo !iter loop
400! endif !endif use_lake_model
401
402 endif !endif of flag
403
404 enddo
405
406125 format(1x,i3,1x,9(1x,f10.3))
407!126 format(1x,i2,1x,i2,1x,6(1x,f14.8))
408!127 format(1x,i2,2(1x,f16.9))
409!------------------------------------------------------------------------------
410! End calculations
411!==============================================================================
412
413 END SUBROUTINE flake_driver_run
414
415end module flake_driver
416
418 use machine, only: kind_phys
419 implicit none
420 private
421 public flake_driver_post_init, flake_driver_post_finalize, flake_driver_post_run
422
423contains
424 subroutine flake_driver_post_init()
425 end subroutine flake_driver_post_init
426
427 subroutine flake_driver_post_finalize()
428 end subroutine flake_driver_post_finalize
429
433subroutine flake_driver_post_run (im, use_lake_model, h_ML, T_wML, &
434 Tsurf, lakedepth, xz, zm, tref, tsfco, &
435 errmsg, errflg)
436
437!use machine , only : kind_phys
438!==============================================================================
439
440 implicit none
441 integer, intent(in) :: im
442! integer, dimension(im), intent(in) :: islmsk
443
444 real (kind=kind_phys), dimension(:), intent(in) :: &
445 & lakedepth, tsurf
446 real (kind=kind_phys), dimension(:), intent(in), optional :: &
447 & h_ml, t_wml
448
449 real (kind=kind_phys),dimension(:),intent(inout), optional :: &
450 & xz, zm, tref
451 real (kind=kind_phys),dimension(:),intent(inout) :: tsfco
452
453 integer, dimension(:), intent(in) :: use_lake_model
454
455 character(len=*), intent(out) :: errmsg
456 integer, intent(out) :: errflg
457
458 integer :: i
459 ! Initialize CCPP error handling variables
460 errmsg = ''
461 errflg = 0
462
463 do i=1, im
464 if(use_lake_model(i).eq.2) then
465 write(0,*)'flake-post-use-lake-model= ',use_lake_model(i)
466 xz(i) = lakedepth(i)
467 zm(i) = h_ml(i)
468 tref(i) = tsurf(i)
469 tsfco(i) = t_wml(i)
470 endif
471 enddo
472
473
474end subroutine flake_driver_post_run
475
476!---------------------------------
477end module flake_driver_post
This module contains the CCPP-compliant flake scheme driver.