18 SUBROUTINE flake_driver_run ( &
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, &
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, &
53 integer,
intent(in) :: im, imon,yearlen
56 real (kind=kind_phys),
dimension(:),
intent(in) :: ps, wind, &
57 & t1, q1, dlwflx, dswsfc, zlvl, elev
59 real (kind=kind_phys),
intent(in) :: delt, min_lakeice
61 real (kind=kind_phys),
dimension(:),
intent(in) :: &
62 & xlat, lakedepth, snow
64 real (kind=kind_phys),
dimension(:),
intent(in) :: weasd
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
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
77 character(len=*),
intent(out) :: errmsg
78 integer,
intent(out) :: errflg
81 real (kind=kind_phys),
parameter :: lake_pct_min = 0.1
83 real (kind=kind_phys),
dimension(im) :: &
99 REAL (kind = kind_phys) :: &
111 REAL (kind = kind_phys) :: &
120 REAL (kind = kind_phys) :: &
138 REAL (kind = kind_phys) :: &
157 REAL (kind = kind_phys) :: &
165 REAL (kind = kind_phys) :: &
166 lake_depth_max, t_bot_2_in, t_bot_2_out, dlat,tb,tr,tt,temp,temp2
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
173 REAL (kind = kind_phys) :: x, y, w
176 INTEGER :: i,ipr,iter
178 LOGICAL :: lflk_botsed_use, do_flake
194 flag(i) = flag_iter(i) .and. use_lake_model(i) .gt. 0
195 do_flake = flag(i) .or. do_flake
197 if (.not. do_flake)
return
199 lake_depth_max = 60.0
203 y = ((((0.0034*x-0.1241)*x+1.6231)*x-8.8666)*x+17.206)*x-4.2929
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)
210 temp2 = sin((pi+pi)*(julian-151)/244)
213 if (flag(i) .and. lakedepth(i) >1.0)
then
214 if(.not.flag_restart .and. first_time_step)
then
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
226 tt = 4.0+273.15-0.0038*elev(i)
227 tb = 0.05+273.15-0.0038*elev(i)
230 if(tsurf(i) > 400.00)
then
232 write(0,*)
'Surface temperature initial is bad'
236 t_sfc(i) = 0.05*tt + 0.95* tsurf(i)
242 if (xlat(i) >= 0.0)
then
243 t_sfc(i) = t_sfc(i) + 0.05*y*w
246 t_sfc(i) = t_sfc(i) - 0.5*y*w
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)
261 chh = ch(i) * wind(i) * 1.225
262 cmm = cm(i) * wind(i)
268 w_albedo(i) = 0.06/cos((xlat(i)-temp)/1.2)
271 if (julian < 90 .or. julian > 333)
then
272 w_extinc(i) = kbar - kbarodelk
274 w_extinc(i) = kbar + kbarodelk*temp2
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)
290 if (flag(i) .and. lakedepth(i) > 1.0)
then
293 if(snwdph(i) < 0.0) snwdph(i) =0.0
296 dmsnowdt_in = snow(i)*0.001
297 if(dmsnowdt_in < 0.0) dmsnowdt_in=0.0
299 q_atm_lw_in = dlwflx(i)
300 height_u_in = zlvl(i)
301 height_tq_in = zlvl(i)
308 albedo_water = w_albedo(i)
309 water_extinc = w_extinc(i)
311 depth_w = min( lakedepth(i), lake_depth_max )
312 depth_bs_in = max( 4.0, min( depth_w * 0.2, 10.0 ) )
315 par_coriolis = 2 * 7.2921 / 100000. * sin( xlat(i) )
325 t_snow_in = t_snow(i)
332 h_snow_in = snwdph(i)
337 tsurf_ice(i)= t_ice(i)
339 t_bot_2_in = t_bot2(i)
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, &
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, &
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, &
361 t_bot_2_in, t_bot_2_out,u_star, q_sfc,chh_out,cmm_out )
366 t_snow(i) = t_snow_out
372 tsurf_ice(i) = t_ice(i)
373 t_bot1(i) = t_bot_out
374 t_bot2(i) = t_bot_2_out
383 snwdph(i) = h_snow_out
406125
format(1x,i3,1x,9(1x,f10.3))