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