← Back to Documentation Home
CCPP SciDoc v8.0.0  v8.0.0
Common Community Physics Package Developed at DTC
 
Loading...
Searching...
No Matches
lsm_ruc.F90
1
3
5module lsm_ruc
6
7 use machine, only: kind_phys, kind_dbl_prec
8
9 use namelist_soilveg_ruc
10 use set_soilveg_ruc_mod, only: set_soilveg_ruc
11 use module_soil_pre
12 use module_sf_ruclsm
13
14 use physcons, only : con_t0c
15
16 implicit none
17
18 private
19
20 public :: lsm_ruc_init, lsm_ruc_run, lsm_ruc_final
21
22 real(kind_phys), parameter :: zero = 0.0_kind_dbl_prec, one = 1.0_kind_dbl_prec, epsln = 1.0e-8_kind_dbl_prec
23 real(kind_phys), dimension (2), parameter, private :: d = (/0.1,0.25/)
24 integer, dimension(20), parameter, private:: &
25 istwe = (/1,1,1,1,1,2,2,1,1,2,2,2,2,2,1,2,2,1,2,2/) ! IGBP 20 classes
26
27
28
29 contains
30
36 subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, &
37 lsm_cold_start, flag_init, con_fvirt, con_rd, &
38 im, lsoil_ruc, lsoil, kice, nlev, & ! in
39 lsm_ruc, lsm, slmsk, stype, vtype, landfrac, & ! in
40 q1, prsl1, tsfc_lnd, tsfc_ice, tsfc_wat, & ! in
41 tg3, smc, slc, stc, fice, min_seaice, & ! in
42 sncovr_lnd, sncovr_ice, snoalb, & ! in
43 facsf, facwf, alvsf, alvwf, alnsf, alnwf, & ! in
44 sfcqv_lnd, sfcqv_ice, & ! out
45 sfalb_lnd_bck, & ! out
46 semisbase, semis_lnd, semis_ice, & ! out
47 albdvis_lnd,albdnir_lnd,albivis_lnd,albinir_lnd, & ! out
48 albdvis_ice,albdnir_ice,albivis_ice,albinir_ice, & ! out
49 zs, sh2o, smfrkeep, tslb, smois, wetness, & ! out
50 tsice, pores, resid, errmsg, errflg)
51
52 implicit none
53! --- in
54 integer, intent(in) :: me, master, isot, ivegsrc, nlunit
55 logical, intent(in) :: lsm_cold_start
56 logical, intent(in) :: flag_init
57 integer, intent(in) :: im
58 integer, intent(in) :: lsoil_ruc
59 integer, intent(in) :: lsoil
60 integer, intent(in) :: kice
61 integer, intent(in) :: nlev
62 integer, intent(in) :: lsm_ruc, lsm
63 real (kind_phys),intent(in) :: con_fvirt
64 real (kind_phys),intent(in) :: con_rd
65
66
67 real (kind_phys), dimension(:), intent(in) :: slmsk
68 integer, dimension(:), intent(in) :: stype
69 integer, dimension(:), intent(in) :: vtype
70 real (kind_phys), dimension(:), intent(in) :: landfrac
71 real (kind_phys), dimension(:), intent(in) :: q1
72 real (kind_phys), dimension(:), intent(in) :: prsl1
73 real (kind_phys), dimension(:), intent(in) :: tsfc_lnd
74 real (kind_phys), dimension(:), intent(in) :: tsfc_ice
75 real (kind_phys), dimension(:), intent(in) :: tsfc_wat
76 real (kind_phys), dimension(:), intent(in) :: tg3
77 real (kind_phys), dimension(:), intent(in) :: sncovr_lnd
78 real (kind_phys), dimension(:), intent(in) :: sncovr_ice
79 real (kind_phys), dimension(:), intent(in) :: snoalb
80 real (kind_phys), dimension(:), intent(in) :: fice
81 real (kind_phys), dimension(:), intent(in) :: facsf
82 real (kind_phys), dimension(:), intent(in) :: facwf
83 real (kind_phys), dimension(:), intent(in) :: alvsf
84 real (kind_phys), dimension(:), intent(in) :: alvwf
85 real (kind_phys), dimension(:), intent(in) :: alnsf
86 real (kind_phys), dimension(:), intent(in) :: alnwf
87
88 real (kind_phys), dimension(:,:), intent(in) :: smc,slc,stc
89 real (kind_phys), intent(in) :: min_seaice
90! --- in/out:
91 real (kind_phys), dimension(:), intent(inout) :: wetness
92
93! --- inout
94 real (kind_phys), dimension(:,:), intent(inout) :: sh2o, smfrkeep
95 real (kind_phys), dimension(:,:), intent(inout) :: tslb, smois
96 real (kind_phys), dimension(:), intent(inout) :: semis_lnd
97 real (kind_phys), dimension(:), intent(inout) :: semis_ice
98 real (kind_phys), dimension(:), intent(inout) :: &
99 albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd
100 real (kind_phys), dimension(:), intent(inout) :: &
101 albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, &
102 sfcqv_lnd, sfcqv_ice
103
104! --- out
105 real (kind_phys), dimension(:), intent(out) :: zs
106 real (kind_phys), dimension(:), intent(inout) :: sfalb_lnd_bck
107 real (kind_phys), dimension(:,:), intent(inout) :: tsice
108 real (kind_phys), dimension(:), intent(out) :: semisbase
109 real (kind_phys), dimension(:), intent(out) :: pores, resid
110
111 character(len=*), intent(out) :: errmsg
112 integer, intent(out) :: errflg
113
114! --- local
115 real (kind_phys), dimension(lsoil_ruc) :: dzs
116 real (kind_phys) :: alb_lnd, alb_ice
117 real (kind_phys) :: q0, qs1
118 integer :: ipr, i, k
119 logical :: debug_print
120
121 ! Initialize CCPP error handling variables
122 errmsg = ''
123 errflg = 0
124
125 ! Consistency checks
126 if (lsm/=lsm_ruc) then
127 write(errmsg,'(*(a))') 'Logic error: namelist choice of ', &
128 & 'LSM is different from RUC'
129 errflg = 1
130 return
131 end if
132
133 ipr = 10
134 debug_print = .false.
135
136 if (ivegsrc /= 1) then
137 errmsg = 'The RUC LSM expects that the ivegsrc physics namelist parameter is 1. Exiting...'
138 errflg = 1
139 return
140 end if
141 if (isot > 1) then
142 errmsg = 'The RUC LSM expects that the isot physics namelist parameter is 0, or 1. Exiting...'
143 errflg = 1
144 return
145 end if
146
148
149 if ( debug_print) then
150 write (0,*) 'RUC LSM initialization'
151 write (0,*) 'lsoil_ruc, lsoil',lsoil_ruc, lsoil
152 write (0,*) 'me, isot, ivegsrc, nlunit ',me, isot, ivegsrc, nlunit
153 write (0,*) 'noah soil temp',stc(ipr,:)
154 write (0,*) 'noah mois(ipr)',ipr,smc(ipr,:)
155 write (0,*) 'stype=',stype(ipr)
156 write (0,*) 'vtype=',vtype(ipr)
157 write (0,*) 'tsfc_lnd=',tsfc_lnd(ipr)
158 write (0,*) 'tsfc_wat=',tsfc_wat(ipr)
159 write (0,*) 'tg3=',tg3(ipr)
160 write (0,*) 'slmsk=',slmsk(ipr)
161 write (0,*) 'flag_init =',flag_init
162 write (0,*) 'lsm_cold_start =',lsm_cold_start
163 endif
164
165 !--- initialize soil vegetation
166 call set_soilveg_ruc(me, isot, ivegsrc, nlunit, errmsg, errflg)
167 if(errflg/=0) return
168
169 pores(:) = maxsmc(:)
170 resid(:) = drysmc(:)
171
172 do i = 1, im ! i - horizontal loop
173
174 !-- initialize background emissivity
175 semisbase(i) = lemitbl(vtype(i)) ! no snow effect
176
177 if (lsm_cold_start) then
178 !-- land
179 semis_lnd(i) = semisbase(i) * (one-sncovr_lnd(i)) &
180 + 0.99_kind_phys * sncovr_lnd(i)
181 sfalb_lnd_bck(i) = 0.25_kind_phys*(alnsf(i) + alnwf(i) + alvsf(i) + alvwf(i)) &
182 * min(one, facsf(i)+facwf(i))
183 alb_lnd = sfalb_lnd_bck(i) * (one - sncovr_lnd(i)) &
184 + snoalb(i) * sncovr_lnd(i)
185 albdvis_lnd(i) = alb_lnd
186 albdnir_lnd(i) = alb_lnd
187 albivis_lnd(i) = alb_lnd
188 albinir_lnd(i) = alb_lnd
189 !-- ice
190 semis_ice(i) = 0.97_kind_phys * (one - sncovr_ice(i)) + 0.99_kind_phys * sncovr_ice(i)
191 alb_ice = 0.55_kind_phys * (one - sncovr_ice(i)) + 0.75_kind_phys * sncovr_ice(i)
192 albdvis_ice(i) = alb_ice
193 albdnir_ice(i) = alb_ice
194 albivis_ice(i) = alb_ice
195 albinir_ice(i) = alb_ice
196
197 !-- initialize QV mixing ratio at the surface from atm. 1st level
198 q0 = max(q1(i)/(one-q1(i)), epsln) ! q1=specific humidity at level 1 (kg/kg)
199 qs1 = rslf(prsl1(i),tsfc_lnd(i)) !* qs1=sat. mixing ratio at level 1 (kg/kg)
200 q0 = min(qs1, q0)
201 sfcqv_lnd(i) = q0
202 qs1 = rslf(prsl1(i),tsfc_ice(i))
203 sfcqv_ice(i) = qs1
204 endif ! lsm_cold_start
205
206 enddo ! i
207
208 call init_soil_depth_3 ( zs , dzs , lsoil_ruc )
209
210 call rucinit (lsm_cold_start, im, lsoil_ruc, lsoil, nlev, & ! in
211 me, master, lsm_ruc, lsm, slmsk, & ! in
212 stype, vtype, landfrac, fice, & ! in
213 min_seaice, tsfc_lnd, tsfc_wat, tg3, & ! in
214 zs, dzs, smc, slc, stc, & ! in
215 sh2o, smfrkeep, tslb, smois, & ! out
216 wetness, errmsg, errflg)
217 if(errflg/=0) return
218
219 if (lsm_cold_start) then
220 do i = 1, im ! i - horizontal loop
221 do k = 1, min(kice,lsoil_ruc)
222 ! - at initial time set sea ice T (tsice)
223 ! equal to TSLB, initialized from the Noah STC variable
224 tsice(i,k) = tslb(i,k)
225 enddo
226 enddo ! i
227 endif ! .not. restart
228
229 !-- end of initialization
230
231 if ( debug_print) then
232 write (0,*) 'ruc soil tslb',tslb(ipr,:)
233 write (0,*) 'ruc soil tsice',tsice(ipr,:)
234 write (0,*) 'ruc soil smois',smois(ipr,:)
235 write (0,*) 'ruc wetness',wetness(ipr)
236 endif
237
238 end subroutine lsm_ruc_init
239
243 subroutine lsm_ruc_final (errmsg, errflg)
244
245 implicit none
246
247 character(len=*), intent(out) :: errmsg
248 integer, intent(out) :: errflg
249
250 ! Initialize CCPP error handling variables
251 errmsg = ''
252 errflg = 0
253
254 end subroutine lsm_ruc_final
255
256! ===================================================================== !
257! lsm_ruc_run: !
258! RUC Surface Model - WRF4.0 version !
259! program history log: !
260! may 2018 -- tanya smirnova !
261! !
262! ==================== defination of variables ==================== !
263! !
264! inputs: size !
265! im - integer, horiz dimention and num of used pts 1 !
266! km - integer, vertical soil layer dimension 9 !
267! ps - real, surface pressure (pa) im !
268! t1 - real, surface layer mean temperature (k) im !
269! q1 - real, surface layer mean specific humidity im !
270! stype - integer, soil type (integer index) im !
271! vtype - integer, vegetation type (integer index) im !
272! sigmaf - real, areal fractional cover of green vegetation im !
273! dlwflx - real, total sky sfc downward lw flux ( w/m**2 ) im !
274! dswflx - real, total sky sfc downward sw flux ( w/m**2 ) im !
275! delt - real, time interval (second) 1 !
276! tg3 - real, deep soil temperature (k) im !
277! cm - real, surface exchange coeff for momentum (m/s) im !
278! ch - real, surface exchange coeff heat & moisture(m/s) im !
279! prsl1 - real, sfc layer 1 mean pressure (pa) im !
280! prslki - real, dimensionless exner function at layer 1 im !
281! zf - real, height of bottom layer (m) im !
282! wind real, surface layer wind speed (m/s) im !
283! slopetyp - integer, class of sfc slope (integer index) im !
284! shdmin - real, min fractional coverage of green veg im !
285! shdmax - real, max fractnl cover of green veg (not used) im !
286! snoalb - real, upper bound on max albedo over deep snow im !
287! flag_iter- logical, im !
288! flag_guess-logical, im !
289! isot - integer, sfc soil type data source zobler or statsgo !
290! ivegsrc - integer, sfc veg type data source umd or igbp !
291! smois - real, total soil moisture content (fractional) im,km !
292! !
293! input/outputs: !
294! weasd - real, water equivalent accumulated snow depth (mm) im !
295! snwdph - real, snow depth (water equiv) over land im !
296! tskin - real, ground surface skin temperature ( k ) im !
297! tprcp - real, total precipitation im !
298! srflag - real, snow/rain flag for precipitation or mixed-phase
299! precipitation fraction (depends on MP) im !
300! tslb - real, soil temp (k) im,km !
301! sh2o - real, liquid soil moisture im,km !
302! canopy - real, canopy moisture content (mm) im !
303! tsurf - real, surface skin temperature (after iteration) im !
304! !
305! outputs: !
306! sncovr1 - real, snow cover over land (fractional) im !
307! qsurf - real, specific humidity at sfc im !
308! gflux - real, soil heat flux (w/m**2) im !
309! drain - real, subsurface runoff (mm/s) im !
310! evap - real, latent heat flux in kg kg-1 m s-1 im !
311! runof - real, surface runoff (mm/s) im !
312! evbs - real, direct soil evaporation (W m-2) im !
313! evcw - real, canopy water evaporation (W m-2) im !
314! sbsno - real, sublimation/deposit from snopack (W m-2) im !
315! stm - real, total soil column moisture content (m) im !
316! trans - real, total plant transpiration (W m-2) im !
317! zorl - real, surface roughness (cm) im !
318! wetness - real, normalized soil wetness im !
319! !
320! ==================== end of description ===================== !
321
329 subroutine lsm_ruc_run & ! inputs
330 & ( iter, me, master, delt, kdt, im, nlev, lsm_ruc, lsm, &
331 & imp_physics, imp_physics_gfdl, imp_physics_thompson, &
332 & imp_physics_nssl, do_mynnsfclay, use_cdeps_data, mask_dat, &
333 & exticeden, lsoil_ruc, lsoil, mosaic_lu, mosaic_soil, &
334 & isncond_opt, isncovr_opt, nlcat, nscat, &
335 & rdlai, xlat_d, xlon_d, &
336 & oro, sigma, zs, t1, q1, qc, stype, vtype, vegtype_frac, &
337 & soiltype_frac, sigmaf, laixy, &
338 & dlwflx, dswsfc, tg3, coszen, land, icy, use_lake, &
339 & rainnc, rainc, ice, snow, graupel, prsl1, zf, &
340 & wind, shdmin, shdmax, &
341 & srflag, sfalb_lnd_bck, snoalb, &
342 & isot, ivegsrc, fice, smcwlt2, smcref2, &
343 & min_lakeice, min_seaice, oceanfrac, rhonewsn1, &
344 ! --- constants
345 & con_cp, con_rd, con_rv, con_g, con_pi, con_hvap, &
346 & con_hfus, con_fvirt, stbolt, rhoh2o, &
347 ! --- in/outs for ice and land
348 & semisbase, semis_lnd, semis_ice, sfalb_lnd, sfalb_ice, &
349 & sncovr1_lnd, weasd_lnd, snwdph_lnd, tskin_lnd, &
350 & sncovr1_ice, weasd_ice, snwdph_ice, tskin_ice, &
351 ! for land
352 & smois, tsice, tslb, sh2o, keepfr, smfrkeep, & ! on RUC levels
353 & canopy, trans, tsurf_lnd, tsnow_lnd, z0rl_lnd, &
354 & sfcqc_lnd, sfcqv_lnd, &
355 & qsurf_lnd, gflux_lnd, evap_lnd, hflx_lnd, &
356 & runof, runoff, srunoff, drain, &
357 & cm_lnd, ch_lnd, evbs, evcw, stm, wetness, &
358 & snowfallac_lnd, acsnow_lnd, snowmt_lnd, snohf, &
359 & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, &
360 ! for ice
361 & sfcqc_ice, sfcqv_ice, &
362 & tsurf_ice, tsnow_ice, z0rl_ice, &
363 & qsurf_ice, gflux_ice, evap_ice, ep1d_ice, hflx_ice, &
364 & cm_ice, ch_ice, snowfallac_ice, acsnow_ice, snowmt_ice, &
365 & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, &
366 & add_fire_heat_flux, fire_heat_flux_out, &
367 & frac_grid_burned_out, &
368 ! --- out
369 & rhosnf, sbsno, &
370 & cmm_lnd, chh_lnd, cmm_ice, chh_ice, &
371 !
372 & flag_iter, flag_guess, flag_init, lsm_cold_start, &
373 & flag_cice, frac_grid, errmsg, errflg &
374 & )
375
376 implicit none
377
378! --- input:
379 integer, intent(in) :: me, master
380 integer, intent(in) :: im, nlev, iter, lsoil_ruc, lsoil, kdt, isot, ivegsrc
381 integer, intent(in) :: mosaic_lu, mosaic_soil, isncond_opt, isncovr_opt
382 integer, intent(in) :: nlcat, nscat
383 integer, intent(in) :: lsm_ruc, lsm
384 integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, &
385 imp_physics_nssl
386 real (kind_phys), dimension(:), intent(in) :: xlat_d, xlon_d
387 real (kind_phys), dimension(:), intent(in) :: oro, sigma
388 real (kind_phys), dimension(:), intent(in) :: sfalb_lnd_bck
389 real (kind_phys), dimension(:), intent(in) :: &
390 & t1, sigmaf, dlwflx, dswsfc, tg3, &
391 & coszen, prsl1, wind, shdmin, shdmax, &
392 & snoalb, zf, qc, q1, &
393 ! for land
394 & cm_lnd, ch_lnd, &
395 ! for water
396 & oceanfrac, &
397 ! for ice
398 & cm_ice, ch_ice
399
400 real (kind_phys), intent(in) :: delt, min_seaice, min_lakeice
401 real (kind_phys), intent(in) :: con_cp, con_rv, con_g, &
402 con_pi, con_rd, &
403 con_hvap, con_hfus, &
404 con_fvirt, stbolt, rhoh2o
405
406 logical, dimension(:), intent(in) :: flag_iter, flag_guess
407 logical, dimension(:), intent(in) :: land, icy
408 integer, dimension(:), intent(in) :: use_lake
409 logical, dimension(:), intent(in) :: flag_cice
410 logical, intent(in) :: frac_grid
411 logical, intent(in) :: do_mynnsfclay
412 logical, intent(in) :: use_cdeps_data
413 logical, intent(in) :: exticeden
414
415 logical, intent(in) :: rdlai
416
417! --- in/out:
418 integer, dimension(:), intent(inout) :: stype
419 integer, dimension(:), intent(in) :: vtype
420
421 real (kind_phys), dimension(:,:), intent(in) :: vegtype_frac
422 real (kind_phys), dimension(:,:), intent(in) :: soiltype_frac
423
424 real (kind_phys), dimension(:), intent(in) :: zs
425 real (kind_phys), dimension(:), intent(in) :: srflag
426 real (kind_phys), dimension(:), intent(in), optional :: mask_dat
427 real (kind_phys), dimension(:), intent(inout) :: &
428 & laixy, tsnow_lnd, sfcqv_lnd, sfcqc_lnd, sfcqc_ice, sfcqv_ice,&
429 & tsnow_ice
430 real (kind_phys), dimension(:), intent(inout) :: &
431 & canopy, trans, smcwlt2, smcref2, &
432 ! for land
433 & weasd_lnd, snwdph_lnd, tskin_lnd, &
434 & tsurf_lnd, z0rl_lnd, &
435 ! for ice
436 & weasd_ice, snwdph_ice, tskin_ice, &
437 & tsurf_ice, z0rl_ice, fice
438
439! --- in
440 real (kind_phys), dimension(:), intent(in) :: &
441 & rainnc, rainc, ice, snow, graupel
442 real (kind_phys), dimension(:), intent(in) :: rhonewsn1
443 real (kind_phys), dimension(:), intent(in) :: &
444 fire_heat_flux_out, frac_grid_burned_out
445 logical, intent(in) :: add_fire_heat_flux
446! --- in/out:
447! --- on RUC levels
448 real (kind_phys), dimension(:,:), intent(inout) :: &
449 & smois, tslb, sh2o, keepfr, smfrkeep
450 real (kind_phys), dimension(:,:), intent(inout) :: &
451 & tsice
452
453! --- output:
454 real (kind_phys), dimension(:), intent(inout) :: &
455 & sfalb_lnd, sfalb_ice, wetness, snowfallac_lnd, &
456 & snowfallac_ice, rhosnf
457 real (kind_phys), dimension(:), intent(inout) :: &
458 & runof, drain, runoff, srunoff, evbs, evcw, &
459 & stm, semisbase, semis_lnd, semis_ice, &
460 ! for land
461 & sncovr1_lnd, qsurf_lnd, gflux_lnd, evap_lnd, &
462 & cmm_lnd, chh_lnd, hflx_lnd, sbsno, &
463 & snowmt_lnd, snohf, &
464 ! for ice
465 & sncovr1_ice, qsurf_ice, gflux_ice, evap_ice, ep1d_ice, &
466 & cmm_ice, chh_ice, hflx_ice, &
467 & snowmt_ice
468 real (kind_phys), dimension(:), intent(inout) :: &
469 acsnow_lnd, acsnow_ice
470 real (kind_phys), dimension(:), intent( out) :: &
471 & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd
472 real (kind_phys), dimension(:), intent( out) :: &
473 & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice
474
475 logical, intent(in) :: flag_init, lsm_cold_start
476 character(len=*), intent(out) :: errmsg
477 integer, intent(out) :: errflg
478
479! --- SPP - should be INTENT(IN)
480 integer :: spp_lsm
481 real(kind_phys), dimension(im,nlev) :: pattern_spp
482
483! --- locals:
484 real (kind_phys), dimension(im) :: rho, rhonewsn_ex, &
485 & q0, qs1, albbcksol, srunoff_old, runoff_old, &
486 & tprcp_old, srflag_old, sr_old, canopy_old, wetness_old, &
487 ! for land
488 & weasd_lnd_old, snwdph_lnd_old, tskin_lnd_old, &
489 & tsnow_lnd_old, snowfallac_lnd_old, acsnow_lnd_old, &
490 & sfcqv_lnd_old, sfcqc_lnd_old, z0rl_lnd_old, &
491 & sncovr1_lnd_old,snowmt_lnd_old, &
492 ! for ice
493 & weasd_ice_old, snwdph_ice_old, tskin_ice_old, &
494 & tsnow_ice_old, snowfallac_ice_old, acsnow_ice_old, &
495 & sfcqv_ice_old, sfcqc_ice_old, z0rl_ice_old, &
496 & sncovr1_ice_old,snowmt_ice_old
497
498 !-- local spp pattern array
499 real (kind_phys), dimension(im,lsoil_ruc,1) :: pattern_spp_lsm
500
501 real (kind_phys), dimension(lsoil_ruc) :: et
502
503 real (kind_phys), dimension(im,lsoil_ruc,1) :: smsoil, &
504 slsoil, stsoil, smfrsoil, keepfrsoil, stsice
505 real (kind_phys), dimension(im,lsoil_ruc,1) :: smice, &
506 slice, stice, smfrice, keepfrice
507
508 real (kind_phys), dimension(im,lsoil_ruc) :: smois_old, &
509 & tsice_old, tslb_old, sh2o_old, &
510 & keepfr_old, smfrkeep_old
511
512 real (kind_phys), dimension(im,nlcat,1) :: landusef
513 real (kind_phys), dimension(im,nscat,1) :: soilctop
514
515 real (kind_phys),dimension (im,1,1) :: &
516 & conflx2, sfcprs, sfctmp, q2, qcatm, rho2
517 real (kind_phys),dimension (im,1) :: orog, stdev
518 real (kind_phys),dimension (im,1) :: &
519 & albbck_lnd, alb_lnd, chs_lnd, flhc_lnd, flqc_lnd, &
520 & wet, wet_ice, smmax, cmc, drip, ec, edir, ett, &
521 & dew_lnd, lh_lnd, esnow_lnd, etp, qfx_lnd, acceta, &
522 & ffrozp, lwdn, prcp, xland, xland_wat, xice, xice_lnd, &
523 & graupelncv, snowncv, rainncv, raincv, &
524 & solnet_lnd, sfcexc, &
525 & runoff1, runoff2, acrunoff, semis_bck, &
526 & sfcems_lnd, hfx_lnd, shdfac, shdmin1d, shdmax1d, &
527 & fire_heat_flux1d, &
528 & sneqv_lnd, snoalb1d_lnd, snowh_lnd, snoh_lnd, tsnav_lnd, &
529 & snomlt_lnd, sncovr_lnd, soilw, soilm, ssoil_lnd, &
530 & soilt_lnd, tbot, &
531 & xlai, swdn, z0_lnd, znt_lnd, rhosnfr, infiltr, &
532 & precipfr, snfallac_lnd, acsn_lnd, soilt1_lnd, chklowq, &
533 & qsfc_lnd, qsg_lnd, qvg_lnd, qcg_lnd, smcwlt, smcref
534 ! ice
535 real (kind_phys),dimension (im,1) :: &
536 & albbck_ice, alb_ice, chs_ice, flhc_ice, flqc_ice, &
537 & dew_ice, lh_ice, esnow_ice, qfx_ice, &
538 & solnet_ice, sfcems_ice, hfx_ice, &
539 & sneqv_ice, snoalb1d_ice, snowh_ice, snoh_ice, tsnav_ice, &
540 & snomlt_ice, sncovr_ice, ssoil_ice, soilt_ice, &
541 & z0_ice, znt_ice, snfallac_ice, acsn_ice, &
542 & qsfc_ice, qsg_ice, qvg_ice, qcg_ice, soilt1_ice
543
544
545 real (kind_phys) :: xice_threshold
546 real (kind_phys) :: fwat, qsw, evapw, hfxw
547
548 character(len=256) :: llanduse
551
552 integer :: nsoil, iswater, isice
553 integer, dimension (1:im,1:1) :: stype_wat, vtype_wat
554 integer, dimension (1:im,1:1) :: stype_lnd, vtype_lnd
555 integer, dimension (1:im,1:1) :: stype_ice, vtype_ice
556 integer :: ipr
557
558 ! local
559 integer :: ims,ime, its,ite, jms,jme, jts,jte, kms,kme, kts,kte
560 integer :: l, k, i, j, fractional_seaice, ilst
561 real (kind_phys) :: dm, cimin(im)
562 logical :: flag(im), flag_ice(im), flag_ice_uncoupled(im)
563 logical :: myj, frpcpn
564 logical :: debug_print
565
566 !-- diagnostic point
567 real (kind_phys) :: testptlat, testptlon
568!
569 ! Initialize CCPP error handling variables
570 errmsg = ''
571 errflg = 0
572
573 ipr = 10
574
575 !--
576 testptlat = 68.6_kind_phys
577 testptlon = 298.6_kind_phys
578 !--
579
580 debug_print=.false.
581
582 chklowq = one
583
584 do i = 1, im ! i - horizontal loop
585 flag_ice(i) = .false.
586 if (icy(i) .and. .not. flag_cice(i)) then ! flag_cice(i)=.true. when coupled to CICE
587 ! - uncoupled ice model
588 if (oceanfrac(i) > zero) then
589 cimin(i) = min_seaice
590 else
591 cimin(i) = min_lakeice
592 endif
593 if (fice(i) >= cimin(i)) then
594 ! - ice fraction is above the threshold for ice
595 flag_ice(i) = .true.
596 endif
597 endif
598 ! - Set flag for ice points for uncoupled model (islmsk(i) == 4 when coupled to CICE)
599 ! - Exclude ice on the lakes if the lake model is turned on.
600 flag_ice_uncoupled(i) = (flag_ice(i) .and. use_lake(i)<1)
602 !- 10may19 - ice points are turned off.
603 flag(i) = land(i) .or. flag_ice_uncoupled(i)
604 enddo
605
606 if(debug_print) then
607 write (0,*)'RUC LSM run'
608 write (0,*)'stype=',ipr,stype(ipr)
609 write (0,*)'vtype=',ipr,vtype(ipr)
610 write (0,*)'kdt, iter =',kdt,iter
611 write (0,*)'flag_init =',flag_init
612 write (0,*)'lsm_cold_start =',lsm_cold_start
613 endif
614
615 ims = 1
616 its = 1
617 ime = 1
618 ite = 1
619 jms = 1
620 jts = 1
621 jme = 1
622 jte = 1
623 kms = 1
624 kts = 1
625 kme = 1
626 kte = 1
627
628 ! mosaic_lu=mosaic_soil=0, set in set_soilveg_ruc.F90
629 ! set mosaic_lu=mosaic_soil=1 when fractional land and soil
630 ! categories available
631 ! for now set fractions of differnet landuse and soil types
632 ! in the grid cell to zero
633
634
635 !-- spp
636 spp_lsm = 0 ! so far (10May2021)
637 if(spp_lsm == 0) then
638 pattern_spp(:,:) = 0.0
639 endif
640
642 !if(isot == 1) then
643 !nscat = 19 ! stasgo
644 !else
645 !nscat = 9 ! zobler
646 !endif
648 if(ivegsrc == 1) then
649 llanduse = 'MODI-RUC' ! IGBP
650 iswater = 17
651 isice = glacier
652 else
653 write(errmsg, '(a,i0)') 'Logic error in sfc_drv_ruc_run: iswater/isice not configured for ivegsrc=', ivegsrc
654 errflg = 1
655 return
656 endif
657
658 fractional_seaice = 1
659 if ( fractional_seaice == 0 ) then
660 xice_threshold = 0.5_kind_phys
661 else if ( fractional_seaice == 1 ) then
662 xice_threshold = 0.15_kind_phys ! consistent with GFS physics, 0.02 in HRRR
663 endif
664
665 nsoil = lsoil_ruc
666
667 do i = 1, im ! i - horizontal loop
668 if(.not. land(i)) then
669 !water and sea ice
670 smcref(i,1) = one
671 smcwlt(i,1) = zero
672 xlai(i,1) = zero
673 elseif (kdt == 1) then
674 !land
675 ! reassign smcref2 and smcwlt2 to RUC values at kdt=1
676 smcref(i,1) = refsmc(stype(i))
677 smcwlt(i,1) = wltsmc(stype(i))
678 !-- rdlai is .true. when the LAI data is available in the INPUT/sfc_data.nc on cold-start
679 if(rdlai) then
680 xlai(i,1) = laixy(i)
681 else
682 xlai(i,1) = laitbl(vtype(i))
683 endif
684 else
685 !-- land and kdt > 1, parameters has sub-grid heterogeneity
686 smcref(i,1) = smcref2(i)
687 smcwlt(i,1) = smcwlt2(i)
688 xlai(i,1) = laixy(i)
689 endif
690 enddo
691
692 do i = 1, im ! i - horizontal loop
693 if (flag(i) .and. flag_guess(i)) then
695 wetness_old(i) = wetness(i)
696 canopy_old(i) = canopy(i)
697 ! for land
698 weasd_lnd_old(i) = weasd_lnd(i)
699 snwdph_lnd_old(i) = snwdph_lnd(i)
700 tskin_lnd_old(i) = tskin_lnd(i)
701 tsnow_lnd_old(i) = tsnow_lnd(i)
702 sfcqv_lnd_old(i) = sfcqv_lnd(i)
703 sfcqc_lnd_old(i) = sfcqc_lnd(i)
704 z0rl_lnd_old(i) = z0rl_lnd(i)
705 sncovr1_lnd_old(i) = sncovr1_lnd(i)
706 snowmt_lnd_old(i) = snowmt_lnd(i)
707 acsnow_lnd_old(i) = acsnow_lnd(i)
708 snowfallac_lnd_old(i) = snowfallac_lnd(i)
709 srunoff_old(i) = srunoff(i)
710 runoff_old(i) = runoff(i)
711 ! for ice
712 weasd_ice_old(i) = weasd_ice(i)
713 snwdph_ice_old(i) = snwdph_ice(i)
714 tskin_ice_old(i) = tskin_ice(i)
715 tsnow_ice_old(i) = tsnow_ice(i)
716 sfcqv_ice_old(i) = sfcqv_ice(i)
717 sfcqc_ice_old(i) = sfcqc_ice(i)
718 z0rl_ice_old(i) = z0rl_ice(i)
719 sncovr1_ice_old(i) = sncovr1_ice(i)
720 snowmt_ice_old(i) = snowmt_ice(i)
721 acsnow_ice_old(i) = acsnow_ice(i)
722 snowfallac_ice_old(i) = snowfallac_ice(i)
723
724 do k = 1, lsoil_ruc
725 smois_old(i,k) = smois(i,k)
726 tslb_old(i,k) = tslb(i,k)
727 sh2o_old(i,k) = sh2o(i,k)
728 keepfr_old(i,k) = keepfr(i,k)
729 smfrkeep_old(i,k) = smfrkeep(i,k)
730 ! for ice
731 tsice_old(i,k) = tsice(i,k)
732 enddo
733 endif
734 enddo ! im
735
736! --- ... initialization block
737
738 do j = jms, jme
739 do i = 1, im ! i - horizontal loop
740 if (flag_iter(i) .and. flag(i)) then
741 evap_lnd(i) = zero
742 evap_ice(i) = zero
743 hflx_lnd(i) = zero
744 hflx_ice(i) = zero
745 gflux_lnd(i) = zero
746 gflux_ice(i) = zero
747 drain(i) = zero
748 canopy(i) = max(canopy(i), zero)
749
750 evbs(i) = zero
751 evcw(i) = zero
752 trans(i) = zero
753 sbsno(i) = zero
754
755 !local i,j arrays
756 snoh_lnd(i,j) = zero
757 snoh_ice(i,j) = zero
758 dew_lnd(i,j) = zero
759 dew_ice(i,j) = zero
760 soilm(i,j) = zero
761 smmax(i,j) = zero
762 hfx_lnd(i,j) = zero
763 hfx_ice(i,j) = zero
764 qfx_lnd(i,j) = zero
765 qfx_ice(i,j) = zero
766 lh_lnd(i,j) = zero
767 lh_ice(i,j) = zero
768 esnow_lnd(i,j)= zero
769 esnow_ice(i,j)= zero
770 sfcexc(i,j) = zero
771 acceta(i,j) = zero
772 ssoil_lnd(i,j)= zero
773 ssoil_ice(i,j)= zero
774 infiltr(i,j) = zero
775 precipfr(i,j) = zero
776 rhosnfr(i,j) = -1.e3_kind_phys
777 runoff1(i,j) = zero
778 runoff2(i,j) = zero
779 if(kdt == 1) then
780 acrunoff(i,j) = zero
781 snfallac_lnd(i,j) = zero
782 acsn_lnd(i,j) = zero
783 snfallac_ice(i,j) = zero
784 acsn_ice(i,j) = zero
785 snomlt_lnd(i,j) = zero
786 snomlt_ice(i,j) = zero
787 endif
788 endif
789 enddo ! i=1,im
790 enddo
791
792! --- ... initialize atm. forcing variables
793
794 do i = 1, im
795 if (flag_iter(i) .and. flag(i)) then
796 q0(i) = max(q1(i)/(one-q1(i)), epsln) !* q1=specific humidity at level 1 (kg/kg)
797
798 rho(i) = prsl1(i) / (con_rd*t1(i)*(one+con_fvirt*q0(i)))
799 qs1(i) = rslf(prsl1(i),t1(i)) !* qs1=sat. mixing ratio at level 1 (kg/kg)
800 q0(i) = min(qs1(i), q0(i))
801 endif ! flag_iter & flag
802 enddo ! i
803
814
815 ! Set flag for mixed phase precipitation depending on microphysics scheme.
816 ! For GFDL and Thompson, srflag is fraction of frozen precip for convective+explicit precip.
817 if (imp_physics==imp_physics_gfdl .or. imp_physics==imp_physics_thompson .or. &
818 imp_physics == imp_physics_nssl) then
819 frpcpn = .true.
820 else
821 frpcpn = .false.
822 endif
823
824 do j = jms, jme
825 do i = 1, im ! i - horizontal loop
826 orog(i,j) = oro(i) !topography
827 stdev(i,j) = sigma(i) ! st. deviation (m)
828 do k=1,nlcat
829 landusef(i,k,j) = vegtype_frac(i,k)
830 enddo
831 do k=1,nscat
832 soilctop(i,k,j) = soiltype_frac(i,k)
833 enddo
834 enddo
835 enddo
836
837 do j = jms, jme
838 do i = 1, im ! i - horizontal loop
839 xice(i,j) = zero
840 if (flag_iter(i) .and. flag(i)) then
841
842 if (frpcpn) then
843 ffrozp(i,j) = srflag(i)
844 else
845 ffrozp(i,j) = real(nint(srflag(i)),kind_phys)
846 endif
847
848
849 conflx2(i,1,j) = zf(i) * 2._kind_phys ! factor 2. is needed to get the height of
850 ! atm. forcing inside RUC LSM (inherited
851 ! from WRF)
852
859
860 sfcprs(i,1,j) = prsl1(i)
861 sfctmp(i,1,j) = t1(i)
862 q2(i,1,j) = q0(i)
863 qcatm(i,1,j) = max(zero, qc(i))
864 rho2(i,1,j) = rho(i)
865
866!!\n \a lwdn - lw dw radiation flux at surface (\f$W m^{-2}\f$)
867!!\n \a swdn - sw dw radiation flux at surface (\f$W m^{-2}\f$)
868!!\n \a prcp - time-step total precip (\f$kg m^{-2} \f$)
869!!\n \a raincv - time-step convective precip (\f$kg m^{-2} \f$)
870!!\n \a rainncv - time-step non-convective precip (\f$kg m^{-2} \f$)
871!!\n \a graupelncv - time-step graupel (\f$kg m^{-2} \f$)
872!!\n \a snowncv - time-step snow (\f$kg m^{-2} \f$)
873!!\n \a precipfr - time-step precipitation in solid form (\f$kg m^{-2} \f$)
874!!\n \a shdfac - areal fractional coverage of green vegetation (0.0-100.%)
875!!\n \a shdmin - minimum areal fractional coverage of green vegetation in % -> !shdmin1d
876!!\n \a shdmax - maximum areal fractional coverage of green vegetation in % -> !shdmax1d
877!!\n \a tbot - bottom soil temperature (local yearly-mean sfc air temp)
878
879 lwdn(i,j) = dlwflx(i) !..downward lw flux at sfc in w/m2
880 swdn(i,j) = dswsfc(i) !..downward sw flux at sfc in w/m2
881
882
883 ! all precip input to RUC LSM is in [mm]
884 !prcp(i,j) = rhoh2o * tprcp(i) ! tprcp in [m] - convective plus explicit
885 !raincv(i,j) = rhoh2o * rainc(i) ! total time-step convective precip
886 !rainncv(i,j) = rhoh2o * max(rain(i)-rainc(i),0.0) ! total time-step explicit precip
887 !graupelncv(i,j) = rhoh2o * graupel(i)
888 !snowncv(i,j) = rhoh2o * snow(i)
889 prcp(i,j) = rhoh2o * (rainc(i)+rainnc(i)) ! total time-step convective plus explicit [mm]
890 raincv(i,j) = rhoh2o * rainc(i) ! total time-step convective precip [mm]
891 rainncv(i,j) = rhoh2o * rainnc(i) ! total time-step explicit precip [mm]
892 graupelncv(i,j) = rhoh2o * graupel(i)
893 snowncv(i,j) = rhoh2o * snow(i)
894 rhonewsn_ex(i) = rhonewsn1(i)
895 if (debug_print) then
896 !-- diagnostics for a test point with known lat/lon
897 if (abs(xlat_d(i)-testptlat).lt.0.2 .and. &
898 abs(xlon_d(i)-testptlon).lt.0.2)then
899 !if(weasd_lnd(i) > 0.) &
900 print 100,'(ruc_lsm_drv) i=',i, &
901 ' lat,lon=',xlat_d(i),xlon_d(i), &
902 'rainc',rainc(i),'rainnc',rainnc(i), &
903 'graupel',graupel(i),'qc',qc(i),'sfcqv_lnd',sfcqv_lnd(i),&
904 'dlwflx',dlwflx(i),'dswsfc',dswsfc(i), &
905 'sncovr1_lnd',sncovr1_lnd(i),'sfalb_lnd_bck',sfalb_lnd_bck(i),&
906 'prsl1',prsl1(i),'t1',t1(i), &
907 'srflag',srflag(i),'weasd mm ',weasd_lnd(i), &
908 'tsnow_lnd',tsnow_lnd(i),'snwdph mm',snwdph_lnd(i), &
909 'tsurf_lnd',tsurf_lnd(i),'tslb(i,1)',tslb(i,1)
910 endif
911 endif
912 100 format (";;; ",a,i4,a,2f14.7/(4(a10,'='es9.2)))
913 !--
914
915 tbot(i,j) = tg3(i)
916
923
924 if(ivegsrc == 1) then ! IGBP - MODIS
925 vtype_wat(i,j) = 17 ! 17 - water (oceans and lakes) in MODIS
926 stype_wat(i,j) = 14
927 xland_wat(i,j) = 2. ! xland = 2 for water
928 vtype_lnd(i,j) = vtype(i)
929 stype_lnd(i,j) = stype(i)
930 vtype_ice(i,j) = 15 ! MODIS
931 if(isot == 0) then
932 stype_ice(i,j) = 9 ! ZOBLER
933 else
934 stype_ice(i,j) = 16 ! STASGO
935 endif
937 ! SLMSK0 - SEA(0),LAND(1),ICE(2) MASK
938
939 if(land(i)) then ! some land
940 xland(i,j) = one
941 xice_lnd(i,j) = zero
942 elseif(flag_ice_uncoupled(i)) then ! some ice
943 xland(i,j) = one
944 xice(i,j) = fice(i) ! fraction of sea-ice
945 endif
946 else
947 write (0,*)'MODIS landuse is not available'
948 endif
949
950 semis_bck(i,j) = semisbase(i)
951 ! --- units %
952 shdfac(i,j) = sigmaf(i)*100._kind_phys
953 shdmin1d(i,j) = shdmin(i)*100._kind_phys
954 shdmax1d(i,j) = shdmax(i)*100._kind_phys
955 fire_heat_flux1d(i,j) = fire_heat_flux_out(i) ! JLS
956
957 if (land(i)) then ! at least some land in the grid cell
958
979
980 qvg_lnd(i,j) = sfcqv_lnd(i)
981 qsfc_lnd(i,j) = sfcqv_lnd(i)/(1.+sfcqv_lnd(i))
982 qsg_lnd(i,j) = rslf(prsl1(i),tsurf_lnd(i))
983 qcg_lnd(i,j) = sfcqc_lnd(i)
984 sncovr_lnd(i,j) = sncovr1_lnd(i)
985 if (kdt == 1) then
986 sfcems_lnd(i,j) = semisbase(i) * (one-sncovr_lnd(i,j)) + 0.99_kind_phys * sncovr_lnd(i,j)
987 else
988 sfcems_lnd(i,j) = semis_lnd(i)
989 endif
990
991 if(coszen(i) > zero .and. weasd_lnd(i) < 1.e-4_kind_phys) then
992 !-- solar zenith angle dependence when no snow
993 ilst=istwe(vtype(i)) ! 1 or 2
994 dm = (one+2._kind_phys*d(ilst))/(one+2._kind_phys*d(ilst)*coszen(i))
995 albbcksol(i) = sfalb_lnd_bck(i)*dm
996 else
997 albbcksol(i) = sfalb_lnd_bck(i)
998 endif ! coszen > 0.
999
1000 snoalb1d_lnd(i,j) = snoalb(i)
1001 albbck_lnd(i,j) = min(0.9_kind_phys,albbcksol(i)) !sfalb_lnd_bck(i)
1002
1003 !-- spp_lsm
1004 if (spp_lsm == 1) then
1005 !-- spp for LSM is dimentioned as (1:lsoil_ruc)
1006 do k = 1, lsoil_ruc
1007 pattern_spp_lsm(i,k,j) = pattern_spp(i,k)
1008 enddo
1009 !-- stochastic perturbation of snow-free albedo, emissivity and veg.
1010 !-- fraction
1011 albbck_lnd(i,j) = min(albbck_lnd(i,j) * (one + 0.4_kind_phys*pattern_spp_lsm(i,1,j)), one)
1012 sfcems_lnd(i,j) = min(sfcems_lnd(i,j) * (one + 0.1_kind_phys*pattern_spp_lsm(i,1,j)), one)
1013 shdfac(i,j) = min(0.01_kind_phys*shdfac(i,j) * (one + 0.33_kind_phys*pattern_spp_lsm(i,1,j)),one)*100._kind_phys
1014 if (kdt == 2) then
1015 !-- stochastic perturbation of soil moisture at time step 2
1016 do k = 1, lsoil_ruc
1017 smois(i,k) = smois(i,k)*(one+1.5_kind_phys*pattern_spp_lsm(i,k,j))
1018 enddo
1019 endif
1020 endif
1021
1022 alb_lnd(i,j) = albbck_lnd(i,j) * (one-sncovr_lnd(i,j)) + snoalb(i) * sncovr_lnd(i,j) ! sfalb_lnd(i)
1023 solnet_lnd(i,j) = dswsfc(i)*(one-alb_lnd(i,j)) !..net sw rad flx (dn-up) at sfc in w/m2
1024
1025 IF ( add_fire_heat_flux .and. fire_heat_flux_out(i) > 0) then ! JLS
1026 if (debug_print) then
1027 print *,'alb_lnd before fire, xlat/xlon ', alb_lnd(i,j), xlat_d(i),xlon_d(i)
1028 print *,'fire_heat_flux_out, frac_grid_burned_out, xlat/xlon ', &
1029 fire_heat_flux_out(i),frac_grid_burned_out(i),xlat_d(i),xlon_d(i)
1030 endif
1031 ! limit albedo in the areas affected by the fire
1032 alb_lnd(i,j) = alb_lnd(i,j) * (one-frac_grid_burned_out(i)) + 0.08_kind_phys*frac_grid_burned_out(i)
1033 if (debug_print) then
1034 print *,'alb_lnd after fire, xlat/xlon ', alb_lnd(i,j), xlat_d(i),xlon_d(i)
1035 endif
1036 ENDIF
1037
1038 cmc(i,j) = canopy(i) ! [mm]
1039 soilt_lnd(i,j) = tsurf_lnd(i)
1040 ! sanity check for snow temperature tsnow
1041 if (tsnow_lnd(i) > 200._kind_phys .and. tsnow_lnd(i) < con_t0c) then
1042 soilt1_lnd(i,j) = tsnow_lnd(i)
1043 else
1044 soilt1_lnd(i,j) = tsurf_lnd(i)
1045 endif
1046 tsnav_lnd(i,j) = min(zero,0.5_kind_phys*(soilt_lnd(i,j) + soilt1_lnd(i,j)) - con_t0c)
1047 do k = 1, lsoil_ruc
1048 smsoil(i,k,j) = smois(i,k)
1049 slsoil(i,k,j) = sh2o(i,k)
1050 stsoil(i,k,j) = tslb(i,k)
1051 smfrsoil(i,k,j) = smfrkeep(i,k)
1052 keepfrsoil(i,k,j) = keepfr(i,k)
1053 enddo
1054 ! land
1055 if (wetness(i) > zero) then
1056 wet(i,j) = wetness(i)
1057 else
1058 wet(i,j) = max(0.0001_kind_phys,smsoil(i,1,j)/0.3_kind_phys)
1059 endif
1060
1061 chs_lnd(i,j) = ch_lnd(i) * wind(i) ! compute conductance
1062 flhc_lnd(i,j) = chs_lnd(i,j) * rho(i) * con_cp * (one+0.84_kind_phys*q2(i,1,j))
1063 flqc_lnd(i,j) = chs_lnd(i,j) * rho(i) * wet(i,j)
1064
1065 ! for output
1066 cmm_lnd(i) = cm_lnd(i) * wind(i)
1067 chh_lnd(i) = chs_lnd(i,j) * rho(i)
1068 !
1069 sneqv_lnd(i,j) = weasd_lnd(i)
1070 snowh_lnd(i,j) = snwdph_lnd(i) * 0.001_kind_phys ! convert from mm to m
1071
1072 if(kdt > 1) then
1073 !-- run-total accumulation
1074 snfallac_lnd(i,j) = snowfallac_lnd(i)
1075 acsn_lnd(i,j) = acsnow_lnd(i)
1076 snomlt_lnd(i,j) = snowmt_lnd(i)
1077 endif
1078
1080 if (sneqv_lnd(i,j) /= zero .and. snowh_lnd(i,j) == zero) then
1081 if (debug_print) print *,'bad sneqv_lnd',kdt,i,j,sneqv_lnd(i,j),snowh_lnd(i,j),xlat_d(i),xlon_d(i)
1082 if(sneqv_lnd(i,j) < epsln.or.soilt_lnd(i,j)>con_t0c) then
1083 sneqv_lnd(i,j) = zero
1084 snowh_lnd(i,j) = zero
1085 else
1086 sneqv_lnd(i,j) = 300._kind_phys * snowh_lnd(i,j) ! snow density ~300 kg m-3
1087 endif
1088 if (debug_print) print *,'fixed sneqv_lnd',kdt,i,j,sneqv_lnd(i,j),snowh_lnd(i,j)
1089 elseif (snowh_lnd(i,j) /= zero .and. sneqv_lnd(i,j) == zero) then
1090 if (debug_print) print *,'bad snowh_lnd',kdt,i,j,sneqv_lnd(i,j),snowh_lnd(i,j),xlat_d(i),xlon_d(i)
1091 if(snowh_lnd(i,j) < 3.e-10_kind_dbl_prec.or.soilt_lnd(i,j)>con_t0c) then
1092 snowh_lnd(i,j) = zero
1093 sneqv_lnd(i,j) = zero
1094 else
1095 snowh_lnd(i,j) = 0.003_kind_dbl_prec * sneqv_lnd(i,j) ! snow density ~300 kg m-3
1096 endif
1097 if (debug_print) print *,'fixed snowh_lnd',kdt,i,j,sneqv_lnd(i,j),snowh_lnd(i,j)
1098 elseif (sneqv_lnd(i,j) > zero .and. snowh_lnd(i,j) > zero) then
1099 if (debug_print .and. abs(xlat_d(i)-testptlat).lt.0.5 .and. &
1100 abs(xlon_d(i)-testptlon).lt.0.5)then
1101 print *,'sneqv_lnd(i,j)/snowh_lnd(i,j)',kdt,i,j,sneqv_lnd(i,j)/snowh_lnd(i,j),sneqv_lnd(i,j),snowh_lnd(i,j)
1102 endif
1103 if(sneqv_lnd(i,j)/snowh_lnd(i,j) > 500._kind_phys) then
1104 if (debug_print .and. abs(xlat_d(i)-testptlat).lt.0.5 .and. &
1105 abs(xlon_d(i)-testptlon).lt.0.5)then
1106 print *,'large snow density',kdt,i,j,sneqv_lnd(i,j)/snowh_lnd(i,j),sneqv_lnd(i,j),snowh_lnd(i,j)
1107 print *,'large snow density lat/lon',kdt,i,j,xlat_d(i),xlon_d(i)
1108 endif
1109 if(soilt_lnd(i,j)>con_t0c) then
1110 snowh_lnd(i,j) = zero
1111 sneqv_lnd(i,j) = zero
1112 else
1113 snowh_lnd(i,j) = 0.002_kind_dbl_prec * sneqv_lnd(i,j)
1114 endif
1115 if (debug_print .and. abs(xlat_d(i)-testptlat).lt.0.5 .and. &
1116 abs(xlon_d(i)-testptlon).lt.0.5)then
1117 print *,'fixed large snow density',kdt,i,j,sneqv_lnd(i,j)/snowh_lnd(i,j),sneqv_lnd(i,j),snowh_lnd(i,j)
1118 endif
1119 elseif(sneqv_lnd(i,j)/snowh_lnd(i,j) < 58._kind_phys) then
1120 if (debug_print .and. abs(xlat_d(i)-testptlat).lt.0.5 .and. &
1121 abs(xlon_d(i)-testptlon).lt.0.5)then
1122 print *,'small snow density',kdt,i,j,sneqv_lnd(i,j)/snowh_lnd(i,j),sneqv_lnd(i,j),snowh_lnd(i,j)
1123 print *,'small snow density lat/lon',kdt,i,j,xlat_d(i),xlon_d(i)
1124 endif
1125 if(soilt_lnd(i,j)>con_t0c) then
1126 snowh_lnd(i,j) = zero
1127 sneqv_lnd(i,j) = zero
1128 else
1129 sneqv_lnd(i,j) = 58._kind_phys * snowh_lnd(i,j)
1130 endif
1131 if (debug_print .and. abs(xlat_d(i)-testptlat).lt.0.5 .and. &
1132 abs(xlon_d(i)-testptlon).lt.0.5)then
1133 print *,'fixed small snow density',kdt,i,j,sneqv_lnd(i,j)/snowh_lnd(i,j),sneqv_lnd(i,j),snowh_lnd(i,j)
1134 endif
1135 endif
1136 endif
1137
1138 !-- z0rl is in [cm]
1139 z0_lnd(i,j) = z0rl_lnd(i)/100._kind_phys
1140 znt_lnd(i,j) = z0rl_lnd(i)/100._kind_phys
1141
1142 ! Workaround needed for subnormal numbers. This should be
1143 ! done after all other sanity checks, in case a sanity check
1144 ! results in subnormal numbers.
1145 !
1146 ! This bug was caught by the UFS gfortran debug-mode
1147 ! regression tests, and the fix is necessary to pass those
1148 ! tests.
1149 if(abs(snowh_lnd(i,j))<1e-20_kind_phys) then
1150 snowh_lnd(i,j)=zero
1151 endif
1152 if(abs(sneqv_lnd(i,j))<1e-20_kind_phys) then
1153 sneqv_lnd(i,j)=zero
1154 endif
1155
1156 if (debug_print) then
1157 !-- diagnostics for a land test point with known lat/lon
1158 !if (kdt < 10) then
1159 if (abs(xlat_d(i)-testptlat).lt.0.5 .and. &
1160 abs(xlon_d(i)-testptlon).lt.0.5)then
1161 !if(weasd_lnd(i) > 0.) &
1162 print 100,'(ruc_lsm_drv before RUC land call) i=',i, &
1163 ' lat,lon=',xlat_d(i),xlon_d(i), &
1164 'rainc',rainc(i),'rainnc',rainnc(i),'prcp',prcp(i,j), &
1165 'graupel',graupel(i),'qc',qc(i),'sfcqv_lnd',sfcqv_lnd(i), &
1166 'dlwflx',dlwflx(i),'dswsfc',dswsfc(i), &
1167 'sncovr1_lnd',sncovr1_lnd(i),'sfalb_lnd_bck',sfalb_lnd_bck(i),&
1168 'albbcksol',albbcksol(i),'alb_lnd',alb_lnd(i,j), &
1169 'solnet_lnd',solnet_lnd(i,j),'t1',t1(i), &
1170 'sfcems_lnd',sfcems_lnd(i,j),'flhc_lnd',flhc_lnd(i,j), &
1171 'flqc_lnd',flqc_lnd(i,j),'wet',wet(i,j),'cmc',cmc(i,j), &
1172 'qcg_lnd',qcg_lnd(i,j),'dew',dew_lnd(i,j), &
1173 'znt_lnd',znt_lnd(i,j),'shdfac',shdfac(i,j), &
1174 'srflag',srflag(i),'weasd_lnd',weasd_lnd(i), &
1175 'smsoil1',smsoil(i,1,j),'slsoil',slsoil(i,1,j), &
1176 'keepfrsoil',keepfrsoil(i,1,j), &
1177 'tsurf_lnd',tsurf_lnd(i),'tslb(i,1)',tslb(i,1)
1178 endif
1179 endif ! debug_print
1180 !--
1181
1183 call lsmruc(xlat_d(i),xlon_d(i), &
1184 & delt, flag_init, lsm_cold_start, kdt, iter, nsoil, &
1185 & graupelncv(i,j), snowncv(i,j), rainncv(i,j), raincv(i,j), &
1186 & zs, prcp(i,j), sneqv_lnd(i,j), snowh_lnd(i,j), &
1187 & sncovr_lnd(i,j), &
1188 & ffrozp(i,j), frpcpn, &
1189 & rhosnfr(i,j), precipfr(i,j), exticeden, &
1190! --- inputs:
1191 & orog(i,j), stdev(i,j), &
1192 & conflx2(i,1,j), sfcprs(i,1,j), sfctmp(i,1,j), q2(i,1,j), &
1193 & qcatm(i,1,j), rho2(i,1,j), semis_bck(i,j), lwdn(i,j), &
1194 & swdn(i,j), solnet_lnd(i,j), sfcems_lnd(i,j), chklowq(i,j), &
1195 & chs_lnd(i,j), flqc_lnd(i,j), flhc_lnd(i,j), rhonewsn_ex(i), &
1196! --- snow model options
1197 & mosaic_lu, mosaic_soil, isncond_opt, isncovr_opt, &
1198! --- input/outputs:
1199 & wet(i,j), cmc(i,j), shdfac(i,j), alb_lnd(i,j), znt_lnd(i,j), &
1200 & z0_lnd(i,j), snoalb1d_lnd(i,j), albbck_lnd(i,j), &
1201 & xlai(i,j), landusef(i,:,j), nlcat, &
1202 & soilctop(i,:,j), nscat, smcwlt(i,j), smcref(i,j), &
1203 & qsfc_lnd(i,j), qsg_lnd(i,j), qvg_lnd(i,j), qcg_lnd(i,j), &
1204 & dew_lnd(i,j), soilt1_lnd(i,j), &
1205 & tsnav_lnd(i,j), tbot(i,j), vtype_lnd(i,j), stype_lnd(i,j), &
1206 & xland(i,j), iswater, isice, xice_lnd(i,j), xice_threshold, & ! xice=0. for the land portion of grid area
1207! --- constants
1208 & con_cp, con_rv, con_rd, con_g, con_pi, con_hvap, stbolt, &
1209! --- input/outputs:
1210 & smsoil(i,:,j), slsoil(i,:,j), soilm(i,j), smmax(i,j), &
1211 & stsoil(i,:,j), soilt_lnd(i,j), &
1212 & edir(i,j), ec(i,j), ett(i,j), esnow_lnd(i,j), snoh_lnd(i,j), &
1213 & hfx_lnd(i,j), qfx_lnd(i,j), lh_lnd(i,j), &
1214 & infiltr(i,j), runoff1(i,j), runoff2(i,j), acrunoff(i,j), &
1215 & sfcexc(i,j), acceta(i,j), ssoil_lnd(i,j), &
1216 & snfallac_lnd(i,j), acsn_lnd(i,j), snomlt_lnd(i,j), &
1217 & smfrsoil(i,:,j),keepfrsoil(i,:,j), &
1218 & add_fire_heat_flux,fire_heat_flux1d(i,j), .false., &
1219 & shdmin1d(i,j), shdmax1d(i,j), rdlai, &
1220 & ims,ime, jms,jme, kms,kme, &
1221 & its,ite, jts,jte, kts,kte, errmsg, errflg )
1222 if(debug_print) then
1223 if (abs(xlat_d(i)-testptlat).lt.0.5 .and. &
1224 abs(xlon_d(i)-testptlon).lt.0.5)then
1225 print 100,'(ruc_lsm_drv after RUC land call) i=',i, &
1226 ' lat,lon=',xlat_d(i),xlon_d(i), &
1227 'sneqv(i,j) =',sneqv_lnd(i,j), &
1228 'snowh(i,j) =',snowh_lnd(i,j), &
1229 'sncovr(i,j) =',sncovr_lnd(i,j), &
1230 'vtype(i,j) =',vtype_lnd(i,j), &
1231 'stype(i,j) =',stype_lnd(i,j), &
1232 'wet(i,j) =',wet(i,j), &
1233 'cmc(i,j) =',cmc(i,j), &
1234 'qsfc(i,j) =',qsfc_lnd(i,j), &
1235 'qvg(i,j) =',qvg_lnd(i,j), &
1236 'qsg(i,j) =',qsg_lnd(i,j), &
1237 'qcg(i,j) =',qcg_lnd(i,j), &
1238 'dew(i,j) =',dew_lnd(i,j), &
1239 'soilt(i,j) =',soilt_lnd(i,j), &
1240 'tskin(i) =',tskin_lnd(i), &
1241 'soilt1(i,j) =',soilt1_lnd(i,j), &
1242 'tsnav(i,j) =',tsnav_lnd(i,j), &
1243 'smsoil(i,:,j)=',smsoil(i,:,j), &
1244 'slsoil(i,:,j)=',slsoil(i,:,j), &
1245 'stsoil(i,:,j)=',stsoil(i,:,j), &
1246 'smfrsoil(i,:,j)=',smfrsoil(i,:,j), &
1247 'keepfrsoil(i,:,j)=',keepfrsoil(i,:,j), &
1248 'soilm(i,j) =',soilm(i,j), &
1249 'smmax(i,j) =',smmax(i,j), &
1250 'hfx(i,j) =',hfx_lnd(i,j), &
1251 'lh(i,j) =',lh_lnd(i,j), &
1252 'infiltr(i,j) =',infiltr(i,j), &
1253 'runoff1(i,j) =',runoff1(i,j), &
1254 'runoff2(i,j) =',runoff2(i,j), &
1255 'ssoil(i,j) =',ssoil_lnd(i,j), &
1256 'snfallac(i,j) =',snfallac_lnd(i,j), &
1257 'acsn_lnd(i,j) =',acsn_lnd(i,j), &
1258 'snomlt(i,j) =',snomlt_lnd(i,j),'xlai(i,j) =',xlai(i,j)
1259 endif
1260 endif
1261
1262
1271!
1272! --- ... units [m/s] = [g m-2 s-1]
1273! evcw (W m-2) - canopy water evaporation flux
1274! evbs (W m-2) - direct soil evaporation flux
1275! trans (W m-2) - total plant transpiration
1276! edir, ec, ett - direct evaporation, evaporation of
1277! canopy water and transpiration (kg m-2 s-1)
1278! et(nsoil)-plant transpiration from a particular root layer (m s-1)
1279! esnow - sublimation from (or deposition to if <0) snowpack (kg m-2 s-1)
1280! sbsno - sublimation from (or deposition to if <0) snowpack (W m-2)
1281! hfx - upward heat flux at the surface (W/m^2)
1282! qfx - upward moisture flux at the surface (kg kg-1 kg m-2 s-1)
1283! drip - through-fall of precip and/or dew in excess of canopy
1284! water-holding capacity (m)
1285! snomlt - snow melt (kg m-2) (water equivalent)
1286! xlai - leaf area index (dimensionless)
1287! soilw - available soil moisture in root zone (unitless fraction
1288! between smcwlt and smcmax)
1289! soilm - total soil column moisture content (frozen+unfrozen) (m)
1290! nroot - number of root layers, a function of veg type, determined
1291! in subroutine redprm.
1292
1293 evbs(i) = edir(i,j) * rhoh2o * con_hvap
1294 evcw(i) = ec(i,j) * rhoh2o * con_hvap
1295 trans(i) = ett(i,j) * rhoh2o * con_hvap
1296 sbsno(i) = esnow_lnd(i,j) * con_hfus
1297 snohf(i) = snoh_lnd(i,j)
1298
1299 ! Interstitial
1300 evap_lnd(i) = qfx_lnd(i,j) / rho(i) ! kg kg-1 m s-1 kinematic
1301 hflx_lnd(i) = hfx_lnd(i,j) / (con_cp*rho(i)) ! K m s-1 kinematic
1302 gflux_lnd(i) = ssoil_lnd(i,j)
1303 qsurf_lnd(i) = qsfc_lnd(i,j)
1304 tsurf_lnd(i) = soilt_lnd(i,j)
1305 tsnow_lnd(i) = soilt1_lnd(i,j)
1306 stm(i) = soilm(i,j) * 1.e-3_kind_phys ! convert to [m]
1307
1308 runof(i) = runoff1(i,j) * rhoh2o ! surface kg m-2 s-1
1309 drain(i) = runoff2(i,j) * rhoh2o ! kg m-2 s-1
1310
1311 wetness(i) = wet(i,j)
1312 sfcqv_lnd(i) = qvg_lnd(i,j)
1313 sfcqc_lnd(i) = qcg_lnd(i,j)
1314
1315 rhosnf(i) = rhosnfr(i,j) ! kg m-3
1316 acsnow_lnd(i) = acsn_lnd(i,j) ! accum kg m-2
1317 snowmt_lnd(i) = snomlt_lnd(i,j) ! accum kg m-2
1318
1319 ! --- ... accumulated total runoff and surface runoff
1320 runoff(i) = runoff(i) + (drain(i)+runof(i)) * delt ! accum total kg m-2
1321 srunoff(i) = srunoff(i) + runof(i) * delt ! accum surface kg m-2
1322
1323 ! --- ... accumulated frozen precipitation (accumulation in lsmruc)
1324 snowfallac_lnd(i) = snfallac_lnd(i,j) ! accum kg m-2
1325 ! --- ... unit conversion (from m to mm)
1326 snwdph_lnd(i) = snowh_lnd(i,j) * rhoh2o
1327
1328 laixy(i) = xlai(i,j)
1329 smcwlt2(i) = smcwlt(i,j)
1330 smcref2(i) = smcref(i,j)
1331
1332 canopy(i) = cmc(i,j) ! mm
1333 weasd_lnd(i) = sneqv_lnd(i,j) ! mm
1334 sncovr1_lnd(i) = sncovr_lnd(i,j)
1335 ! ---- ... outside RUC LSM, roughness uses cm as unit
1336 ! (update after snow's effect)
1337 z0rl_lnd(i) = znt_lnd(i,j)*100._kind_phys
1338 !-- semis_lnd is with snow effect
1339 semis_lnd(i) = sfcems_lnd(i,j)
1340 !-- semisbas is without snow effect, but can have vegetation mosaic effect
1341 semisbase(i) = semis_bck(i,j)
1342 !-- sfalb_lnd has snow effect
1343 sfalb_lnd(i) = alb_lnd(i,j)
1344 !-- fill in albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd,
1345 albdvis_lnd(i) = sfalb_lnd(i)
1346 albdnir_lnd(i) = sfalb_lnd(i)
1347 albivis_lnd(i) = sfalb_lnd(i)
1348 albinir_lnd(i) = sfalb_lnd(i)
1349
1350 do k = 1, lsoil_ruc
1351 smois(i,k) = smsoil(i,k,j)
1352 sh2o(i,k) = slsoil(i,k,j)
1353 tslb(i,k) = stsoil(i,k,j)
1354 keepfr(i,k) = keepfrsoil(i,k,j)
1355 smfrkeep(i,k) = smfrsoil(i,k,j)
1356 enddo
1357 if(debug_print) then
1358 write (0,*)'LAND -i,j,stype_lnd,vtype_lnd',i,j,stype_lnd(i,j),vtype_lnd(i,j)
1359 write (0,*)'i,j,tsurf_lnd(i)',i,j,tsurf_lnd(i)
1360 write (0,*)'kdt,iter,stsoil(i,:,j)',kdt,iter,stsoil(i,:,j)
1361 write (0,*)'laixy(i)',laixy(i)
1362 endif
1363 endif ! end of land
1364
1365 if (flag_ice_uncoupled(i)) then ! at least some ice in the grid cell
1366 !-- ice point
1367
1368 if (debug_print) then
1369 if (abs(xlat_d(i)-testptlat).lt.0.1 .and. &
1370 abs(xlon_d(i)-testptlon).lt.0.1)then
1371 !if(weasd_ice(i) > 0.) &
1372 print 101,'(ruc_lsm_drv_ice) i=',i, &
1373 ' lat,lon=',xlat_d(i),xlon_d(i), &
1374 'sfcqv_ice',sfcqv_ice(i), &
1375 'sncovr1_ice',sncovr1_ice(i),'sfalb_ice',sfalb_ice(i),&
1376 'sfcqc_ice',sfcqc_ice(i),'tsnow_ice',tsnow_ice(i), &
1377 'prsl1',prsl1(i),'t1',t1(i),'snwdph_ice ',snwdph_ice(i), &
1378 'srflag',srflag(i),'weasd_ice',weasd_ice(i), &
1379 'tsurf_ice',tsurf_ice(i),'tslb(i,1)',tslb(i,1)
1380 endif
1381 endif
1382 101 format (";;; ",a,i4,a,2f14.7/(4(a10,'='es9.2)))
1383
1384 edir(i,j) = zero
1385 ec(i,j) = zero
1386 ett(i,j) = zero
1387
1388 sncovr_ice(i,j) = sncovr1_ice(i)
1389 !-- alb_ice* is computed in setalb called from rrtmg_sw_pre.
1390 snoalb1d_ice(i,j) = 0.75_kind_phys !alb_ice_snow(i) !0.75 is RAP value for max snow alb on ice
1391 albbck_ice(i,j) = 0.55_kind_phys !alb_ice_snowfree(i) !0.55 is RAP value for ice alb
1392 alb_ice(i,j) = sfalb_ice(i)
1393 solnet_ice(i,j) = dswsfc(i)*(one-alb_ice(i,j))
1394 qvg_ice(i,j) = sfcqv_ice(i)
1395 qsfc_ice(i,j) = sfcqv_ice(i)/(one+sfcqv_ice(i))
1396 qsg_ice(i,j) = rslf(prsl1(i),tsurf_ice(i))
1397 qcg_ice(i,j) = sfcqc_ice(i)
1398 semis_bck(i,j) = 0.99_kind_phys
1399 if (kdt == 1) then
1400 sfcems_ice(i,j) = semisbase(i) * (one-sncovr_ice(i,j)) + 0.99_kind_phys * sncovr_ice(i,j)
1401 else
1402 sfcems_ice(i,j) = semis_ice(i)
1403 endif
1404 cmc(i,j) = canopy(i) ! [mm]
1405 soilt_ice(i,j) = tsurf_ice(i)
1406 if (tsnow_ice(i) > 150._kind_phys .and. tsnow_ice(i) < con_t0c) then
1407 soilt1_ice(i,j) = tsnow_ice(i)
1408 else
1409 soilt1_ice(i,j) = tsurf_ice(i)
1410 endif
1411 tsnav_ice(i,j) = min(zero,0.5_kind_phys*(soilt_ice(i,j) + soilt1_ice(i,j)) - con_t0c)
1412 do k = 1, lsoil_ruc
1413 stsice(i,k,j) = tsice(i,k)
1414 smice(i,k,j) = one
1415 slice(i,k,j) = zero
1416 smfrice(i,k,j) = one
1417 keepfrice(i,k,j) = one
1418 enddo
1419
1420 wet_ice(i,j) = one
1421
1422 chs_ice(i,j) = ch_ice(i) * wind(i) ! compute conductance
1423 flhc_ice(i,j) = chs_ice(i,j) * rho(i) * con_cp * (one + 0.84_kind_phys*q2(i,1,j))
1424 flqc_ice(i,j) = chs_ice(i,j) * rho(i) * wet_ice(i,j)
1425
1426 ! for output
1427 cmm_ice(i) = cm_ice(i) * wind(i)
1428 chh_ice(i) = chs_ice(i,j) * rho(i)
1429
1430
1431 snowh_ice(i,j) = snwdph_ice(i) * 0.001_kind_phys ! convert from mm to m
1432 sneqv_ice(i,j) = weasd_ice(i) ! [mm]
1433 if(kdt > 1) then
1434 snfallac_ice(i,j) = snowfallac_ice(i)
1435 acsn_ice(i,j) = acsnow_ice(i)
1436 snomlt_ice(i,j) = snowmt_ice(i)
1437 endif
1438
1440 if (sneqv_ice(i,j) /= zero .and. snowh_ice(i,j) == zero) then
1441 snowh_ice(i,j) = 0.003_kind_phys * sneqv_ice(i,j) ! snow density ~300 kg m-3
1442 endif
1443
1444 if (snowh_ice(i,j) /= zero .and. sneqv_ice(i,j) == zero) then
1445 sneqv_ice(i,j) = 300._kind_phys * snowh_ice(i,j) ! snow density ~300 kg m-3
1446 endif
1447
1448 if (sneqv_ice(i,j) > zero .and. snowh_ice(i,j) > zero) then
1449 if(sneqv_ice(i,j)/snowh_ice(i,j) > 950._kind_phys) then
1450 sneqv_ice(i,j) = 300._kind_phys * snowh_ice(i,j)
1451 endif
1452 endif
1453
1454 z0_ice(i,j) = z0rl_ice(i)/100._kind_phys
1455 znt_ice(i,j) = z0rl_ice(i)/100._kind_phys
1456
1457 runoff1(i,j) = zero
1458 runoff2(i,j) = zero
1459
1460 ! Workaround needed for subnormal numbers. This should be
1461 ! done after all other sanity checks, in case a sanity check
1462 ! results in subnormal numbers.
1463 !
1464 ! Although this bug has not been triggered yet, it is expected
1465 ! to be, like the _lnd variants many lines up from here.
1466 if(abs(snowh_ice(i,j))<1e-20_kind_phys) then
1467 snowh_ice(i,j)=zero
1468 endif
1469 if(abs(sneqv_ice(i,j))<1e-20_kind_phys) then
1470 sneqv_ice(i,j)=zero
1471 endif
1472
1474 call lsmruc(xlat_d(i),xlon_d(i), &
1475 & delt, flag_init, lsm_cold_start, kdt, iter, nsoil, &
1476 & graupelncv(i,j), snowncv(i,j), rainncv(i,j), raincv(i,j), &
1477 & zs, prcp(i,j), sneqv_ice(i,j), snowh_ice(i,j), &
1478 & sncovr_ice(i,j), &
1479 & ffrozp(i,j), frpcpn, &
1480 & rhosnfr(i,j), precipfr(i,j), exticeden, &
1481! --- inputs:
1482 & orog(i,j), stdev(i,j), &
1483 & conflx2(i,1,j), sfcprs(i,1,j), sfctmp(i,1,j), q2(i,1,j), &
1484 & qcatm(i,1,j), rho2(i,1,j), semis_bck(i,j), lwdn(i,j), &
1485 & swdn(i,j), solnet_ice(i,j), sfcems_ice(i,j), chklowq(i,j), &
1486 & chs_ice(i,j), flqc_ice(i,j), flhc_ice(i,j), rhonewsn_ex(i), &
1487! --- snow model options
1488 & mosaic_lu, mosaic_soil, isncond_opt, isncovr_opt, &
1489! --- input/outputs:
1490 & wet_ice(i,j), cmc(i,j), shdfac(i,j), alb_ice(i,j), &
1491 & znt_ice(i,j), z0_ice(i,j), snoalb1d_ice(i,j), &
1492 & albbck_ice(i,j), xlai(i,j),landusef(i,:,j), nlcat, &
1493 & soilctop(i,:,j), nscat, smcwlt(i,j), smcref(i,j), &
1494 & qsfc_ice(i,j), qsg_ice(i,j), qvg_ice(i,j), qcg_ice(i,j), &
1495 & dew_ice(i,j), soilt1_ice(i,j), &
1496 & tsnav_ice(i,j), tbot(i,j), vtype_ice(i,j), stype_ice(i,j), &
1497 & xland(i,j), iswater, isice, xice(i,j), xice_threshold, &
1498! --- constants
1499 & con_cp, con_rv, con_rd, con_g, con_pi, con_hvap, stbolt, &
1500! --- input/outputs:
1501 & smice(i,:,j), slice(i,:,j), soilm(i,j), smmax(i,j), &
1502 & stsice(i,:,j), soilt_ice(i,j), &
1503 & edir(i,j), ec(i,j), ett(i,j), esnow_ice(i,j), snoh_ice(i,j), &
1504 & hfx_ice(i,j), qfx_ice(i,j), lh_ice(i,j), &
1505 & infiltr(i,j), runoff1(i,j), runoff2(i,j), acrunoff(i,j), &
1506 & sfcexc(i,j), acceta(i,j), ssoil_ice(i,j), &
1507 & snfallac_ice(i,j), acsn_ice(i,j), snomlt_ice(i,j), &
1508 & smfrice(i,:,j),keepfrice(i,:,j), &
1509 & add_fire_heat_flux,fire_heat_flux1d(i,j), .false., &
1510 & shdmin1d(i,j), shdmax1d(i,j), rdlai, &
1511 & ims,ime, jms,jme, kms,kme, &
1512 & its,ite, jts,jte, kts,kte, &
1513 & errmsg, errflg)
1514
1515 ! Interstitial
1516 evap_ice(i) = qfx_ice(i,j) / rho(i) ! kinematic
1517 ep1d_ice(i) = qfx_ice(i,j) * con_hvap
1518 hflx_ice(i) = hfx_ice(i,j) / (con_cp*rho(i)) ! kinematic
1519 gflux_ice(i) = ssoil_ice(i,j)
1520
1521 qsurf_ice(i) = qsfc_ice(i,j)
1522 tsurf_ice(i) = soilt_ice(i,j)
1523 tsnow_ice(i) = soilt1_ice(i,j)
1524
1525 sfcqv_ice(i) = qvg_ice(i,j)
1526 sfcqc_ice(i) = qcg_ice(i,j)
1527
1528 rhosnf(i) = rhosnfr(i,j) ! kg m-3
1529 snowfallac_ice(i) = snfallac_ice(i,j) ! kg m-2
1530 acsnow_ice(i) = acsn_ice(i,j) ! kg m-2
1531 snowmt_ice(i) = snomlt_ice(i,j) ! kg m-2
1532 ! --- ... unit conversion (from m to mm)
1533 snwdph_ice(i) = snowh_ice(i,j) * rhoh2o
1534 weasd_ice(i) = sneqv_ice(i,j) ! kg m-2
1535 sncovr1_ice(i) = sncovr_ice(i,j)
1536 z0rl_ice(i) = znt_ice(i,j)*100._kind_phys ! cm
1537 !-- semis_ice is with snow effect
1538 semis_ice(i) = sfcems_ice(i,j)
1539 !-- sfalb_ice is with snow effect
1540 sfalb_ice(i) = alb_ice(i,j)
1541 !-- albdvis_ice,albdnir_ice,albivis_ice,albinir_ice
1542 albdvis_ice(i) = sfalb_ice(i)
1543 albdnir_ice(i) = sfalb_ice(i)
1544 albivis_ice(i) = sfalb_ice(i)
1545 albinir_ice(i) = sfalb_ice(i)
1546
1547 laixy(i) = zero
1548 smcwlt2(i) = zero
1549 smcref2(i) = one
1550 stm(i) = 3.e3_kind_phys ! kg m-2
1551
1552 do k = 1, lsoil_ruc
1553 tsice(i,k) = stsice(i,k,j)
1554 if(.not. frac_grid .or. .not. land(i)) then
1555 smois(i,k) = one
1556 sh2o(i,k) = zero
1557 tslb(i,k) = stsice(i,k,j)
1558 keepfr(i,k) = one
1559 smfrkeep(i,k) = one
1560 endif
1561 enddo
1562 if(debug_print) then
1563 write (0,*)'ICE - i,j,stype_ice,vtype_ice)',i,j,stype_ice(i,j),vtype_ice(i,j)
1564 write (0,*)'i,j,tsurf_ice(i)',i,j,tsurf_ice(i)
1565 write (0,*)'kdt,iter,stsice(i,:,j)',kdt,iter,stsice(i,:,j)
1566 write (0,*)'laixy(i)',laixy(i)
1567 endif
1568
1569 endif ! ice
1570
1571
1572 endif ! end if_flag_iter_and_flag
1573 enddo ! j
1574 enddo ! i
1575
1577 do j = jms, jme
1578 do i = 1, im
1579 if (flag(i)) then
1580 if(debug_print) write (0,*)'end ',i,flag_guess(i),flag_iter(i)
1581 if (flag_guess(i)) then
1582 if(debug_print) write (0,*)'guess run'
1583
1584 weasd_lnd(i) = weasd_lnd_old(i)
1585 snwdph_lnd(i) = snwdph_lnd_old(i)
1586 tskin_lnd(i) = tskin_lnd_old(i)
1587 canopy(i) = canopy_old(i)
1588 tsnow_lnd(i) = tsnow_lnd_old(i)
1589 snowfallac_lnd(i) = snowfallac_lnd_old(i)
1590 acsnow_lnd(i) = acsnow_lnd_old(i)
1591 sfcqv_lnd(i) = sfcqv_lnd_old(i)
1592 sfcqc_lnd(i) = sfcqc_lnd_old(i)
1593 wetness(i) = wetness_old(i)
1594 z0rl_lnd(i) = z0rl_lnd_old(i)
1595 sncovr1_lnd(i) = sncovr1_lnd_old(i)
1596 snowmt_lnd(i) = snowmt_lnd_old(i)
1597 !ice
1598 weasd_ice(i) = weasd_ice_old(i)
1599 snwdph_ice(i) = snwdph_ice_old(i)
1600 tskin_ice(i) = tskin_ice_old(i)
1601 tsnow_ice(i) = tsnow_ice_old(i)
1602 snowfallac_ice(i) = snowfallac_ice_old(i)
1603 acsnow_ice(i) = acsnow_ice_old(i)
1604 sfcqv_ice(i) = sfcqv_ice_old(i)
1605 sfcqc_ice(i) = sfcqc_ice_old(i)
1606 z0rl_ice(i) = z0rl_ice_old(i)
1607 sncovr1_ice(i) = sncovr1_ice_old(i)
1608 snowmt_ice(i) = snowmt_ice_old(i)
1609 srunoff(i) = srunoff_old(i)
1610 runoff(i) = runoff_old(i)
1611
1612 do k = 1, lsoil_ruc
1613 smois(i,k) = smois_old(i,k)
1614 tslb(i,k) = tslb_old(i,k)
1615 tsice(i,k) = tsice_old(i,k)
1616 sh2o(i,k) = sh2o_old(i,k)
1617 keepfr(i,k) = keepfr_old(i,k)
1618 smfrkeep(i,k) = smfrkeep_old(i,k)
1619 enddo
1620 else ! flag_guess
1621 if(debug_print) write (0,*)'iter run', i,j, tskin_ice(i),tsurf_ice(i)
1622 tskin_lnd(i) = tsurf_lnd(i)
1623 !don't overwrite surface skin temperature over ice when using CDEPS inline over the mask
1624 if (use_cdeps_data) then
1625 if (mask_dat(i) <= 0.0) then
1626 tskin_ice(i) = tsurf_ice(i)
1627 endif
1628 else
1629 tskin_ice(i) = tsurf_ice(i)
1630 endif
1631 endif ! flag_guess
1632 endif ! flag
1633 enddo ! i
1634 enddo ! j
1635!
1636!...................................
1637 end subroutine lsm_ruc_run
1638!-----------------------------------
1639
1642 subroutine rucinit (lsm_cold_start, im, lsoil_ruc, lsoil, & ! in
1643 nlev, me, master, lsm_ruc, lsm, slmsk, & ! in
1644 stype, vtype, landfrac, fice, & ! in
1645 min_seaice, tskin_lnd, tskin_wat, tg3, & ! in
1646 zs, dzs, smc, slc, stc, & ! in
1647 sh2o, smfrkeep, tslb, smois, & ! out
1648 wetness, errmsg, errflg)
1649
1650 implicit none
1651
1652 logical, intent(in ) :: lsm_cold_start
1653 integer, intent(in ) :: lsm
1654 integer, intent(in ) :: lsm_ruc
1655 integer, intent(in ) :: im, nlev
1656 integer, intent(in ) :: lsoil_ruc
1657 integer, intent(in ) :: lsoil
1658 real (kind_phys), intent(in ) :: min_seaice
1659 real (kind_phys), dimension(im), intent(in ) :: slmsk
1660 real (kind_phys), dimension(im), intent(in ) :: landfrac
1661 real (kind_phys), dimension(im), intent(in ) :: fice
1662 real (kind_phys), dimension(im), intent(in ) :: tskin_lnd, tskin_wat
1663 real (kind_phys), dimension(im), intent(in ) :: tg3
1664 real (kind_phys), dimension(1:lsoil_ruc), intent(in ) :: zs
1665 real (kind_phys), dimension(1:lsoil_ruc), intent(in ) :: dzs
1666 real (kind_phys), dimension(im,lsoil), intent(in ) :: smc ! Noah
1667 real (kind_phys), dimension(im,lsoil), intent(in ) :: stc ! Noah
1668 real (kind_phys), dimension(im,lsoil), intent(in ) :: slc ! Noah
1669
1670 integer, dimension(im), intent(in) :: stype, vtype
1671 real (kind_phys), dimension(im), intent(inout) :: wetness
1672 real (kind_phys), dimension(im,lsoil_ruc), intent(inout) :: smois! ruc
1673 real (kind_phys), dimension(im,lsoil_ruc), intent(inout) :: tslb ! ruc
1674 real (kind_phys), dimension(im,lsoil_ruc), intent(inout) :: sh2o ! ruc
1675 real (kind_phys), dimension(im,lsoil_ruc), intent(inout) :: smfrkeep ! ruc
1676
1677 integer, intent(in ) :: me
1678 integer, intent(in ) :: master
1679 character(len=*), intent(out) :: errmsg
1680 integer, intent(out) :: errflg
1681
1683 logical :: debug_print
1684 logical :: smadj ! for soil mosture adjustment
1685 logical :: swi_init ! for initialization in terms of SWI (soil wetness index)
1686
1687 integer :: flag_soil_layers, flag_soil_levels, flag_sst
1688 real (kind_phys), dimension(1:lsoil_ruc) :: factorsm
1689 real (kind_phys), dimension(im) :: smcref2
1690 real (kind_phys), dimension(im) :: smcwlt2
1691
1692 integer , dimension( 1:im , 1:1 ) :: ivgtyp
1693 integer , dimension( 1:im , 1:1) :: isltyp
1694 real (kind_phys), dimension( 1:im , 1:1 ) :: mavail
1695 real (kind_phys), dimension( 1:im , 1:1 ) :: sst
1696 real (kind_phys), dimension( 1:im , 1:1 ) :: landmask
1697 real (kind_phys), dimension( 1:im , 1:1 ) :: tsk
1698 real (kind_phys), dimension( 1:im , 1:1 ) :: tbot
1699 real (kind_phys), dimension( 1:im , 1:1 ) :: smtotn
1700 real (kind_phys), dimension( 1:im , 1:1 ) :: smtotr
1701 real (kind_phys), dimension( 1:im , 1:lsoil_ruc, 1:1 ) :: dumsm
1702 real (kind_phys), dimension( 1:im , 1:lsoil_ruc, 1:1 ) :: dumt
1703 real (kind_phys), dimension( 1:im , 1:lsoil_ruc, 1:1 ) :: smfr
1704 real (kind_phys), dimension( 1:im , 1:lsoil_ruc, 1:1 ) :: soilm
1705 real (kind_phys), dimension( 1:im , 1:lsoil_ruc, 1:1 ) :: soiltemp
1706 real (kind_phys), dimension( 1:im , 1:lsoil_ruc, 1:1 ) :: soilh2o
1707
1708 real (kind_phys) :: st_input(1:im,1:lsoil_ruc*3,1:1)
1709 real (kind_phys) :: sm_input(1:im,1:lsoil_ruc*3,1:1)
1710
1711 integer :: ids,ide, jds,jde, kds,kde, &
1712 ims,ime, jms,jme, kms,kme, &
1713 its,ite, jts,jte, kts,kte, &
1714 i, j, k, l, num_soil_layers, ipr
1715
1716 integer, dimension(1:lsoil) :: st_levels_input ! 4 - for Noah lsm
1717 integer, dimension(1:lsoil) :: sm_levels_input ! 4 - for Noah lsm
1718
1719 integer :: ii,jj
1720 ! Initialize the CCPP error handling variables
1721 errmsg = ''
1722 errflg = 0
1723
1724 debug_print = .false.
1725
1726 if (lsm/=lsm_ruc) then
1727 write(errmsg,'(a,i0,a,i0)') &
1728 'ERROR in lsm_ruc_init: namelist variable lsm=', &
1729 lsm, ' incompatible with RUC LSM, please set to ', lsm_ruc
1730 errflg = 1
1731 return
1732 else if (debug_print) then
1733 write (0,*) 'Start of RUC LSM initialization'
1734 write (0,*)'lsoil, lsoil_ruc =',lsoil, lsoil_ruc
1735 write (0,*)'lsm_cold_start = ',lsm_cold_start
1736 endif
1737
1738 ipr = 10
1739
1740 ! Set internal dimensions
1741 ids = 1
1742 ims = 1
1743 its = 1
1744 ide = im
1745 ime = im
1746 ite = im
1747 jds = 1
1748 jms = 1
1749 jts = 1
1750 jde = 1
1751 jme = 1
1752 jte = 1
1753 kds = 1
1754 kms = 1
1755 kts = 1
1756 kde = nlev
1757 kme = nlev
1758 kte = nlev
1759
1760 !! Check if RUC soil data (tslb, ...) is provided or not
1761 !if (minval(tslb)==maxval(tslb)) then
1762 ! For restart runs, can assume that RUC soil data is provided
1763 if (lsm_cold_start) then
1764
1765 flag_sst = 0
1766
1767 num_soil_layers = lsoil ! 4 - for Noah lsm
1768
1769 if( lsoil_ruc == lsoil) then
1770 ! RUC LSM input
1771 smadj = .false.
1772 swi_init = .false.
1773 flag_soil_layers = 0 ! =1 for input from the Noah LSM
1774 flag_soil_levels = 1 ! =1 for input from RUC LSM
1775 else
1776 ! for Noah input set smadj and swi_init to .true.
1777 smadj = .true.
1778 swi_init = .true.
1779 flag_soil_layers = 1 ! =1 for input from the Noah LSM
1780 flag_soil_levels = 0 ! =1 for input from RUC LSM
1781 endif
1782
1783 if(lsoil == 4 ) then ! for Noah input
1784 st_levels_input = (/ 5, 25, 70, 150/) ! Noah centers of soil layers
1785 sm_levels_input = (/ 5, 25, 70, 150/) ! Noah centers of soil layers
1786 elseif(lsoil /= lsoil_ruc) then
1787 write(errmsg,'(a,i0,a)') &
1788 'WARNING in lsm_ruc_init: non-Noah and non-RUC input, lsoil=', lsoil
1789 errflg = 1
1790 return
1791 endif
1792
1793 else
1794
1795 ! For RUC restart data, return here
1796 return
1797
1798 endif
1799
1800 if(debug_print) then
1801 write (0,*)'smc(ipr,:) =', ipr, smc(ipr,:)
1802 write (0,*)'stc(ipr,:) =', ipr, stc(ipr,:)
1803 write (0,*)'tskin_lnd(ipr) =', tskin_lnd(ipr)
1804 write (0,*)'tskin_wat(ipr) =', tskin_wat(ipr)
1805 write (0,*)'vtype(ipr) =', ipr, vtype(ipr)
1806 write (0,*)'stype(ipr) =', ipr, stype(ipr)
1807 write (0,*)'its,ite,jts,jte =', its,ite,jts,jte
1808 endif
1809
1810
1811 do j=jts,jte !
1812 do i=its,ite ! i = horizontal loop
1813
1814 sst(i,j) = tskin_wat(i)
1815 tbot(i,j) = tg3(i)
1816 ivgtyp(i,j) = vtype(i)
1817 isltyp(i,j) = stype(i)
1818 if(isltyp(i,j)==0) isltyp(i,j)=14
1819 if(ivgtyp(i,j)==0) ivgtyp(i,j)=17
1820 if (landfrac(i) > zero .or. fice(i) > zero) then
1821 !-- land or ice
1822 tsk(i,j) = tskin_lnd(i)
1823 landmask(i,j)=one
1824 else
1825 !-- water
1826 tsk(i,j) = tskin_wat(i)
1827 landmask(i,j)=zero
1828 endif ! land(i)
1829
1830 enddo
1831 enddo
1832
1833 if ( flag_soil_layers == 1 ) then
1834 ! Noah lsm input
1835 do j=jts,jte !
1836 do i=its,ite ! i = horizontal loop
1837
1838 st_input(i,1,j)=tsk(i,j)
1839 sm_input(i,1,j)=zero
1840
1841 !--- initialize smcwlt2 and smcref2 with Noah values
1842 if(landfrac(i) > zero) then
1843 smcref2(i) = refsmcnoah(stype(i))
1844 smcwlt2(i) = wltsmcnoah(stype(i))
1845 else
1846 smcref2(i) = one
1847 smcwlt2(i) = zero
1848 endif
1849
1850 do k=1,lsoil
1851 st_input(i,k+1,j)=stc(i,k)
1852 ! convert volumetric soil moisture to SWI (soil wetness index)
1853 if(landfrac(i) > zero .and. swi_init) then
1854 sm_input(i,k+1,j)=min(one,max(zero,(smc(i,k) - smcwlt2(i))/ &
1855 (smcref2(i) - smcwlt2(i))))
1856 else
1857 sm_input(i,k+1,j)=smc(i,k)
1858 endif
1859 enddo
1860 do k=lsoil+2,lsoil_ruc * 3
1861 st_input(i,k,j)=zero
1862 sm_input(i,k,j)=zero
1863 enddo
1864
1865 enddo ! i - horizontal loop
1866 enddo ! jme
1867
1868 if(debug_print) then
1869 write (0,*)'st_input=',ipr, st_input(ipr,:,1)
1870 write (0,*)'sm_input=',ipr, sm_input(ipr,:,1)
1871 endif
1872
1873 CALL init_soil_3_real ( tsk , tbot , dumsm , dumt , &
1874 st_input , sm_input , landmask , sst , &
1875 zs , dzs , &
1876 st_levels_input, sm_levels_input, &
1877 lsoil_ruc , num_soil_layers, &
1878 num_soil_layers, &
1879 lsoil_ruc * 3 , lsoil_ruc * 3 , &
1880 flag_sst, &
1881 flag_soil_layers , flag_soil_levels , &
1882 ids , ide , jds , jde , kds , kde , &
1883 ims , ime , jms , jme , kms , kme , &
1884 its , ite , jts , jte , kts , kte )
1885
1886 do j=jts,jte
1887 do i=its,ite
1888 if (landfrac(i) == one) then
1889 !-- land
1890 do k=1,lsoil_ruc
1891 ! convert from SWI to RUC volumetric soil moisture
1892 if(swi_init) then
1893 soilm(i,k,j) = dumsm(i,k,j) * &
1894 (refsmc(isltyp(i,j))-drysmc(isltyp(i,j))) &
1895 + drysmc(isltyp(i,j))
1896 else
1897 soilm(i,k,j) = dumsm(i,k,j)
1898 endif
1899 soiltemp(i,k,j) = dumt(i,k,j)
1900 enddo ! k
1901 else
1902 !-- ice or water
1903 do k=1,lsoil_ruc
1904 soilm(i,k,j) = one
1905 soiltemp(i,k,j) = dumt(i,k,j)
1906 enddo ! k
1907 endif ! land
1908 enddo
1909 enddo
1910
1911 if(debug_print) then
1912 write (0,*)'tsk(i,j),tbot(i,j),sst(i,j),landmask(i,j)' &
1913 ,ipr,1,tsk(ipr,1),tbot(ipr,1),sst(ipr,1),landmask(ipr,1)
1914 write (0,*)'tskin_lnd(ipr)=',ipr,tskin_lnd(ipr)
1915 write (0,*)'stc(ipr)=',ipr,stc(ipr,:)
1916 write (0,*)'smc(ipr)=',ipr,smc(ipr,:)
1917 write (0,*)'soilt(1,:,ipr)',ipr,soiltemp(ipr,:,1)
1918 write (0,*)'soilm(1,:,ipr)',ipr,soilm(ipr,:,1)
1919 endif ! debug_print
1920
1921 ! smadj should be true when the Noah LSM is used to initialize RUC
1922 if( smadj ) then
1923 ! With other LSMs as input, or when RUC soil moisture is cycled, it
1924 ! should be set to .false.
1925
1926 do j=jts,jte
1927 do i=its,ite
1928
1929 if (landfrac(i) > zero) then
1930
1931 ! initialize factor
1932 do k=1,lsoil_ruc
1933 factorsm(k)=one
1934 enddo
1935
1936 ! RUC soil moisture bucket
1937 smtotr(i,j)=zero
1938 do k=1,lsoil_ruc -1
1939 smtotr(i,j)=smtotr(i,j) + soilm(i,k,j) *dzs(k)
1940 enddo
1941 ! Noah soil moisture bucket
1942 smtotn(i,j)=smc(i,1)*0.1_kind_phys + smc(i,2)*0.2_kind_phys + smc(i,3)*0.7_kind_phys + smc(i,4)*one
1943
1944 if(debug_print) then
1945 if(i==ipr) then
1946 write (0,*)'from Noah to RUC: RUC bucket and Noah bucket at', &
1947 i,j,smtotr(i,j),smtotn(i,j)
1948 write (0,*)'before smois=',i,j,soilm(i,:,j)
1949 endif
1950 endif
1951
1952 ! RUC soil moisture correction to match Noah soil moisture bucket
1953 do k=1,lsoil_ruc-1
1954 soilm(i,k,j) = max(0.02_kind_phys,soilm(i,k,j)*smtotn(i,j)/(0.9_kind_phys*smtotr(i,j)))
1955 enddo
1956
1957 if( soilm(i,2,j) > soilm(i,1,j) .and. soilm(i,3,j) > soilm(i,2,j)) then
1958 ! typical for daytime, no recent precip
1959 factorsm(1) = 0.75_kind_phys
1960 factorsm(2) = 0.8_kind_phys
1961 factorsm(3) = 0.85_kind_phys
1962 factorsm(4) = 0.9_kind_phys
1963 factorsm(5) = 0.95_kind_phys
1964 endif
1965 do k=1,lsoil_ruc
1966 soilm(i,k,j) = factorsm(k) * soilm(i,k,j)
1967 enddo
1968 if(debug_print) then
1969 if(i==ipr) write (0,*)'after smois=',i,j,soilm(i,:,j)
1970 endif
1971 smtotr(i,j) = zero
1972 do k=1,lsoil_ruc - 1
1973 smtotr(i,j)=smtotr(i,j) + soilm(i,k,j) *dzs(k)
1974 enddo
1975 if(debug_print) then
1976 if(i==ipr) write (0,*)'after correction: RUC bucket and Noah bucket at', &
1977 i,j,smtotr(i,j),smtotn(i,j)
1978 endif
1979
1980 endif ! land(i)
1981
1982 enddo
1983 enddo
1984
1985 endif ! smadj==.true.
1986
1987 elseif (flag_soil_layers==0) then
1988 ! RUC LSM input
1989 if(debug_print) write (0,*)' RUC LSM input for soil variables'
1990 do j=jts,jte
1991 do i=its,ite
1992 do k=1,lsoil_ruc
1993 soilm(i,k,j) = smc(i,k)
1994 soiltemp(i,k,j) = stc(i,k)
1995 enddo
1996 enddo
1997 enddo
1998
1999 endif ! flag_soil_layers==1
2000
2001
2002 ! Initialize liquid and frozen soil moisture from total soil moisture
2003 ! and soil temperature, and also soil moisture availability in the top
2004 ! layer
2005
2006 call ruclsminit( debug_print, landfrac, fice, min_seaice, &
2007 lsoil_ruc, isltyp, ivgtyp, mavail, &
2008 soilh2o, smfr, soiltemp, soilm, &
2009 ims,ime, jms,jme, kms,kme, &
2010 its,ite, jts,jte, kts,kte )
2011
2012 do j=jts,jte
2013 do i=its,ite
2014 wetness(i) = mavail(i,j)
2015 do k = 1, lsoil_ruc
2016 smois(i,k) = soilm(i,k,j)
2017 tslb(i,k) = soiltemp(i,k,j)
2018 sh2o(i,k) = soilh2o(i,k,j)
2019 smfrkeep(i,k) = smfr(i,k,j)
2020 enddo
2021 enddo
2022 enddo
2023
2024 if(debug_print) then
2025 do i=1,im
2026 write (0,*)'End of RUC LSM initialization'
2027 write (0,*)'tslb(i)=',i,tslb(i,:)
2028 write (0,*)'smois(i)=',i,smois(i,:)
2029 write (0,*)'wetness(i)=',i,wetness(i)
2030 enddo
2031 endif ! debug_print
2032
2033 end subroutine rucinit
2034
2035end module lsm_ruc
module_sf_ruclsm::ruclsminit
subroutine, public ruclsminit(debug_print, landfrac, fice, min_seaice, nzs, isltyp, ivgtyp, mavail, sh2o, smfr3d, tslb, smois, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte)
This subroutine computes liquid and forezen soil moisture from the total soil moisture,...
Definition module_sf_ruclsm.F90:7232
module_soil_pre::init_soil_depth_3
subroutine, public init_soil_depth_3(zs, dzs, num_soil_levels)
This subroutine defines level depth in soil and thickness of soil layers RUC LSM.
Definition module_soil_pre.F90:27
module_sf_ruclsm::rslf
real(kind_phys) function, public rslf(p, t)
This function calculates the liquid saturation vapor mixing ratio as a function of temperature and pr...
Definition module_sf_ruclsm.F90:7710
module_soil_pre::init_soil_3_real
subroutine, public init_soil_3_real(tsk, tmn, smois, tslb, st_input, sm_input, landmask, sst, zs, dzs, st_levels_input, sm_levels_input, num_soil_layers, num_st_levels_input, num_sm_levels_input, num_st_levels_alloc, num_sm_levels_alloc, flag_sst, flag_soil_layers, flag_soil_levels, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte)
This subroutine initializes soil moisture and temperature at RUC vertical levels from the Noah layers...
Definition module_soil_pre.F90:81
module_sf_ruclsm::lsmruc
subroutine, public lsmruc(xlat, xlon, dt, init, lsm_cold_start, ktau, iter, nsl, graupelncv, snowncv, rainncv, raincv, zs, rainbl, snow, snowh, snowc, frzfrac, frpcpn, rhosnf, precipfr, exticeden, hgt, stdev, z3d, p8w, t3d, qv3d, qc3d, rho3d, emisbck, glw, gswdn, gsw, emiss, chklowq, chs, flqc, flhc, rhonewsn_ex, mosaic_lu, mosaic_soil, isncond_opt, isncovr_opt, mavail, canwat, vegfra, alb, znt, z0, snoalb, albbck, lai, landusef, nlcat, soilctop, nscat, smcwlt, smcref, qsfc, qsg, qvg, qcg, dew, soilt1, tsnav, tbot, ivgtyp, isltyp, xland, iswater, isice, xice, xice_threshold, cp, rv, rd, g0, pi, lv, stbolt, soilmois, sh2o, smavail, smmax, tso, soilt, edir, ec, ett, sublim, snoh, hfx, qfx, lh, infiltr, runoff1, runoff2, acrunoff, sfcexc, sfcevp, grdflx, snowfallac, acsnow, snom, smfr3d, keepfr3dflag, add_fire_heat_flux, fire_heat_flux, myj, shdmin, shdmax, rdlai2d, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte, errmsg, errflg)
The RUN LSM model is described in Smirnova et al.(1997) and Smirnova et al.(2000) .
Definition module_sf_ruclsm.F90:116
set_soilveg_ruc_mod::set_soilveg_ruc
subroutine, public set_soilveg_ruc(me, isot, ivet, nlunit, errmsg, errflg)
This subroutine specifies vegetation and soil parameters for a given soil and land-use classification...
Definition set_soilveg_ruc.F90:22
lsm_ruc
This module contain the RUC land surface model driver.
Definition lsm_ruc.F90:5
module_sf_ruclsm
This module contains the entity of the RUC LSM model, which is a soil/veg/snowpack and ice/snowpack...
Definition module_sf_ruclsm.F90:9
module_soil_pre
This module contains subroutines that initialize RUC LSM levels, soil temperature/moisture.
Definition module_soil_pre.F90:5
namelist_soilveg_ruc
This module contains the namelist options of soil/vegetation in RUC.
Definition namelist_soilveg_ruc.F90:4
set_soilveg_ruc_mod
This module contains subroutine to specify vegetation and soil parameters for a given soild and land-...
Definition set_soilveg_ruc.F90:5