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