← Back to Documentation Home
CCPP SciDoc v8.0.0  v8.0.0
Common Community Physics Package Developed at DTC
 
Loading...
Searching...
No Matches
noahmpdrv.F90
1#ifndef CCPP
2#define CCPP
3#endif
4
6
12
14 module noahmpdrv
15
16 use module_sf_noahmplsm
17
18! These hold and apply Land IAU increments for soil temperature
19! (possibly will extend to soil moisture increments)
20 use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, land_iau_state_type, &
21 land_iau_mod_init, land_iau_mod_getiauforcing, land_iau_mod_final, calculate_landinc_mask
22
23 implicit none
24
25 integer, parameter :: psi_opt = 0 ! 0: MYNN or 1:GFS
26
27 private
28
29 public :: noahmpdrv_init, noahmpdrv_run, &
30 noahmpdrv_timestep_init, noahmpdrv_final
31
32 contains
33
40 subroutine noahmpdrv_init(lsm, lsm_noahmp, me, isot, ivegsrc, &
41 nlunit, pores, resid, &
42 do_mynnsfclay,do_mynnedmf, &
43 errmsg, errflg, &
44 Land_IAU_Control, Land_IAU_Data, Land_IAU_state)
45
46 use machine, only: kind_phys
47 use set_soilveg_mod, only: set_soilveg
48 use namelist_soilveg
49 use noahmp_tables
50
51 implicit none
52 integer, intent(in) :: lsm
53 integer, intent(in) :: lsm_noahmp
54 integer, intent(in) :: me, isot, ivegsrc, nlunit
55
56 real (kind=kind_phys), dimension(:), intent(out) :: pores, resid
57
58 logical, intent(in) :: do_mynnsfclay
59 logical, intent(in) :: do_mynnedmf
60
61
62 character(len=*), intent(out) :: errmsg
63 integer, intent(out) :: errflg
64
65 ! Land iau mod DDTs ! made optional to allow NoahMP Component model call this function without having to deal with IAU
66
67 ! Land IAU Control holds settings' information, maily read from namelist
68 ! (e.g., block of global domain that belongs to current process,
69 ! whether to do IAU increment at this time step, time step informatoin, etc)
70 type(land_iau_control_type), intent(inout), optional :: Land_IAU_Control
71
72 ! land iau state holds increment data read from file (before interpolation)
73 type(land_iau_state_type), intent(inout), optional :: Land_IAU_state
74
75 ! Land IAU Data holds spatially and temporally interpolated increments per time step
76 type(land_iau_external_data_type), intent(inout), optional :: Land_IAU_Data ! arry of (number of blocks):each proc holds nblks
77
78 ! Initialize CCPP error handling variables
79 errmsg = ''
80 errflg = 0
81
82 ! Consistency checks
83 if (lsm/=lsm_noahmp) then
84 write(errmsg,'(*(a))') 'Logic error: namelist choice of ', &
85 & 'LSM is different from Noah'
86 errflg = 1
87 return
88 end if
89
90 if (ivegsrc /= 1) then
91 errmsg = 'The NOAHMP LSM expects that the ivegsrc physics '// &
92 'namelist parameter is 1. Exiting...'
93 errflg = 1
94 return
95 end if
96 if (isot /= 1) then
97 errmsg = 'The NOAHMP LSM expects that the isot physics '// &
98 'namelist parameter is 1. Exiting...'
99 errflg = 1
100 return
101 end if
102
103 if ( do_mynnsfclay .and. .not. do_mynnedmf) then
104 errmsg = 'Problem : do_mynnsfclay = .true.' // &
105 'but mynnpbl is .false.. Exiting ...'
106 errflg = 1
107 return
108 end if
109
110
111 !--- initialize soil vegetation
112 call set_soilveg(me, isot, ivegsrc, nlunit, errmsg, errflg)
113 if(errflg/=0) return
114
115 !--- read in noahmp table
116 call read_mp_table_parameters(errmsg, errflg)
117 if(errflg/=0) return
118
119 ! initialize psih and psim
120 if ( do_mynnsfclay ) then
121 call psi_init(psi_opt,errmsg,errflg)
122 if(errflg/=0) return
123 endif
124
125 pores(:) = maxsmc(:)
126 resid(:) = drysmc(:)
127
128 if (present(land_iau_control) .and. present(land_iau_data) .and. present(land_iau_state)) then
129
130 ! Initialize IAU for land--land_iau_control was set by host model
131 if (.not. land_iau_control%do_land_iau) return
132 call land_iau_mod_init (land_iau_control, land_iau_data, land_iau_state, errmsg, errflg)
133
134 endif
135
136 end subroutine noahmpdrv_init
137
144subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, &
145 isot, ivegsrc, soiltyp, vegtype, weasd, &
146 land_iau_control, land_iau_data, land_iau_state, &
147 stc, slc, smc, errmsg, errflg, &
148 con_g, con_t0c, con_hfus)
149
150 use machine, only: kind_phys
151 use namelist_soilveg
152 ! use set_soilveg_snippet_mod, only: set_soilveg_noahmp
153 use noahmp_tables
154
155 implicit none
156
157 integer , intent(in) :: itime !current forecast iteration
158 real(kind=kind_phys) , intent(in) :: fhour !current forecast time (hr)
159 real(kind=kind_phys) , intent(in) :: delt ! time interval [s]
160 integer , intent(in) :: km !vertical soil layer dimension
161 integer, intent(in) :: ncols
162 integer, intent(in) :: isot
163 integer, intent(in) :: ivegsrc
164
165 integer , dimension(:) , intent(in) :: soiltyp ! soil type (integer index)
166 integer , dimension(:) , intent(in) :: vegtype ! vegetation type (integer index)
167 real(kind=kind_phys), dimension(:) , intent(inout) :: weasd ! water equivalent accumulated snow depth [mm]
168
169 type(land_iau_control_type) , intent(inout) :: Land_IAU_Control
170 type(land_iau_external_data_type) , intent(inout) :: Land_IAU_Data
171 type(land_iau_state_type) , intent(inout) :: Land_IAU_State
172 real(kind=kind_phys), dimension(:,:) , intent(inout) :: stc ! soiltemp [K]
173 real(kind=kind_phys), dimension(:,:) , intent(inout) :: slc !liquid soil moisture [m3/m3]'
174 real(kind=kind_phys), dimension(:,:) , intent(inout) :: smc !
175 character(len=*), intent(out) :: errmsg
176 integer, intent(out) :: errflg
177 real(kind=kind_phys), intent(in) :: con_g ! grav
178 real(kind=kind_phys), intent(in) :: con_t0c ! tfreez
179 real(kind=kind_phys), intent(in) :: con_hfus ! hfus
180
181 ! IAU update
182 real(kind=kind_phys),allocatable, dimension(:,:) :: stc_inc_flat, slc_inc_flat
183 real(kind=kind_phys), dimension(km) :: dz ! layer thickness
184
185!TODO: This is hard-coded in noahmpdrv
186 real(kind=kind_phys) :: zsoil(4) = (/ -0.1, -0.4, -1.0, -2.0 /) !zsoil(km)
187
188 integer :: lsoil_incr
189 integer, allocatable :: mask_tile(:)
190 integer,allocatable :: stc_updated(:)
191 logical :: soil_freeze, soil_ice
192 integer :: soiltype
193 real(kind=kind_phys) :: slc_new
194
195 integer :: i, j, ij, l, k, ib
196 integer :: lensfc
197
198 real(kind=kind_phys) :: smp
199 real(kind=kind_phys) :: hc_incr
200 real(kind=kind_phys), parameter :: tfreez_noahmp=273.16 ! tfreez used in NoahMP to determine frozen ground
201
202 ! --- Initialize CCPP error handling variables
203 errmsg = ''
204 errflg = 0
205
206 if (.not. land_iau_control%do_land_iau) return
207
209 land_iau_control%fhour=fhour
210
212 call land_iau_mod_getiauforcing(land_iau_control, land_iau_data, land_iau_state, errmsg, errflg)
213 if (errflg .ne. 0) then
214 return
215 endif
216
218 if (.not. land_iau_data%in_interval) then
219 return
220 endif
221
222 if(land_iau_control%me == land_iau_control%mpi_root) then
223 print*, "adding land iau increments"
224 endif
225
226 if (land_iau_control%lsoil .ne. km) then
227 write(errmsg,*) 'noahmpdrv_timestep_init: Land_IAU_Data%lsoil ',land_iau_control%lsoil,' not equal to km ',km
228 errflg = 1
229 return
230 endif
231
232 ! local variable to copy blocked data Land_IAU_Data%stc_inc
233 allocate(stc_inc_flat(land_iau_control%nx * land_iau_control%ny, km)) !GFS_Control%ncols
234 allocate(slc_inc_flat(land_iau_control%nx * land_iau_control%ny, km)) !GFS_Control%ncols
235 allocate(stc_updated(land_iau_control%nx * land_iau_control%ny))
236
237 !copy background stc
238 stc_updated = 0
239 ib = 1
240 do j = 1, land_iau_control%ny
241 do k = 1, km
242 stc_inc_flat(ib:ib+land_iau_control%nx-1, k) = land_iau_data%stc_inc(:,j, k)
243 slc_inc_flat(ib:ib+land_iau_control%nx-1, k) = land_iau_data%slc_inc(:,j, k)
244 enddo
245 ib = ib + land_iau_control%nx
246 enddo
247
248 if ((land_iau_control%dtp - delt) > 0.0001) then
249 if(land_iau_control%me == land_iau_control%mpi_root) then
250 print*, "Warning! noahmpdrv_timestep_init delt ",delt," different from Land_IAU_Control%dtp ",land_iau_control%dtp
251 endif
252 endif
253
254 lsoil_incr = land_iau_control%lsoil_incr
255 lensfc = land_iau_control%nx * land_iau_control%ny
256
257 if(land_iau_control%me == land_iau_control%mpi_root) print*,' adjusting first ', lsoil_incr, ' surface layers only, delt ', delt
258
259 allocate(mask_tile(lensfc))
260 call calculate_landinc_mask(weasd, vegtype, soiltyp, lensfc, isice_table, mask_tile)
261
262 dz(1) = -zsoil(1)
263 do k = 2, km
264 dz(k) = -zsoil(k) + zsoil(k-1)
265 enddo
266 !IAU increments are in units of 1/sec
267 ij_loop : do ij = 1, lensfc
268 ! mask: 1 - soil, 2 - snow, 0 - land-ice, -1 - not land
269 if (mask_tile(ij) == 1) then
270
271 soil_freeze=.false.
272 soil_ice=.false.
273 do k = 1, lsoil_incr
274 if ( stc(ij,k) < tfreez_noahmp ) soil_freeze=.true.
275 if ( smc(ij,k) - slc(ij,k) > 0.001 ) soil_ice=.true.
276
277 if (land_iau_control%upd_stc) then
278 if (k==1) stc_updated(ij) = 1
279 stc(ij,k) = stc(ij,k) + stc_inc_flat(ij,k)*delt
280 endif
281
282 ! do not do SLC updates if this layer or any above is frozen
283 if ( (.not. soil_freeze ) .and. (.not. soil_ice ) ) then
284 if (land_iau_control%upd_slc) then
285 ! if soil moisture is <0.1 mm in layer, prevent DA from further reducing it
286 slc(ij,k) = max(slc(ij,k) + slc_inc_flat(ij,k)*delt, min(0.0001/dz(k), slc(ij,k)))
287 smc(ij,k) = max(smc(ij,k) + slc_inc_flat(ij,k)*delt, min(0.0001/dz(k), smc(ij,k)))
288 endif
289 endif
290 enddo
291 endif ! if soil/snow point
292 enddo ij_loop
293
294 !!do moisture/temperature adjustment for consistency after increment add
295 call read_mp_table_parameters(errmsg, errflg)
296 if (errflg .ne. 0) then
297 errmsg = 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp'
298 return
299 endif
300 if (land_iau_control%do_stcsmc_adjustment) then
301 if (land_iau_control%upd_stc) then
302 do i=1,lensfc
303 if (stc_updated(i) == 1 ) then ! soil-only location
304 soiltype = soiltyp(i)
305 do l = 1, lsoil_incr
306 if (abs(stc_inc_flat(i,l)) > land_iau_control%min_T_increment) then
307 !the following if case applies when updated stc > melting point, it handles both
308 !case 1: frz ==> frz, recalculate slc, smc remains
309 !case 2: unfrz ==> frz, recalculate slc, smc remains
310 if (stc(i,l) .LE. tfreez_noahmp )then
311 !recompute supercool liquid water,smc_anl remain unchanged
312 smp = con_hfus*(tfreez_noahmp-stc(i,l))/(con_g*stc(i,l)) !(m)
313 slc_new=maxsmc(soiltype)*(smp/satpsi(soiltype))**(-1./bb(soiltype))
314 slc(i,l) = max( min( slc_new, smc(i,l)), 0.0 )
315 endif
316 !case 3: frz ==> unfrz melt all soil ice (if any)
317 if ( stc(i,l) .GT. tfreez_noahmp .and. &
318 stc(i,l) - stc_inc_flat(i,l)*delt .LE. tfreez_noahmp ) then
319 slc(i,l)=smc(i,l)
320 endif
321 endif
322 enddo
323 endif
324 enddo
325 endif
326
327 endif
328 deallocate(stc_inc_flat, slc_inc_flat, stc_updated)
329 deallocate(mask_tile)
330
331
332end subroutine noahmpdrv_timestep_init
333
340 subroutine noahmpdrv_final (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg)
341
342 use machine, only: kind_phys
343 implicit none
344 type(land_iau_control_type) , intent(in ) :: Land_IAU_Control
345 type(land_iau_external_data_type) , intent(inout) :: Land_IAU_Data
346 type(land_iau_state_type) , intent(inout) :: Land_IAU_State
347 character(len=*), intent(out) :: errmsg
348 integer, intent(out) :: errflg
349 integer :: j, k, ib
350 ! --- Initialize CCPP error handling variables
351 errmsg = ''
352 errflg = 0
353
354 if (.not. land_iau_control%do_land_iau) return
355 call land_iau_mod_final(land_iau_control, land_iau_data, land_iau_state, errmsg, errflg)
356
357 end subroutine noahmpdrv_final
358
380 subroutine noahmpdrv_run &
381!...................................
382! --- inputs:
383 ( im, km, lsnowl, itime, ps, u1, v1, t1, q1, soiltyp,soilcol,&
384 vegtype, sigmaf, dlwflx, dswsfc, snet, delt, tg3, cm, ch, &
385 prsl1, prslk1, prslki, prsik1, zf,pblh, dry, wind, slopetyp,&
386 shdmin, shdmax, snoalb, sfalb, flag_iter,con_g, &
387 idveg, iopt_crs, iopt_btr, iopt_run, iopt_sfc, iopt_frz, &
388 iopt_inf, iopt_rad, iopt_alb, iopt_snf, iopt_tbot,iopt_stc,&
389 iopt_trs,iopt_diag,xlatin, xcoszin, iyrlen, julian, garea, &
390 rainn_mp, rainc_mp, snow_mp, graupel_mp, ice_mp, rhonewsn1,&
391 con_hvap, con_cp, con_jcal, rhoh2o, con_eps, con_epsm1, &
392 con_fvirt, con_rd, con_hfus, thsfc_loc, cpllnd, cpllnd2atm,&
393
394! --- in/outs:
395 weasd, snwdph, tskin, tprcp, srflag, smc, stc, slc, &
396 canopy, trans, tsurf, zorl, &
397 rb1, fm1, fh1, ustar1, stress1, fm101, fh21, &
398 rmol1,flhc1,flqc1,do_mynnsfclay, &
399
400! --- Noah MP specific
401
402 snowxy, tvxy, tgxy, canicexy, canliqxy, eahxy, tahxy, cmxy,&
403 chxy, fwetxy, sneqvoxy, alboldxy, qsnowxy, wslakexy, zwtxy,&
404 waxy, wtxy, tsnoxy, zsnsoxy, snicexy, snliqxy, lfmassxy, &
405 rtmassxy, stmassxy, woodxy, stblcpxy, fastcpxy, xlaixy, &
406 xsaixy, taussxy, smoiseq, smcwtdxy, deeprechxy, rechxy, &
407 albdvis, albdnir, albivis, albinir,emiss, &
408
409! --- outputs:
410 sncovr1, qsurf, gflux, drain, evap, hflx, ep, runoff, &
411 cmm, chh, evbs, evcw, sbsno, pah, ecan, etran, edir, snowc,&
412 stm, snohf,smcwlt2, smcref2, wet1, t2mmp, q2mp,zvfun, &
413 ztmax, rca, errmsg, errflg, &
414 canopy_heat_storage_ccpp, &
415 rainfall_ccpp, &
416 sw_absorbed_total_ccpp, &
417 sw_reflected_total_ccpp, &
418 lw_absorbed_total_ccpp, &
419 temperature_bare_grd_ccpp, &
420 temperature_veg_grd_ccpp, &
421 temperature_veg_2m_ccpp, &
422 temperature_bare_2m_ccpp, &
423 spec_humidity_veg_2m_ccpp, &
424 spec_humidity_bare_2m_ccpp, &
425 sw_absorbed_veg_ccpp, &
426 sw_absorbed_ground_ccpp, &
427 snowmelt_out_ccpp, &
428 snowmelt_shallow_ccpp, &
429 albedo_direct_snow_ccpp, &
430 albedo_diffuse_snow_ccpp, &
431 ch_vegetated_ccpp, &
432 ch_bare_ground_ccpp, &
433 sensible_heat_grd_veg_ccpp, &
434 sensible_heat_leaf_ccpp, &
435 sensible_heat_grd_bar_ccpp, &
436 latent_heat_grd_veg_ccpp, &
437 latent_heat_grd_bare_ccpp, &
438 ground_heat_veg_ccpp, &
439 ground_heat_bare_ccpp, &
440 lw_absorbed_grd_veg_ccpp, &
441 lw_absorbed_leaf_ccpp, &
442 lw_absorbed_grd_bare_ccpp, &
443 latent_heat_trans_ccpp, &
444 latent_heat_leaf_ccpp, &
445 ch_leaf_ccpp, &
446 ch_below_canopy_ccpp, &
447 ch_vegetated_2m_ccpp, &
448 ch_bare_ground_2m_ccpp, &
449 precip_adv_heat_veg_ccpp, &
450 precip_adv_heat_grd_v_ccpp, &
451 precip_adv_heat_grd_b_ccpp, &
452 spec_humid_sfc_veg_ccpp, &
453 spec_humid_sfc_bare_ccpp &
454 )
455
456 use machine , only : kind_phys
457 use funcphys, only : fpvs
458
459 use module_sf_noahmplsm, only : gfs_stability
460 use module_sf_noahmp_glacier
461 use noahmp_tables
462
463 implicit none
464
465 real(kind=kind_phys), parameter :: a2 = 17.2693882
466 real(kind=kind_phys), parameter :: a3 = 273.16
467 real(kind=kind_phys), parameter :: a4 = 35.86
468 real(kind=kind_phys), parameter :: a23m4 = a2*(a3-a4)
469 real(kind=kind_phys), intent(in) :: con_g
470
471 real, parameter :: undefined = 9.99e20_kind_phys
472
473 integer, parameter :: nsoil = 4 ! hardwired to Noah
474 integer, parameter :: nsnow = 3 ! max. snow layers
475
476 integer, parameter :: iz0tlnd = 0 ! z0t treatment option
477
478 real(kind=kind_phys), save :: zsoil(nsoil)
479 data zsoil / -0.1, -0.4, -1.0, -2.0 /
480
481!
482! --- CCPP interface fields (in call order)
483!
484
485 integer , intent(in) :: im ! horiz dimension and num of used pts
486 integer , intent(in) :: km ! vertical soil layer dimension
487 integer , intent(in) :: lsnowl ! lower bound for snow level arrays
488 integer , intent(in) :: itime ! NOT USED
489 real(kind=kind_phys), dimension(:) , intent(in) :: ps ! surface pressure [Pa]
490 real(kind=kind_phys), dimension(:) , intent(in) :: u1 ! u-component of wind [m/s]
491 real(kind=kind_phys), dimension(:) , intent(in) :: v1 ! u-component of wind [m/s]
492 real(kind=kind_phys), dimension(:) , intent(in) :: t1 ! layer 1 temperature [K]
493 real(kind=kind_phys), dimension(:) , intent(in) :: q1 ! layer 1 specific humidity [kg/kg]
494 integer , dimension(:) , intent(in) :: soiltyp ! soil type (integer index)
495 integer , dimension(:) , intent(in) :: soilcol ! soil color (integer index)
496 integer , dimension(:) , intent(in) :: vegtype ! vegetation type (integer index)
497 real(kind=kind_phys), dimension(:) , intent(in) :: sigmaf ! areal fractional cover of green vegetation
498 real(kind=kind_phys), dimension(:) , intent(in) :: dlwflx ! downward longwave radiation [W/m2]
499 real(kind=kind_phys), dimension(:) , intent(in) :: dswsfc ! downward shortwave radiation [W/m2]
500 real(kind=kind_phys), dimension(:) , intent(in) :: snet ! total sky sfc netsw flx into ground[W/m2]
501 real(kind=kind_phys) , intent(in) :: delt ! time interval [s]
502 real(kind=kind_phys), dimension(:) , intent(in) :: tg3 ! deep soil temperature [K]
503 real(kind=kind_phys), dimension(:) , intent(inout) :: cm ! surface exchange coeff for momentum [-]
504 real(kind=kind_phys), dimension(:) , intent(inout) :: ch ! surface exchange coeff heat & moisture[-]
505 real(kind=kind_phys), dimension(:) , intent(in) :: prsl1 ! sfc layer 1 mean pressure [Pa]
506 real(kind=kind_phys), dimension(:) , intent(in) :: prslk1 ! exner_function_at lowest model layer
507
508 real(kind=kind_phys), dimension(:) , intent(in) :: prslki ! Exner function bt midlayer and interface at 1st layer
509 real(kind=kind_phys), dimension(:) , intent(in) :: prsik1 ! Exner function at the ground surfac
510
511 real(kind=kind_phys), dimension(:) , intent(in) :: zf ! height of bottom layer [m]
512
513 logical , intent(in) :: do_mynnsfclay !flag for MYNN sfc layer scheme
514
515 real(kind=kind_phys), dimension(:) , intent(in) :: pblh ! height of pbl
516 real(kind=kind_phys), dimension(:) , intent(inout) :: rmol1 !
517 real(kind=kind_phys), dimension(:) , intent(inout) :: flhc1 !
518 real(kind=kind_phys), dimension(:) , intent(inout) :: flqc1 !
519
520
521 logical , dimension(:) , intent(in) :: dry ! = T if a point with any land
522 real(kind=kind_phys), dimension(:) , intent(in) :: wind ! wind speed [m/s]
523 integer , dimension(:) , intent(in) :: slopetyp ! surface slope classification
524 real(kind=kind_phys), dimension(:) , intent(in) :: shdmin ! min green vegetation coverage [fraction]
525 real(kind=kind_phys), dimension(:) , intent(in) :: shdmax ! max green vegetation coverage [fraction]
526 real(kind=kind_phys), dimension(:) , intent(in) :: snoalb ! upper bound on max albedo over deep snow
527 real(kind=kind_phys), dimension(:) , intent(inout) :: sfalb ! mean surface albedo [fraction]
528 logical , dimension(:) , intent(in) :: flag_iter !
529 integer , intent(in) :: idveg ! option for dynamic vegetation
530 integer , intent(in) :: iopt_crs ! option for canopy stomatal resistance
531 integer , intent(in) :: iopt_btr ! option for soil moisture factor for stomatal resistance
532 integer , intent(in) :: iopt_run ! option for runoff and groundwater
533 integer , intent(in) :: iopt_sfc ! option for surface layer drag coeff (ch & cm)
534 integer , intent(in) :: iopt_frz ! option for supercooled liquid water (or ice fraction)
535 integer , intent(in) :: iopt_inf ! option for frozen soil permeability
536 integer , intent(in) :: iopt_rad ! option for radiation transfer
537 integer , intent(in) :: iopt_alb ! option for ground snow surface albedo
538 integer , intent(in) :: iopt_snf ! option for partitioning precipitation into rainfall & snowfall
539 integer , intent(in) :: iopt_tbot ! option for lower boundary condition of soil temperature
540 integer , intent(in) :: iopt_stc ! option for snow/soil temperature time scheme (only layer 1)
541 integer , intent(in) :: iopt_trs ! option for thermal roughness scheme
542 integer , intent(in) :: iopt_diag ! option for surface diagnose approach
543 real(kind=kind_phys), dimension(:) , intent(in) :: xlatin ! latitude
544 real(kind=kind_phys), dimension(:) , intent(in) :: xcoszin ! cosine of zenith angle
545 integer , intent(in) :: iyrlen ! year length [days]
546 real(kind=kind_phys) , intent(in) :: julian ! julian day of year
547 real(kind=kind_phys), dimension(:) , intent(in) :: garea ! area of the grid cell
548 real(kind=kind_phys), dimension(:) , intent(in) :: rainn_mp ! microphysics non-convective precipitation [mm]
549 real(kind=kind_phys), dimension(:) , intent(in) :: rainc_mp ! microphysics convective precipitation [mm]
550 real(kind=kind_phys), dimension(:) , intent(in) :: snow_mp ! microphysics snow [mm]
551 real(kind=kind_phys), dimension(:) , intent(in) :: graupel_mp ! microphysics graupel [mm]
552 real(kind=kind_phys), dimension(:) , intent(in) :: ice_mp ! microphysics ice/hail [mm]
553 real(kind=kind_phys), dimension(:) , intent(in) :: rhonewsn1 ! precipitation ice density (kg/m^3)
554 real(kind=kind_phys) , intent(in) :: con_hvap ! latent heat condensation [J/kg]
555 real(kind=kind_phys) , intent(in) :: con_cp ! specific heat air [J/kg/K]
556 real(kind=kind_phys) , intent(in) :: con_jcal ! joules per calorie (not used)
557 real(kind=kind_phys) , intent(in) :: rhoh2o ! density of water [kg/m^3]
558 real(kind=kind_phys) , intent(in) :: con_eps ! Rd/Rv
559 real(kind=kind_phys) , intent(in) :: con_epsm1 ! Rd/Rv - 1
560 real(kind=kind_phys) , intent(in) :: con_fvirt ! Rv/Rd - 1
561 real(kind=kind_phys) , intent(in) :: con_rd ! gas constant air [J/kg/K]
562 real(kind=kind_phys) , intent(in) :: con_hfus ! lat heat H2O fusion [J/kg]
563
564 logical , intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation
565
566 logical , intent(in) :: cpllnd ! Flag for land coupling (atm->lnd)
567 logical , intent(in) :: cpllnd2atm ! Flag for land coupling (lnd->atm)
568
569 real(kind=kind_phys), dimension(:) , intent(inout) :: weasd ! water equivalent accumulated snow depth [mm]
570 real(kind=kind_phys), dimension(:) , intent(inout) :: snwdph ! snow depth [mm]
571 real(kind=kind_phys), dimension(:) , intent(inout) :: tskin ! ground surface skin temperature [K]
572 real(kind=kind_phys), dimension(:) , intent(inout) :: tprcp ! total precipitation [m]
573 real(kind=kind_phys), dimension(:) , intent(inout) :: srflag ! snow/rain flag for precipitation
574 real(kind=kind_phys), dimension(:,:) , intent(inout) :: smc ! total soil moisture content [m3/m3]
575 real(kind=kind_phys), dimension(:,:) , intent(inout) :: stc ! soil temp [K]
576 real(kind=kind_phys), dimension(:,:) , intent(inout) :: slc ! liquid soil moisture [m3/m3]
577 real(kind=kind_phys), dimension(:) , intent(inout) :: canopy ! canopy moisture content [mm]
578 real(kind=kind_phys), dimension(:) , intent(inout) :: trans ! total plant transpiration [m/s]
579 real(kind=kind_phys), dimension(:) , intent(inout) :: tsurf ! surface skin temperature [K]
580 real(kind=kind_phys), dimension(:) , intent(inout) :: zorl ! surface roughness [cm]
581
582 real(kind=kind_phys), dimension(:) , intent(inout) :: rb1 ! bulk richardson #
583 real(kind=kind_phys), dimension(:) , intent(inout) :: fm1 ! Monin_Obukhov_silarity_function for momentum
584 real(kind=kind_phys), dimension(:) , intent(inout) :: fh1 ! Monin_Obukhov_silarity_function for heat
585 real(kind=kind_phys), dimension(:) , intent(inout) :: ustar1 ! friction velocity m s-1
586 real(kind=kind_phys), dimension(:) , intent(inout) :: stress1 ! Wind stress m2 S-2
587 real(kind=kind_phys), dimension(:) , intent(inout) :: fm101 ! MOS function for momentum evaulated @ 10 m
588 real(kind=kind_phys), dimension(:) , intent(inout) :: fh21 ! MOS function for heat evaulated @ 2m
589
590 real(kind=kind_phys), dimension(:) , intent(inout) :: snowxy ! actual no. of snow layers
591 real(kind=kind_phys), dimension(:) , intent(inout) :: tvxy ! vegetation leaf temperature [K]
592 real(kind=kind_phys), dimension(:) , intent(inout) :: tgxy ! bulk ground surface temperature [K]
593 real(kind=kind_phys), dimension(:) , intent(inout) :: canicexy ! canopy-intercepted ice [mm]
594 real(kind=kind_phys), dimension(:) , intent(inout) :: canliqxy ! canopy-intercepted liquid water [mm]
595 real(kind=kind_phys), dimension(:) , intent(inout) :: eahxy ! canopy air vapor pressure [Pa]
596 real(kind=kind_phys), dimension(:) , intent(inout) :: tahxy ! canopy air temperature [K]
597 real(kind=kind_phys), dimension(:) , intent(inout) :: cmxy ! bulk momentum drag coefficient [m/s]
598 real(kind=kind_phys), dimension(:) , intent(inout) :: chxy ! bulk sensible heat exchange coefficient [m/s]
599 real(kind=kind_phys), dimension(:) , intent(inout) :: fwetxy ! wetted or snowed fraction of the canopy [-]
600 real(kind=kind_phys), dimension(:) , intent(inout) :: sneqvoxy ! snow mass at last time step[mm h2o]
601 real(kind=kind_phys), dimension(:) , intent(inout) :: alboldxy ! snow albedo at last time step [-]
602 real(kind=kind_phys), dimension(:) , intent(inout) :: qsnowxy ! snowfall on the ground [mm/s]
603 real(kind=kind_phys), dimension(:) , intent(inout) :: wslakexy ! lake water storage [mm]
604 real(kind=kind_phys), dimension(:) , intent(inout) :: zwtxy ! water table depth [m]
605 real(kind=kind_phys), dimension(:) , intent(inout) :: waxy ! water in the "aquifer" [mm]
606 real(kind=kind_phys), dimension(:) , intent(inout) :: wtxy ! groundwater storage [mm]
607 real(kind=kind_phys), dimension(:,lsnowl:), intent(inout) :: tsnoxy ! snow temperature [K]
608 real(kind=kind_phys), dimension(:,lsnowl:), intent(inout) :: zsnsoxy ! snow/soil layer depth [m]
609 real(kind=kind_phys), dimension(:,lsnowl:), intent(inout) :: snicexy ! snow layer ice [mm]
610 real(kind=kind_phys), dimension(:,lsnowl:), intent(inout) :: snliqxy ! snow layer liquid water [mm]
611 real(kind=kind_phys), dimension(:) , intent(inout) :: lfmassxy ! leaf mass [g/m2]
612 real(kind=kind_phys), dimension(:) , intent(inout) :: rtmassxy ! mass of fine roots [g/m2]
613 real(kind=kind_phys), dimension(:) , intent(inout) :: stmassxy ! stem mass [g/m2]
614 real(kind=kind_phys), dimension(:) , intent(inout) :: woodxy ! mass of wood (incl. woody roots) [g/m2]
615 real(kind=kind_phys), dimension(:) , intent(inout) :: stblcpxy ! stable carbon in deep soil [g/m2]
616 real(kind=kind_phys), dimension(:) , intent(inout) :: fastcpxy ! short-lived carbon, shallow soil [g/m2]
617 real(kind=kind_phys), dimension(:) , intent(inout) :: xlaixy ! leaf area index [m2/m2]
618 real(kind=kind_phys), dimension(:) , intent(inout) :: xsaixy ! stem area index [m2/m2]
619 real(kind=kind_phys), dimension(:) , intent(inout) :: taussxy ! snow age factor [-]
620 real(kind=kind_phys), dimension(:,:) , intent(inout) :: smoiseq ! eq volumetric soil moisture [m3/m3]
621 real(kind=kind_phys), dimension(:) , intent(inout) :: smcwtdxy ! soil moisture content in the layer to the water table when deep
622 real(kind=kind_phys), dimension(:) , intent(inout) :: deeprechxy ! recharge to the water table when deep
623 real(kind=kind_phys), dimension(:) , intent(inout) :: rechxy ! recharge to the water table
624 real(kind=kind_phys), dimension(:) , intent(out) :: albdvis ! albedo - direct visible [fraction]
625 real(kind=kind_phys), dimension(:) , intent(out) :: albdnir ! albedo - direct NIR [fraction]
626 real(kind=kind_phys), dimension(:) , intent(out) :: albivis ! albedo - diffuse visible [fraction]
627 real(kind=kind_phys), dimension(:) , intent(out) :: albinir ! albedo - diffuse NIR [fraction]
628 real(kind=kind_phys), dimension(:) , intent(out) :: emiss ! sfc lw emissivity [fraction]
629 real(kind=kind_phys), dimension(:) , intent(out) :: sncovr1 ! snow cover over land [fraction]
630 real(kind=kind_phys), dimension(:) , intent(out) :: qsurf ! specific humidity at sfc [kg/kg]
631 real(kind=kind_phys), dimension(:) , intent(out) :: gflux ! soil heat flux [W/m2]
632 real(kind=kind_phys), dimension(:) , intent(out) :: drain ! subsurface runoff [mm/s]
633 real(kind=kind_phys), dimension(:) , intent(out) :: evap ! total latent heat flux [W/m2]
634 real(kind=kind_phys), dimension(:) , intent(out) :: hflx ! sensible heat flux [W/m2]
635 real(kind=kind_phys), dimension(:) , intent(out) :: ep ! potential evaporation [mm/s?]
636 real(kind=kind_phys), dimension(:) , intent(out) :: runoff ! surface runoff [mm/s]
637 real(kind=kind_phys), dimension(:) , intent(out) :: cmm ! cm*U [m/s]
638 real(kind=kind_phys), dimension(:) , intent(out) :: chh ! ch*U*rho [kg/m2/s]
639 real(kind=kind_phys), dimension(:) , intent(out) :: evbs ! direct soil evaporation [m/s]
640 real(kind=kind_phys), dimension(:) , intent(out) :: evcw ! canopy water evaporation [m/s]
641 real(kind=kind_phys), dimension(:) , intent(out) :: sbsno ! sublimation/deposit from snopack [W/m2]
642 real(kind=kind_phys), dimension(:) , intent(out) :: pah ! precipitation advected heat - total (w/m2)
643 real(kind=kind_phys), dimension(:) , intent(out) :: ecan ! evaporation of intercepted water (mm/s)
644 real(kind=kind_phys), dimension(:) , intent(out) :: etran ! transpiration rate (mm/s)
645 real(kind=kind_phys), dimension(:) , intent(out) :: edir ! soil surface evaporation rate (mm/s)
646 real(kind=kind_phys), dimension(:) , intent(out) :: snowc ! fractional snow cover [-]
647 real(kind=kind_phys), dimension(:) , intent(out) :: stm ! total soil column moisture content [mm]
648 real(kind=kind_phys), dimension(:) , intent(out) :: snohf ! snow/freezing-rain latent heat flux [W/m2]
649 real(kind=kind_phys), dimension(:) , intent(out) :: smcwlt2 ! dry soil moisture threshold [m3/m3]
650 real(kind=kind_phys), dimension(:) , intent(out) :: smcref2 ! soil moisture threshold [m3/m3]
651 real(kind=kind_phys), dimension(:) , intent(out) :: wet1 ! normalized surface soil saturated fraction
652 real(kind=kind_phys), dimension(:) , intent(out) :: t2mmp ! combined T2m from tiles
653 real(kind=kind_phys), dimension(:) , intent(out) :: q2mp ! combined q2m from tiles
654 real(kind=kind_phys), dimension(:) , intent(out) :: zvfun !
655 real(kind=kind_phys), dimension(:) , intent(out) :: ztmax ! thermal roughness length
656 real(kind=kind_phys), dimension(:) , intent(out) :: rca ! total canopy/stomatal resistance (s/m)
657
658 character(len=*) , intent(out) :: errmsg
659 integer , intent(out) :: errflg
660
661 real(kind=kind_phys), dimension(:) , intent(out), optional :: canopy_heat_storage_ccpp ! within-canopy heat [W/m2]
662 real(kind=kind_phys), dimension(:) , intent(out), optional :: rainfall_ccpp
663 real(kind=kind_phys), dimension(:) , intent(out), optional :: sw_absorbed_total_ccpp
664 real(kind=kind_phys), dimension(:) , intent(out), optional :: sw_reflected_total_ccpp
665 real(kind=kind_phys), dimension(:) , intent(out), optional :: lw_absorbed_total_ccpp
666 real(kind=kind_phys), dimension(:) , intent(out), optional :: temperature_bare_grd_ccpp
667 real(kind=kind_phys), dimension(:) , intent(out), optional :: temperature_veg_grd_ccpp
668 real(kind=kind_phys), dimension(:) , intent(out), optional :: temperature_veg_2m_ccpp
669 real(kind=kind_phys), dimension(:) , intent(out), optional :: temperature_bare_2m_ccpp
670 real(kind=kind_phys), dimension(:) , intent(out), optional :: spec_humidity_veg_2m_ccpp
671 real(kind=kind_phys), dimension(:) , intent(out), optional :: spec_humidity_bare_2m_ccpp
672 real(kind=kind_phys), dimension(:) , intent(out), optional :: sw_absorbed_veg_ccpp
673 real(kind=kind_phys), dimension(:) , intent(out), optional :: sw_absorbed_ground_ccpp
674 real(kind=kind_phys), dimension(:) , intent(out), optional :: snowmelt_out_ccpp
675 real(kind=kind_phys), dimension(:) , intent(out), optional :: snowmelt_shallow_ccpp
676 real(kind=kind_phys), dimension(:,:), intent(out), optional :: albedo_direct_snow_ccpp
677 real(kind=kind_phys), dimension(:,:), intent(out), optional :: albedo_diffuse_snow_ccpp
678 real(kind=kind_phys), dimension(:) , intent(out), optional :: ch_vegetated_ccpp
679 real(kind=kind_phys), dimension(:) , intent(out), optional :: ch_bare_ground_ccpp
680 real(kind=kind_phys), dimension(:) , intent(out), optional :: sensible_heat_grd_veg_ccpp
681 real(kind=kind_phys), dimension(:) , intent(out), optional :: sensible_heat_leaf_ccpp
682 real(kind=kind_phys), dimension(:) , intent(out), optional :: sensible_heat_grd_bar_ccpp
683 real(kind=kind_phys), dimension(:) , intent(out), optional :: latent_heat_grd_veg_ccpp
684 real(kind=kind_phys), dimension(:) , intent(out), optional :: latent_heat_grd_bare_ccpp
685 real(kind=kind_phys), dimension(:) , intent(out), optional :: ground_heat_veg_ccpp
686 real(kind=kind_phys), dimension(:) , intent(out), optional :: ground_heat_bare_ccpp
687 real(kind=kind_phys), dimension(:) , intent(out), optional :: lw_absorbed_grd_veg_ccpp
688 real(kind=kind_phys), dimension(:) , intent(out), optional :: lw_absorbed_leaf_ccpp
689 real(kind=kind_phys), dimension(:) , intent(out), optional :: lw_absorbed_grd_bare_ccpp
690 real(kind=kind_phys), dimension(:) , intent(out), optional :: latent_heat_trans_ccpp
691 real(kind=kind_phys), dimension(:) , intent(out), optional :: latent_heat_leaf_ccpp
692 real(kind=kind_phys), dimension(:) , intent(out), optional :: ch_leaf_ccpp
693 real(kind=kind_phys), dimension(:) , intent(out), optional :: ch_below_canopy_ccpp
694 real(kind=kind_phys), dimension(:) , intent(out), optional :: ch_vegetated_2m_ccpp
695 real(kind=kind_phys), dimension(:) , intent(out), optional :: ch_bare_ground_2m_ccpp
696 real(kind=kind_phys), dimension(:) , intent(out), optional :: precip_adv_heat_veg_ccpp
697 real(kind=kind_phys), dimension(:) , intent(out), optional :: precip_adv_heat_grd_v_ccpp
698 real(kind=kind_phys), dimension(:) , intent(out), optional :: precip_adv_heat_grd_b_ccpp
699 real(kind=kind_phys), dimension(:) , intent(out), optional :: spec_humid_sfc_veg_ccpp
700 real(kind=kind_phys), dimension(:) , intent(out), optional :: spec_humid_sfc_bare_ccpp
701
702!
703! --- some new options, hard code for now
704!
705
706 integer :: iopt_rsf = 4 ! option for surface resistance
707 integer :: iopt_soil = 1 ! option for soil parameter treatment
708 integer :: iopt_pedo = 1 ! option for pedotransfer function
709 integer :: iopt_crop = 0 ! option for crop model
710 integer :: iopt_gla = 2 ! option for glacier treatment
711 integer :: iopt_z0m = 1 ! option for z0m treatment
712
713!
714! --- local inputs to noah-mp and glacier subroutines; listed in order in noah-mp call
715!
716 ! intent
717 integer :: i_location ! in | grid index
718 integer :: j_location ! in | grid index (not used in ccpp)
719 real (kind=kind_phys) :: latitude ! in | latitude [radians]
720 integer :: year_length ! in | number of days in the current year
721 real (kind=kind_phys) :: julian_day ! in | julian day of year [floating point]
722 real (kind=kind_phys) :: cosine_zenith ! in | cosine solar zenith angle [-1,1]
723 real (kind=kind_phys) :: timestep ! in | time step [sec]
724 real (kind=kind_phys) :: spatial_scale ! in | spatial scale [m] (not used in noah-mp)
725 real (kind=kind_phys) :: atmosphere_thickness ! in | thickness of lowest atmo layer [m] (not used in noah-mp)
726 integer :: soil_levels ! in | soil levels
727 real (kind=kind_phys), dimension( 1:nsoil) :: soil_interface_depth ! in | soil layer-bottom depth from surface [m]
728 integer :: max_snow_levels ! in | maximum number of snow levels
729 real (kind=kind_phys) :: vegetation_frac ! in | vegetation fraction [0.0-1.0]
730 real (kind=kind_phys) :: area_grid ! in |
731 real (kind=kind_phys) :: max_vegetation_frac ! in | annual maximum vegetation fraction [0.0-1.0]
732 integer :: vegetation_category ! in | vegetation category
733 integer :: ice_flag ! in | ice flag (1->ice)
734 integer :: surface_type ! in | surface type flag 1->soil; 2->lake
735 integer :: crop_type ! in | crop type category
736 real (kind=kind_phys), dimension( 1:nsoil) :: eq_soil_water_vol ! in | (opt_run=5) equilibrium soil water content [m3/m3]
737 real (kind=kind_phys) :: temperature_forcing ! in | forcing air temperature [K]
738 real (kind=kind_phys) :: air_pressure_surface ! in | surface air pressure [Pa]
739 real (kind=kind_phys) :: air_pressure_forcing ! in | forcing air pressure [Pa]
740 real (kind=kind_phys) :: uwind_forcing ! in | forcing u-wind [m/s]
741 real (kind=kind_phys) :: vwind_forcing ! in | forcing v-wind [m/s]
742 real (kind=kind_phys) :: spec_humidity_forcing ! in | forcing mixing ratio [kg/kg]
743 real (kind=kind_phys) :: cloud_water_forcing ! in | cloud water mixing ratio [kg/kg] (not used in noah-mp)
744 real (kind=kind_phys) :: sw_radiation_forcing ! in | forcing downward shortwave radiation [W/m2]
745 real (kind=kind_phys) :: radiation_lw_forcing ! in | forcing downward longwave radiation [W/m2]
746 real (kind=kind_phys) :: precipitation_forcing ! in | total precipitation [mm/s]
747 real (kind=kind_phys) :: precip_convective ! in | convective precipitation [mm/s]
748 real (kind=kind_phys) :: precip_non_convective ! in | non-convective precipitation [mm/s]
749 real (kind=kind_phys) :: precip_sh_convective ! in | shallow convective precipitation [mm/s]
750 real (kind=kind_phys) :: precip_snow ! in | snow precipitation [mm/s]
751 real (kind=kind_phys) :: precip_graupel ! in | graupel precipitation [mm/s]
752 real (kind=kind_phys) :: precip_hail ! in | hail precipitation [mm/s]
753 real (kind=kind_phys) :: temperature_soil_bot ! in | soil bottom boundary condition temperature [K]
754 real (kind=kind_phys) :: co2_air ! in | atmospheric co2 concentration [Pa]
755 real (kind=kind_phys) :: o2_air ! in | atmospheric o2 concentration [Pa]
756 real (kind=kind_phys) :: foliage_nitrogen ! in | foliage nitrogen [%] [1-saturated]
757 real (kind=kind_phys), dimension(-nsnow+1: 0) :: snow_ice_frac_old ! in | snow ice fraction at last timestep [-]
758 real (kind=kind_phys) :: forcing_height ! inout | forcing height [m]
759 real (kind=kind_phys) :: snow_albedo_old ! inout | snow albedo at last time step (class option) [-]
760 real (kind=kind_phys) :: snow_water_equiv_old ! inout | snow water equivalent at last time step [mm]
761 real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: temperature_snow_soil ! inout | snow/soil temperature [K]
762 real (kind=kind_phys), dimension( 1:nsoil) :: soil_liquid_vol ! inout | volumetric liquid soil moisture [m3/m3]
763 real (kind=kind_phys), dimension( 1:nsoil) :: soil_moisture_vol ! inout | volumetric soil moisture (ice + liq.) [m3/m3]
764
765 real (kind=kind_phys) :: surface_temperature ! out | surface aerodynamic temp
766
767 real (kind=kind_phys) :: temperature_canopy_air! inout | canopy air tmeperature [K]
768 real (kind=kind_phys) :: vapor_pres_canopy_air ! inout | canopy air vapor pressure [Pa]
769 real (kind=kind_phys) :: canopy_wet_fraction ! inout | wetted or snowed fraction of canopy (-)
770 real (kind=kind_phys) :: canopy_liquid ! inout | canopy intercepted liquid [mm]
771 real (kind=kind_phys) :: canopy_ice ! inout | canopy intercepted ice [mm]
772 real (kind=kind_phys) :: temperature_leaf ! inout | leaf temperature [K]
773 real (kind=kind_phys) :: temperature_ground ! inout | grid ground surface temperature [K]
774 real (kind=kind_phys) :: spec_humidity_surface ! inout | surface specific humidty [kg/kg]
775 real (kind=kind_phys) :: snowfall ! inout | land model partitioned snowfall [mm/s]
776 real (kind=kind_phys) :: rainfall ! inout | land model partitioned rainfall [mm/s]
777 integer :: snow_levels ! inout | active snow levels [-]
778 real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: interface_depth ! inout | layer-bottom depth from snow surf [m]
779 real (kind=kind_phys) :: snow_depth ! inout | snow depth [m]
780 real (kind=kind_phys) :: snow_water_equiv ! inout | snow water equivalent [mm]
781 real (kind=kind_phys), dimension(-nsnow+1: 0) :: snow_level_ice ! inout | snow level ice [mm]
782 real (kind=kind_phys), dimension(-nsnow+1: 0) :: snow_level_liquid ! inout | snow level liquid [mm]
783 real (kind=kind_phys) :: depth_water_table ! inout | depth to water table [m]
784 real (kind=kind_phys) :: aquifer_water ! inout | water storage in aquifer [mm]
785 real (kind=kind_phys) :: saturated_water ! inout | water in aquifer+saturated soil [mm]
786 real (kind=kind_phys) :: lake_water ! inout | lake water storage (can be neg.) [mm]
787 real (kind=kind_phys) :: leaf_carbon ! inout | leaf mass [g/m2]
788 real (kind=kind_phys) :: root_carbon ! inout | mass of fine roots [g/m2]
789 real (kind=kind_phys) :: stem_carbon ! inout | stem mass [g/m2]
790 real (kind=kind_phys) :: wood_carbon ! inout | mass of wood (incl. woody roots) [g/m2]
791 real (kind=kind_phys) :: soil_carbon_stable ! inout | stable soil carbon [g/m2]
792 real (kind=kind_phys) :: soil_carbon_fast ! inout | short-lived soil carbon [g/m2]
793 real (kind=kind_phys) :: leaf_area_index ! inout | leaf area index [-]
794 real (kind=kind_phys) :: stem_area_index ! inout | stem area index [-]
795 real (kind=kind_phys) :: cm_noahmp ! inout | grid momentum drag coefficient [m/s]
796 real (kind=kind_phys) :: ch_noahmp ! inout | grid heat exchange coefficient [m/s]
797 real (kind=kind_phys) :: snow_age ! inout | non-dimensional snow age [-]
798 real (kind=kind_phys) :: grain_carbon ! inout | grain mass [g/m2]
799 real (kind=kind_phys) :: growing_deg_days ! inout | growing degree days [-]
800 integer :: plant_growth_stage ! inout | plant growing stage [-]
801 real (kind=kind_phys) :: soil_moisture_wtd ! inout | (opt_run=5) soil water content between bottom of the soil and water table [m3/m3]
802 real (kind=kind_phys) :: deep_recharge ! inout | (opt_run=5) recharge to or from the water table when deep [m]
803 real (kind=kind_phys) :: recharge ! inout | (opt_run=5) recharge to or from the water table when shallow [m] (diagnostic)
804 real (kind=kind_phys) :: z0_total ! out | weighted z0 sent to coupled model [m]
805 real (kind=kind_phys) :: z0h_total ! out | weighted z0h sent to coupled model [m]
806
807 real (kind=kind_phys) :: sw_absorbed_total ! out | total absorbed solar radiation [W/m2]
808 real (kind=kind_phys) :: sw_reflected_total ! out | total reflected solar radiation [W/m2]
809 real (kind=kind_phys) :: lw_absorbed_total ! out | total net lw rad [W/m2] [+ to atm]
810 real (kind=kind_phys) :: sensible_heat_total ! out | total sensible heat [W/m2] [+ to atm]
811 real (kind=kind_phys) :: ground_heat_total ! out | ground heat flux [W/m2] [+ to soil]
812 real (kind=kind_phys) :: latent_heat_canopy ! out | canopy evaporation heat flux [W/m2] [+ to atm]
813 real (kind=kind_phys) :: latent_heat_ground ! out | ground evaporation heat flux [W/m2] [+ to atm]
814 real (kind=kind_phys) :: transpiration_heat ! out | transpiration heat flux [W/m2] [+ to atm]
815 real (kind=kind_phys) :: evaporation_canopy ! out | canopy evaporation [mm/s]
816 real (kind=kind_phys) :: transpiration ! out | transpiration [mm/s]
817 real (kind=kind_phys) :: evaporation_soil ! out | soil surface evaporation [mm/s]
818 real (kind=kind_phys) :: temperature_radiative ! out | surface radiative temperature [K]
819 real (kind=kind_phys) :: temperature_bare_grd ! out | bare ground surface temperature [K]
820 real (kind=kind_phys) :: temperature_veg_grd ! out | below_canopy ground surface temperature [K]
821 real (kind=kind_phys) :: temperature_veg_2m ! out | vegetated 2-m air temperature [K]
822 real (kind=kind_phys) :: temperature_bare_2m ! out | bare ground 2-m air temperature [K]
823 real (kind=kind_phys) :: spec_humidity_veg_2m ! out | vegetated 2-m air specific humidity [K]
824 real (kind=kind_phys) :: spec_humidity_bare_2m ! out | bare ground 2-m air specfic humidity [K]
825 real (kind=kind_phys) :: runoff_surface ! out | surface runoff [mm/s]
826 real (kind=kind_phys) :: runoff_baseflow ! out | baseflow runoff [mm/s]
827 real (kind=kind_phys) :: par_absorbed ! out | absorbed photosynthesis active radiation [W/m2]
828 real (kind=kind_phys) :: photosynthesis ! out | total photosynthesis [umol CO2/m2/s] [+ out]
829 real (kind=kind_phys) :: sw_absorbed_veg ! out | solar radiation absorbed by vegetation [W/m2]
830 real (kind=kind_phys) :: sw_absorbed_ground ! out | solar radiation absorbed by ground [W/m2]
831 real (kind=kind_phys) :: snow_cover_fraction ! out | snow cover fraction on the ground [-]
832 real (kind=kind_phys) :: net_eco_exchange ! out | net ecosystem exchange [g/m2/s CO2]
833 real (kind=kind_phys) :: global_prim_prod ! out | global primary production [g/m2/s C]
834 real (kind=kind_phys) :: net_prim_prod ! out | net primary productivity [g/m2/s C]
835 real (kind=kind_phys) :: vegetation_fraction ! out | vegetation fraction [0.0-1.0]
836 real (kind=kind_phys) :: albedo_total ! out | total surface albedo [-]
837 real (kind=kind_phys) :: snowmelt_out ! out | snowmelt out bottom of pack [mm/s]
838 real (kind=kind_phys) :: snowmelt_shallow ! out | shallow snow melt [mm]
839 real (kind=kind_phys) :: snowmelt_shallow_1 ! out | additional shallow snow melt [mm]
840 real (kind=kind_phys) :: snowmelt_shallow_2 ! out | additional shallow snow melt [mm]
841 real (kind=kind_phys) :: rs_sunlit ! out | sunlit leaf stomatal resistance [s/m]
842 real (kind=kind_phys) :: rs_shaded ! out | shaded leaf stomatal resistance [s/m]
843 real (kind=kind_phys), dimension(1:2) :: albedo_direct ! out | direct vis/nir albedo [-]
844 real (kind=kind_phys), dimension(1:2) :: albedo_diffuse ! out | diffuse vis/nir albedo [-]
845 real (kind=kind_phys), dimension(1:2) :: albedo_direct_snow ! out | direct vis/nir snow albedo [-]
846 real (kind=kind_phys), dimension(1:2) :: albedo_diffuse_snow ! out | diffuse vis/nir snow albedo [-]
847 real (kind=kind_phys) :: canopy_gap_fraction ! out | between canopy gap fraction [-]
848 real (kind=kind_phys) :: incanopy_gap_fraction ! out | within canopy gap fraction for beam [-]
849 real (kind=kind_phys) :: ch_vegetated ! out | vegetated heat exchange coefficient [m/s]
850 real (kind=kind_phys) :: ch_bare_ground ! out | bare-ground heat exchange coefficient [m/s]
851 real (kind=kind_phys) :: emissivity_total ! out | grid emissivity [-]
852 real (kind=kind_phys) :: sensible_heat_grd_veg ! out | below-canopy ground sensible heat flux [W/m2]
853 real (kind=kind_phys) :: sensible_heat_leaf ! out | leaf-to-canopy sensible heat flux [W/m2]
854 real (kind=kind_phys) :: sensible_heat_grd_bar ! out | bare ground sensible heat flux [W/m2]
855 real (kind=kind_phys) :: latent_heat_grd_veg ! out | below-canopy ground evaporation heat flux [W/m2]
856 real (kind=kind_phys) :: latent_heat_grd_bare ! out | bare ground evaporation heat flux [W/m2]
857 real (kind=kind_phys) :: ground_heat_veg ! out | below-canopy ground heat flux [W/m2]
858 real (kind=kind_phys) :: ground_heat_bare ! out | bare ground heat flux [W/m2]
859 real (kind=kind_phys) :: lw_absorbed_grd_veg ! out | below-canopy ground absorbed longwave radiation [W/m2]
860 real (kind=kind_phys) :: lw_absorbed_leaf ! out | leaf absorbed longwave radiation [W/m2]
861 real (kind=kind_phys) :: lw_absorbed_grd_bare ! out | bare ground net longwave radiation [W/m2]
862 real (kind=kind_phys) :: latent_heat_trans ! out | transpiration [W/m2]
863 real (kind=kind_phys) :: latent_heat_leaf ! out | leaf evaporation [W/m2]
864 real (kind=kind_phys) :: ch_leaf ! out | leaf exchange coefficient [m/s]
865 real (kind=kind_phys) :: ch_below_canopy ! out | below-canopy exchange coefficient [m/s]
866 real (kind=kind_phys) :: ch_vegetated_2m ! out | 2-m vegetated heat exchange coefficient [m/s]
867 real (kind=kind_phys) :: ch_bare_ground_2m ! out | 2-m bare-ground heat exchange coefficient [m/s]
868 real (kind=kind_phys) :: precip_frozen_frac ! out | precipitation snow fraction [-]
869 real (kind=kind_phys) :: precip_adv_heat_veg ! out | precipitation advected heat - vegetation net [W/m2]
870 real (kind=kind_phys) :: precip_adv_heat_grd_v ! out | precipitation advected heat - below-canopy net [W/m2]
871 real (kind=kind_phys) :: precip_adv_heat_grd_b ! out | precipitation advected heat - bare ground net [W/m2]
872 real (kind=kind_phys) :: precip_adv_heat_total ! out | precipitation advected heat - total [W/m2)
873 real (kind=kind_phys) :: snow_sublimation ! out | snow sublimation [W/m2]
874 real (kind=kind_phys) :: lai_sunlit ! out | sunlit leaf area index [m2/m2]
875 real (kind=kind_phys) :: lai_shaded ! out | shaded leaf area index [m2/m2]
876 real (kind=kind_phys) :: leaf_air_resistance ! out | leaf boundary layer resistance [s/m]
877
878 real (kind=kind_phys) :: canopy_heat_storage ! out | within-canopy heat [W/m2]
879 real (kind=kind_phys) :: spec_humid_sfc_veg ! out | surface specific humidty over vegetation [kg/kg]
880 real (kind=kind_phys) :: spec_humid_sfc_bare ! out | surface specific humidty over bare soil [kg/kg]
881
882 real (kind=kind_phys) :: ustarx ! inout |surface friction velocity
883 real (kind=kind_phys) :: prslkix ! in exner function
884 real (kind=kind_phys) :: prsik1x ! in exner function
885 real (kind=kind_phys) :: prslk1x ! in exner function
886
887 real (kind=kind_phys) :: ch2
888 real (kind=kind_phys) :: cq2
889 real (kind=kind_phys) :: qfx
890 real (kind=kind_phys) :: wspd1 ! wind speed with all components
891 real (kind=kind_phys) :: pblhx ! height of pbl
892 integer :: mnice
893
894 real (kind=kind_phys) :: rah_total !
895 real (kind=kind_phys) :: cah_total !
896
897
898!
899! --- local variable
900!
901
902 integer :: soil_category(nsoil)
903 integer :: slope_category
904 integer :: soil_color_category
905 character(len=256) :: dataset_identifier
906
907 real (kind=kind_phys) :: spec_humidity_sat ! saturation specific humidity
908 real (kind=kind_phys) :: vapor_pressure_sat ! saturation vapor pressure
909 real (kind=kind_phys) :: latent_heat_total ! total latent heat flux [W/m2]
910 real (kind=kind_phys) :: density ! air density
911 real (kind=kind_phys) :: virtual_temperature ! used for penman calculation and density
912 real (kind=kind_phys) :: potential_evaporation ! used for penman calculation
913 real (kind=kind_phys) :: potential_temperature ! used for penman calculation
914 real (kind=kind_phys) :: penman_radiation ! used for penman calculation
915 real (kind=kind_phys) :: dqsdt ! used for penman calculation
916 real (kind=kind_phys) :: precip_freeze_frac_in ! used for penman calculation
917
918 real (kind=kind_phys) :: virtfac1 ! virtual factor
919 real (kind=kind_phys) :: tflux ! surface flux temp
920 real (kind=kind_phys) :: tvs1 ! surface virtual temp
921 real (kind=kind_phys) :: vptemp ! virtual potential temp
922
923 real(kind=kind_phys) :: tem1,tem2,gdx
924 real(kind=kind_phys), parameter :: z0lo=0.1, z0up=1.0
925
926 logical :: is_snowing ! used for penman calculation
927 logical :: is_freeze_rain ! used for penman calculation
928 integer :: i, k
929
930!
931! --- local derived constants:
932!
933
934 type(noahmp_parameters) :: parameters
935
936!
937! --- end declaration
938!
939
940!
941! --- Initialize CCPP error handling variables
942!
943 errmsg = ''
944 errflg = 0
945
946!
947! --- Just return if external land component is activated for two-way interaction
948!
949 if (cpllnd .and. cpllnd2atm) return
950
951 do i = 1, im
952
953 if (flag_iter(i) .and. dry(i)) then
954
955!
956! --- variable checks and derived fields
957!
958
959 if(vegtype(i) == isice_table ) then
960 if(weasd(i) < 0.1) then
961 weasd(i) = 0.1
962 end if
963 end if
964
965!
966! --- noah-mp input variables (except snow_ice_frac_old done later)
967!
968
969 dataset_identifier = "modified_igbp_modis_noah"
970
971 i_location = i
972 j_location = -9999
973 latitude = xlatin(i)
974 year_length = iyrlen
975 julian_day = julian
976 cosine_zenith = xcoszin(i)
977 timestep = delt
978 spatial_scale = -9999.0
979 atmosphere_thickness = -9999.0
980 soil_levels = km
981 soil_interface_depth = zsoil
982 max_snow_levels = nsnow
983 vegetation_frac = sigmaf(i)
984 max_vegetation_frac = shdmax(i)
985 vegetation_category = vegtype(i)
986 surface_type = 1
987 crop_type = 0
988 eq_soil_water_vol = smoiseq(i,:) ! only need for run=5
989 temperature_forcing = t1(i)
990 air_pressure_surface = ps(i)
991 air_pressure_forcing = prsl1(i)
992 uwind_forcing = u1(i)
993 vwind_forcing = v1(i)
994 area_grid = garea(i)
995
996 pblhx = pblh(i)
997
998 prslkix = prslki(i)
999 prsik1x = prsik1(i)
1000 prslk1x = prslk1(i)
1001
1002 spec_humidity_forcing = max(q1(i), 1.e-8) ! specific humidity at level 1 (kg/kg)
1003 virtual_temperature = temperature_forcing * &
1004 (1.0 + con_fvirt * spec_humidity_forcing) ! virtual temperature
1005 vapor_pressure_sat = fpvs( temperature_forcing ) ! sat. vapor pressure at level 1 (Pa)
1006 spec_humidity_sat = con_eps*vapor_pressure_sat / &
1007 (prsl1(i) + con_epsm1*vapor_pressure_sat) ! sat. specific humidity at level 1 (kg/kg)
1008 spec_humidity_sat = max(spec_humidity_sat, 1.e-8) ! lower limit sat. specific humidity (kg/kg)
1009 spec_humidity_forcing = min(spec_humidity_sat,spec_humidity_forcing) ! limit specific humidity at level 1 (kg/kg)
1010
1011 cloud_water_forcing = -9999.0
1012 sw_radiation_forcing = dswsfc(i)
1013 radiation_lw_forcing = dlwflx(i)
1014 precipitation_forcing = 1000.0 * tprcp(i) / delt
1015 precip_convective = rainc_mp(i)
1016 precip_non_convective = rainn_mp(i)
1017 precip_sh_convective = 0.
1018 precip_snow = snow_mp(i)
1019 precip_graupel = graupel_mp(i)
1020 precip_hail = ice_mp(i)
1021 temperature_soil_bot = tg3(i)
1022 co2_air = co2_table * air_pressure_forcing
1023 o2_air = o2_table * air_pressure_forcing
1024 foliage_nitrogen = 1.0
1025
1026!
1027! --- noah-mp inout variables
1028!
1029
1030 forcing_height = zf(i)
1031 snow_albedo_old = alboldxy(i)
1032 snow_water_equiv_old = sneqvoxy(i)
1033 temperature_snow_soil(-2: 0) = tsnoxy(i,:)
1034 temperature_snow_soil( 1:km) = stc(i,:)
1035 soil_liquid_vol = slc(i,:)
1036 soil_moisture_vol = smc(i,:)
1037 temperature_canopy_air = tahxy(i)
1038 vapor_pres_canopy_air = eahxy(i)
1039 canopy_wet_fraction = fwetxy(i)
1040 canopy_liquid = canliqxy(i)
1041 canopy_ice = canicexy(i)
1042 temperature_leaf = tvxy(i)
1043 temperature_ground = tgxy(i)
1044 spec_humidity_surface = undefined ! doesn't need inout; should be out
1045 snowfall = qsnowxy(i) ! doesn't need inout; should be out
1046 rainfall = -9999.0 ! doesn't need inout; should be out
1047 snow_levels = nint(snowxy(i))
1048 interface_depth = zsnsoxy(i,:)
1049 snow_depth = snwdph(i) * 0.001 ! convert from mm to m
1050 snow_water_equiv = weasd(i)
1051 if (snow_water_equiv /= 0.0 .and. snow_depth == 0.0) then
1052 snow_depth = 10.0 * snow_water_equiv /1000.0
1053 endif
1054 snow_level_ice = snicexy(i,:)
1055 snow_level_liquid = snliqxy(i,:)
1056 depth_water_table = zwtxy(i)
1057 aquifer_water = waxy(i)
1058 saturated_water = wtxy(i)
1059 lake_water = wslakexy(i)
1060 leaf_carbon = lfmassxy(i)
1061 root_carbon = rtmassxy(i)
1062 stem_carbon = stmassxy(i)
1063 wood_carbon = woodxy(i)
1064 soil_carbon_stable = stblcpxy(i)
1065 soil_carbon_fast = fastcpxy(i)
1066 leaf_area_index = xlaixy(i)
1067 stem_area_index = xsaixy(i)
1068 cm_noahmp = cmxy(i)
1069 ch_noahmp = chxy(i)
1070 snow_age = taussxy(i)
1071! grain_carbon ! new variable
1072! growing_deg_days ! new variable
1073! plant_growth_stage ! new variable
1074 soil_moisture_wtd = smcwtdxy(i)
1075 deep_recharge = deeprechxy(i)
1076 recharge = rechxy(i)
1077
1078 ustarx = ustar1(i)
1079
1080 snow_ice_frac_old = 0.0
1081 do k = snow_levels+1, 0
1082 if(snow_level_ice(k) > 0.0 ) &
1083 snow_ice_frac_old(k) = snow_level_ice(k) /(snow_level_ice(k)+snow_level_liquid(k))
1084 end do
1085
1086
1087 if (snow_depth .gt. 0.1 .or. vegetation_category == isice_table ) then
1088 mnice = 1
1089 else
1090 mnice = 0
1091 endif
1092
1093!
1094! --- some outputs for atm model?
1095!
1096 density = air_pressure_forcing / (con_rd * virtual_temperature)
1097 chh(i) = ch(i) * wind(i) * density
1098 cmm(i) = cm(i) * wind(i)
1099!
1100! --- noah-mp additional variables
1101!
1102
1103 soil_category = soiltyp(i)
1104 slope_category = slopetyp(i)
1105 soil_color_category = soilcol(i)
1106! soil_color_category = 4
1107
1108
1109 call transfer_mp_parameters(vegetation_category, soil_category, &
1110 slope_category, soil_color_category, crop_type,parameters)
1111 parameters%prcpiceden = rhonewsn1(i)
1112 call noahmp_options(idveg ,iopt_crs, iopt_btr , iopt_run, iopt_sfc, &
1113 iopt_frz, iopt_inf , iopt_rad, iopt_alb, &
1114 iopt_snf, iopt_tbot, iopt_stc, iopt_rsf, &
1115 iopt_soil,iopt_pedo, iopt_crop,iopt_trs, &
1116 iopt_diag,iopt_z0m)
1117
1118 if ( vegetation_category == isice_table ) then
1119
1120 if (precipitation_forcing > 0.0) then
1121 if (srflag(i) > 0.0) then
1122 snowfall = srflag(i) * precipitation_forcing ! need snowfall for glacier snow age
1123 endif
1124 endif
1125
1126 ice_flag = -1
1127 temperature_soil_bot = min(temperature_soil_bot,263.15)
1128
1129 call noahmp_options_glacier(iopt_alb, iopt_snf, iopt_tbot, iopt_stc, iopt_gla, &
1130 iopt_sfc ,iopt_trs)
1131 vegetation_frac = 0.0
1132 call noahmp_glacier ( &
1133 i_location ,1 ,cosine_zenith ,nsnow , &
1134 nsoil ,timestep , &
1135 temperature_forcing ,air_pressure_forcing ,uwind_forcing ,vwind_forcing , &
1136 spec_humidity_forcing,sw_radiation_forcing ,precipitation_forcing,radiation_lw_forcing , &
1137 temperature_soil_bot ,forcing_height ,snow_ice_frac_old ,zsoil , &
1138 thsfc_loc ,prslkix ,prsik1x ,prslk1x , &
1139 air_pressure_surface ,pblhx ,iz0tlnd ,itime , &
1140 vegetation_frac ,area_grid ,psi_opt , &
1141 con_fvirt ,con_eps ,con_epsm1 ,con_cp , &
1142 snowfall ,snow_water_equiv_old ,snow_albedo_old , &
1143 cm_noahmp ,ch_noahmp ,snow_levels ,snow_water_equiv , &
1144 soil_moisture_vol ,interface_depth ,snow_depth ,snow_level_ice , &
1145 snow_level_liquid ,temperature_ground ,temperature_snow_soil,soil_liquid_vol , &
1146 snow_age ,spec_humidity_surface,sw_absorbed_total ,sw_reflected_total , &
1147 lw_absorbed_total ,sensible_heat_total ,latent_heat_ground ,ground_heat_total , &
1148 temperature_radiative,evaporation_soil ,runoff_surface ,runoff_baseflow , &
1149 sw_absorbed_ground ,albedo_total ,snowmelt_out ,snowmelt_shallow , &
1150 snowmelt_shallow_1 ,snowmelt_shallow_2 ,temperature_bare_2m ,spec_humidity_bare_2m, &
1151 z0h_total , &
1152 emissivity_total ,precip_frozen_frac ,ch_bare_ground_2m ,snow_sublimation , &
1153#ifdef CCPP
1154 albedo_direct ,albedo_diffuse, errmsg ,errflg )
1155#else
1156 albedo_direct ,albedo_diffuse)
1157#endif
1158
1159#ifdef CCPP
1160 if (errflg /= 0) return
1161#endif
1162
1163!
1164! set some non-glacier fields over the glacier
1165!
1166
1167 snow_cover_fraction = 1.0
1168 temperature_leaf = temperature_radiative
1169 canopy_ice = 0.0
1170 canopy_liquid = 0.0
1171 vapor_pres_canopy_air = 2000.0
1172 temperature_canopy_air = temperature_radiative
1173 canopy_wet_fraction = 0.0
1174 lake_water = 0.0
1175 depth_water_table = 0.0
1176 aquifer_water = 0.0
1177 saturated_water = 0.0
1178 leaf_carbon = 0.0
1179 root_carbon = 0.0
1180 stem_carbon = 0.0
1181 wood_carbon = 0.0
1182 soil_carbon_stable = 0.0
1183 soil_carbon_fast = 0.0
1184 leaf_area_index = 0.0
1185 stem_area_index = 0.0
1186 evaporation_canopy = 0.0
1187 transpiration = 0.0
1188 aquifer_water = 0.0
1189 precip_adv_heat_total = 0.0
1190 soil_moisture_wtd = 0.0
1191 recharge = 0.0
1192 deep_recharge = 0.0
1193 eq_soil_water_vol = soil_moisture_vol
1194 transpiration_heat = 0.0
1195 latent_heat_canopy = 0.0
1196 z0_total = 0.002
1197 latent_heat_total = latent_heat_ground
1198 t2mmp(i) = temperature_bare_2m
1199 q2mp(i) = spec_humidity_bare_2m
1200
1201 tskin(i) = temperature_radiative
1202 tflux = temperature_ground
1203 surface_temperature = temperature_ground
1204 vegetation_fraction = vegetation_frac
1205 ch_vegetated = 0.0
1206 ch_bare_ground = ch_noahmp
1207 canopy_heat_storage = 0.0
1208 lai_sunlit = 0.0
1209 lai_shaded = 0.0
1210 rs_sunlit = 0.0
1211 rs_shaded = 0.0
1212
1213 else ! not glacier
1214
1215 ice_flag = 0
1216
1217 call noahmp_sflx (parameters , &
1218 i_location ,j_location ,latitude , &
1219 year_length ,julian_day ,cosine_zenith , &
1220 timestep ,spatial_scale ,atmosphere_thickness , &
1221 soil_levels ,soil_interface_depth ,max_snow_levels , &
1222 vegetation_frac ,max_vegetation_frac ,vegetation_category , &
1223 ice_flag ,surface_type ,crop_type , &
1224 eq_soil_water_vol ,temperature_forcing ,air_pressure_forcing , &
1225 air_pressure_surface ,uwind_forcing ,vwind_forcing , &
1226 spec_humidity_forcing ,area_grid ,cloud_water_forcing , &
1227 sw_radiation_forcing ,radiation_lw_forcing ,thsfc_loc , &
1228 prslkix ,prsik1x ,prslk1x , &
1229 pblhx ,iz0tlnd ,itime , &
1230 psi_opt , &
1231 precip_convective , &
1232 precip_non_convective ,precip_sh_convective ,precip_snow , &
1233 precip_graupel ,precip_hail ,temperature_soil_bot , &
1234 co2_air ,o2_air ,foliage_nitrogen , &
1235 snow_ice_frac_old ,forcing_height , &
1236 con_fvirt ,con_eps, con_epsm1 ,con_cp , &
1237 snow_albedo_old ,snow_water_equiv_old , &
1238 temperature_snow_soil ,soil_liquid_vol ,soil_moisture_vol , &
1239 temperature_canopy_air,vapor_pres_canopy_air ,canopy_wet_fraction , &
1240 canopy_liquid ,canopy_ice ,temperature_leaf , &
1241 temperature_ground ,spec_humidity_surface ,snowfall , &
1242 rainfall ,snow_levels ,interface_depth , &
1243 snow_depth ,snow_water_equiv ,snow_level_ice , &
1244 snow_level_liquid ,depth_water_table ,aquifer_water , &
1245 saturated_water , &
1246 lake_water ,leaf_carbon ,root_carbon , &
1247 stem_carbon ,wood_carbon ,soil_carbon_stable , &
1248 soil_carbon_fast ,leaf_area_index ,stem_area_index , &
1249 cm_noahmp ,ch_noahmp ,snow_age , &
1250 grain_carbon ,growing_deg_days ,plant_growth_stage , &
1251 soil_moisture_wtd ,deep_recharge ,recharge,ustarx , &
1252 z0_total ,z0h_total ,surface_temperature , &
1253 sw_absorbed_total ,sw_reflected_total , &
1254 lw_absorbed_total ,sensible_heat_total ,ground_heat_total , &
1255 latent_heat_canopy ,latent_heat_ground ,transpiration_heat , &
1256 evaporation_canopy ,transpiration ,evaporation_soil , &
1257 temperature_radiative ,temperature_bare_grd ,temperature_veg_grd , &
1258 temperature_veg_2m ,temperature_bare_2m ,spec_humidity_veg_2m , &
1259 spec_humidity_bare_2m ,runoff_surface ,runoff_baseflow , &
1260 par_absorbed ,photosynthesis ,sw_absorbed_veg , &
1261 sw_absorbed_ground ,snow_cover_fraction ,net_eco_exchange , &
1262 global_prim_prod ,net_prim_prod ,vegetation_fraction , &
1263 albedo_total ,snowmelt_out ,snowmelt_shallow , &
1264 snowmelt_shallow_1 ,snowmelt_shallow_2 ,rs_sunlit , &
1265 rs_shaded ,albedo_direct ,albedo_diffuse , &
1266 albedo_direct_snow ,albedo_diffuse_snow , &
1267 canopy_gap_fraction , &
1268 incanopy_gap_fraction ,ch_vegetated ,ch_bare_ground , &
1269 emissivity_total ,sensible_heat_grd_veg ,sensible_heat_leaf , &
1270 sensible_heat_grd_bar ,latent_heat_grd_veg ,latent_heat_grd_bare , &
1271 ground_heat_veg ,ground_heat_bare ,lw_absorbed_grd_veg , &
1272 lw_absorbed_leaf ,lw_absorbed_grd_bare ,latent_heat_trans , &
1273 latent_heat_leaf ,ch_leaf ,ch_below_canopy , &
1274 ch_vegetated_2m ,ch_bare_ground_2m ,precip_frozen_frac , &
1275 precip_adv_heat_veg ,precip_adv_heat_grd_v ,precip_adv_heat_grd_b , &
1276 precip_adv_heat_total ,snow_sublimation ,canopy_heat_storage , &
1277 lai_sunlit ,lai_shaded ,leaf_air_resistance , &
1278#ifdef CCPP
1279 spec_humid_sfc_veg ,spec_humid_sfc_bare , &
1280 errmsg ,errflg )
1281#else
1282 spec_humid_sfc_veg ,spec_humid_sfc_bare )
1283#endif
1284
1285#ifdef CCPP
1286 if (errflg /= 0) return
1287#endif
1288
1289 latent_heat_total = latent_heat_canopy + latent_heat_ground + transpiration_heat
1290
1291 t2mmp(i) = temperature_veg_2m * vegetation_fraction + &
1292 temperature_bare_2m * (1-vegetation_fraction)
1293 q2mp(i) = spec_humidity_veg_2m * vegetation_fraction + &
1294 spec_humidity_bare_2m * (1-vegetation_fraction)
1295
1296 tskin(i) = temperature_radiative
1297 tflux = surface_temperature
1298
1299 endif ! glacial split ends
1300
1301!
1302! --- noah-mp inout and out variables
1303!
1304
1305 tsnoxy(i,:) = temperature_snow_soil(-2: 0)
1306 stc(i,:) = temperature_snow_soil( 1:km)
1307 hflx(i) = sensible_heat_total !note unit change below
1308 evap(i) = latent_heat_total !note unit change below
1309 evbs(i) = latent_heat_ground
1310 evcw(i) = latent_heat_canopy
1311 trans(i) = transpiration_heat
1312 gflux(i) = -1.0*ground_heat_total ! opposite sign to be consistent with noah
1313 snohf(i) = snowmelt_out * con_hfus ! only snow that exits pack
1314 sbsno(i) = snow_sublimation
1315 pah(i) = precip_adv_heat_total
1316
1317 cmxy(i) = cm_noahmp
1318 chxy(i) = ch_noahmp
1319 zorl(i) = z0_total * 100.0 ! convert to cm
1320 ztmax(i) = z0h_total
1321
1322 !LAI-scale canopy resistance based on weighted sunlit shaded fraction
1323 if(rs_sunlit .le. 0.0 .or. rs_shaded .le. 0.0 .or. &
1324 lai_sunlit .eq. 0.0 .or. lai_shaded .eq. 0.0) then
1325 rca(i) = parameters%rsmax
1326 else !calculate LAI-scale canopy conductance (1/Rs)
1327 rca(i) = ((1.0/(rs_sunlit+leaf_air_resistance)*lai_sunlit) + &
1328 ((1.0/(rs_shaded+leaf_air_resistance))*lai_shaded))
1329 rca(i) = max((1.0/rca(i)),parameters%rsmin) !resistance
1330 end if
1331
1332 smc(i,:) = soil_moisture_vol
1333 slc(i,:) = soil_liquid_vol
1334 snowxy(i) = float(snow_levels)
1335 weasd(i) = snow_water_equiv
1336 snicexy(i,:) = snow_level_ice
1337 snliqxy(i,:) = snow_level_liquid
1338 snwdph(i) = snow_depth * 1000.0 ! convert from mm to m
1339 canopy(i) = canopy_ice + canopy_liquid
1340 canliqxy(i) = canopy_liquid
1341 canicexy(i) = canopy_ice
1342 zwtxy(i) = depth_water_table
1343 waxy(i) = aquifer_water
1344 wtxy(i) = saturated_water
1345 qsnowxy(i) = snowfall
1346 ecan(i) = evaporation_canopy
1347 etran(i) = transpiration
1348 edir(i) = evaporation_soil
1349 drain(i) = runoff_baseflow
1350 runoff(i) = runoff_surface
1351
1352 lfmassxy(i) = leaf_carbon
1353 rtmassxy(i) = root_carbon
1354 stmassxy(i) = stem_carbon
1355 woodxy(i) = wood_carbon
1356 stblcpxy(i) = soil_carbon_stable
1357 fastcpxy(i) = soil_carbon_fast
1358 xlaixy(i) = leaf_area_index
1359 xsaixy(i) = stem_area_index
1360
1361 snowc(i) = snow_cover_fraction
1362 sncovr1(i) = snow_cover_fraction
1363
1364 qsurf(i) = spec_humidity_surface
1365 tsurf(i) = tskin(i)
1366
1367 tvxy(i) = temperature_leaf
1368 tgxy(i) = temperature_ground
1369 tahxy(i) = temperature_canopy_air
1370 eahxy(i) = vapor_pres_canopy_air
1371 emiss(i) = emissivity_total
1372
1373 if(albedo_total > 0.0) then
1374 sfalb(i) = albedo_total
1375 albdvis(i) = albedo_direct(1)
1376 albdnir(i) = albedo_direct(2)
1377 albivis(i) = albedo_diffuse(1)
1378 albinir(i) = albedo_diffuse(2)
1379 end if
1380
1381 zsnsoxy(i,:) = interface_depth
1382
1383 if(present(canopy_heat_storage_ccpp )) canopy_heat_storage_ccpp(i) = canopy_heat_storage
1384 if(present(rainfall_ccpp )) rainfall_ccpp(i) = rainfall
1385 if(present(sw_absorbed_total_ccpp )) sw_absorbed_total_ccpp(i) = sw_absorbed_total
1386 if(present(sw_reflected_total_ccpp )) sw_reflected_total_ccpp(i) = sw_reflected_total
1387 if(present(lw_absorbed_total_ccpp )) lw_absorbed_total_ccpp(i) = lw_absorbed_total
1388 if(present(temperature_bare_grd_ccpp )) temperature_bare_grd_ccpp(i) = temperature_bare_grd
1389 if(present(temperature_veg_grd_ccpp )) temperature_veg_grd_ccpp(i) = temperature_veg_grd
1390 if(present(temperature_veg_2m_ccpp )) temperature_veg_2m_ccpp(i) = temperature_veg_2m
1391 if(present(temperature_bare_2m_ccpp )) temperature_bare_2m_ccpp(i) = temperature_bare_2m
1392 if(present(spec_humidity_veg_2m_ccpp )) spec_humidity_veg_2m_ccpp(i) = spec_humidity_veg_2m
1393 if(present(spec_humidity_bare_2m_ccpp)) spec_humidity_bare_2m_ccpp(i) = spec_humidity_bare_2m
1394 if(present(sw_absorbed_veg_ccpp )) sw_absorbed_veg_ccpp(i) = sw_absorbed_veg
1395 if(present(sw_absorbed_ground_ccpp )) sw_absorbed_ground_ccpp(i) = sw_absorbed_ground
1396 if(present(snowmelt_out_ccpp )) snowmelt_out_ccpp(i) = snowmelt_out
1397 if(present(snowmelt_shallow_ccpp )) snowmelt_shallow_ccpp(i) = snowmelt_shallow
1398 if(present(albedo_direct_snow_ccpp )) albedo_direct_snow_ccpp(i,:) = albedo_direct_snow
1399 if(present(albedo_diffuse_snow_ccpp )) albedo_diffuse_snow_ccpp(i,:) = albedo_diffuse_snow
1400 if(present(ch_vegetated_ccpp )) ch_vegetated_ccpp(i) = ch_vegetated
1401 if(present(ch_bare_ground_ccpp )) ch_bare_ground_ccpp(i) = ch_bare_ground
1402 if(present(sensible_heat_grd_veg_ccpp)) sensible_heat_grd_veg_ccpp(i) = sensible_heat_grd_veg
1403 if(present(sensible_heat_leaf_ccpp )) sensible_heat_leaf_ccpp(i) = sensible_heat_leaf
1404 if(present(sensible_heat_grd_bar_ccpp)) sensible_heat_grd_bar_ccpp(i) = sensible_heat_grd_bar
1405 if(present(latent_heat_grd_veg_ccpp )) latent_heat_grd_veg_ccpp(i) = latent_heat_grd_veg
1406 if(present(latent_heat_grd_bare_ccpp )) latent_heat_grd_bare_ccpp(i) = latent_heat_grd_bare
1407 if(present(ground_heat_veg_ccpp )) ground_heat_veg_ccpp(i) = ground_heat_veg
1408 if(present(ground_heat_bare_ccpp )) ground_heat_bare_ccpp(i) = ground_heat_bare
1409 if(present(lw_absorbed_grd_veg_ccpp )) lw_absorbed_grd_veg_ccpp(i) = lw_absorbed_grd_veg
1410 if(present(lw_absorbed_leaf_ccpp )) lw_absorbed_leaf_ccpp(i) = lw_absorbed_leaf
1411 if(present(lw_absorbed_grd_bare_ccpp )) lw_absorbed_grd_bare_ccpp(i) = lw_absorbed_grd_bare
1412 if(present(latent_heat_trans_ccpp )) latent_heat_trans_ccpp(i) = latent_heat_trans
1413 if(present(latent_heat_leaf_ccpp )) latent_heat_leaf_ccpp(i) = latent_heat_leaf
1414 if(present(ch_leaf_ccpp )) ch_leaf_ccpp(i) = ch_leaf
1415 if(present(ch_below_canopy_ccpp )) ch_below_canopy_ccpp(i) = ch_below_canopy
1416 if(present(ch_vegetated_2m_ccpp )) ch_vegetated_2m_ccpp(i) = ch_vegetated_2m
1417 if(present(ch_bare_ground_2m_ccpp )) ch_bare_ground_2m_ccpp(i) = ch_bare_ground_2m
1418 if(present(precip_adv_heat_veg_ccpp )) precip_adv_heat_veg_ccpp(i) = precip_adv_heat_veg
1419 if(present(precip_adv_heat_grd_v_ccpp)) precip_adv_heat_grd_v_ccpp(i) = precip_adv_heat_grd_v
1420 if(present(precip_adv_heat_grd_b_ccpp)) precip_adv_heat_grd_b_ccpp(i) = precip_adv_heat_grd_b
1421 if(present(spec_humid_sfc_veg_ccpp )) spec_humid_sfc_veg_ccpp(i) = spec_humid_sfc_veg
1422 if(present(spec_humid_sfc_bare_ccpp )) spec_humid_sfc_bare_ccpp(i) = spec_humid_sfc_bare
1423
1424 wslakexy(i) = lake_water ! not active
1425 fwetxy(i) = canopy_wet_fraction
1426 taussxy(i) = snow_age
1427 alboldxy(i) = snow_albedo_old
1428 sneqvoxy(i) = snow_water_equiv_old
1429
1430 smcwtdxy(i) = soil_moisture_wtd ! only need for run=5
1431 deeprechxy(i) = deep_recharge ! only need for run=5
1432 rechxy(i) = recharge ! only need for run=5
1433 smoiseq(i,:) = eq_soil_water_vol ! only need for run=5; listed as in
1434
1435 stm(i) = (0.1*soil_moisture_vol(1) + &
1436 0.3*soil_moisture_vol(2) + &
1437 0.6*soil_moisture_vol(3) + & ! clean up and use depths above
1438 1.0*soil_moisture_vol(4))*1000.0 ! unit conversion from m to kg m-2
1439
1440 wet1(i) = soil_moisture_vol(1) / smcmax_table(soil_category(1))
1441 smcwlt2(i) = smcdry_table(soil_category(1)) !!!change to wilt?
1442 smcref2(i) = smcref_table(soil_category(1))
1443
1444 virtfac1 = 1.0 + con_fvirt * max(q1(i), 1.e-8) !from forcing
1445
1446 if(thsfc_loc) then ! Use local potential temperature
1447 vptemp =temperature_forcing * prslki(i)*virtfac1 !virtual potential temperature @zlvl 1
1448 else ! Use potential temperature reference to 1000 hPa
1449 vptemp =temperature_forcing /prslk1(i) * virtfac1
1450 endif
1451
1452 if(thsfc_loc) then ! Use local potential temperature
1453 tvs1 = tflux * virtfac1
1454 else ! Use potential temperature referenced to 1000 hPa
1455 tvs1 = tflux/prsik1(i) * virtfac1
1456 endif
1457
1458 z0_total = max(min(z0_total,forcing_height),1.0e-6)
1459 z0h_total = max(z0h_total,1.0e-6)
1460
1461
1462 tem1 = (z0_total - z0lo) / (z0up - z0lo)
1463 tem1 = min(max(tem1, 0.0_kind_phys), 1.0_kind_phys)
1464 tem2 = max(vegetation_fraction, 0.1_kind_phys)
1465 zvfun(i) = sqrt(tem1 * tem2)
1466 gdx=sqrt(garea(i))
1467
1468! if ( .not. do_mynnsfclay) then !GFS sfcdiff
1469 if ( iopt_sfc .ne. 4 ) then !GFS sfcdiff
1470
1471 call gfs_stability &
1472 (zf(i), zvfun(i), gdx, virtual_temperature, vptemp,wind(i), z0_total, z0h_total, &
1473 tvs1, con_g, thsfc_loc, &
1474 rb1(i), fm1(i), fh1(i), fm101(i), fh21(i), cm(i), ch(i), stress1(i), ustar1(i))
1475
1476 rmol1(i) = undefined !not used in GFS sfcdif -> to satsify output
1477 flhc1(i) = undefined
1478 flqc1(i) = undefined
1479
1480 rah_total = max(1.0,1.0/( ch(i)*wind(i)) )
1481 cah_total = density * con_cp /rah_total
1482! tskin(i) = sensible_heat_total/cah_total + temperature_forcing ! test to use combined ch and SH to backout Ts
1483
1484! ch(i) = ch_vegetated * vegetation_frac + ch_bare_ground*(1.0-vegetation_frac)
1485
1486 else ! MYNN - note the GFS option is the same as sfcdif3; so removed.
1487
1488 qfx = evap(i) / con_hvap ! use flux from output
1489
1490 call sfcdif4(i_location ,j_location ,uwind_forcing ,vwind_forcing , &
1491 temperature_forcing, air_pressure_forcing ,air_pressure_surface , &
1492 pblhx,gdx,z0_total,con_fvirt,con_eps,con_cp,itime,snwdph(i),mnice, &
1493 psi_opt,surface_temperature, &
1494 spec_humidity_forcing,forcing_height,iz0tlnd,spec_humidity_surface,&
1495 sensible_heat_total,qfx,cm(i),ch(i),ch2,cq2,rmol1(i),ustar1(i), &
1496 rb1(i),fm1(i),fh1(i),stress1(i),fm101(i),fh21(i),wspd1,flhc1(i), &
1497 flqc1(i) )
1498
1499 ch(i)=ch(i)/wspd1
1500 cm(i)=cm(i)/wspd1
1501
1502 ch(i) = ch_vegetated * vegetation_fraction + ch_bare_ground*(1.0-vegetation_fraction)
1503
1504 rah_total = max(1.0,1.0/( ch(i)*wind(i)) )
1505 cah_total = density * con_cp /rah_total
1506
1507! tskin(i) = sensible_heat_total/cah_total + temperature_forcing !
1508
1509 endif
1510
1511
1512
1513 cmxy(i) = cm(i)
1514 chxy(i) = ch(i)
1515
1516 chh(i) = chxy(i) * wind(i) * density
1517 cmm(i) = cmxy(i) * wind(i)
1518
1519 snwdph(i) = snow_depth * 1000.0 ! convert from m to mm; wait after the stability call
1520! qsurf (i) = q1(i) + evap(i)/(con_hvap*density*ch(i)*wind(i))
1521
1522!
1523! --- change units for output
1524!
1525 hflx(i) = hflx(i) / density / con_cp
1526 evap(i) = evap(i) / density / con_hvap
1527
1528!
1529! --- calculate potential evaporation using noah code
1530!
1531 potential_temperature = temperature_forcing * prslki(i)
1532 virtual_temperature = temperature_forcing * (1.0 + 0.61*spec_humidity_forcing)
1533 penman_radiation = sw_absorbed_total + radiation_lw_forcing
1534 dqsdt = spec_humidity_sat * a23m4/(temperature_forcing-a4)**2
1535
1536 precip_freeze_frac_in = srflag(i)
1537 is_snowing = .false.
1538 is_freeze_rain = .false.
1539 if (precipitation_forcing > 0.0) then
1540 if (precip_freeze_frac_in > 0.0) then ! rain/snow flag, one condition is enough?
1541 is_snowing = .true.
1542 else
1543 if (temperature_forcing <= 275.15) is_freeze_rain = .true.
1544 end if
1545 end if
1546
1547!
1548! using new combined ch output to compute ep
1549!
1550 ch_noahmp = chxy(i) * wind(i)
1551
1552 call penman (temperature_forcing, air_pressure_forcing , ch_noahmp , &
1553 virtual_temperature, potential_temperature, precipitation_forcing, &
1554 penman_radiation , ground_heat_total , spec_humidity_forcing, &
1555 spec_humidity_sat , potential_evaporation, is_snowing , &
1556 is_freeze_rain , precip_freeze_frac_in, dqsdt , &
1557 emissivity_total , snow_cover_fraction )
1558
1559 ep(i) = potential_evaporation
1560
1561 end if ! flag_iter(i) .and. dry(i)
1562
1563 end do ! im loop
1564
1565 return
1566
1567 end subroutine noahmpdrv_run
1569!-----------------------------------
1570
1574 subroutine transfer_mp_parameters (vegtype,soiltype,slopetype, &
1575 soilcolor,croptype,parameters)
1576
1577 use noahmp_tables
1578 use module_sf_noahmplsm
1579
1580 implicit none
1581
1582 integer, intent(in) :: vegtype
1583 integer, intent(in) :: soiltype(4)
1584 integer, intent(in) :: slopetype
1585 integer, intent(in) :: soilcolor
1586 integer, intent(in) :: croptype
1587
1588 type (noahmp_parameters), intent(out) :: parameters
1589
1590 real :: refdk
1591 real :: refkdt
1592 real :: frzk
1593 real :: frzfact
1594 integer :: isoil
1595
1596 parameters%iswater = iswater_table
1597 parameters%isbarren = isbarren_table
1598 parameters%isice = isice_table
1599 parameters%iscrop = iscrop_table
1600 parameters%eblforest = eblforest_table
1601
1602!-----------------------------------------------------------------------&
1603 parameters%urban_flag = .false.
1604 if( vegtype == isurban_table .or. vegtype == 31 &
1605 & .or.vegtype == 32 .or. vegtype == 33) then
1606 parameters%urban_flag = .true.
1607 endif
1608
1609!------------------------------------------------------------------------------------------!
1610! transfer veg parameters
1611!------------------------------------------------------------------------------------------!
1612
1613 parameters%ch2op = ch2op_table(vegtype) !maximum intercepted h2o per unit lai+sai (mm)
1614 parameters%dleaf = dleaf_table(vegtype) !characteristic leaf dimension (m)
1615 parameters%z0mvt = z0mvt_table(vegtype) !momentum roughness length (m)
1616 parameters%hvt = hvt_table(vegtype) !top of canopy (m)
1617 parameters%hvb = hvb_table(vegtype) !bottom of canopy (m)
1618 parameters%z0mhvt = z0mhvt_table(vegtype) !momentum roughness length (m)
1619 parameters%den = den_table(vegtype) !tree density (no. of trunks per m2)
1620 parameters%rc = rc_table(vegtype) !tree crown radius (m)
1621 parameters%mfsno = mfsno_table(vegtype) !snowmelt m parameter ()
1622 parameters%scffac = scffac_table(vegtype) !snow cover factor
1623 parameters%cbiom = cbiom_table(vegtype) !canopy biomass heat capacity parameter (m)
1624 parameters%saim = saim_table(vegtype,:) !monthly stem area index, one-sided
1625 parameters%laim = laim_table(vegtype,:) !monthly leaf area index, one-sided
1626 parameters%sla = sla_table(vegtype) !single-side leaf area per kg [m2/kg]
1627 parameters%dilefc = dilefc_table(vegtype) !coeficient for leaf stress death [1/s]
1628 parameters%dilefw = dilefw_table(vegtype) !coeficient for leaf stress death [1/s]
1629 parameters%fragr = fragr_table(vegtype) !fraction of growth respiration !original was 0.3
1630 parameters%ltovrc = ltovrc_table(vegtype) !leaf turnover [1/s]
1631
1632 parameters%c3psn = c3psn_table(vegtype) !photosynthetic pathway: 0. = c4, 1. = c3
1633 parameters%kc25 = kc25_table(vegtype) !co2 michaelis-menten constant at 25c (pa)
1634 parameters%akc = akc_table(vegtype) !q10 for kc25
1635 parameters%ko25 = ko25_table(vegtype) !o2 michaelis-menten constant at 25c (pa)
1636 parameters%ako = ako_table(vegtype) !q10 for ko25
1637 parameters%vcmx25 = vcmx25_table(vegtype) !maximum rate of carboxylation at 25c (umol co2/m**2/s)
1638 parameters%avcmx = avcmx_table(vegtype) !q10 for vcmx25
1639 parameters%bp = bp_table(vegtype) !minimum leaf conductance (umol/m**2/s)
1640 parameters%mp = mp_table(vegtype) !slope of conductance-to-photosynthesis relationship
1641 parameters%qe25 = qe25_table(vegtype) !quantum efficiency at 25c (umol co2 / umol photon)
1642 parameters%aqe = aqe_table(vegtype) !q10 for qe25
1643 parameters%rmf25 = rmf25_table(vegtype) !leaf maintenance respiration at 25c (umol co2/m**2/s)
1644 parameters%rms25 = rms25_table(vegtype) !stem maintenance respiration at 25c (umol co2/kg bio/s)
1645 parameters%rmr25 = rmr25_table(vegtype) !root maintenance respiration at 25c (umol co2/kg bio/s)
1646 parameters%arm = arm_table(vegtype) !q10 for maintenance respiration
1647 parameters%folnmx = folnmx_table(vegtype) !foliage nitrogen concentration when f(n)=1 (%)
1648 parameters%tmin = tmin_table(vegtype) !minimum temperature for photosynthesis (k)
1649
1650 parameters%xl = xl_table(vegtype) !leaf/stem orientation index
1651 parameters%rhol = rhol_table(vegtype,:) !leaf reflectance: 1=vis, 2=nir
1652 parameters%rhos = rhos_table(vegtype,:) !stem reflectance: 1=vis, 2=nir
1653 parameters%taul = taul_table(vegtype,:) !leaf transmittance: 1=vis, 2=nir
1654 parameters%taus = taus_table(vegtype,:) !stem transmittance: 1=vis, 2=nir
1655
1656 parameters%mrp = mrp_table(vegtype) !microbial respiration parameter (umol co2 /kg c/ s)
1657 parameters%cwpvt = cwpvt_table(vegtype) !empirical canopy wind parameter
1658
1659 parameters%wrrat = wrrat_table(vegtype) !wood to non-wood ratio
1660 parameters%wdpool = wdpool_table(vegtype) !wood pool (switch 1 or 0) depending on woody or not [-]
1661 parameters%tdlef = tdlef_table(vegtype) !characteristic t for leaf freezing [k]
1662
1663 parameters%nroot = nroot_table(vegtype) !number of soil layers with root present
1664 parameters%rgl = rgl_table(vegtype) !parameter used in radiation stress function
1665 parameters%rsmin = rs_table(vegtype) !minimum stomatal resistance [s m-1]
1666 parameters%hs = hs_table(vegtype) !parameter used in vapor pressure deficit function
1667 parameters%topt = topt_table(vegtype) !optimum transpiration air temperature [k]
1668 parameters%rsmax = rsmax_table(vegtype) !maximal stomatal resistance [s m-1]
1669
1670!------------------------------------------------------------------------------------------!
1671! transfer rad parameters
1672!------------------------------------------------------------------------------------------!
1673
1674 parameters%albsat = albsat_table(soilcolor,:)
1675 parameters%albdry = albdry_table(soilcolor,:)
1676 parameters%albice = albice_table
1677 parameters%alblak = alblak_table
1678 parameters%omegas = omegas_table
1679 parameters%betads = betads_table
1680 parameters%betais = betais_table
1681 parameters%eg = eg_table
1682
1683!------------------------------------------------------------------------------------------!
1684! Transfer crop parameters
1685!------------------------------------------------------------------------------------------!
1686
1687 if(croptype > 0) then
1688 parameters%pltday = pltday_table(croptype) ! planting date
1689 parameters%hsday = hsday_table(croptype) ! harvest date
1690 parameters%plantpop = plantpop_table(croptype) ! plant density [per ha] - used?
1691 parameters%irri = irri_table(croptype) ! irrigation strategy 0= non-irrigation 1=irrigation (no water-stress)
1692 parameters%gddtbase = gddtbase_table(croptype) ! base temperature for gdd accumulation [c]
1693 parameters%gddtcut = gddtcut_table(croptype) ! upper temperature for gdd accumulation [c]
1694 parameters%gdds1 = gdds1_table(croptype) ! gdd from seeding to emergence
1695 parameters%gdds2 = gdds2_table(croptype) ! gdd from seeding to initial vegetative
1696 parameters%gdds3 = gdds3_table(croptype) ! gdd from seeding to post vegetative
1697 parameters%gdds4 = gdds4_table(croptype) ! gdd from seeding to intial reproductive
1698 parameters%gdds5 = gdds5_table(croptype) ! gdd from seeding to pysical maturity
1699 parameters%c3c4 = c3c4_table(croptype) ! photosynthetic pathway: 1. = c3 2. = c4
1700 parameters%aref = aref_table(croptype) ! reference maximum co2 assimulation rate
1701 parameters%psnrf = psnrf_table(croptype) ! co2 assimulation reduction factor(0-1) (e.g.pests, weeds)
1702 parameters%i2par = i2par_table(croptype) ! fraction of incoming solar radiation to photosynthetically active radiation
1703 parameters%tassim0 = tassim0_table(croptype) ! minimum temperature for co2 assimulation [c]
1704 parameters%tassim1 = tassim1_table(croptype) ! co2 assimulation linearly increasing until temperature reaches t1 [c]
1705 parameters%tassim2 = tassim2_table(croptype) ! co2 assmilation rate remain at aref until temperature reaches t2 [c]
1706 parameters%k = k_table(croptype) ! light extinction coefficient
1707 parameters%epsi = epsi_table(croptype) ! initial light use efficiency
1708 parameters%q10mr = q10mr_table(croptype) ! q10 for maintainance respiration
1709 parameters%foln_mx = foln_mx_table(croptype) ! foliage nitrogen concentration when f(n)=1 (%)
1710 parameters%lefreez = lefreez_table(croptype) ! characteristic t for leaf freezing [k]
1711 parameters%dile_fc = dile_fc_table(croptype,:) ! coeficient for temperature leaf stress death [1/s]
1712 parameters%dile_fw = dile_fw_table(croptype,:) ! coeficient for water leaf stress death [1/s]
1713 parameters%fra_gr = fra_gr_table(croptype) ! fraction of growth respiration
1714 parameters%lf_ovrc = lf_ovrc_table(croptype,:) ! fraction of leaf turnover [1/s]
1715 parameters%st_ovrc = st_ovrc_table(croptype,:) ! fraction of stem turnover [1/s]
1716 parameters%rt_ovrc = rt_ovrc_table(croptype,:) ! fraction of root tunrover [1/s]
1717 parameters%lfmr25 = lfmr25_table(croptype) ! leaf maintenance respiration at 25c [umol co2/m**2 /s]
1718 parameters%stmr25 = stmr25_table(croptype) ! stem maintenance respiration at 25c [umol co2/kg bio/s]
1719 parameters%rtmr25 = rtmr25_table(croptype) ! root maintenance respiration at 25c [umol co2/kg bio/s]
1720 parameters%grainmr25 = grainmr25_table(croptype) ! grain maintenance respiration at 25c [umol co2/kg bio/s]
1721 parameters%lfpt = lfpt_table(croptype,:) ! fraction of carbohydrate flux to leaf
1722 parameters%stpt = stpt_table(croptype,:) ! fraction of carbohydrate flux to stem
1723 parameters%rtpt = rtpt_table(croptype,:) ! fraction of carbohydrate flux to root
1724 parameters%grainpt = grainpt_table(croptype,:) ! fraction of carbohydrate flux to grain
1725 parameters%bio2lai = bio2lai_table(croptype) ! leaf are per living leaf biomass [m^2/kg]
1726 end if
1727
1728!------------------------------------------------------------------------------------------!
1729! transfer global parameters
1730!------------------------------------------------------------------------------------------!
1731
1732 parameters%co2 = co2_table
1733 parameters%o2 = o2_table
1734 parameters%timean = timean_table
1735 parameters%fsatmx = fsatmx_table
1736 parameters%z0sno = z0sno_table
1737 parameters%ssi = ssi_table
1738 parameters%snow_ret_fac = snow_ret_fac_table
1739 parameters%swemx = swemx_table
1740 parameters%tau0 = tau0_table
1741 parameters%grain_growth = grain_growth_table
1742 parameters%extra_growth = extra_growth_table
1743 parameters%dirt_soot = dirt_soot_table
1744 parameters%bats_cosz = bats_cosz_table
1745 parameters%bats_vis_new = bats_vis_new_table
1746 parameters%bats_nir_new = bats_nir_new_table
1747 parameters%bats_vis_age = bats_vis_age_table
1748 parameters%bats_nir_age = bats_nir_age_table
1749 parameters%bats_vis_dir = bats_vis_dir_table
1750 parameters%bats_nir_dir = bats_nir_dir_table
1751 parameters%rsurf_snow = rsurf_snow_table
1752 parameters%rsurf_exp = rsurf_exp_table
1753 parameters%snow_emis = snow_emis_table
1754
1755! ----------------------------------------------------------------------
1756! transfer soil parameters
1757! ----------------------------------------------------------------------
1758
1759 do isoil = 1, size(soiltype)
1760 parameters%bexp(isoil) = bexp_table(soiltype(isoil))
1761 parameters%dksat(isoil) = dksat_table(soiltype(isoil))
1762 parameters%dwsat(isoil) = dwsat_table(soiltype(isoil))
1763 parameters%psisat(isoil) = psisat_table(soiltype(isoil))
1764 parameters%quartz(isoil) = quartz_table(soiltype(isoil))
1765 parameters%smcdry(isoil) = smcdry_table(soiltype(isoil))
1766 parameters%smcmax(isoil) = smcmax_table(soiltype(isoil))
1767 parameters%smcref(isoil) = smcref_table(soiltype(isoil))
1768 parameters%smcwlt(isoil) = smcwlt_table(soiltype(isoil))
1769 end do
1770
1771 parameters%f1 = f1_table(soiltype(1))
1772 parameters%refdk = refdk_table
1773 parameters%refkdt = refkdt_table
1774
1775! ----------------------------------------------------------------------
1776! transfer genparm parameters
1777! ----------------------------------------------------------------------
1778 parameters%csoil = csoil_table
1779 parameters%zbot = zbot_table
1780 parameters%czil = czil_table
1781
1782 frzk = frzk_table
1783 parameters%kdt = parameters%refkdt * parameters%dksat(1) / parameters%refdk
1784 parameters%slope = slope_table(slopetype)
1785
1786 if(parameters%urban_flag)then ! hardcoding some urban parameters for soil
1787 parameters%smcmax = 0.45
1788 parameters%smcref = 0.42
1789 parameters%smcwlt = 0.40
1790 parameters%smcdry = 0.40
1791 parameters%csoil = 3.e6
1792 endif
1793
1794 ! adjust frzk parameter to actual soil type: frzk * frzfact
1795
1796!-----------------------------------------------------------------------&
1797 if(soiltype(1) /= 14) then
1798 frzfact = (parameters%smcmax(1) / parameters%smcref(1)) * (0.412 / 0.468)
1799 parameters%frzx = frzk * frzfact
1800 end if
1801
1802 end subroutine transfer_mp_parameters
1803
1806SUBROUTINE pedotransfer_sr2006(nsoil,sand,clay,orgm,parameters)
1807
1808 use module_sf_noahmplsm
1809 use noahmp_tables
1810
1811 implicit none
1812
1813 integer, intent(in ) :: nsoil ! number of soil layers
1814 real, dimension( 1:nsoil ), intent(inout) :: sand
1815 real, dimension( 1:nsoil ), intent(inout) :: clay
1816 real, dimension( 1:nsoil ), intent(inout) :: orgm
1817
1818 real, dimension( 1:nsoil ) :: theta_1500t
1819 real, dimension( 1:nsoil ) :: theta_1500
1820 real, dimension( 1:nsoil ) :: theta_33t
1821 real, dimension( 1:nsoil ) :: theta_33
1822 real, dimension( 1:nsoil ) :: theta_s33t
1823 real, dimension( 1:nsoil ) :: theta_s33
1824 real, dimension( 1:nsoil ) :: psi_et
1825 real, dimension( 1:nsoil ) :: psi_e
1826
1827 type(noahmp_parameters), intent(inout) :: parameters
1828 integer :: k
1829
1830 do k = 1,4
1831 if(sand(k) <= 0 .or. clay(k) <= 0) then
1832 sand(k) = 0.41
1833 clay(k) = 0.18
1834 end if
1835 if(orgm(k) <= 0 ) orgm(k) = 0.0
1836 end do
1837
1838 theta_1500t = sr2006_theta_1500t_a*sand &
1839 + sr2006_theta_1500t_b*clay &
1840 + sr2006_theta_1500t_c*orgm &
1841 + sr2006_theta_1500t_d*sand*orgm &
1842 + sr2006_theta_1500t_e*clay*orgm &
1843 + sr2006_theta_1500t_f*sand*clay &
1844 + sr2006_theta_1500t_g
1845
1846 theta_1500 = theta_1500t &
1847 + sr2006_theta_1500_a*theta_1500t &
1848 + sr2006_theta_1500_b
1849
1850 theta_33t = sr2006_theta_33t_a*sand &
1851 + sr2006_theta_33t_b*clay &
1852 + sr2006_theta_33t_c*orgm &
1853 + sr2006_theta_33t_d*sand*orgm &
1854 + sr2006_theta_33t_e*clay*orgm &
1855 + sr2006_theta_33t_f*sand*clay &
1856 + sr2006_theta_33t_g
1857
1858 theta_33 = theta_33t &
1859 + sr2006_theta_33_a*theta_33t*theta_33t &
1860 + sr2006_theta_33_b*theta_33t &
1861 + sr2006_theta_33_c
1862
1863 theta_s33t = sr2006_theta_s33t_a*sand &
1864 + sr2006_theta_s33t_b*clay &
1865 + sr2006_theta_s33t_c*orgm &
1866 + sr2006_theta_s33t_d*sand*orgm &
1867 + sr2006_theta_s33t_e*clay*orgm &
1868 + sr2006_theta_s33t_f*sand*clay &
1869 + sr2006_theta_s33t_g
1870
1871 theta_s33 = theta_s33t &
1872 + sr2006_theta_s33_a*theta_s33t &
1873 + sr2006_theta_s33_b
1874
1875 psi_et = sr2006_psi_et_a*sand &
1876 + sr2006_psi_et_b*clay &
1877 + sr2006_psi_et_c*theta_s33 &
1878 + sr2006_psi_et_d*sand*theta_s33 &
1879 + sr2006_psi_et_e*clay*theta_s33 &
1880 + sr2006_psi_et_f*sand*clay &
1881 + sr2006_psi_et_g
1882
1883 psi_e = psi_et &
1884 + sr2006_psi_e_a*psi_et*psi_et &
1885 + sr2006_psi_e_b*psi_et &
1886 + sr2006_psi_e_c
1887
1888 parameters%smcwlt = theta_1500
1889 parameters%smcref = theta_33
1890 parameters%smcmax = theta_33 &
1891 + theta_s33 &
1892 + sr2006_smcmax_a*sand &
1893 + sr2006_smcmax_b
1894
1895 parameters%bexp = 3.816712826 / (log(theta_33) - log(theta_1500) )
1896 parameters%psisat = psi_e
1897 parameters%dksat = 1930.0 * (parameters%smcmax - theta_33) ** (3.0 - 1.0/parameters%bexp)
1898 parameters%quartz = sand
1899
1900! Units conversion
1901
1902 parameters%psisat = max(0.1,parameters%psisat) ! arbitrarily impose a limit of 0.1kpa
1903 parameters%psisat = 0.101997 * parameters%psisat ! convert kpa to m
1904 parameters%dksat = parameters%dksat / 3600000.0 ! convert mm/h to m/s
1905 parameters%dwsat = parameters%dksat * parameters%psisat *parameters%bexp / parameters%smcmax ! units should be m*m/s
1906 parameters%smcdry = parameters%smcwlt
1907
1908! Introducing somewhat arbitrary limits (based on SOILPARM) to prevent bad things
1909
1910 parameters%smcmax = max(0.32 ,min(parameters%smcmax, 0.50 ))
1911 parameters%smcref = max(0.17 ,min(parameters%smcref,parameters%smcmax ))
1912 parameters%smcwlt = max(0.01 ,min(parameters%smcwlt,parameters%smcref ))
1913 parameters%smcdry = max(0.01 ,min(parameters%smcdry,parameters%smcref ))
1914 parameters%bexp = max(2.50 ,min(parameters%bexp, 12.0 ))
1915 parameters%psisat = max(0.03 ,min(parameters%psisat, 1.00 ))
1916 parameters%dksat = max(5.e-7,min(parameters%dksat, 1.e-5))
1917 parameters%dwsat = max(1.e-6,min(parameters%dwsat, 3.e-5))
1918 parameters%quartz = max(0.05 ,min(parameters%quartz, 0.95 ))
1919
1920 END SUBROUTINE pedotransfer_sr2006
1921
1922!-----------------------------------------------------------------------&
1923
1928 subroutine penman (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil, &
1929 & q2,q2sat,etp,snowng,frzgra,ffrozp, &
1930 & dqsdt2,emissi_in,sncovr)
1931
1932! etp is calcuated right after ssoil
1933
1934! ----------------------------------------------------------------------
1935! subroutine penman
1936! ----------------------------------------------------------------------
1937 use machine, only: kind_phys
1938 implicit none
1939 logical, intent(in) :: snowng, frzgra
1940 real(kind=kind_phys), intent(in) :: ch, dqsdt2,fdown,prcp,ffrozp, &
1941 & q2, q2sat,ssoil, sfcprs, sfctmp, &
1942 & t2v, th2,emissi_in,sncovr
1943 real(kind=kind_phys), intent(out) :: etp
1944 real(kind=kind_phys) :: epsca,flx2,rch,rr,t24
1945 real(kind=kind_phys) :: a, delta, fnet,rad,rho,emissi,elcp1,lvs
1946
1947 real(kind=kind_phys), parameter :: elcp = 2.4888e+3, lsubc = 2.501000e+6,cp = 1004.6
1948 real(kind=kind_phys), parameter :: lsubs = 2.83e+6, rd = 287.05, cph2o = 4.1855e+3
1949 real(kind=kind_phys), parameter :: cpice = 2.106e+3, lsubf = 3.335e5
1950 real(kind=kind_phys), parameter :: sigma = 5.6704e-8
1951
1952! ----------------------------------------------------------------------
1953! executable code begins here:
1954! ----------------------------------------------------------------------
1955! ----------------------------------------------------------------------
1956! prepare partial quantities for penman equation.
1957! ----------------------------------------------------------------------
1958 emissi=emissi_in
1959! elcp1 = (1.0-sncovr)*elcp + sncovr*elcp*lsubs/lsubc
1960 lvs = (1.0-sncovr)*lsubc + sncovr*lsubs
1961
1962 flx2 = 0.0
1963 delta = elcp * dqsdt2
1964! delta = elcp1 * dqsdt2
1965 t24 = sfctmp * sfctmp * sfctmp * sfctmp
1966 rr = t24 * 6.48e-8 / (sfcprs * ch) + 1.0
1967! rr = emissi*t24 * 6.48e-8 / (sfcprs * ch) + 1.0
1968 rho = sfcprs / (rd * t2v)
1969
1970! ----------------------------------------------------------------------
1971! adjust the partial sums / products with the latent heat
1972! effects caused by falling precipitation.
1973! ----------------------------------------------------------------------
1974 rch = rho * cp * ch
1975 if (.not. snowng) then
1976 if (prcp > 0.0) rr = rr + cph2o * prcp / rch
1977 else
1978! ---- ... fractional snowfall/rainfall
1979 rr = rr + (cpice*ffrozp+cph2o*(1.-ffrozp)) &
1980 & *prcp/rch
1981 end if
1982
1983! ----------------------------------------------------------------------
1984! include the latent heat effects of frzng rain converting to ice on
1985! impact in the calculation of flx2 and fnet.
1986! ----------------------------------------------------------------------
1987! fnet = fdown - sigma * t24- ssoil
1988 fnet = fdown - emissi*sigma * t24- ssoil
1989 if (frzgra) then
1990 flx2 = - lsubf * prcp
1991 fnet = fnet - flx2
1992! ----------------------------------------------------------------------
1993! finish penman equation calculations.
1994! ----------------------------------------------------------------------
1995 end if
1996 rad = fnet / rch + th2- sfctmp
1997 a = elcp * (q2sat - q2)
1998! a = elcp1 * (q2sat - q2)
1999 epsca = (a * rr + rad * delta) / (delta + rr)
2000 etp = epsca * rch / lsubc
2001! etp = epsca * rch / lvs
2002
2003! ----------------------------------------------------------------------
2004 end subroutine penman
2005
2006 end module noahmpdrv
noahmp_sflx
subroutine noahmp_sflx(parameters, iloc, jloc, lat, yearlen, julian, cosz, dt, dx, dz8w, nsoil, zsoil, nsnow, shdfac, shdmax, vegtyp, ice, ist, croptype, smceq, sfctmp, sfcprs, psfc, uu, vv, q2, garea1, qc, soldn, lwdn, thsfc_loc, prslkix, prsik1x, prslk1x, pblhx, iz0tlnd, itime,psi_opt, prcpconv, prcpnonc, prcpshcv, prcpsnow, prcpgrpl, prcphail, tbot, co2air, o2air, foln, ficeold, zlvl, ep_1, ep_2, epsm1, cp, albold, sneqvo, stc, sh2o, smc, tah, eah, fwet, canliq, canice, tv, tg, qsfc, qsnow, qrain, isnow, zsnso, snowh, sneqv, snice, snliq, zwt, wa, wt, wslake, lfmass, rtmass, stmass, wood, stblcp, fastcp, lai, sai, cm, ch, tauss, grain, gdd, pgs, smcwtd,deeprech, rech, ustarx, z0wrf, z0hwrf, ts, fsa, fsr, fira, fsh, ssoil, fcev, fgev, fctr, ecan, etran, edir, trad, tgb, tgv, t2mv, t2mb, q2v, q2b, runsrf, runsub, apar, psn, sav, sag, fsno, nee, gpp, npp, fveg, albedo, qsnbot, ponding, ponding1, ponding2, rssun, rssha, albd, albi, albsnd, albsni, bgap, wgap, chv, chb, emissi, shg, shc, shb, evg, evb, ghv, ghb, irg, irc, irb, tr, evc, chleaf, chuc, chv2, chb2, fpice, pahv, pahg, pahb, pah, esnow, canhs, laisun, laisha, rb, qsfcveg, qsfcbare ifdef ccpp
Definition module_sf_noahmplsm.F90:456
set_soilveg_mod::set_soilveg
subroutine, public set_soilveg(me, isot, ivet, nlunit, errmsg, errflg)
This subroutine initializes soil and vegetation.
Definition set_soilveg.f:17
land_iau_mod
TODO: replace with appropriate licence for CCPP.
Definition lnd_iau_mod.F90:24
module_sf_noahmp_glacier
This module contains the interface of noahmp_glacier_routines and noahmp_glacier_globals.
Definition module_sf_noahmp_glacier.F90:3533
namelist_soilveg
This module contains namelist options for Noah LSM.
Definition namelist_soilveg.f:6
noahmp_tables
brief Data from MPTABLE.TBL, SOILPARM.TBL, GENPARM.TBL for NoahMP
Definition noahmp_tables.f90:11
set_soilveg_mod
This module contains set_soilveg subroutine.
Definition set_soilveg.f:4
land_iau_mod::land_iau_control_type
Definition lnd_iau_mod.F90:62
land_iau_mod::land_iau_external_data_type
Definition lnd_iau_mod.F90:36
land_iau_mod::land_iau_state_type
Definition lnd_iau_mod.F90:53