diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 1084aa426..3b31935b6 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -64,7 +64,8 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & prsi,del,prsl,prslk,phii,phil,delt,dspheat, & & dusfc,dvsfc,dtsfc,dqsfc,hpbl,hgamt,hgamq,dkt, & & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr, & - & xkzminv,moninq_fac,errmsg,errflg) + & xkzminv,moninq_fac,hurr_pbl,islimsk,var_ric, & + & coef_ric_l,coef_ric_s,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -74,14 +75,15 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! ! arguments ! - logical, intent(in) :: lprnt - integer, intent(in) :: ipr + logical, intent(in) :: lprnt, hurr_pbl + integer, intent(in) :: ipr, islimsk(im) integer, intent(in) :: ix, im, km, ntrac, ntcw, kinver(im) integer, intent(out) :: kpbl(im) ! real(kind=kind_phys), intent(in) :: delt, xkzm_m, xkzm_h, xkzm_s - real(kind=kind_phys), intent(in) :: xkzminv, moninq_fac + real(kind=kind_phys), intent(in) :: xkzminv, moninq_fac, var_ric, & + & coef_ric_l, coef_ric_s real(kind=kind_phys), intent(inout) :: dv(im,km), du(im,km), & & tau(im,km), rtg(im,km,ntrac) real(kind=kind_phys), intent(in) :: & @@ -180,7 +182,15 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & ptem, ptem1, ptem2, tx1(im), tx2(im) ! real(kind=kind_phys) zstblmax,h1, h2, qlcr, actei, - & cldtime + & cldtime, ttend_fac + + !! for hurricane application + real(kind=kind_phys) wspm(im,km-1) + integer kLOC ! RGF + real :: xDKU ! RGF + + integer, parameter :: useshape=2!0-- no change, original ALPHA adjustment,1-- shape1, 2-- shape2(adjust above sfc) + real :: smax,ashape,sz2h, sksfc,skmax,ashape1,skminusk0, hmax cc parameter(gravi=1.0/grav) parameter(g=grav) @@ -211,6 +221,8 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & parameter (zstblmax = 2500., qlcr=3.5e-5) ! parameter (actei = 0.23) parameter (actei = 0.7) + + c c----------------------------------------------------------------------- c @@ -422,23 +434,48 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & !! The temperature of the thermal is of primary importance. For the initial estimate of the PBL height, the thermal is assumed to have one of two temperatures. If the boundary layer is stable, the thermal is assumed to have a temperature equal to the surface virtual temperature. Otherwise, the thermal is assumed to have the same virtual potential temperature as the lowest model level. For the stable case, the critical bulk Richardson number becomes a function of the wind speed and roughness length, otherwise it is set to a tunable constant. ! compute the pbl height ! - do i=1,im - flg(i) = .false. - rbup(i) = rbsoil(i) -! - if(pblflg(i)) then - thermal(i) = thvx(i,1) - crb(i) = crbcon - else - thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) - tem = sqrt(u10m(i)**2+v10m(i)**2) - tem = max(tem, 1.) - robn = tem / (f0 * z0(i)) - tem1 = 1.e-7 * robn - crb(i) = 0.16 * (tem1 ** (-0.18)) - crb(i) = max(min(crb(i), crbmax), crbmin) - endif - enddo + if (.not. hurr_pbl) then + do i=1,im + flg(i) = .false. + rbup(i) = rbsoil(i) + ! + if(pblflg(i)) then + thermal(i) = thvx(i,1) + crb(i) = crbcon + else + thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) + tem = sqrt(u10m(i)**2+v10m(i)**2) + tem = max(tem, 1.) + robn = tem / (f0 * z0(i)) + tem1 = 1.e-7 * robn + crb(i) = 0.16 * (tem1 ** (-0.18)) + crb(i) = max(min(crb(i), crbmax), crbmin) + endif + enddo + else + do i=1,im + flg(i) = .false. + rbup(i) = rbsoil(i) + + ! use variable Ri for all conditions + if(pblflg(i)) then + thermal(i) = thvx(i,1) + else + thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) + endif + tem = sqrt(u10m(i)**2+v10m(i)**2) + tem = max(tem, 1.) + robn = tem / (f0 * z0(i)) + tem1 = 1.e-7 * robn + crb(i) = crbcon + if (var_ric .eq. 1.) then + if (islimsk(i) .eq. 1) crb(I) = coef_ric_l*(tem1)**(-0.18) + if (islimsk(i) .eq. 0) crb(I) = coef_ric_s*(tem1)**(-0.18) + endif + crb(i) = max(min(crb(i), crbmax), crbmin) + enddo + endif + !> Given the thermal's properties and the critical Richardson number, a loop is executed to find the first level above the surface where the modified Richardson number is greater than the critical Richardson number, using equation 10a from Troen and Mahrt (1986) \cite troen_and_mahrt_1986 (also equation 8 from Hong and Pan (1996) \cite hong_and_pan_1996): !! \f[ !! h = Ri\frac{T_0\left|\vec{v}(h)\right|^2}{g\left(\theta_v(h) - \theta_s\right)} @@ -719,38 +756,223 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & kpbl(i) = 1 endif enddo -! + + +!!! 20150915 WeiguoWang added alpha (moninq_fac) and wind-dependent modification of K by RGF +! ------------------------------------------------------------------------------------- +! begin RGF modifications +! this is version MOD05 + +! RGF determine wspd at roughly 500 m above surface, or as close as possible, +! reuse SPDK2 +! zi(i,k) is AGL, right? May not matter if applied only to water grid points + if(hurr_pbl .and. moninq_fac .lt. 0.0) then + do i=1,im + spdk2 = 0. + wspm(i,1) = 0. + do k = 1, kmpbl ! kmpbl is like a max possible pbl height + if (zi(i,k) .le. 500. .and. zi(i,k+1) .gt. 500.) then ! find level bracketing 500 m + spdk2 = SQRT(u1(i,k)*u1(i,k)+v1(i,k)*v1(i,k)) ! wspd near 500 m + wspm(i,1) = spdk2/0.6 ! now the Km limit for 500 m. just store in K=1 + wspm(i,2) = float(k) ! height of level at gridpoint i. store in K=2 + endif + enddo !k + enddo ! i + endif ! hurr_pbl and moninq_fac < 0 + + ! compute diffusion coefficients below pbl !> ## Compute diffusion coefficients below the PBL top !! Below the PBL top, the diffusion coefficients (\f$K_m\f$ and \f$K_h\f$) are calculated according to equation 2 in Hong and Pan (1996) \cite hong_and_pan_1996 where a different value for \f$w_s\f$ (PBL vertical velocity scale) is used depending on the PBL stability. \f$K_h\f$ is calculated from \f$K_m\f$ using the Prandtl number. The calculated diffusion coefficients are checked so that they are bounded by maximum values and the local background diffusion coefficients. - do k = 1, kmpbl - do i=1,im - if(k < kpbl(i)) then -! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ -! 1 (hpbl(i)-zl(i,1))), zfmin) - zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) - tem = zi(i,k+1) * (zfac**pfac) * moninq_fac ! lmh suggested by kg - if(pblflg(i)) then - tem1 = vk * wscaleu(i) * tem -! dku(i,k) = xkzmo(i,k) + tem1 -! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) - dku(i,k) = tem1 - dkt(i,k) = tem1 * prinv(i) - else - tem1 = vk * wscale(i) * tem -! dku(i,k) = xkzmo(i,k) + tem1 -! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) - dku(i,k) = tem1 - dkt(i,k) = tem1 * prinv(i) + if (.not. hurr_pbl) then + do k = 1, kmpbl + do i=1,im + if(k < kpbl(i)) then +! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ +! 1 (hpbl(i)-zl(i,1))), zfmin) + zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) + tem = zi(i,k+1) * (zfac**pfac) * moninq_fac ! lmh suggested by kg + if(pblflg(i)) then + tem1 = vk * wscaleu(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + else + tem1 = vk * wscale(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + endif + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) + dktx(i,k)= dkt(i,k) endif - dku(i,k) = min(dku(i,k),dkmax) - dku(i,k) = max(dku(i,k),xkzmo(i,k)) - dkt(i,k) = min(dkt(i,k),dkmax) - dkt(i,k) = max(dkt(i,k),xkzo(i,k)) - dktx(i,k)= dkt(i,k) - endif - enddo - enddo + enddo !i + enddo !k + else + !hurricane PBL case (note that the i and k loop order has been switched) + do i=1, im + do k=1, kmpbl + if (k < kpbl(i)) then +! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ +! 1 (hpbl(i)-zl(i,1))), zfmin) + zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) + tem = zi(i,k+1) * (zfac**pfac) * ABS(moninq_fac) + +!!!! CHANGES FOR HEIGHT-DEPENDENT K ADJUSTMENT, WANG W + if (useshape .ge. 1) then + sz2h=(zi(i,k+1)-zl(i,1))/(hpbl(i)-zl(i,1)) + sz2h=max(sz2h,zfmin) + sz2h=min(sz2h,1.0) + zfac=(1.0-sz2h)**pfac +! smax=0.148 !! max value of this shape function + smax=0.148 !! max value of this shape function + hmax=0.333 !! roughly height if max K + skmax=hmax*(1.0-hmax)**pfac + sksfc=min(zi(i,2)/hpbl(i),0.05) ! surface layer top, 0.05H or ZI(2) (Zi(1)=0) + sksfc=sksfc*(1-sksfc)**pfac + + zfac=max(zfac,zfmin) + ashape=max(ABS(moninq_fac),0.2) ! should not be smaller than 0.2, otherwise too much adjustment(?) + if (useshape == 1) then + ashape=(1.0 - ((sz2h*zfac/smax)**0.25) *(1.0 - ashape)) + tem = zi(i,k+1) * (zfac) * ashape + elseif (useshape == 2) then !only adjus K that is > K_surface_top + ashape1=1.0 + if (skmax > sksfc) then + ashape1=(skmax*ashape-sksfc)/(skmax-sksfc) + endif + skminusk0 = zi(i,k+1)*zfac - hpbl(i)*sksfc + tem = zi(i,k+1) * (zfac) ! no adjustment + if (skminusk0 > 0) then ! only adjust K which is > surface top K + tem = skminusk0*ashape1 + hpbl(i)*sksfc + endif + endif ! useshape == 1 or 2 + endif ! endif useshape>1 +!!!! END OF CHANGES , WANG W + +!!If alpha >= 0, this is the only modification of K +! if alpha = -1, the above provides the first guess for DKU, based on assumption +! alpha = +1 +! (other values of alpha < 0 can also be applied) +! if alpha > 0, the above applies the alpha suppression factor and we are +! finished + + if(pblflg(i)) then + tem1 = vk * wscaleu(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + else + tem1 = vk * wscale(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + endif + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) + dktx(i,k)= dkt(i,k) + endif !k < kpbl(i) + enddo !K loop + +! possible modification of first guess DKU, under certain conditions +! (1) this applies only to columns over water + if (islimsk(i) .eq. 0) then ! sea only +! (2) alpha test +! if alpha < 0, find alpha for each column and do the loop again +! if alpha > 0, we are finished + if (moninq_fac .lt. 0.) then ! variable alpha test +! k-level of layer around 500 m + kLOC = INT(wspm(i,2)) +! print *,' kLOC ',kLOC,' KPBL ',KPBL(I) + +! (3) only do this IF KPBL(I) >= kLOC. Otherwise, we are finished, with DKU as +! if alpha = +1 + if(kpbl(i) .gt. kLOC) then + xDKU = DKU(i,kLOC) ! Km at k-level +! (4) DKU check. +! WSPM(i,1) is the KM cap for the 500-m level. +! if DKU at 500-m level < WSPM(i,1), do not limit Km ANYWHERE. Alpha = +! abs(alpha). No need to recalc. +! if DKU at 500-m level > WSPM(i,1), then alpha = WSPM(i,1)/xDKU for entire +! column + if(xDKU .ge. wspm(i,1)) then ! ONLY if DKU at 500-m exceeds cap, otherwise already done + wspm(i,3) = wspm(i,1)/xDKU ! ratio of cap to Km at k-level, store in WSPM(i,3) + !WSPM(i,4) = amin1(WSPM(I,3),1.0) ! this is new column alpha. cap at 1. ! should never be needed + wspm(i,4) = min(wspm(i,3),1.0) ! this is new column alpha. cap at 1. ! should never be needed + !! recalculate K capped by WSPM(i,1) + do k = 1, kmpbl + if(k < kpbl(i)) then +! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ +! 1 (hpbl(i)-zl(i,1))), zfmin) + zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) + tem = zi(i,k+1) * (zfac**pfac) * wspm(i,4) +!!! wang use different K shape, options!!!!!!!!!!!!!!!!!!!!!!!!! +!!!! HANGES FOR HEIGHT-DEPENDENT K ADJUSTMENT, WANG W + if(useshape .ge. 1) then + sz2h=(zi(i,k+1)-zl(i,1))/(hpbl(i)-zl(i,1)) + sz2h=max(sz2h,zfmin) + sz2h=min(sz2h,1.0) + zfac=(1.0-sz2h)**pfac + smax=0.148 !! max value of this shape function + hmax=0.333 !! roughly height if max K + skmax=hmax*(1.0-hmax)**pfac + sksfc=min(zi(i,2)/hpbl(i),0.05) ! surface layer top, 0.05H or ZI(2) (Zi(1)=0) + sksfc=sksfc*(1-sksfc)**pfac + + zfac=max(zfac,zfmin) + ashape=max(wspm(i,4),0.2) !! adjustment coef should not smaller than 0.2 + if(useshape ==1) then + ashape=(1.0 - ((sz2h*zfac/smax)**0.25)* + & (1.0 - ashape)) + tem = zi(i,k+1) * (zfac) * ashape + elseif (useshape == 2) then !only adjus K that is > K_surface_top + ashape1=1.0 + if (skmax > sksfc) then + ashape1=(skmax*ashape-sksfc)/(skmax-sksfc) + endif + skminusk0=zi(i,k+1)*zfac - hpbl(i)*sksfc + tem = zi(i,k+1) * (zfac) ! no adjustment + if (skminusk0 > 0) then ! only adjust K which is > surface top K + tem = skminusk0*ashape1 + HPBL(i)*sksfc + endif + endif ! endif useshape=1 or 2 + endif ! endif useshape>1 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if(pblflg(i)) then + tem1 = vk * wscaleu(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + else + tem1 = vk * wscale(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + endif !pblflg + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) + dktx(i,k)= dkt(i,k) + endif ! k < kpbl(i) + enddo ! K loop + endif ! xDKU .ge. wspm(i,1) + endif ! kpbl(i) .ge. kLOC + endif ! moninq_fac < 0 + endif ! islimsk == 0 + enddo ! I loop + endif ! not hurr_pbl ! ! compute diffusion coefficients based on local scheme above pbl !> ## Compute diffusion coefficients above the PBL top @@ -916,16 +1138,32 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !> After \f$K_h^{Sc}\f$ has been determined from the surface to the top of the stratocumulus layer, it is added to the value for the diffusion coefficient calculated previously using surface-based mixing [see equation 6 of Lock et al. (2000) \cite lock_et_al_2000 ]. - do k = 1, kmpbl - do i=1,im - if(scuflg(i)) then - dkt(i,k) = dkt(i,k)+ckt(i,k) - dku(i,k) = dku(i,k)+cku(i,k) - dkt(i,k) = min(dkt(i,k),dkmax) - dku(i,k) = min(dku(i,k),dkmax) - endif + if (.not. hurr_pbl) then + do k = 1, kmpbl + do i=1,im + if(scuflg(i)) then + dkt(i,k) = dkt(i,k)+ckt(i,k) + dku(i,k) = dku(i,k)+cku(i,k) + dkt(i,k) = min(dkt(i,k),dkmax) + dku(i,k) = min(dku(i,k),dkmax) + endif + enddo enddo - enddo + else + do k = 1, kmpbl + do i=1,im + if(scuflg(i)) then + !! if K needs to be adjusted by alpha, then no need to add this term + if (moninq_fac == 1.0) then + dkt(i,k) = dkt(i,k)+ckt(i,k) + dku(i,k) = dku(i,k)+cku(i,k) + end if + dkt(i,k) = min(dkt(i,k),dkmax) + dku(i,k) = min(dku(i,k),dkmax) + endif + enddo + enddo + endif ! ! compute tridiagonal matrix elements for heat and moisture ! @@ -1067,13 +1305,19 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! add dissipative heating at the first model layer ! !> Next, the temperature tendency is updated following equation 14. + if (hurr_pbl) then + ttend_fac = 0.7 + else + ttend_fac = 0.5 + endif + do i = 1,im tem = govrth(i)*sflux(i) tem1 = tem + stress(i)*spd1(i)/zl(i,1) tem2 = 0.5 * (tem1+diss(i,1)) tem2 = max(tem2, 0.) ttend = tem2 / cp - tau(i,1) = tau(i,1)+0.5*ttend + tau(i,1) = tau(i,1)+ttend_fac*ttend enddo ! ! add dissipative heating above the first model layer @@ -1083,7 +1327,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & tem = 0.5 * (diss(i,k-1)+diss(i,k)) tem = max(tem, 0.) ttend = tem / cp - tau(i,k) = tau(i,k) + 0.5*ttend + tau(i,k) = tau(i,k) + ttend_fac*ttend enddo enddo ! diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 47875640f..f2f7abe35 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -499,6 +499,49 @@ kind = kind_phys intent = in optional = F +[hurr_pbl] + standard_name = flag_hurricane_PBL + long_name = flag for hurricane-specific options in PBL scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[islimsk] + standard_name = sea_land_ice_mask + long_name = sea/land/ice mask (=0/1/2) + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[var_ric] + standard_name = flag_variable_bulk_richardson_number + long_name = flag for calculating variable bulk richardson number for hurricane PBL + units = flag + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[coef_ric_l] + standard_name = coefficient_for_variable_bulk_richardson_number_over_land + long_name = coefficient for calculating variable bulk richardson number for hurricane PBL over land + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[coef_ric_s] + standard_name = coefficient_for_variable_bulk_richardson_number_over_ocean + long_name = coefficient for calculating variable bulk richardson number for hurricane PBL over ocean + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/moninedmf_hafs.meta b/physics/moninedmf_hafs.meta new file mode 100644 index 000000000..6a7b0c7ed --- /dev/null +++ b/physics/moninedmf_hafs.meta @@ -0,0 +1,526 @@ +[ccpp-arg-table] + name = hedmf_init + type = scheme +[moninq_fac] + standard_name = atmosphere_diffusivity_coefficient_factor + long_name = multiplicative constant for atmospheric diffusivities + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = hedmf_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_vertical_diffusion_tracers + long_name = number of tracers to diffuse vertically + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = cloud condensate index in tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[dv] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tau] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rtg] + standard_name = tendency_of_vertically_diffused_tracer_concentration + long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = inout + optional = F +[u1] + standard_name = x_wind + long_name = x component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind + long_name = y component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature + long_name = layer mean air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = vertically_diffused_tracer_concentration + long_name = tracer concentration diffused by PBL scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[swh] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step + long_name = total sky shortwave heating rate + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[hlw] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step + long_name = total sky longwave heating rate + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in + optional = F +[xmu] + standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes + long_name = zenith angle temporal adjustment factor for shortwave + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psk] + standard_name = dimensionless_exner_function_at_lowest_model_interface + long_name = dimensionless Exner function at the surface interface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rbsoil] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length in cm + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[u10m] + standard_name = x_wind_at_10m + long_name = x component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v10m] + standard_name = y_wind_at_10m + long_name = y component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fm] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin-Obukhov similarity function for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fh] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin-Obukhov similarity function for heat + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsea] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[heat] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stress] + standard_name = surface_wind_stress + long_name = surface wind stress + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[spd1] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = PBL top model level index + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = pres(k) - pres(k+1) + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = Exner function at layers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[delt] + standard_name = time_step_for_physics + long_name = time step for physics + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dspheat] + standard_name = flag_TKE_dissipation_heating + long_name = flag for using TKE dissipation heating + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dusfc] + standard_name = instantaneous_surface_x_momentum_flux + long_name = x momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc] + standard_name = instantaneous_surface_y_momentum_flux + long_name = y momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtsfc] + standard_name = instantaneous_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dqsfc] + standard_name = instantaneous_surface_upward_latent_heat_flux + long_name = surface upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hgamt] + standard_name = countergradient_mixing_term_for_temperature + long_name = countergradient mixing term for temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hgamq] + standard_name = countergradient_mixing_term_for_water_vapor + long_name = countergradient mixing term for water vapor + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dkt] + standard_name = atmosphere_heat_diffusivity + long_name = diffusivity for heat + units = m2 s-1 + dimensions = (horizontal_dimension,vertical_dimension_minus_one) + type = real + kind = kind_phys + intent = out + optional = F +[kinver] + standard_name = index_of_highest_temperature_inversion + long_name = index of highest temperature inversion + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[xkzm_m] + standard_name = atmosphere_momentum_diffusivity_background + long_name = background value of momentum diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_h] + standard_name = atmosphere_heat_diffusivity_background + long_name = background value of heat diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_s] + standard_name = diffusivity_background_sigma_level + long_name = sigma level threshold for background diffusivity + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = flag for printing diagnostics to output + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = in + optional = F +[xkzminv] + standard_name = atmosphere_heat_diffusivity_background_maximum + long_name = maximum background value of heat diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[moninq_fac] + standard_name = atmosphere_diffusivity_coefficient_factor + long_name = multiplicative constant for atmospheric diffusivities + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[islimsk] + standard_name = sea_land_ice_mask + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/sfc_diff_hafs.f b/physics/sfc_diff_hafs.f new file mode 100644 index 000000000..62ead6e97 --- /dev/null +++ b/physics/sfc_diff_hafs.f @@ -0,0 +1,839 @@ +!> \file sfc_diff.f +!! this file contains the surface roughness length formulation based on +!! the surface sublayer scheme in +!! zeng and dickinson (1998) \cite zeng_and_dickinson_1998. + +!> this module contains the ccpp-compliant gfs surface layer scheme for +!!hafs. + module module_sfc_diff + + use machine , only : kind_phys + + use physcons, grav => con_g + real (kind=kind_phys), parameter :: ca=.4 ! ca - von karman constant + + contains + + subroutine sfc_diff_init + end subroutine sfc_diff_init + + subroutine sfc_diff_finalize + end subroutine sfc_diff_finalize + +!> \defgroup GFS_diff_main GFS Surface Layer Scheme Module +!> @{ +!> \brief This subroutine calculates surface roughness length. +!! +!! This subroutine includes the surface roughness length formulation +!! based on the surface sublayer scheme in +!! Zeng and Dickinson (1998) \cite zeng_and_dickinson_1998. +!> \section arg_table_sfc_diff_run Argument Table +!! \htmlinclude sfc_diff_run.html +!! +!> \section general_diff GFS Surface Layer Scheme General Algorithm +!! - Calculate the thermal roughness length formulation over the ocean +!(see eq. (25) and (26) +!! in Zeng et al. (1998) \cite zeng_et_al_1998). +!! - Calculate Zeng's momentum roughness length formulation over land +!and sea ice. +!! - Calculate the new vegetation-dependent formulation of thermal +!roughness length +!! (Zheng et al.(2009) \cite zheng_et_al_2009). +!! Zheng et al. (2009) \cite zheng_et_al_2009 proposed a new formulation +!on +!! \f$ln(Z_{0m}^,/Z_{0t})\f$ as follows: +!! \f[ +!! ln(Z_{0m}^,/Z_{0t})=(1-GVF)^2C_{zil}k(u*Z_{0g}/\nu)^{0.5} +!! \f] +!! where \f$Z_{0m}^,\f$ is the effective momentum roughness length +!! computed in the following equation for each grid, \f$Z_{0t}\f$ +!! is the roughness lenghth for heat, \f$C_{zil}\f$ is a coefficient +!! (taken as 0.8), k is the Von Karman constant (0.4), +!! \f$\nu=1.5\times10^{-5}m^{2}s^{-1}\f$ is the molecular viscosity, +!! \f$u*\f$ is the friction velocity, and \f$Z_{0g}\f$ is the bare +!! soil roughness length for momentum (taken as 0.01). +!! \n In order to consider the convergence of \f$Z_{0m}\f$ between +!! fully vegetated and bare soil, the effective \f$Z_{0m}^,\f$ is +!! computed: +!! \f[ +!! +!\ln(Z_{0m}^,)=(1-GVF)^{2}\ln(Z_{0g})+\left[1-(1-GVF)^{2}\right]\ln(Z_{0m}) +!!\f] +!! - Calculate the exchange coefficients:\f$cm\f$, \f$ch\f$, and +!\f$stress\f$ as inputs of other \a sfc schemes. +!! +!!\param[in] ps real, surface air pressure (\f$Pa\f$) +!!\param[in] u1 real, zonal wind velocity (\f$m/s\f$) +!!\param[in] v1 real, meridional wind velocity (\f$m/s\f$) +!!\param[in] t1 real, air temperature (\f$K\f$) +!!\param[in] q1 real, water vapor mixing ratio (\f$kg/kg\f$) +!!\param[in] z1 real, height above ground (\f$m\f$) +!!\param[in] prsl1 real, air pressure at lowest level (\f$Pa\f$) +!!\param[in] prslki real, ratio of exner func bet midlayer and +!! interface at lowest model layer +!!\param[in] ddvel real, (\f$\f$) +!!\param[in] sigmaf real, real fractional cover of green vegetation bounded on the bottom(\f$frac\f$) +!!\param[in] vegtyp integer, vegetation type classification +!!\param[in] shdmax real, max areal coverage of green veg (fraction) +!!\param[in] ivegsrc integer, vegetation type dataset choice +!!\param[in] z0pert real, perturbation of momentum roughness length +!!\param[in] ztpert real, perturbation of heat to momentum roughness length ratio (frac) +!!\param[in] flag_iter flag, flag for perturbation +!!\param[in] redrag logical, flag for reduced drag coefficient over sea +!!\param[in] u10m real, zonal wind at 10 m (\f$m/s\f$) +!!\param[in] v10m real, meridional wind at 10 m (\f$m/s\f$) +!!\param[in] sfc_z0_type integer, flag for surface roughness option over ocean +!!\param[in] wet logical, flag nonzero wet surface fraction +!!\param[in] dry logical, flag nonzero land surface fraction +!!\param[in] ice logical, flag nonzero ice surface fraction +!!\param[in] tskin real, surface skin temperature (\f$K\f$) +!!\param[in] tsurf real, surface skin temperature after iter (\f$K\f$) +!!\param[in] snwdph real, surface snow thickness water equiv (\f$mm\f$) +!!\param[in] z0rl real, surface snow thickness (\f$cm\f$) +!!\param[in,out] ustar real, surface friction velocity (\f$m/s\f$) +!!\param[in,out] cm real, surface drag coeff for momentum in air +!!\param[in,out] ch real, surface drag coeff for heat and moisture in air +!!\param[in,out] rb real, bulk richardson number at lowest mo lev +!!\param[in,out] stress real, surface wind stress (\f$m2/s2\f$) +!!\param[in,out] fm real, Monin Obukhov simi func for momentum +!!\param[in,out] fh real, Monin Obukhov simi func for heat +!!\param[in,out] fm real, Monin Obukhov simi func for momentum 10m +!!\param[in,out] fh real, Monin Obukhov simi func for heat 2m +!!\param[out] wind real, wind speed at lowest mod lev (\f$m/s\f$) + + + subroutine sfc_diff_hafs(im,ps,u1,v1,t1,q1,z1, &!intent(in) + & prsl1,prslki,ddvel, &!intent(in) + & sigmaf,vegtype,shdmax,ivegsrc, &!intent(in) + & z0pert,ztpert, &! mg, sfc-perts !intent(in) + & flag_iter,redrag, &!intent(in) + & u10m,v10m,sfc_z0_type, &!wang,z0 type !intent(in) + & wet,dry,icy, &!intent(in) + & tskin, tsurf, snwdph, z0rl, ustar, & + & cm, ch, rb, stress, fm, fh, fm10, fh2, & + & wind, & + & errmsg,errflg) &!intent(out) +! + use funcphys, only : fpvs + use physcons, rvrdm1 => con_fvirt + &, eps => con_eps, epsm1 => con_epsm1 + implicit none +! +! 1 - land, 2 - ice, 3 - water +! -------- -------- --------- + integer, intent(in) :: im, ivegsrc + integer, intent(in) :: sfc_z0_type ! option for calculating surface roughness length over ocean + + integer, dimension(im), intent(in) :: vegtype + + logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) + logical, dimension(im), intent(in) :: flag_iter, dry, wet, icy + + real(kind=kind_phys), dimension(im), intent(in) :: u10m,v10m + real(kind=kind_phys), dimension(im), intent(in) :: + & ps,u1,v1,t1,q1,z1,prsl1,prslki,ddvel, & + & sigmaf,shdmax, & + & z0pert,ztpert ! mg, sfc-perts + real(kind=kind_phys), dimension(im,3), intent(in) :: & + & tskin, tsurf, snwdph + + real(kind=kind_phys), dimension(im,3), intent(inout) :: & + & z0rl, ustar + +! 1 - land, 2 - ice, 3 - water +! -------- -------- --------- + real(kind=kind_phys), dimension(im,3), intent(out) :: & + & cm, ch, rb, stress, fm, fh, fm10, fh2 + real(kind=kind_phys), dimension(im), intent(out) :: wind +! +! locals +! + real(kind=kind_phys), dimension(im) :: wind10m + + integer i +! + real(kind=kind_phys) :: qs1, rat, thv1, restar, & + & czilc, tem1, tem2 + + real(kind=kind_phys) :: tvs_ocn, tvs_lnd, tvs_ice, & + & z0_ocn, z0_lnd, z0_ice, & + & z0max_ocn,z0max_lnd,z0max_ice, & + & ztmax_ocn,ztmax_lnd,ztmax_ice +! + real(kind=kind_phys), parameter :: + & charnock=.014, z0s_max=.317e-2, & ! a limiting value at high winds over sea + & vis=1.4e-5, rnu=1.51e-5, visi=1.0/vis, & + & log01=log(0.01), log05=log(0.05), log07=log(0.07) + +! parameter (charnock=.014,ca=.4)!c ca is the von karman constant +! parameter (alpha=5.,a0=-3.975,a1=12.32,b1=-7.755,b2=6.041) +! parameter (a0p=-7.941,a1p=24.75,b1p=-8.705,b2p=7.899,vis=1.4e-5) + +! real(kind=kind_phys) aa1,bb1,bb2,cc,cc1,cc2,arnu +! parameter (aa1=-1.076,bb1=.7045,cc1=-.05808) +! parameter (bb2=-.1954,cc2=.009999) +! parameter (arnu=.135*rnu) +! +! z0s_max=.196e-2 for u10_crit=25 m/s +! z0s_max=.317e-2 for u10_crit=30 m/s +! z0s_max=.479e-2 for u10_crit=35 m/s +! +! mbek -- toga-coare flux algorithm +! parameter (rnu=1.51e-5,arnu=0.11*rnu) +! +! initialize variables. all units are supposedly m.k.s. unless specified +! ps is in pascals, wind is wind speed, +! surface roughness length is converted to m from cm +! + +! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type + + do i=1,im + ztmax_ocn = 0.0 ; ztmax_lnd = 0.0 ; ztmax_ice = 0.0 + tvs_lnd = 0.0 ; tvs_ice = 0.0 ; tvs_ocn = 0.0 + + wind10m(i) = max(sqrt( u10m(i)*u10m(i) + v10m(i)*v10m(i)), & + & 1.0) + + + if(flag_iter(i)) then + wind(i) = max(sqrt(u1(i)*u1(i) + v1(i)*v1(i)) & + & + max(0.0, min(ddvel(i), 30.0)), 1.0) + tem1 = 1.0 + rvrdm1 * max(q1(i),1.e-8) + thv1 = t1(i) * prslki(i) * tem1 + if (dry(i)) tvs_lnd = 0.5 * (tsurf(i,1)+tskin(i,1)) * tem1 + if (icy(i)) tvs_ice = 0.5 * (tsurf(i,2)+tskin(i,2)) * tem1 + if (wet(i)) tvs_ocn = 0.5 * (tsurf(i,3)+tskin(i,3)) * tem1 + + qs1 = fpvs(t1(i)) + qs1 = max(1.0e-8, eps * qs1 / (prsl1(i) + epsm1 * qs1)) + + z0_lnd = 0.01 * z0rl(i,1) + z0max_lnd = max(1.0e-6, min(z0_lnd,z1(i))) + z0_ice = 0.01 * z0rl(i,2) + z0max_ice = max(1.0e-6, min(z0_ice,z1(i))) + z0_ocn = 0.01 * z0rl(i,3) + z0max_ocn = max(1.0e-6, min(z0_ocn,z1(i))) + +! compute stability dependent exchange coefficients +! this portion of the code is presently suppressed +! + + if (wet(i)) then ! some open ocean + ustar(i,3) = sqrt(grav * z0_ocn / charnock) + +!** test xubin's new z0 + +! ztmax = z0max + + restar = max(ustar(i,3)*z0max_ocn*visi, 0.000001) + +! restar = log(restar) +! restar = min(restar,5.) +! restar = max(restar,-5.) +! rat = aa1 + (bb1 + cc1*restar) * restar +! rat = rat / (1. + (bb2 + cc2*restar) * restar)) +! rat taken from zeng, zhao and dickinson 1997 + + rat = min(7.0, 2.67 * sqrt(sqrt(restar)) - 2.57) + ztmax_ocn = z0max_ocn * exp(-rat) + + if (sfc_z0_type == 6) then + call znot_t_v6(wind10m(i),ztmax_ocn) ! 10-m wind,m/s, ztmax(m) + else if (sfc_z0_type == 7) then + call znot_t_v7(wind10m(i),ztmax_ocn) ! 10-m wind,m/s, ztmax(m) + else if (sfc_z0_type .ne. 0) then + write(0,*)'no option for sfc_z0_type=',sfc_z0_type + stop + endif + + endif ! open ocean + + if (dry(i) .or. icy(i)) then ! over land or sea ice +!** xubin's new z0 over land and sea ice + tem1 = 1.0 - shdmax(i) + tem2 = tem1 * tem1 + tem1 = 1.0 - tem2 + + if( ivegsrc == 1 ) then + + if (vegtype(i) == 10) then + z0max_lnd = exp( tem2*log01 + tem1*log07 ) + elseif (vegtype(i) == 6) then + z0max_lnd = exp( tem2*log01 + tem1*log05 ) + elseif (vegtype(i) == 7) then +! z0max = exp( tem2*log01 + tem1*log01 ) + z0max_lnd = 0.01 + elseif (vegtype(i) == 16) then +! z0max = exp( tem2*log01 + tem1*log01 ) + z0max_lnd = 0.01 + else + z0max_lnd = exp( tem2*log01 + tem1*log(z0max_lnd) ) + endif + + elseif (ivegsrc == 2 ) then + + if (vegtype(i) == 7) then + z0max_lnd = exp( tem2*log01 + tem1*log07 ) + elseif (vegtype(i) == 8) then + z0max_lnd = exp( tem2*log01 + tem1*log05 ) + elseif (vegtype(i) == 9) then +! z0max = exp( tem2*log01 + tem1*log01 ) + z0max_lnd = 0.01 + elseif (vegtype(i) == 11) then +! z0max = exp( tem2*log01 + tem1*log01 ) + z0max_lnd = 0.01 + else + z0max_lnd = exp( tem2*log01 + tem1*log(z0max_lnd) ) + endif + + endif ! over land or sea ice + + z0max_ice = z0max_lnd + +! mg, sfc-perts: add surface perturbations to z0max over land + if (dry(i) .and. z0pert(i) /= 0.0 ) then + z0max_lnd = z0max_lnd * (10.**z0pert(i)) + endif + + z0max_lnd = max(z0max_lnd,1.0e-6) + z0max_ice = max(z0max_ice,1.0e-6) + +! czilc = 10.0 ** (- (0.40/0.07) * z0) ! fei's canopy height dependance of czil + czilc = 0.8 + + tem1 = 1.0 - sigmaf(i) + ztmax_lnd = z0max_lnd*exp( - tem1*tem1 & + & * czilc*ca*sqrt(ustar(i,1)*(0.01/1.5e-05))) + ztmax_ice = z0max_ice*exp( - tem1*tem1 & + & * czilc*ca*sqrt(ustar(i,2)*(0.01/1.5e-05))) + + +! mg, sfc-perts: add surface perturbations to ztmax/z0max ratio over land + if (dry(i) .and. ztpert(i) /= 0.0) then + ztmax_lnd = ztmax_lnd * (10.**ztpert(i)) + endif + + + endif ! end of if(sfctype flags) then + + ztmax_ocn = max(ztmax_ocn,1.0e-6) + ztmax_lnd = max(ztmax_lnd,1.0e-6) + ztmax_ice = max(ztmax_ice,1.0e-6) + +! bwg begin "stability" block, 2019-03-23 + if (wet(i)) then ! some open ocean + call stability & +! --- inputs: + & (z1(i),snwdph(i,3),thv1,wind(i), & + & z0max_ocn,ztmax_ocn,tvs_ocn, & +! --- outputs: + & rb(i,3), fm(i,3), fh(i,3), fm10(i,3), fh2(i,3), & + & cm(i,3), ch(i,3), stress(i,3), ustar(i,3)) + endif ! open ocean points + + if (dry(i)) then ! some land + call stability & +! --- inputs: + & (z1(i),snwdph(i,1),thv1,wind(i), & + & z0max_lnd,ztmax_lnd,tvs_lnd, & +! --- outputs: + & rb(i,1), fm(i,1), fh(i,1), fm10(i,1), fh2(i,1), & + & cm(i,1), ch(i,1), stress(i,1), ustar(i,1)) + endif ! dry points + + if (icy(i)) then ! some ice + call stability & +! --- inputs: + & (z1(i),snwdph(i,2),thv1,wind(i), & + & z0max_ice,ztmax_ice,tvs_ice, +! --- outputs: + & rb(i,2), fm(i,2), fh(i,2), fm10(i,2), fh2(i,2), & + & cm(i,2), ch(i,2), stress(i,2), ustar(i,2)) + endif ! icy points + +! bwg: everything from here to end of subroutine was after +! the stuff now put into "stability" + +! +! update z0 over ocean +! + if (wet(i)) then + z0_ocn = (charnock / grav) * ustar(i,3) * ustar(i,3) + +! mbek -- toga-coare flux algorithm +! z0 = (charnock / grav) * ustar(i)*ustar(i) + arnu/ustar(i) +! new implementation of z0 +! cc = ustar(i) * z0 / rnu +! pp = cc / (1. + cc) +! ff = grav * arnu / (charnock * ustar(i) ** 3) +! z0 = arnu / (ustar(i) * ff ** pp) + + if (redrag) then + z0rl(i,3) = 100.0 * max(min(z0_ocn, z0s_max), 1.e-7) + else + z0rl(i,3) = 100.0 * max(min(z0_ocn,.1), 1.e-7) + endif + + if (sfc_z0_type == 6) then ! wang + call znot_m_v6(wind10m(i),z0_ocn) ! wind, m/s, z0, m + z0rl(i,3) = 100.0 * z0_ocn ! cm + endif !wang + if (sfc_z0_type == 7) then ! wang + call znot_m_v7(wind10m(i),z0_ocn) ! wind, m/s, z0, m + z0rl(i,3) = 100.0 * z0_ocn ! cm + endif !wang + + + endif ! end of if(open ocean) + endif ! end of if(flagiter) loop + enddo + + return +!................................ + end subroutine sfc_diff +!................................ + + +!---------------------------------------- + subroutine stability +!........................................ +! --- inputs: + & ( z1, snwdph, thv1, wind, z0max, ztmax, tvs, & +! --- outputs: + & rb, fm, fh, fm10, fh2, cm, ch, stress, ustar) +!----- + +! --- inputs: + real(kind=kind_phys), intent(in) :: & + & z1, snwdph, thv1, wind, z0max, ztmax, tvs + +! --- outputs: + real(kind=kind_phys), intent(out) :: & + & rb, fm, fh, fm10, fh2, cm, ch, stress, ustar + +! --- locals: + real(kind=kind_phys), parameter :: alpha=5., a0=-3.975, & + & a1=12.32, alpha4=4.0*alpha, & + & b1=-7.755, b2=6.041, alpha2=alpha+alpha, beta=1.0,& + & a0p=-7.941, a1p=24.75, b1p=-8.705, b2p=7.899, & + & ztmin1=-999.0 + + real(kind=kind_phys) aa, aa0, bb, bb0, dtv, adtv, & + & hl1, hl12, pm, ph, pm10, ph2, & + & z1i, & + & fms, fhs, hl0, hl0inf, hlinf, & + & hl110, hlt, hltinf, olinf, & + & tem1, tem2, ztmax1 + + z1i = 1.0 / z1 + + tem1 = z0max/z1 + if (abs(1.0-tem1) > 1.0e-6) then + ztmax1 = - beta*log(tem1)/(alpha2*(1.-tem1)) + else + ztmax1 = 99.0 + endif + if( z0max < 0.05 .and. snwdph < 10.0 ) ztmax1 = 99.0 + +! compute stability indices (rb and hlinf) + + dtv = thv1 - tvs + adtv = max(abs(dtv),0.001) + dtv = sign(1.,dtv) * adtv + rb = max(-5000.0, (grav+grav) * dtv * z1 + & / ((thv1 + tvs) * wind * wind)) + tem1 = 1.0 / z0max + tem2 = 1.0 / ztmax + fm = log((z0max+z1) * tem1) + fh = log((ztmax+z1) * tem2) + fm10 = log((z0max+10.)* tem1) + fh2 = log((ztmax+2.) * tem2) + hlinf = rb * fm * fm / fh + hlinf = min(max(hlinf,ztmin1),ztmax1) +! +! stable case +! + if (dtv >= 0.0) then + hl1 = hlinf + if(hlinf > .25) then + tem1 = hlinf * z1i + hl0inf = z0max * tem1 + hltinf = ztmax * tem1 + aa = sqrt(1. + alpha4 * hlinf) + aa0 = sqrt(1. + alpha4 * hl0inf) + bb = aa + bb0 = sqrt(1. + alpha4 * hltinf) + pm = aa0 - aa + log( (aa + 1.)/(aa0 + 1.) ) + ph = bb0 - bb + log( (bb + 1.)/(bb0 + 1.) ) + fms = fm - pm + fhs = fh - ph + hl1 = fms * fms * rb / fhs + hl1 = min(max(hl1, ztmin1), ztmax1) + endif +! +! second iteration +! + tem1 = hl1 * z1i + hl0 = z0max * tem1 + hlt = ztmax * tem1 + aa = sqrt(1. + alpha4 * hl1) + aa0 = sqrt(1. + alpha4 * hl0) + bb = aa + bb0 = sqrt(1. + alpha4 * hlt) + pm = aa0 - aa + log( (1.0+aa)/(1.0+aa0) ) + ph = bb0 - bb + log( (1.0+bb)/(1.0+bb0) ) + hl110 = hl1 * 10. * z1i + hl110 = min(max(hl110, ztmin1), ztmax1) + aa = sqrt(1. + alpha4 * hl110) + pm10 = aa0 - aa + log( (1.0+aa)/(1.0+aa0) ) + hl12 = (hl1+hl1) * z1i + hl12 = min(max(hl12,ztmin1),ztmax1) +! aa = sqrt(1. + alpha4 * hl12) + bb = sqrt(1. + alpha4 * hl12) + ph2 = bb0 - bb + log( (1.0+bb)/(1.0+bb0) ) +! +! unstable case - check for unphysical obukhov length +! + else ! dtv < 0 case + olinf = z1 / hlinf + tem1 = 50.0 * z0max + if(abs(olinf) <= tem1) then + hlinf = -z1 / tem1 + hlinf = min(max(hlinf,ztmin1),ztmax1) + endif +! +! get pm and ph +! + if (hlinf >= -0.5) then + hl1 = hlinf + pm = (a0 + a1*hl1) * hl1 / (1.+ (b1+b2*hl1) *hl1) + ph = (a0p + a1p*hl1) * hl1 / (1.+ (b1p+b2p*hl1)*hl1) + hl110 = hl1 * 10. * z1i + hl110 = min(max(hl110, ztmin1), ztmax1) + pm10 = (a0 + a1*hl110) * hl110 / (1.+(b1+b2*hl110)*hl110) + hl12 = (hl1+hl1) * z1i + hl12 = min(max(hl12, ztmin1), ztmax1) + ph2 = (a0p + a1p*hl12) * hl12 / (1.+(b1p+b2p*hl12)*hl12) + else ! hlinf < 0.05 + hl1 = -hlinf + tem1 = 1.0 / sqrt(hl1) + pm = log(hl1) + 2. * sqrt(tem1) - .8776 + ph = log(hl1) + .5 * tem1 + 1.386 +! pm = log(hl1) + 2.0 * hl1 ** (-.25) - .8776 +! ph = log(hl1) + 0.5 * hl1 ** (-.5) + 1.386 + hl110 = hl1 * 10. * z1i + hl110 = min(max(hl110, ztmin1), ztmax1) + pm10 = log(hl110) + 2.0 / sqrt(sqrt(hl110)) - .8776 +! pm10 = log(hl110) + 2. * hl110 ** (-.25) - .8776 + hl12 = (hl1+hl1) * z1i + hl12 = min(max(hl12, ztmin1), ztmax1) + ph2 = log(hl12) + 0.5 / sqrt(hl12) + 1.386 +! ph2 = log(hl12) + .5 * hl12 ** (-.5) + 1.386 + endif + + endif ! end of if (dtv >= 0 ) then loop +! +! finish the exchange coefficient computation to provide fm and fh +! + fm = fm - pm + fh = fh - ph + fm10 = fm10 - pm10 + fh2 = fh2 - ph2 + cm = ca * ca / (fm * fm) + ch = ca * ca / (fm * fh) + tem1 = 0.00001/z1 + cm = max(cm, tem1) + ch = max(ch, tem1) + stress = cm * wind * wind + ustar = sqrt(stress) + + return +!................................. + end subroutine stability +!--------------------------------- + + +!! add fitted z0,zt curves for hurricane application (used in hwrf/hmon) +!! weiguo wang, 2019-0425 + + subroutine znot_m_v6 & +! inputs + & (uref, & +! outputs + & znotm) + implicit none +! calculate areodynamical roughness over water with input 10-m wind +! for low-to-moderate winds, try to match the cd-u10 relationship from coare v3.5 (edson et al. 2013) +! for high winds, try to fit available observational data +! +! bin liu, noaa/ncep/emc 2017 +! +! uref(m/s) : wind speed at 10-m height +! znotm(meter): areodynamical roughness scale over water +! + + real (kind=kind_phys), intent(in) :: uref + real (kind=kind_phys), intent(out):: znotm + real :: p13, p12, p11, p10 + real :: p25, p24, p23, p22, p21, p20 + real :: p35, p34, p33, p32, p31, p30 + real :: p40 + + real(kind=kind_phys), parameter :: p13 = -1.296521881682694e-02, & + & p12 = 2.855780863283819e-01 p11 = -1.597898515251717e+00, & + & p10 = -8.396975715683501e+00, & + + & p25 = 3.790846746036765e-10, p24 = 3.281964357650687e-09, & + & p23 = 1.962282433562894e-07, p22 = -1.240239171056262e-06, & + & p21 = 1.739759082358234e-07, p20 = 2.147264020369413e-05, & + + & p35 = 1.840430200185075e-07, p34 = -2.793849676757154e-05, & + & p33 = 1.735308193700643e-03, p32 = -6.139315534216305e-02, & + & p31 = 1.255457892775006e+00, p30 = -1.663993561652530e+01, & + + & p40 = 4.579369142033410e-04 + + if (uref >= 0.0 .and. uref <= 6.5 ) then + znotm = exp( p10 + p11*uref + p12*uref**2 + & + & p13*uref**3) + elseif (uref > 6.5 .and. uref <= 15.7) then + znotm = p25*uref**5 + p24*uref**4 + p23*uref**3 + & + & p22*uref**2 + p21*uref + p20 + elseif (uref > 15.7 .and. uref <= 53.0) then + znotm = exp( p35*uref**5 + p34*uref**4 + & + & p33*uref**3 + p32*uref**2 + p31*uref + p30 ) + elseif ( uref > 53.0) then + znotm = p40 + else + print*, 'wrong input uref value:',uref + endif + + return +!................................. + end subroutine znot_m_v6 +!................................. + + subroutine znot_t_v6(uref,znott) +! inputs + & (uref, +! outputs + & znott) + implicit none +! calculate scalar roughness over water with input 10-m wind +! for low-to-moderate winds, try to match the ck-u10 relationship from coare algorithm +! for high winds, try to retain the ck-u10 relationship of fy2015 hwrf +! +! bin liu, noaa/ncep/emc 2017 +! +! uref(m/s) : wind speed at 10-m height +! znott(meter): scalar roughness scale over water +! + + real (kind=kind_phys), intent(in) :: uref + real (kind=kind_phys), intent(out):: znott + + real :: p00 + real :: p15, p14, p13, p12, p11, p10 + real :: p25, p24, p23, p22, p21, p20 + real :: p35, p34, p33, p32, p31, p30 + real :: p45, p44, p43, p42, p41, p40 + real :: p56, p55, p54, p53, p52, p51, p50 + real :: p60 + + real(kind=kind_phys), parameter :: p00 = 1.100000000000000e-04, & + + & p15 = -9.144581627678278e-10, p14 = 7.020346616456421e-08, & + & p13 = -2.155602086883837e-06, p12 = 3.333848806567684e-05, & + & p11 = -2.628501274963990e-04, p10 = 8.634221567969181e-04, & + + & p25 = -8.654513012535990e-12, p24 = 1.232380050058077e-09, & + & p23 = -6.837922749505057e-08, p22 = 1.871407733439947e-06, & + & p21 = -2.552246987137160e-05, p20 = 1.428968311457630e-04, & + + & p35 = 3.207515102100162e-12, p34 = -2.945761895342535e-10, & + & p33 = 8.788972147364181e-09, p32 = -3.814457439412957e-08, & + & p31 = -2.448983648874671e-06, p30 = 3.436721779020359e-05, & + + & p45 = -3.530687797132211e-11, p44 = 3.939867958963747e-09, & + & p43 = -1.227668406985956e-08, p42 = -1.367469811838390e-05, & + & p41 = 5.988240863928883e-04, p40 = -7.746288511324971e-03, & + + & p56 = -1.187982453329086e-13, p55 = 4.801984186231693e-11, & + & p54 = -8.049200462388188e-09, p53 = 7.169872601310186e-07, & + & p52 = -3.581694433758150e-05, p51 = 9.503919224192534e-04, & + & p50 = -1.036679430885215e-02, + + & p60 = 4.751256171799112e-05 + + if (uref >= 0.0 .and. uref < 5.9 ) then + znott = p00 + elseif (uref >= 5.9 .and. uref <= 15.4) then + znott = p15*uref**5 + p14*uref**4 + p13*uref**3 & + & + p12*uref**2 + p11*uref + p10 + elseif (uref > 15.4 .and. uref <= 21.6) then + znott = p25*uref**5 + p24*uref**4 + p23*uref**3 & + & + p22*uref**2 + p21*uref + p20 + elseif (uref > 21.6 .and. uref <= 42.2) then + znott = p35*uref**5 + p34*uref**4 + p33*uref**3 & + & + p32*uref**2 + p31*uref + p30 + elseif ( uref > 42.2 .and. uref <= 53.3) then + znott = p45*uref**5 + p44*uref**4 + p43*uref**3 & + & + p42*uref**2 + p41*uref + p40 + elseif ( uref > 53.3 .and. uref <= 80.0) then + znott = p56*uref**6 + p55*uref**5 + p54*uref**4 & + & + p53*uref**3 + p52*uref**2 + p51*uref + p50 + elseif ( uref > 80.0) then + znott = p60 + else + print*, 'wrong input uref value:',uref + endif + + return +!................................. + end subroutine znot_t_v6 +!................................. + + subroutine znot_m_v7 & +! inputs + & (uref, & +! outputs + & znotm) + implicit none +! calculate areodynamical roughness over water with input 10-m wind +! for low-to-moderate winds, try to match the cd-u10 relationship from coare v3.5 (edson et al. 2013) +! for high winds, try to fit available observational data +! comparing to znot_t_v6, slightly decrease cd for higher wind speed +! +! bin liu, noaa/ncep/emc 2018 +! +! uref(m/s) : wind speed at 10-m height +! znotm(meter): areodynamical roughness scale over water +! + + real (kind=kind_phys), intent(in) :: uref + real (kind=kind_phys), intent(out):: znotm + real :: p13, p12, p11, p10 + real :: p25, p24, p23, p22, p21, p20 + real :: p35, p34, p33, p32, p31, p30 + real :: p40 + + real(kind=kind_phys), parameter :: p13 = -1.296521881682694e-02, & + & p12 = 2.855780863283819e-01, p11 = -1.597898515251717e+00, & + & p10 = -8.396975715683501e+00, & + + & p25 = 3.790846746036765e-10, p24 = 3.281964357650687e-09, & + & p23 = 1.962282433562894e-07, p22 = -1.240239171056262e-06, & + & p21 = 1.739759082358234e-07, p20 = 2.147264020369413e-05, & + + + & p35 = 1.897534489606422e-07, p34 = -3.019495980684978e-05, & + & p33 = 1.931392924987349e-03, p32 = -6.797293095862357e-02, & + & p31 = 1.346757797103756e+00, p30 = -1.707846930193362e+01, & + + & p40 = 3.371427455376717e-04 + + if (uref >= 0.0 .and. uref <= 6.5 ) then + znotm = exp( p10 + p11*uref + p12*uref**2 + p13*uref**3) + elseif (uref > 6.5 .and. uref <= 15.7) then + znotm = p25*uref**5 + p24*uref**4 + p23*uref**3 + & + & p22*uref**2 + p21*uref + p20 + elseif (uref > 15.7 .and. uref <= 53.0) then + znotm = exp( p35*uref**5 + p34*uref**4 + p33*uref**3 + & + & p32*uref**2 + p31*uref + p30 ) + elseif ( uref > 53.0) then + znotm = p40 + else + print*, 'wrong input uref value:',uref + endif + + return +!................................. + end subroutine znot_m_v7 +!................................. + + subroutine znot_t_v7 & +! inputs + & (uref, & +! outputs + & znott) + +! calculate scalar roughness over water with input 10-m wind +! for low-to-moderate winds, try to match the ck-u10 relationship from coare algorithm +! for high winds, try to retain the ck-u10 relationship of fy2015 hwrf +! to be compatible with the slightly decreased cd for higher wind speed +! +! bin liu, noaa/ncep/emc 2018 +! +! uref(m/s) : wind speed at 10-m height +! znott(meter): scalar roughness scale over water +! + + implicit none + real (kind=kind_phys), intent(in) :: uref + real (kind=kind_phys), intent(out):: znott + + real :: p00 + real :: p15, p14, p13, p12, p11, p10 + real :: p25, p24, p23, p22, p21, p20 + real :: p35, p34, p33, p32, p31, p30 + real :: p45, p44, p43, p42, p41, p40 + real :: p56, p55, p54, p53, p52, p51, p50 + real :: p60 + + real(kind=kind_phys), parameter ::p00 = 1.100000000000000e-04, & + + & p15 = -9.193764479895316e-10, p14 = 7.052217518653943e-08, & + & p13 = -2.163419217747114e-06, p12 = 3.342963077911962e-05, & + & p11 = -2.633566691328004e-04, p10 = 8.644979973037803e-04, & + + & p25 = -9.402722450219142e-12, p24 = 1.325396583616614e-09, & + & p23 = -7.299148051141852e-08, p22 = 1.982901461144764e-06, & + & p21 = -2.680293455916390e-05, p20 = 1.484341646128200e-04, & + + & p35 = 7.921446674311864e-12, p34 = -1.019028029546602e-09, & + & p33 = 5.251986927351103e-08, p32 = -1.337841892062716e-06, & + & p31 = 1.659454106237737e-05, p30 = -7.558911792344770e-05, & + + & p45 = -2.694370426850801e-10, p44 = 5.817362913967911e-08, & + & p43 = -5.000813324746342e-06, p42 = 2.143803523428029e-04, & + & p41 = -4.588070983722060e-03, p40 = 3.924356617245624e-02, & + + & p56 = -1.663918773476178e-13, p55 = 6.724854483077447e-11, & + & p54 = -1.127030176632823e-08, p53 = 1.003683177025925e-06, & + & p52 = -5.012618091180904e-05, p51 = 1.329762020689302e-03, & + & p50 = -1.450062148367566e-02, + + & p60 = 6.840803042788488e-05 + + if (uref >= 0.0 .and. uref < 5.9 ) then + znott = p00 + elseif (uref >= 5.9 .and. uref <= 15.4) then + znott = p15*uref**5 + p14*uref**4 + p13*uref**3 + & + & p12*uref**2 + p11*uref + p10 + elseif (uref > 15.4 .and. uref <= 21.6) then + znott = p25*uref**5 + p24*uref**4 + p23*uref**3 + & + & p22*uref**2 + p21*uref + p20 + elseif (uref > 21.6 .and. uref <= 42.6) then + znott = p35*uref**5 + p34*uref**4 + p33*uref**3 + & + & p32*uref**2 + p31*uref + p30 + elseif ( uref > 42.6 .and. uref <= 53.0) then + znott = p45*uref**5 + p44*uref**4 + p43*uref**3 + & + & p42*uref**2 + p41*uref + p40 + elseif ( uref > 53.0 .and. uref <= 80.0) then + znott = p56*uref**6 + p55*uref**5 + p54*uref**4 + & + & p53*uref**3 + p52*uref**2 + p51*uref + p50 + elseif ( uref > 80.0) then + znott = p60 + else + print*, 'wrong input uref value:',uref + endif + + return +!................................. + end subroutine znot_t_v7 +!................................. + + +!--------------------------------- + end module module_sfc_diff diff --git a/physics/sfc_diff_hafs.meta b/physics/sfc_diff_hafs.meta new file mode 100644 index 000000000..79d6f8994 --- /dev/null +++ b/physics/sfc_diff_hafs.meta @@ -0,0 +1,398 @@ +[ccpp-arg-table] + name = sfc_diff_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[rvrdm1] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ps] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[u1] + standard_name = x_wind_at_lowest_model_level + long_name = 1st model layer u wind speed + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind_at_lowest_model_level + long_name = 1st model layer v wind speed + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature_at_lowest_model_layer + long_name = 1st model layer air temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer + long_name = 1st model layer specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[z1] + standard_name = height_above_ground_at_lowest_model_layer + long_name = height above ground at 1st model layer + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[prsl1] + standard_name = air_pressure_at_lowest_model_layer + long_name = Model layer 1 mean pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslki] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsik1] + standard_name = dimensionless_exner_function_at_lowest_model_interface + long_name = dimensionless Exner function at the ground surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk1] + standard_name = dimensionless_exner_function_at_lowest_model_layer + long_name = dimensionless Exner function at the lowest model layer + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sigmaf] + standard_name = bounded_vegetation_area_fraction + long_name = areal fractional cover of green vegetation bounded on the bottom + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vegtype] + standard_name = vegetation_type_classification + long_name = vegetation type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[shdmax] + standard_name = maximum_vegetation_area_fraction + long_name = max fractnl cover of green veg + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ivegsrc] + standard_name = vegetation_type_dataset_choice + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[z0pert] + standard_name = perturbation_of_momentum_roughness_length + long_name = perturbation of momentum roughness length + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ztpert] + standard_name = perturbation_of_heat_to_momentum_roughness_length_ratio + long_name = perturbation of heat to momentum roughness length ratio + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[redrag] + standard_name = flag_for_reduced_drag_coefficient_over_sea + long_name = flag for reduced drag coefficient over sea + units = flag + dimensions = () + type = logical + intent = in + optional = F +[u10m] + standard_name = x_wind_at_10m + long_name = 10 meter u wind speed + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v10m] + standard_name = y_wind_at_10m + long_name = 10 meter v wind speed + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_z0_type] + standard_name = flag_for_surface_roughness_option_over_ocean + long_name = surface roughness options over ocean + units = flag + dimensions = () + type = integer + intent = in + optional = F +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[tskin] + standard_name = surface_skin_temperature_interstitial + long_name = surface skin temperature over 1-land 2-ice 3-ocean (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsurf] + standard_name = surface_skin_temperature_after_iteration + long_name = surface skin temperature after iteration over 1-land 2-ice 3-ocean + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snwdph] + standard_name = surface_snow_thickness_water_equivalent + long_name = water equivalent snow depth 1-land 2-ice 3-ocean + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[z0rl] + standard_name = surface_roughness_length_interstitial + long_name = surface roughness length over 1-land 2-ice 3-ocean (temporary use as interstitial) + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ustar] + standard_name = surface_friction_velocity + long_name = surface friction velocity over 1-land 2-ice 3-ocean + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cm] + standard_name = surface_drag_coefficient_for_momentum_in_air + long_name = surface exchange coeff for momentum over 1-land 2-ice 3-ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ch] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air + long_name = surface exchange coeff heat & moisture over 1-land 2-ice 3-ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rb] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface over 1-land 2-ice 3-ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stress] + standard_name = surface_wind_stress + long_name = surface wind stress over 1-land 2-ice 3-ocean + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin-Obukhov similarity function for momentum over 1-land 2-ice 3-ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin-Obukhov similarity function for heat over 1-land 2-ice 3-ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fm10] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m + long_name = Monin-Obukhov similarity parameter for momentum at 10m over 1-land 2-ice 3-ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fh2] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m + long_name = Monin-Obukhov similarity parameter for heat at 2m over 1-land 2-ice 3-ocean + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/sflx_hafs.f b/physics/sflx_hafs.f new file mode 100644 index 000000000..68fdcaf85 --- /dev/null +++ b/physics/sflx_hafs.f @@ -0,0 +1,6238 @@ +!>\file sflx_hafs.f +!! This file is the entity of GFS Noah LSM Model(Version 2.7). + +!>\ingroup Noah_LSM +!!\brief This is the entity of GFS Noah LSM model of physics subroutines. +!! It is a soil/veg/snowpack land-surface model to update soil moisture, soil +!! ice, soil temperature, skin temperature, snowpack water content, snowdepth, +!! and all terms of the surface energy balance and surface water balance +!! (excluding input atmospheric forcings of downward radiation and +!! precipitation). +!! +!! The land-surface model component was substantially upgraded from the Oregon +!! State University (OSU) land surface model to EMC's new Noah Land Surface Model +!! (Noah LSM) during the major implementation in the NCEP Global Forecast System +!! (GFS) on May 31, 2005. Forecast System (GFS). The Noah LSM embodies about 10 +!! years of upgrades (see \cite chen_et_al_1996, \cite koren_et_al_1999, +!! \cite ek_et_al_2003) to its ancestor, the OSU LSM. The Noah LSM upgrade includes: +!! - An increase from two (10, 190 cm thick) to four soil layers (10, 30, 60, 100 cm thick) +!! - Addition of frozen soil physics +!! - Add glacial ice treatment +!! - Two snowpack states (SWE, density) +!! - New formulations for infiltration and runoff account for sub-grid variability in precipitation and soil moisture +!! - Revised physics of the snowpack and its influence on surface heat fluxes and albedo +!! - Higher canopy resistance +!! - Spatially varying root depth +!! - Surface fluxes weighted by snow cover fraction +!! - Improved thermal conduction in soil/snow +!! - Improved seasonality of green vegetation cover. +!! - Improved evaporation treatment over bare soil and snowpack +!! +!!\param[in] nsoil integer, number of soil layers (>=2 but <=nsold) +!!\param[in] couple integer, =0:uncoupled (land model only), +!! =1:coupled with parent atmos model +!!\param[in] icein integer, sea-ice flag (=1: sea-ice, =0: land) +!!\param[in] ffrozp real, flag for snow-rain detection (1.=snow, 0.=rain) +!!\param[in] dt real, time step (<3600 sec) +!!\param[in] zlvl real, height abv atmos ground forcing vars (\f$m\f$) +!!\param[in] sldpth real, thickness of each soil layer (\f$m\f$), nsoil +!!\param[in] swdn real, downward SW radiation flux (\f$W/m^2\f$) +!!\param[in] swnet real, downward SW net (dn-up) flux (\f$W/m^2\f$) +!!\param[in] lwdn real, downward LW radiation flux (\f$W/m^2\f$) +!!\param[in] sfcems real, sfc LW emissivity (fractional) +!!\param[in] embrd real, background sfc LW emissivity (fractional) +!!\param[in] sfcprs real, pressure at height zlvl above ground(\f$Pa\f$) +!!\param[in] sfctmp real, air temp at height zlvl above ground (\f$K\f$) +!!\param[in] sfcspd real, wind speed at height zlvl above ground (\f$m s^{-1}\f$) +!!\param[in] prcp real, precipitation rate (\f$kgm^{-2}s^{-1}\f$) +!!\param[in] q2 real, mixing ratio at hght zlvl above ground (\f$kgkg^{-1}\f$) +!!\param[in] q2sat real, sat mixing ratio at zlvl above ground (\f$kgkg^{-1}\f$) +!!\param[in] dqsdt2 real, slope of sat specific humidity curve at t=sfctmp (\f$kgkg^{-1}k^{-1}\f$) +!!\param[in] th2 real, air potential temperature at zlvl above ground (\f$K\f$) +!!\param[in] ivegsrc integer, sfc veg type data source UMD or IGBP +!!\param[in] vegtyp integer, vegetation type (integer index) +!!\param[in] soiltyp integer, soil type (integer index) +!!\param[in] slopetyp integer, class of sfc slope (integer index) +!!\param[in] shdmin real, min areal coverage of green veg (fraction) +!!\param[in] shdmax real, max areal coverage of green veg (fraction) +!!\param[in] alb real, background snow-free sfc albedo (fraction) +!!\param[in] snoalb real, max albedo over deep snow (fraction) +!!\param[in] usemonalb logical, use 2d field (.true.) vs table (.false.)values +!!\param[in,out] snotime1 real, initial number of timesteps since last +!!snowfall +!!\param[in,out] tbot real, bottom soil temp (\f$K\f$) (local yearly-mean sfc air temp) +!!\param[in,out] z0brd real, background fixed roughness length (m) +!!\param[in,out] cmc real, canopy moisture content (\f$m\f$) +!!\param[in,out] t1 real, ground/canopy/snowpack eff skin temp (\f$K\f$) +!!\param[in,out] stc real, soil temp (\f$K\f$) +!!\param[in,out] smc real, total soil moisture (vol fraction) +!!\param[in,out] sh2o real, unfrozen soil moisture (vol fraction), note: frozen part = smc-sh2o +!!\param[in,out] sneqv real, water-equivalent snow depth (\f$m\f$), note: snow density = snwqv/snowh +!!\param[in,out] ch real, sfc exchange coeff for heat & moisture (\f$ms^{-1}\f$), +!! note: conductance since it's been mult by wind +!!\param[in,out] cm real, sfc exchange coeff for momentum +!! (\f$ms^{-1}\f$), note: conductance since it's been mult by wind +!!\param[in,out] z0 real, roughness length (\f$m\f$) +!!\param[in,out] ribb real, documentation needed +!!\param[out] nroot integer, number of root layers +!!\param[out] shdfac real, aeral coverage of green veg (fraction) +!!\param[out] snowh real, snow depth (\f$m\f$) +!!\param[out] albedo real, sfc albedo incl snow effect (fraction) +!!\param[out] eta real, downward latent heat flux (\f$W/m^2\f$) +!!\param[out] eta_kinematic real, actual latent heat flux (\f$Kg/m^{-2}s^{-1}\f$) +!!\param[out] sheat real, downward sensible heat flux (\f$W/m^2\f$) +!!\param[out] ec real, canopy water evaporation (\f$W/m^2\f$) +!!\param[out] edir real, direct soil evaporation (\f$W/m^2\f$) +!!\param[out] et real, plant transpiration (\f$W/m^2\f$) +!!\param[out] ett real, total plant transpiration (\f$W/m^2\f$) +!!\param[out] esnow real, sublimation from snowpack (\f$W/m^2\f$) +!!\param[out] drip real, through-fall of precip and/or dew in +!! excess of canopy water-holding capacity (\f$m\f$) +!!\param[out] dew real, dewfall (or frostfall for t<273.15) (\f$m\f$) +!!\param[out] beta real, ratio of actual/potential evap +!!\param[out] etp real, potential evaporation (\f$W/m^2\f$) +!!\param[out] ssoil real, upward soil heat flux (\f$W/m^2\f$) +!!\param[out] flx1 real, precip-snow sfc flux (\f$W/m^2\f$) +!!\param[out] flx2 real, freezing rain latent heat flux (\f$W/m^2\f$) +!!\param[out] flx3 real, phase-change heat flux from snowmelt (\f$W/m^2\f$) +!!\param[out] flx4 real, energy added to sensible heat(ua_phys) (\f$W/m^2\f$) +!!\param[out] fvb real, frac veg w/snow beneath (ua_phys) (fraction) +!!\param[out] fbur real, frac of canopy buried (ua_phys) (fraction) +!!\param[out] fgsn real, frac of ground snow cover (ua_phys) (fraction) +!!\param[out] runoff1 real, surface runoff (\f$ms^{-1}\f$) not infiltrating sfc +!!\param[out] runoff2 real, sub sfc runoff (\f$ms^{-1}\f$) (baseflow) +!!\param[out] runoff3 real, excess of porosity for a given soil layer +!!\param[out] snomlt real, snow melt (\f$m\f$) (water equivalent) +!!\param[out] sncovr real, fractional snow cover +!!\param[out] rc real, canopy resistance (s/m) +!!\param[out] pc real, plant coeff (fraction) where pc*etp=transpi +!!\param[out] rsmin real, minimum canopy resistance (s/m) +!!\param[out] xlai real, leaf area index (dimensionless) +!!\param[out] rcs real, incoming solar rc factor (dimensionless) +!!\param[out] rct real, air temperature rc factor (dimensionless) +!!\param[out] rcq real, atoms vapor press deficit rc factor +!!\param[out] rcsoil real, soil moisture rc factor (dimensionless) +!!\param[out] soilw real, available soil moisture in root zone +!!\param[out] soilm real, total soil column moisture (frozen+unfrozen) (\f$m\f$) +!!\param[out] q1 real, mixing ratio at surface;used for diag (\f$kgkg^{-1}\f$) +!!\param[out] smav real, soil mois avail for each lyr, frac bet +!! smcwlt and smcmax +!!\param[out] smcwlt real, wilting point (volumetric) +!!\param[out] smcdry real, dry soil moisture threshold (volumetric) +!!\param[out] smcref real, soil moisture threshold (volumetric) +!!\param[out] smcmax real, porosity (sat val of soil mois) +!>\section general_sflx GFS Noah LSM General Algorithm +!! @{ + subroutine gfssflx_hafs &! --- inputs: + & ( nsoil, couple, icein, ffrozp, dt, zlvl, sldpth, & + & swdn, swnet, lwdn, sfcems, sfcprs, sfctmp, & + & sfcspd, prcp, q2, q2sat, dqsdt2, th2, ivegsrc, & + & vegtyp, soiltyp, slopetyp, shdmin, shdmax, alb, snoalb, & + & z0brd, usemonalb, snotime1, ribb, &! --- input/outputs: + & tbot, cmc, t1, stc, smc, sh2o, sneqv, ch, cm,z0, &! --- outputs: + & nroot, shdfac, snowh, albedo, eta, sheat, ec, & + & edir, et, ett, esnow, drip, dew, beta, etp, ssoil, & + & flx1, flx2, flx3, runoff1, runoff2, runoff3, & + & snomlt, sncovr, rc, pc, rsmin, xlai, rcs, rct, rcq, & + & rcsoil, soilw, soilm, q1, smav, smcwlt, smcdry, smcref, & + & smcmax, embrd, eta_kinematic, & + & flx4, fvb, fbur, fgsn ! --- ua_phys + +! ===================================================================== ! +! description: ! +! ! +! subroutine sflx - version 2.7: ! +! sub-driver for "noah/osu lsm" family of physics subroutines for a ! +! soil/veg/snowpack land-surface model to update soil moisture, soil ! +! ice, soil temperature, skin temperature, snowpack water content, ! +! snowdepth, and all terms of the surface energy balance and surface ! +! water balance (excluding input atmospheric forcings of downward ! +! radiation and precip) ! +! ! +! usage: ! +! ! +! call sflx_hafs ! +! --- inputs: ! +! ( nsoil, couple, icein, ffrozp, dt, zlvl, sldpth, ! +! swdn, swnet, lwdn, sfcems, sfcprs, sfctmp, ! +! sfcspd, prcp, q2, q2sat, dqsdt2, th2,ivegsrc, ! +! vegtyp, soiltyp, slopetyp, shdmin, shdmax, alb, snoalb, ! +! z0brd, usemonalb, ! +! --- input/outputs: ! +! tbot, cmc, t1, stc, smc, sh2o, sneqv, ch, cm, ! +! --- outputs: ! +! nroot, shdfac, snowh, albedo, eta, sheat, ec, ! +! edir, et, ett, esnow, drip, dew, beta, etp, ssoil, ! +! flx1, flx2, flx3, runoff1, runoff2, runoff3, ! +! snomlt, sncovr, rc, pc, rsmin, xlai, rcs, rct, rcq, ! +! rcsoil, soilw, soilm, q1, smcwlt, smcdry, smcref, smcmax ) ! +! ! +! ! +! subprograms called: redprm, snow_new, csnow, snfrac, alcalc, ! +! tdfcnd, snowz0, sfcdif, penman, canres, nopac, snopac. ! +! ! +! ! +! program history log: ! +! jun 2003 -- k. mitchell et. al -- created version 2.7 ! +! 200x -- sarah lu modified the code including: ! +! added passing argument, couple; replaced soldn ! +! and solnet by radflx; call sfcdif if couple=0; ! +! apply time filter to stc and tskin; and the ! +! way of namelist inport. ! +! feb 2004 -- m. ek noah v2.7.1 non-linear weighting of snow vs ! +! non-snow covered portions of gridbox ! +! apr 2009 -- y.-t. hou added lw surface emissivity effect, ! +! streamlined and reformatted the code, and ! +! consolidated constents/parameters by using ! +! module physcons, and added program documentation! +! sep 2009 -- s. moorthi minor fixes ! +! nov 2018 -- j. han add canopy heat storage parameterization ! +! jan 2020 -- m. biswas noah lsm in wrf ccpp complaint ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! nsoil - integer, number of soil layers (>=2 but <=nsold) 1 ! +! couple - integer, =0:uncoupled (land model only) 1 ! +! =1:coupled with parent atmos model ! +! icein - integer, sea-ice flag (=1: sea-ice, =0: land) 1 ! +! ffrozp - real, fractional snow/rain 1 ! +! dt - real, time step (<3600 sec) 1 ! +! zlvl - real, height abv atmos ground forcing vars (m) 1 ! +! sldpth - real, thickness of each soil layer (m) nsoil ! +! swdn - real, downward sw radiation flux (w/m**2) 1 ! +! swnet - real, downward sw net (dn-up) flux (w/m**2) 1 ! +! lwdn - real, downward lw radiation flux (w/m**2) 1 ! +! sfcems - real, sfc lw emissivity (fractional) 1 ! +! embrd - real, background sfc lw emissivity (fractional) 1 ! +! sfcprs - real, pressure at height zlvl abv ground(pascals) 1 ! +! sfctmp - real, air temp at height zlvl abv ground (k) 1 ! +! sfcspd - real, wind speed at height zlvl abv ground (m/s) 1 ! +! prcp - real, precip rate (kg m-2 s-1) 1 ! +! q2 - real, mixing ratio at hght zlvl abv grnd (kg/kg) 1 ! +! q2sat - real, sat mixing ratio at zlvl abv grnd (kg/kg) 1 ! +! dqsdt2 - real, slope of sat specific humidity curve at 1 ! +! t=sfctmp (kg kg-1 k-1) ! +! th2 - real, air potential temp at zlvl abv grnd (k) 1 ! +! ivegsrc - integer, sfc veg type data source umd or igbp ! +! vegtyp - integer, vegetation type (integer index) 1 ! +! soiltyp - integer, soil type (integer index) 1 ! +! slopetyp - integer, class of sfc slope (integer index) 1 ! +! shdmin - real, min areal coverage of green veg (fraction) 1 ! +! shdmax - real, max areal coverage of green veg (fraction) 1 ! +! alb - real, bkground snow-free sfc albedo (fraction) 1 ! +! snoalb - real, max albedo over deep snow (fraction) 1 ! +! ! +! input/outputs: ! +! tbot - real, bottom soil temp (k) 1 ! +! (local yearly-mean sfc air temp) ! +! z0brd - real, background fixed roughness length (m) 1 ! +! cmc - real, canopy moisture content (m) 1 ! +! t1 - real, ground/canopy/snowpack eff skin temp (k) 1 ! +! stc - real, soil temp (k) nsoil ! +! smc - real, total soil moisture (vol fraction) nsoil ! +! sh2o - real, unfrozen soil moisture (vol fraction) nsoil ! +! note: frozen part = smc-sh2o ! +! sneqv - real, water-equivalent snow depth (m) 1 ! +! note: snow density = snwqv/snowh ! +! ch - real, sfc exchange coeff for heat & moisture (m/s)1 ! +! note: conductance since it's been mult by wind ! +! cm - real, sfc exchange coeff for momentum (m/s) 1 ! +! note: conductance since it's been mult by wind ! +! ! +! outputs: ! +! nroot - integer, number of root layers 1 ! +! shdfac - real, aeral coverage of green veg (fraction) 1 ! +! snowh - real, snow depth (m) 1 ! +! albedo - real, sfc albedo incl snow effect (fraction) 1 ! +! eta - real, downward latent heat flux (w/m2) 1 ! +! eta_kinematic - real, actual latent heat flux (w/m2) 1 ! +! sheat - real, downward sensible heat flux (w/m2) 1 ! +! ec - real, canopy water evaporation (w/m2) 1 ! +! edir - real, direct soil evaporation (w/m2) 1 ! +! et - real, plant transpiration (w/m2) nsoil ! +! ett - real, total plant transpiration (w/m2) 1 ! +! esnow - real, sublimation from snowpack (w/m2) 1 ! +! drip - real, through-fall of precip and/or dew in excess 1 ! +! of canopy water-holding capacity (m) ! +! dew - real, dewfall (or frostfall for t<273.15) (m) 1 ! +! beta - real, ratio of actual/potential evap 1 ! +! etp - real, potential evaporation (w/m2) 1 ! +! ssoil - real, upward soil heat flux (w/m2) 1 ! +! flx1 - real, precip-snow sfc flux (w/m2) 1 ! +! flx2 - real, freezing rain latent heat flux (w/m2) 1 ! +! flx3 - real, phase-change heat flux from snowmelt (w/m2) 1 ! +! flx4 - real, energy added to sensible heat(ua_phys)w/m2) 1 ! +! snomlt - real, snow melt (m) (water equivalent) 1 ! +! sncovr - real, fractional snow cover 1 ! +! runoff1 - real, surface runoff (m/s) not infiltrating sfc 1 ! +! runoff2 - real, sub sfc runoff (m/s) (baseflow) 1 ! +! runoff3 - real, excess of porosity for a given soil layer 1 ! +! rc - real, canopy resistance (s/m) 1 ! +! pc - real, plant coeff (fraction) where pc*etp=transpi 1 ! +! rsmin - real, minimum canopy resistance (s/m) 1 ! +! xlai - real, leaf area index (dimensionless) 1 ! +! rcs - real, incoming solar rc factor (dimensionless) 1 ! +! rct - real, air temp rc factor (dimensionless) 1 ! +! rcq - real, atoms vapor press deficit rc factor 1 ! +! rcsoil - real, soil moisture rc factor (dimensionless) 1 ! +! soilw - real, available soil mois in root zone 1 ! +! soilm - real, total soil column mois (frozen+unfrozen) (m)1 ! +! q1 - real, mixing ratio at surface (kg kg-1) 1 ! +! smav - real, soil mois avail for each layer 1 ! +! smcwlt - real, wilting point (volumetric) 1 ! +! smcdry - real, dry soil mois threshold (volumetric) 1 ! +! smcref - real, soil mois threshold (volumetric) 1 ! +! smcmax - real, porosity (sat val of soil mois) 1 ! +! ! +! ==================== end of description ===================== ! +! + use machine , only : kind_phys +! + use physcons, only : con_cp, con_rd, con_t0c, con_g, con_pi, & + & con_cliq, con_csol, con_hvap, con_hfus, & + & con_sbc +! + implicit none + +! --- constant parameters: +! *** note: some of the constants are different in subprograms and need to +! be consolidated with the standard def in module physcons at sometime +! at the present time, those diverse values are kept temperately to +! provide the same result as the original codes. -- y.t.h. may09 + +!MKB These came through WRF Registry, need to think how to get them in +!CCPP + integer, parameter :: opt_thcnd = 1 !< thermal conductivity + + integer, parameter :: nsold = 4 !< max soil layers + + integer :: defined_soil + integer :: defined_veg + integer :: defined_slope + +! real (kind=kind_phys), parameter :: gs = con_g !< con_g =9.80665 + real (kind=kind_phys), parameter :: gs1 = 9.8 !< con_g in sfcdif + real (kind=kind_phys), parameter :: gs = 9.81 !< con_g in snowpack, frh2o + real (kind=kind_phys), parameter :: tfreez = con_t0c !< con_t0c =273.16 + real (kind=kind_phys), parameter :: lsubc = 2.501e+6 !< con_hvap=2.5000e+6 + real (kind=kind_phys), parameter :: lsubf = 3.335e5 !< con_hfus=3.3358e+5 + real (kind=kind_phys), parameter :: lsubs = 2.83e+6 ! ? in sflx, snopac + real (kind=kind_phys), parameter :: elcp = 2.4888e+3 ! ? in penman +! real (kind=kind_phys), parameter :: rd = con_rd ! con_rd =287.05 + real (kind=kind_phys), parameter :: rd = 287.04 ! con_rd in sflx, penman, canres + real (kind=kind_phys), parameter :: cp = con_cp ! con_cp =1004.6 + real (kind=kind_phys), parameter :: cp = 1004.5 ! con_cp in sflx, canres + real (kind=kind_phys), parameter :: cp2 = 1004.0 ! con_cp in htr +! real (kind=kind_phys), parameter :: cph2o = con_cliq ! con_cliq=4.1855e+3 + real (kind=kind_phys), parameter :: cph2o = 4.218e+3 ! con_cliq in penman, snopac + real (kind=kind_phys), parameter :: cph2o2 = 4.2e6 ! con_cliq in hrt *unit diff! + real (kind=kind_phys), parameter :: cpice = con_csol ! con_csol=2.106e+3 + real (kind=kind_phys), parameter :: cpice1 = 2.106e6 ! con_csol in hrt *unit diff! +! real (kind=kind_phys), parameter :: sigma = con_sbc ! con_sbc=5.6704e-8 + real (kind=kind_phys), parameter :: sigma = 5.67e-8 ! con_sbc in penman, nopac, snopac + +! --- inputs: + integer, intent(in) :: nsoil, couple, icein, vegtyp, soiltyp, & + & slopetyp, ivegsrc + + real (kind=kind_phys), intent(in) :: ffrozp, dt, zlvl, lwdn, & + & sldpth(nsoil), swdn, swnet, sfcems, sfcprs, sfctmp, & + & sfcspd, prcp, q2, q2sat, dqsdt2, th2, shdmin, shdmax, alb, & + & snoalb, & + + logical, intent(in) :: usemonalb !true for HWRF + logical, intent(in) :: rdlai2d + +! --- input/outputs: + real (kind=kind_phys), intent(inout) :: tbot, cmc, t1, sneqv, & + & stc(nsoil), smc(nsoil), sh2o(nsoil), ch, cm, z0brd, & + & snotime1, ribb + + real (kind=kind_phys), intent(inout) :: fhead1rt,infxs1rt, etpnd1 + +! --- outputs: + integer, intent(out) :: nroot + + real (kind=kind_phys), intent(out) :: shdfac, snowh, albedo, & + & eta, sheat, ec, edir, et(nsoil), ett, esnow, drip, dew, & + & beta, etp, ssoil, flx1, flx2, flx3, snomlt, sncovr, & + & runoff1, runoff2, runoff3, rc, pc, rsmin, xlai, rcs, & + & rct, rcq, rcsoil, soilw, soilm, q1, smav, smcwlt, smcdry, & + & smcref, smcmax, embrd & + & eta_kinematic + +! --- locals: +! real (kind=kind_phys) :: df1h, + real (kind=kind_phys) :: bexp, cfactr, cmcmax, csoil, czil, & + & df1, df1a, dksat, dwsat, dsoil, dtot, frcsno, & + & frcsoi, epsca, fdown, f1, fxexp, frzx, hs, kdt, prcp1, & + & psisat, quartz, rch, refkdt, rr, rgl, rsmax, sndens, & + & sncond, sbeta, sn_new, slope, snup, salp, soilwm, soilww, & + & t1v, t24, t2v, th2v, topt, tsnow, zbot, z0 + + real (kind=kind_phys) :: shdfac0 + real (kind=kind_phys) :: interp_fraction, laimin, laimax, & + & albedomin, albedomax, emissmin, emissmax + real (kind=kind_phys), dimension(nsold) :: rtdis, zsoil + + logical :: frzgra, snowng + + integer :: ice, k, kz +! +! --- parameters for heat storage parametrization +! + real (kind=kind_phys) :: cpx, cpx1, cpfac, xx1, xx2 + real (kind=kind_phys), parameter :: z0min=0.2_kind_phys, & + & z0max=1.0_kind_phys + + logical, intent(in) :: ua_phys ! ua: flag for ua option + real (kind=kind_phys),intent(out) :: flx4 ! ua: energy added to sensible heat + real (kind=kind_phys),intent(out) :: fvb ! ua: frac. veg. w/snow beneath + real (kind=kind_phys),intent(out) :: fbur ! ua: fraction of canopy buried + real (kind=kind_phys),intent(out) :: fgsn ! ua: ground snow cover fraction + real :: ztopv ! ua: height of canopy top + real :: zbotv ! ua: height of canopy bottom + real :: gama ! ua: = exp(-1.* xlai) + real :: fnet ! ua: + real :: etpn ! ua: + real :: ru ! ua: + + ua_phys = .false. + rdlai2d = .false. +! +!===> ... begin here +! +! --- ... initialization + + runoff1 = 0.0 + runoff2 = 0.0 + runoff3 = 0.0 + snomlt = 0.0 + + if ( .not. ua_phys ) then + flx4 = 0.0 + fvb = 0.0 + fbur = 0.0 + fgsn = 0.0 + endif + + +! --- ... define local variable ice to achieve: +! sea-ice case, ice = 1 +! non-glacial land, ice = 0 +! glacial-ice land, ice = -1 +! if vegtype=15 (glacial-ice), re-set ice flag = -1 (glacial-ice) +! note - for open-sea, sflx should *not* have been called. set green +! vegetation fraction (shdfac) = 0. + +!> - Calculate depth (negative) below ground from top skin sfc to +!! bottom of each soil layer. +! note - sign of zsoil is negative (denoting below ground) + + zsoil(1) = -sldpth(1) + do kz = 2, nsoil + zsoil(kz) = -sldpth(kz) + zsoil(kz-1) + end do + +! --- ... next is crucial call to set the land-surface parameters, +! including soil-type and veg-type dependent parameters. +! set shdfac=0.0 for bare soil surfaces + +!> - Call redprm() to set the land-surface paramters, +!! including soil-type and veg-type dependent parameters. + call redprm +!................................... +! --- inputs: + & ( nsoil, vegtyp, soiltyp, slopetyp, sldpth, zsoil, & +! --- outputs + & cfactr, cmcmax, rsmin, rsmax, topt, refkdt, kdt, & + & sbeta, shdfac, rgl, hs, zbot, frzx, psisat, slope, & + & snup, salp, bexp, dksat, dwsat, smcmax, smcwlt, & + & smcref, smcdry, f1, quartz, fxexp, rtdis, nroot, & + & czil, xlai, csoil, lvcoef, laimin, laimax, & + & emissmin, emissmax, albedomin, albedomax, z0min, z0max, & + & ztopv, zbotv + & ) + +! if(ivegsrc == 1) then +!only igbp type has urban +!urban +!MKB vegtyp=isurban in HWRF, need to check whether 13/31 and isurban are +!same + if(vegtyp == 13)then + shdfac=0.05 + rsmin=400.0 + smcmax = 0.45 + smcref = 0.42 + smcwlt = 0.40 + smcdry = 0.40 + endif + + if(shdfac >= shdmax )then + embrd = emissmax + if (.not. rdlai2d)then + xlai = laimax + endif + if (.not. usemonalb)then + alb = albedomin + endif + z0brd = z0max + else if ( shdfac <= shdmin )then + embrd = emissmin + if(.not. rdlai2d)then + xlai = laimin + endif + if(.not. usemonalb)then + alb = albedomax + endif + z0brd = z0min + else + + if ( shdmax > shdmin ) then + + interp_fraction = ( shdfac - shdmin ) / (shdmax - shdmin) + ! Bound interp_fraction between 0 and 1 + interp_fraction = min ( interp_fraction, 1.0 ) + interp_fraction = max ( interp_fraction, 0.0 ) + ! Scale Emissivity and LAI between emissmin and emissmax + ! by interp_fraction + embrd = ( ( 1.0 - interp_fraction ) * emissmin ) + & + & ( interp_fraction * emissmax ) + if (.not. rdlai2d)then + xlai = ( ( 1.0 - interp_fraction ) * laimin ) + & + & ( interp_fraction * laimax ) + endif + if (.not. usemonalb)then + alb = ( ( 1.0 - interp_fraction ) * albedomax ) + & + & ( interp_fraction * albedomin ) + endif + z0brd = ( ( 1.0 - interp_fraction ) * z0min ) + & + & ( interp_fraction * z0max ) + + else + + embrd = 0.5 * emissmin + 0.5 * emissmax + if (.not. rdlai2d)then + xlai = 0.5 * laimin + 0.5 * laimax + endif + if (.not. usemonalb)then + alb = 0.5 * albedomin + 0.5 * albedomax + endif + z0brd = 0.5 * z0min + 0.5 * z0max + + endif + + endif + + + +!> - Initialize precipitation logicals. + + snowng = .false. + frzgra = .false. + +!> ---------------------------------------------------------------------- +! if input snowpack is nonzero, then compute snow density "sndens" and +! snow thermal conductivity "sncond" (note that csnow is a function +! subroutine) +! ---------------------------------------------------------------------- + + if (sneqv <= 1.e-7 ) then + sneqv = 0.0 + snowh = 0.0 + snowh = 1.0 + sncond = 1.0 + else + sndens = sneqv / snowh + if(sndens > 1.0) then +!MKB What is equiv of fatal_error in FV3? + fatal_error( 'physical snow depth is less than snow water & + & equiv.' ) +! stop 333 + endif + + call csnow +! --- inputs: + & ( sndens, & +! --- outputs: + & sncond & + & ) + + endif + + +!> - Determine if it's precipitating and what kind of precipitation it is. +!! if it's precipitating and the air temperature is colder than \f$0^oC\f$, +!! it's snowing! if it's precipitating and the air temperature is warmer than +!! \f$0^oC\f$, but the ground temperature is colder than \f$0^oC\f$, freezing +!! rain is presumed to be falling. + + if (prcp > 0.0) then + +!> snow defined when fraction of frozen precip (ffrozp) > 0.5, +! passed in from model microphysics. + + if (ffrozp > 0.5) then + snowng = .true. + else + if (t1 <= tfreez) frzgra = .true. + endif + endif + +!> - If either precipitation flag (\a snowng, \a frzgra) is set as true: +! determine new snowfall (converting precipitation rate from +! \f$kg m^{-2} s^{-1}\f$ to a liquid equiv snow depth in meters) +! and add it to the existing snowpack. +!> - Since all precip is added to snowpack, no precip infiltrates +!! into the soil so that \a prcp1 is set to zero. + + if (snowng .or. frzgra) then + sn_new = prcp * dt * 0.001 + sneqv = sneqv + sn_new + prcp1 = 0.0 + endif + +!> - Call snow_new() to update snow density based on new snowfall, +!! using old and new snow. + call snow_new +!................................... +! --- inputs: + & ( sfctmp, sn_new, & +! --- input/outputs: + & snowh, sndens & + & ) + +!> - Call csnow() to update snow thermal conductivity. + call csnow +!................................... +! --- inputs: + & ( sndens, & +! --- outputs: + & sncond & + & ) + + else + +!> - If precipitation is liquid (rain), hence save in the precip variable +!! that later can wholely or partially infiltrate the soil (along +!! with any canopy "drip" added to this later). + + prcp1 = prcp + + endif ! end if_snowng_block + +! --- ... non-glacial land +! if snow depth=0, set snowcover fraction=0, albedo=snow free albedo. + + if (sneqv == 0.0) then + + sncovr = 0.0 + albedo = alb + sfcems = embrd + if(ua_phys) fgsn = 0.0 + if(ua_phys) fvb = 0.0 + if(ua_phys) fbur = 0.0 + else + +! --- ... determine snow fraction cover. +! determine surface albedo modification due to snowdepth state. +!> - Call snfrac() to calculate snow fraction cover. + + call snfrac & +!................................... +! --- inputs: + & ( sneqv, snup, salp, snowh, & + & ztopv, zbotv, shdfac, xlai, shdfac, ua_phys & +! --- outputs: + & sncovr, fvb, gama, fbur, fgsn & + & ) + + if ( ua_phys ) then + if(sfctmp <= t1) then + ru = 0.0 + else + ru = 100.0*shdfac*fgsn*min((sfctmp-t1)/5.0, 1.0) & + & *(1.-exp(-xlai)) + endif + ch = ch/(1.0+ru*ch) + endif + + sncovr = min(sncovr,0.98) + + +!> - Call alcalc() to calculate surface albedo modification due to snowdepth +!! state. + call alcalc & +!................................... +! --- inputs: + & ( alb, snoalb, shdfac, shdmin, sncovr, tsnow,embrd,dt,lvcoef & +! --- outputs: + & albedo, sfcems, snotime1 & + & ) + + endif ! end if_sneqv_block + +!> - For non-glacial land case, call tdfcnd() to calculate the thermal +!! diffusivity of top soil layer (\cite peters-lidard_et_al_1998). + +! --- ... next calculate the subsurface heat flux, which first requires +! calculation of the thermal diffusivity. treatment of the +! latter follows that on pages 148-149 from "heat transfer in +! cold climates", by v. j. lunardini (published in 1981 +! by van nostrand reinhold co.) i.e. treatment of two contiguous +! "plane parallel" mediums (namely here the first soil layer +! and the snowpack layer, if any). this diffusivity treatment +! behaves well for both zero and nonzero snowpack, including the +! limit of very thin snowpack. this treatment also eliminates +! the need to impose an arbitrary upper bound on subsurface +! heat flux when the snowpack becomes extremely thin. + +! --- ... first calculate thermal diffusivity of top soil layer, using +! both the frozen and liquid soil moisture, following the +! soil thermal diffusivity function of peters-lidard et al. +! (1998,jas, vol 55, 1209-1224), which requires the specifying +! the quartz content of the given soil class (see routine redprm) + + call tdfcnd & +! --- inputs: + & ( smc(1), qz, smcmax, sh2o(1), bexp, psisat, soiltyp, & + & opt_thcnd, & +! --- outputs: + & df1 & + & ) + +!urban + if ( vegtyp == 13 ) df1=3.24 + +!> - Add subsurface heat flux reduction effect from the +!! overlying green canopy, adapted from section 2.1.2 of +!! \cite peters-lidard_et_al_1997. +!wz only urban for igbp type + df1 = df1 * exp( sbeta*shdfac ) + + if ( sncovr .gt. 0.97 ) then + df1 = sncond + endif + +!> --- ... finally "plane parallel" snowpack effect following +! v.j. linardini reference cited above. note that dtot is +! combined depth of snowdepth and thickness of first soil layer + + dsoil = -0.5 * zsoil(1) + + if (sneqv == 0.0) then + + ssoil = df1 * (t1 - stc(1)) / dsoil + + else + + dtot = snowh + dsoil + frcsno = snowh / dtot + frcsoi = dsoil / dtot + +! --- ... 1. harmonic mean (series flow) + +! df1 = (sncond*df1) / (frcsoi*sncond + frcsno*df1) + df1h = (sncond*df1) / (frcsoi*sncond + frcsno*df1) + +! --- ... 2. arithmetic mean (parallel flow) + +! df1 = frcsno*sncond + frcsoi*df1 + df1a = frcsno*sncond + frcsoi*df1 + +! --- ... 3. geometric mean (intermediate between harmonic and arithmetic mean) + +! df1 = (sncond**frcsno) * (df1**frcsoi) +! df1 = df1h*sncovr + df1a*(1.0-sncovr) +! df1 = df1h*sncovr + df1 *(1.0-sncovr) + df1 = df1a*sncovr + df1 *(1.0-sncovr) + +!> - Calculate subsurface heat flux, \a ssoil, from final thermal +!! diffusivity of surface mediums,\a df1 above, and skin +!! temperature and top mid-layer soil temperature. + + ssoil = df1 * (t1 - stc(1)) / dtot + + endif ! end if_sneqv_block + +!> - For uncoupled mode, call snowz0() to calculate surface roughness +!! (\a z0) over snowpack using snow condition from the previous timestep. + +! if (couple == 0) then ! uncoupled mode + if (sncovr > 0.0) then + + call snowz0 & +!................................... +! --- inputs: + & ( sncovr,z0brd,snowh,fbur,fgsn,shdmax,ua_phys, & +! --- input/outputs: + & z0 & + & ) + + else + + z0=z0brd + + if(ua_phys) + + call snowz0 & +!................................... +! --- inputs: + & ( sncovr,z0brd,snowh,fbur,fgsn,shdmax,ua_phys, & +! --- input/outputs: + & z0 & + & ) + + endif + +!> - Calculate virtual temps and virtual potential temps needed by +!! subroutines sfcdif and penman. + + t2v = sfctmp * (1.0 + 0.61*q2) + +! --- ... next call routine sfcdif to calculate the sfc exchange coef (ch) +! for heat and moisture. +! note - comment out call sfcdif, if sfcdif already called in calling +! program (such as in coupled atmospheric model). +! - do not call sfcdif until after above call to redprm, in case +! alternative values of roughness length (z0) and zilintinkevich +! coef (czil) are set there via namelist i/o. +! - routine sfcdif returns a ch that represents the wind spd times +! the "original" nondimensional "ch" typical in literature. hence +! the ch returned from sfcdif has units of m/s. the important +! companion coefficient of ch, carried here as "rch", is the ch +! from sfcdif times air density and parameter "cp". "rch" is +! computed in "call penman". rch rather than ch is the coeff +! usually invoked later in eqns. +! - sfcdif also returns the surface exchange coefficient for momentum, +! cm, also known as the surface drage coefficient, but cm is not +! used here. + +! --- ... key required radiation term is the total downward radiation +! (fdown) = net solar (swnet) + downward longwave (lwdn), +! for use in penman ep calculation (penman) and other surface +! energy budget calcuations. also need downward solar (swdn) +! for canopy resistance routine (canres). +! note - fdown, swdn are derived differently in the uncoupled and +! coupled modes. + +!> - Calculate the total downward radiation (\a fdown) = net solar (\a swnet) + +!! downward longwave (\a lwdn) as input of penman() and other surface +!! energy budget calculations. + +! swnet = net solar radiation into the ground (w/m2; dn-up) from input +! fdown = net solar + downward lw flux at sfc (w/m2) + + fdown = swnet + lwdn + + +! calc virtual temps and virtual potential temps needed by subroutines +! penman. + t2v = sfctmp * (1.0+ 0.61 * q2 ) + +! iout=0 +! if(iout.eq.1) then +! print*,'before penman' +! print*,' sfctmp',sfctmp,'sfcprs',sfcprs,'ch',ch,'t2v',t2v, & +! 'th2',th2,'prcp',prcp,'fdown',fdown,'t24',t24,'ssoil',ssoil, & +! 'q2',q2,'q2sat',q2sat,'etp',etp,'rch',rch, & +! 'epsca',epsca,'rr',rr ,'snowng',snowng,'frzgra',frzgra, & +! 'dqsdt2',dqsdt2,'flx2',flx2,'snowh',snowh,'sneqv',sneqv, & +! 'dsoil',dsoil,' frcsno',frcsno,' sncovr',sncovr,' dtot',dtot,& +! 'zsoil (1)',zsoil(1),' df1',df1,'t1',t1,' stc1',stc(1), & +! 'albedo',albedo,'smc',smc,'stc',stc,'sh2o',sh2o +! endif + +!> - Call penman() to calculate potential evaporation (\a etp), +!! and other partial products and sums for later +!! calculations. + + call penman +!................................... +! --- inputs: + & ( sfctmp, sfcprs, sfcems, ch, t2v, th2, prcp, fdown, & + & cpx, cpfac, ssoil, q2, q2sat, dqsdt2, snowng, frzgra, & + & sncovr, aoasis, sneqv, albedo, soldn, stc1, & +! --- outputs: + & t24, etp, rch, epsca, rr, flx2, etpn, flx4 & + & ) + +!> - Call canres() to calculate the canopy resistance and convert it +!! into pc if nonzero greenness fraction. + + if ((shdfac > 0.0) .and. (xlai > 0.0)) then + +! --- ... frozen ground extension: total soil water "smc" was replaced +! by unfrozen soil water "sh2o" in call to canres below + +!MKB format + call canres (swdn,ch,sfctmp,q2,sfcprs,smc,zsoil,nsoil, & + smcwlt,smcref,rsmin,rc,pc,nroot,q2sat,dqsdt2, & + topt,rsmax,rgl,hs,xlai, & + rcs,rct,rcq,rcsoil,sfcems) +! --- inputs: ! +! ( nsoil, nroot, swdn, ch, q2, q2sat, dqsdt2, sfctmp, ! +! cpx1, sfcprs, sfcems, sh2o, smcwlt, smcref, zsoil, rsmin, ! +! rsmax, topt, rgl, hs, xlai, ! +! --- outputs: ! +! rc, pc, rcs, rct, rcq, rcsoil ) ! + + else + rc = 0.0 + endif + +!> - Now decide major pathway branch to take depending on whether +!! snowpack exists or not: + + esnow = 0.0 + + if (sneqv .eq. 0.0) then +!> - For no snowpack is present, call nopac() to calculate soil moisture +!! and heat flux values and update soil moisture contant and soil heat +!! content values. + call nopac +!................................... +! --- inputs: + & ( nsoil, nroot, etp, prcp, smcmax, smcwlt, smcref, & + & smcdry, cmcmax, dt, shdfac, sbeta, sfctmp, sfcems, & + & t24, th2, fdown, epsca, bexp, pc, rch, rr, cfactr, & + & slope, kdt, frzx, psisat, zsoil, dksat, dwsat, & + & zbot, rtdis, quartz, fxexp, csoil, & + & opt_thcnd, & +! --- input for fasdas (FDDA) (Not used for HAFS): + & qfx_phy, hcpct_fasdas, xsda_qfx, xqnorm, fasdas, & +! --- input/outputs: + & cmc, t1, stc, sh2o, tbot, & + & sfhead1rt, infxs1rt, rtpnd1, & +! --- outputs: + & eta, smc, ssoil, runoff1, runoff2, runoff3, edir, & + & ec, et, ett, beta, drip, dew, flx1, flx3, & + & hcpct_fasdas & + & ) + + eta_kinematic = eta + + else + +!> - For a snowpack is present, call snopac(). + call snopac +!................................... +! --- inputs: + & ( nsoil, nroot, etp, prcp, smcmax, smcwlt, smcref, smcdry, & + & cmcmax, dt, df1, sfcems, sfctmp, t24, th2, fdown, epsca, & + & bexp, pc, rch, rr, cfactr, slope, kdt, frzx, psisat, & + & zsoil, dwsat, dksat, zbot, shdfac, rtdis, quartz, & + & fxexp, csoil, flx2, snowng, & + & opt_thcnd, & +! --- input for fasdas (FDDA) (Not used for HAFS): + & qfx_phy, hcpct_fasdas, qfx_phy, fasdas, & +! --- input/inout for ua_phys: + & ua_phys, etpn, etpnd1, etp1n, flx4, & +! --- input/outputs: + & prcp1, cmc, t1, stc, sncovr, sneqv, sndens, snowh, & + & sh2o, tbot, beta, ribb, & + & sfhead1rt, infxs1rt, rtpnd1, & +! --- outputs: + & smc, ssoil, runoff1, runoff2, runoff3, edir, ec, et, & + & ett, snomlt, drip, dew, flx1, flx3, esnow, etns & + & hcpct_fasdas & + & ) + + eta_kinematic = esnow + etns - 1000.0*dew + + endif + + q1=q2+eta_kinematic*cp/rch +!> - Noah LSM post-processing: +!> - Calculate sensible heat (h) for return to parent model. + + sheat = -(ch*cp*sfcprs) / (rd*t2v) * (th2 - t1) + + if(ua_phys) sheat = sheat + flx4 +! +! fasdas +! + if ( fasdas == 1 ) then + hfx_phy = sheat + endif +! +! end fasdas +! + + +!> - Convert units and/or sign of total evap (eta), potential evap (etp), +!! subsurface heat flux (s), and runoffs for what parent model expects. +! convert eta from kg m-2 s-1 to w m-2 +! lsubc was lvh2o in WRF: latent heat of water evap (J/kg) +! eta = eta * lsubc +! etp = etp * lsubc + + edir = edir * lsubc + ec = ec * lsubc + + do k = 1, 4 + et(k) = et(k) * lsubc + enddo + + etpnd1=etpnd1 * lsubc + + ett = ett * lsubc + esnow = esnow * lsubs + etp = etp * ((1.0 - sncovr)*lsubc + sncovr*lsubs) + + if(ua_phys) etpn = etpn*((1.-sncovr)*lsubc + sncovr*lsubs) + + if (etp > 0.) then + eta = edir + ec + ett + esnow + else + eta = etp + endif + + beta = eta / etp + + endif +! ---------------------------------------------------------------------- +! determine beta (ratio of actual to potential evap) +! ---------------------------------------------------------------------- + if (etp == 0.0) then + beta = 0.0 + else + beta = eta/etp + endif + +!> - Convert the sign of soil heat flux so that: +!! - ssoil>0: warm the surface (night time) +!! - ssoil<0: cool the surface (day time) + + ssoil = -1.0 * ssoil + +!> - For the case of land (but not glacial-ice): +!! convert runoff3 (internal layer runoff from supersat) from \f$m\f$ +!! to \f$ms^-1\f$ and add to subsurface runoff/baseflow (runoff2). +!! runoff2 is already a rate at this point. + + runoff3 = runoff3 / dt + runoff2 = runoff2 + runoff3 + +!> - Calculate total column soil moisture in meters (soilm) and root-zone +!! soil moisture availability (fraction) relative to porosity/saturation. + + soilm = -1.0 * smc(1) * zsoil(1) + do k = 2, nsoil + soilm = soilm + smc(k)*(zsoil(k-1) - zsoil(k)) + enddo + + soilwm = -1.0 * (smcmax - smcwlt) * zsoil(1) + soilww = -1.0 * (smc(1) - smcwlt) * zsoil(1) + + + do k = 1,nsoil + smav(k)=(smc(k) - smcwlt)/(smcmax - smcwlt) + end do + + if (nroot >= 2) then + do k = 2,nroot + soilwm = soilwm + (smcmax - smcwlt)*(zsoil(k-1)-zsoil (k)) + soilww = soilww + (smc(k) - smcwlt)*(zsoil(k-1)-zsoil (k)) + end do + end if + if (soilwm .lt. 1.e-6) then + soilwm = 0.0 + soilw = 0.0 + soilm = 0.0 + else + soilw = soilww / soilwm + end if + +! + return + + +! ================= + contains +! ================= + +!*************************************! +! section-1 1st level subprograms ! +!*************************************! + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates albedo including snow effect (0 -> 1). + subroutine alcalc & +!................................... +! --- inputs: + & ( alb, snoalb, shdfac, shdmin, sncovr, tsnow,embrd,dt,lvcoef & +! --- outputs: + & albedo, sfcems, snotime1 & + & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine alcalc calculates albedo including snow effect (0 -> 1) ! +! ! +! subprogram called: none ! +! ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs from calling program: size ! +! alb - real, snowfree albedo 1 ! +! snoalb - real, maximum (deep) snow albedo 1 ! +! shdfac - real, areal fractional coverage of green veg. 1 ! +! shdmin - real, minimum areal coverage of green veg. 1 ! +! sncovr - real, fractional snow cover 1 ! +! tsnow - real, snow surface temperature (k) 1 ! +! ! +! outputs to calling program: ! +! albedo - real, surface albedo including snow effect 1 ! +! sfcems - real, sfc LW emissivity (fractional) 1 ! +! ! +! ==================== end of description ===================== ! +! + implicit none +! --- inputs: + real (kind=kind_phys), intent(in) :: alb, snoalb, embrd, shdfac, & + & shdmin, sncovr, tsnow, dt, lvcoef + + logical (kind=kind_phys), intent(in) :: snowng + + real (kind=kind_phys), intent(inout) :: snotime1 + + +! --- outputs: + real (kind=kind_phys), intent(out) :: albedo, sfcems + +! --- locals: + real (kind=kind_phys) :: snoalb1, snoalb2, tm + + real (kind=kind_phys), parameter :: snacca=0.94,snaccb=0.58, & + & snthwa=0.82,snthwb=0.46, & + & emissi_s=0.95 + +! +!===> ... begin here +! +!> --- ... snoalb is argument representing maximum albedo over deep snow, +! as passed into sflx, and adapted from the satellite-based +! maximum snow albedo fields provided by d. robinson and g. kukla +! (1985, jcam, vol 24, 402-411) + +! albedo = alb + (1.0-(shdfac-shdmin))*sncovr*(snoalb-alb) + albedo = alb + sncovr * (snoalb - alb) + sfcems = embrd + sncovr * (emissi_s - embrd) + + +! --- base formulation (dickinson et al., 1986, cogley et al., 1990) +! if (tsnow.le.263.16) then +! albedo=snoalb +! else +! if (tsnow.lt.273.16) then +! tm=0.1*(tsnow-263.16) +! snoalb1=0.5*((0.9-0.2*(tm**3))+(0.8-0.16*(tm**3))) +! else +! snoalb1=0.67 +! if(sncovr.gt.0.95) snoalb1= 0.6 +! snoalb1 = alb + sncovr*(snoalb-alb) +! endif +! endif +! albedo = alb + sncovr*(snoalb1-alb) + +! isba formulation (verseghy, 1991; baker et al., 1990) +! snoalb1 = snoalb+coef*(0.85-snoalb) +! snoalb2=snoalb1 +!!m lstsnw=lstsnw+1 +! snotime1 = snotime1 + dt +! if (snowng) then +! snoalb2=snoalb +!!m lstsnw=0 +! snotime1 = 0.0 +! else +! if (tsnow.lt.273.16) then +!! snoalb2=snoalb-0.008*lstsnw*dt/86400 +!!m snoalb2=snoalb-0.008*snotime1/86400 +! snoalb2=(snoalb2-0.65)*exp(-0.05*dt/3600)+0.65 +!! snoalb2=(albedo-0.65)*exp(-0.01*dt/3600)+0.65 +! else +! snoalb2=(snoalb2-0.5)*exp(-0.0005*dt/3600)+0.5 +!! snoalb2=(snoalb-0.5)*exp(-0.24*lstsnw*dt/86400)+0.5 +!!m snoalb2=(snoalb-0.5)*exp(-0.24*snotime1/86400)+0.5 +! endif +! endif +! +!! print*,'snoalb2',snoalb2,'albedo',albedo,'dt',dt +! albedo = alb + sncovr*(snoalb2-alb) +! if (albedo .gt. snoalb2) albedo=snoalb2 +!!m lstsnw1=lstsnw +!! snotime = snotime1 + +!> formulation by livneh +! ---------------------------------------------------------------------- +! snoalb is considered as the maximum snow albedo for new snow, at +! a value of 85%. snow albedo curve defaults are from bras p.263. should +! not be changed except for serious problems with snow melt. +! to implement accumulatin parameters, snacca and snaccb, assert that it +! is indeed accumulation season. i.e. that snow surface temp is below +! zero and the date falls between october and february +! ---------------------------------------------------------------------- + snoalb1 = snoalb+lvcoef*(0.85-snoalb) + snoalb2=snoalb1 +! ---------------- initial lstsnw -------------------------------------- + if (snowng) then + snotime1 = 0. + else + snotime1=snotime1+dt +! if (tsnow.lt.273.16) then + snoalb2=snoalb1*(snacca**((snotime1/86400.0)**snaccb)) +! else +! snoalb2 +! =snoalb1*(snthwa**((snotime1/86400.0)**snthwb)) +! endif + endif +! + snoalb2 = max ( snoalb2, alb ) + albedo = alb + sncovr*(snoalb2-alb) + if (albedo .gt. snoalb2) albedo=snoalb2 + +! if (tsnow.lt.273.16) then +! albedo=snoalb-0.008*dt/86400 +! else +! albedo=(snoalb-0.5)*exp(-0.24*dt/86400)+0.5 +! endif + +! if (albedo > snoalb) albedo = snoalb + +! + return +!................................... + end subroutine alcalc +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates canopy resistance which depends on incoming +!! solar radiation, air temperature, atmospheric water vapor pressure +!! deficit at the lowest model level, and soil moisture (preferably unfrozen +!! soil moisture rather than total). + subroutine canres (swdn,ch,sfctmp,q2,sfcprs,smc,zsoil,nsoil, & + smcwlt,smcref,rsmin,rc,pc,nroot,q2sat,dqsdt2, & + topt,rsmax,rgl,hs,xlai, & + rcs,rct,rcq,rcsoil,sfcems) + +! --- inputs: +! & ( nsoil, nroot, swdn, ch, q2, q2sat, dqsdt2, sfctmp, & +! & cpx1, sfcprs, sfcems, sh2o, smcwlt, smcref, zsoil, rsmin, & +! & rsmax, topt, rgl, hs, xlai, & +! --- outputs: +! & rc, pc, rcs, rct, rcq, rcsoil & +! & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine canres calculates canopy resistance which depends on ! +! incoming solar radiation, air temperature, atmospheric water vapor ! +! pressure deficit at the lowest model level, and soil moisture ! +! (preferably unfrozen soil moisture rather than total) ! +! ! +! source: jarvis (1976), noilhan and planton (1989, mwr), jacquemin ! +! and noilhan (1990, blm) ! +! see also: chen et al (1996, jgr, vol 101(d3), 7251-7268), eqns ! +! 12-14 and table 2 of sec. 3.1.2 ! +! ! +! subprogram called: none ! +! ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs from calling program: size ! +! nsoil - integer, no. of soil layers 1 ! +! nroot - integer, no. of soil layers in root zone ( ... begin here +! +! --- ... initialize canopy resistance multiplier terms. + + rcs = 0.0 + rct = 0.0 + rcq = 0.0 + rcsoil = 0.0 + rc = 0.0 + +! --- ... contribution due to incoming solar radiation + + ff = 0.55 * 2.0 * swdn / (rgl*xlai) + rcs = (ff + rsmin/rsmax) / (1.0 + ff) + rcs = max( rcs, 0.0001 ) + +! --- ... contribution due to air temperature at first model level above ground +! rct expression from noilhan and planton (1989, mwr). + + rct = 1.0 - 0.0016 * (topt - sfctmp)**2.0 + rct = max( rct, 0.0001 ) + +! --- ... contribution due to vapor pressure deficit at first model level. +! rcq expression from ssib + + rcq = 1.0 / (1.0 + hs*(q2sat-q2)) + rcq = max( rcq, 0.01 ) + +! --- ... contribution due to soil moisture availability. +! determine contribution from each soil layer, then add them up. + + gx = (sh2o(1) - smcwlt) / (smcref - smcwlt) + gx = max( 0.0, min( 1.0, gx ) ) + +! --- ... use soil depth as weighting factor + part(1) = (zsoil(1)/zsoil(nroot)) * gx + +! --- ... use root distribution as weighting factor +! part(1) = rtdis(1) * gx + + do k = 2, nroot + + gx = (sh2o(k) - smcwlt) / (smcref - smcwlt) + gx = max( 0.0, min( 1.0, gx ) ) + +! --- ... use soil depth as weighting factor + part(k) = ((zsoil(k) - zsoil(k-1)) / zsoil(nroot)) * gx + +! --- ... use root distribution as weighting factor +! part(k) = rtdis(k) * gx + + enddo + + do k = 1, nroot + rcsoil = rcsoil + part(k) + enddo + rcsoil = max( rcsoil, 0.0001 ) + +! --- ... determine canopy resistance due to all factors. convert canopy +! resistance (rc) to plant coefficient (pc) to be used with +! potential evap in determining actual evap. pc is determined by: +! pc * linerized penman potential evap = penman-monteith actual +! evaporation (containing rc term). + + rc = rsmin / (xlai*rcs*rct*rcq*rcsoil) + rr = (4.0*sfcems*sigma*rd/cpx1) * (sfctmp**4.0)/(sfcprs*ch) + 1.0 + delta = (lsubc/cpx1) * dqsdt2 + + pc = (rr + delta) / (rr*(1.0 + rc*ch) + delta) +! + return +!................................... + end subroutine canres +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates snow termal conductivity + subroutine csnow +!................................... +! --- inputs: + & ( sndens, & +! --- outputs: + & sncond & + & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine csnow calculates snow thermal conductivity ! +! ! +! subprogram called: none ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs from the calling program: size ! +! sndens - real, snow density 1 ! +! ! +! outputs to the calling program: ! +! sncond - real, snow thermal conductivity 1 ! +! ! +! ==================== end of description ===================== ! +! + implicit none +! --- constant parameters: + real (kind=kind_phys), parameter :: unit = 0.11631 + +! --- inputs: + real (kind=kind_phys), intent(in) :: sndens + +! --- outputs: + real (kind=kind_phys), intent(out) :: sncond + +! --- locals: + real (kind=kind_phys) :: c + +! +!===> ... begin here +! +! --- ... sncond in units of cal/(cm*hr*c), returned in w/(m*c) +! basic version is dyachkova equation (1960), for range 0.1-0.4 + + c = 0.328 * 10**(2.25*sndens) + sncond = 2.0 * unit * c + +! --- ... de vaux equation (1933), in range 0.1-0.6 + +! sncond = 0.0293 * (1.0 + 100.0*sndens**2) + +! --- ... e. andersen from flerchinger + +! sncond = 0.021 + 2.51 * sndens**2 +! + return +!................................... + end subroutine csnow +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates soil moisture and heat flux values and +!! update soil moisture content and soil heat content values for the +!! case when no snow pack is present. + subroutine nopac +!................................... +! --- inputs: + & ( nsoil, nroot, etp, prcp, smcmax, smcwlt, smcref, & + & smcdry, cmcmax, dt, shdfac, sbeta, sfctmp, sfcems, & + & t24, th2, fdown, epsca, bexp, pc, rch, rr, cfactr, & + & slope, kdt, frzx, psisat, zsoil, dksat, dwsat, & + & zbot, rtdis, quartz, fxexp, csoil, & + & opt_thcnd, & +! --- input for fasdas (FDDA) (Not used for HAFS): + & qfx_phy, hcpct_fasdas, xsda_qfx, xqnorm, fasdas, & +! --- input/outputs: + & cmc, t1, stc, sh2o, tbot, & + & sfhead1rt, infxs1rt, rtpnd1, & +! --- outputs: + & eta, smc, ssoil, runoff1, runoff2, runoff3, edir, & + & ec, et, ett, beta, drip, dew, flx1, flx3, & + & hcpct_fasdas & + & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine nopac calculates soil moisture and heat flux values and ! +! update soil moisture content and soil heat content values for the ! +! case when no snow pack is present. ! +! ! +! ! +! subprograms called: evapo, smflx, tdfcnd, shflx ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs from calling program: size ! +! nsoil - integer, number of soil layers 1 ! +! nroot - integer, number of root layers 1 ! +! etp - real, potential evaporation 1 ! +! prcp - real, precip rate 1 ! +! smcmax - real, porosity (sat val of soil mois) 1 ! +! smcwlt - real, wilting point 1 ! +! smcref - real, soil mois threshold 1 ! +! smcdry - real, dry soil mois threshold 1 ! +! cmcmax - real, maximum canopy water parameters 1 ! +! dt - real, time step 1 ! +! shdfac - real, aeral coverage of green veg 1 ! +! sbeta - real, param to cal veg effect on soil heat flux 1 ! +! sfctmp - real, air temp at height zlvl abv ground 1 ! +! sfcems - real, sfc lw emissivity 1 ! +! t24 - real, sfctmp**4 1 ! +! th2 - real, air potential temp at zlvl abv grnd 1 ! +! fdown - real, net solar + downward lw flux at sfc 1 ! +! epsca - real, 1 ! +! bexp - real, soil type "b" parameter 1 ! +! pc - real, plant coeff 1 ! +! rch - real, companion coefficient of ch 1 ! +! rr - real, 1 ! +! cfactr - real, canopy water parameters 1 ! +! slope - real, linear reservoir coefficient 1 ! +! kdt - real, 1 ! +! frzx - real, frozen ground parameter 1 ! +! psisat - real, saturated soil potential 1 ! +! zsoil - real, soil layer depth below ground (negative) nsoil ! +! dksat - real, saturated soil hydraulic conductivity 1 ! +! dwsat - real, saturated soil diffusivity 1 ! +! zbot - real, specify depth of lower bd soil 1 ! +! ice - integer, sea-ice flag (=1: sea-ice, =0: land) 1 ! +! rtdis - real, root distribution nsoil ! +! quartz - real, soil quartz content 1 ! +! fxexp - real, bare soil evaporation exponent 1 ! +! csoil - real, soil heat capacity 1 ! +! ! +! input/outputs from and to the calling program: ! +! cmc - real, canopy moisture content 1 ! +! t1 - real, ground/canopy/snowpack eff skin temp 1 ! +! stc - real, soil temp nsoil ! +! sh2o - real, unfrozen soil moisture nsoil ! +! tbot - real, bottom soil temp 1 ! +! ! +! outputs to the calling program: ! +! eta - real, downward latent heat flux 1 ! +! smc - real, total soil moisture nsoil ! +! ssoil - real, upward soil heat flux 1 ! +! runoff1 - real, surface runoff not infiltrating sfc 1 ! +! runoff2 - real, sub surface runoff (baseflow) 1 ! +! runoff3 - real, excess of porosity 1 ! +! edir - real, direct soil evaporation 1 ! +! ec - real, canopy water evaporation 1 ! +! et - real, plant transpiration nsoil ! +! ett - real, total plant transpiration 1 ! +! beta - real, ratio of actual/potential evap 1 ! +! drip - real, through-fall of precip and/or dew 1 ! +! dew - real, dewfall (or frostfall) 1 ! +! flx1 - real, precip-snow sfc flux 1 ! +! flx3 - real, phase-change heat flux from snowmelt 1 ! +! ! +! ==================== end of description ===================== ! +! + implicit none +! --- inputs: + integer, intent(in) :: nsoil, nroot + integer, intent(in) :: opt_thcnd + + real (kind=kind_phys), intent(in) :: etp, prcp, smcmax, & + & smcwlt, smcref, smcdry, cmcmax, dt, shdfac, sbeta, & + & sfctmp, sfcems, t24, th2, fdown, epsca, bexp, pc, & + & rch, rr, cfactr, slope, kdt, frzx, psisat, & + & dksat, dwsat, zbot, quartz, fxexp, csoil + + real (kind=kind_phys), dimension(nsoil), intent(in) :: zsoil,rtdis + +! --- input/outputs: + real (kind=kind_phys), intent(inout) :: cmc, t1, tbot + real (kind=kind_phys), dimension(nsoil), intent(inout) :: stc,sh2o + +!djg ndhms/wrf-hydro edit... + real (kind=kind_phys), intent(inout) :: sfhead1rt,infxs1rt,etpnd1 + +! --- outputs: + real (kind=kind_phys), intent(out) :: eta, smc(nsoil), ssoil, & + & runoff1, runoff2, runoff3, edir, ec, et(nsoil), ett, & + & beta, drip, dew, flx1, flx3 + +! --- ... fasdas + real (kind=kind_phys), intent(out) :: hcpct_fasdas + +! --- locals: + real (kind=kind_phys) :: df1, eta1, etp1, prcp1, yy, yynum, & + & zz1, ec1, edir1, et1(nsoil), ett1 + + integer :: k + +! --- ... fasdas + real (kind=kind_phys), dimension(nsoil) :: eft, wetty + real (kind=kind_phys) :: qfx_phy, xsda_qfx, xqnorm + integer :: fasdas + +! +!===> ... begin here +! +! --- ... convert etp from kg m-2 s-1 to ms-1 and initialize dew. + + prcp1= prcp * 0.001 + etp1 = etp * 0.001 + dew = 0.0 + edir = 0.0 + edir1= 0.0 + ec = 0.0 + ec1 = 0.0 + + +! fasdas +! + qfx_phy = 0.0 +! end fasdas + + do k = 1, nsoil + et (k) = 0.0 + et1(k) = 0.0 + +! +! fasdas +! + wetty(k) = 1.0 +! +! end fasdas +! + + enddo + + ett = 0.0 + ett1 = 0.0 + +!djg ndhms/wrf-hydro edit... + etpnd1 = 0.0 + + if (etp > 0.0) then + +! --- ... convert prcp from 'kg m-2 s-1' to 'm s-1'. + + call evapo & +! --- inputs: + & ( nsoil, nroot, cmc, cmcmax, etp1, dt, zsoil, & + & sh2o, smcmax, smcwlt, smcref, smcdry, pc, & + & shdfac, cfactr, rtdis, fxexp, & +! --- outputs: + & eta1, edir1, ec1, et1, ett1 & + & ) + + +! +! fasdas +! + if( fasdas == 1 ) then + do k=1,nsoil + qfx_phy = qfx_phy + et1(k) ! m/s +! dont add moisture fluxes if soil moisture is = or > smcref + if(smc(k).ge.smcref.and.xsda_qfx.gt.0.0) wetty(k)=0.0 + end do + qfx_phy = edir1+ec1+qfx_phy ! m/s + eall_now = qfx_phy ! m/s + qfx_phy = qfx_phy*1000.0 ! kg/m2/s + + if(eall_now.ne.0.0) then + efdir = (edir1/eall_now)*xsda_qfx*1.0e-03*xqnorm + efdir = efdir * wetty(1) + !twg2015 bugfix flip sign to conform to net upward flux + edir1 = edir1 + efdir ! new value + + efc = (ec1/eall_now)*xsda_qfx*1.0e-03*xqnorm + !twg2015 bugfix flip sign to conform to net upward flux + ec1 = ec1 + efc ! new value + + + do k=1,nsoil + eft(k) = (et1(k)/eall_now)*xsda_qfx*1.0e-03*xqnorm + eft(k) = eft(k) * wetty(k) + !twg2015 bugfix flip sign to conform to net upward flux + et1(k) = et1(k) + eft(k) ! new value + end do + + + end if ! for non-zero eall_now + else + qfx_phy = 0.0 + endif +! +! end fasdas +! + + + + call smflx & +! --- inputs: + & ( nsoil, dt, kdt, smcmax, smcwlt, cmcmax, prcp1, & + & zsoil, slope, frzx, bexp, dksat, dwsat, shdfac, & + & edir1, ec1, et1, & +! --- input/outputs: + & cmc, sh2o, & +! --- wrf hydro input/outputs: + & fhead1rt,infxs1rt, & +! --- outputs: + & smc, runoff1, runoff2, runoff3, drip & + & ) + +! ---------------------------------------------------------------------- +! convert modeled evapotranspiration from m s-1 to kg m-2 s-1. +! ---------------------------------------------------------------------- + + eta = eta1 * 1000.0 + +! ---------------------------------------------------------------------- +! if etp < 0, assume dew forms (transform etp1 into dew and reinitialize +! etp1 to zero). +! ---------------------------------------------------------------------- + else + dew = - etp1 + +! --- ... convert prcp from 'kg m-2 s-1' to 'm s-1' and add dew amount. + + prcp1 = prcp1 + dew + +! +! fasdas +! + if( fasdas == 1 ) then + do k=1,nsoil + qfx_phy = qfx_phy + et1(k) ! m/s +! dont add moisture fluxes if soil moisture is = or > smcref + if(smc(k).ge.smcref.and.xsda_qfx.gt.0.0) wetty(k)=0.0 + end do + qfx_phy = edir1+ec1+qfx_phy ! m/s + eall_now = qfx_phy ! m/s + qfx_phy = qfx_phy*1000.0 ! kg/m2/s + + if(eall_now.ne.0.0) then + efdir = (edir1/eall_now)*xsda_qfx*1.0e-03*xqnorm + efdir = efdir * wetty(1) + !twg2015 bugfix flip sign to conform to net upward flux + edir1 = edir1 + efdir ! new value + + efc = (ec1/eall_now)*xsda_qfx*1.0e-03*xqnorm + !twg2015 bugfix flip sign to conform to net upward flux + ec1 = ec1+ efc ! new value + + do k=1,nsoil + eft(k) = (et1(k)/eall_now)*xsda_qfx*1.0e-03*xqnorm + eft(k) = eft(k) * wetty(k) + !twg2015 bugfix flip sign to conform to net upward flux + et1(k) = et1(k) + eft(k) ! new value + end do + + end if ! for non-zero eall_now + else + qfx_phy = 0.0 + endif +! +! end fasdas +! + + + call smflx & +! --- inputs: + & ( nsoil, dt, kdt, smcmax, smcwlt, cmcmax, prcp1, & + & zsoil, slope, frzx, bexp, dksat, dwsat, shdfac, & + & edir1, ec1, et1, & +! --- input/outputs: + & cmc, sh2o, & +! --- wrf hydro input/outputs: + & fhead1rt,infxs1rt, & +! --- outputs: + & smc, runoff1, runoff2, runoff3, drip & + & ) + + endif ! end if_etp_block + +! --- ... based on etp and e values, determine beta + + if ( etp <= 0.0 ) then + beta = 0.0 + eta = etp + if ( etp < 0.0 ) then + beta = 1.0 + endif + else + beta = eta / etp + endif + +! --- ... convert modeled evapotranspiration fm m s-1 to kg m-2 s-1 + +! eta = eta1 * 1000.0 + edir = edir1 * 1000.0 + ec = ec1 * 1000.0 + + do k = 1, nsoil + et(k) = et1(k) * 1000.0 + enddo + + ett = ett1 * 1000.0 + +! --- ... get soil thermal diffuxivity/conductivity for top soil lyr, +! calc. adjusted top lyr soil temp and adjusted soil flux, then +! call shflx to compute/update soil heat flux and soil temps. + + call tdfcnd & +! --- inputs: + & ( smc(1), quartz, smcmax, sh2o(1), & +! --- outputs: + & df1 & + & ) +! if(ivegsrc == 1) then +!urban + if ( vegtyp == 13 ) df1=3.24 + endif + +! --- ... vegetation greenness fraction reduction in subsurface heat +! flux via reduction factor, which is convenient to apply here +! to thermal diffusivity that is later used in hrt to compute +! sub sfc heat flux (see additional comments on veg effect +! sub-sfc heat flx in routine sflx) +!wz only urban for igbp type + df1 = df1 * exp( sbeta*shdfac ) + +! --- ... compute intermediate terms passed to routine hrt (via routine +! shflx below) for use in computing subsurface heat flux in hrt + + yynum = fdown - sfcems*sigma*t24 + yy = sfctmp + (yynum/rch + th2 - sfctmp - beta*epsca)/rr + zz1 = df1/(-0.5*zsoil(1)*rch*rr) + 1.0 + + call shflx & +! --- inputs: + & ( nsoil, smc, smcmax, dt, yy, zz1, zsoil, zbot, & + & psisat, bexp, df1, ice, quartz, csoil, vegtyp, & +! --- input/outputs: + & stc, t1, tbot, sh2o, & +! --- outputs: + & ssoil & + & ) + +! --- ... set flx1 and flx3 (snopack phase change heat fluxes) to zero since +! they are not used here in snopac. flx2 (freezing rain heat flux) +! was similarly initialized in the penman routine. + + flx1 = cph2o * prcp * (t1- sfctmp) + flx3 = 0.0 +! + return +!................................... + end subroutine nopac +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates potential evaporation for the current point. +!! various partial sums/products are also calculated and passed back +!! to the calling routine for later use + subroutine penman +!................................... +! --- inputs: + & ( sfctmp, sfcprs, sfcems, ch, t2v, th2, prcp, fdown, & + & cpx, cpfac, ssoil, q2, q2sat, dqsdt2, snowng, frzgra, & + & sncovr, aoasis, sneqv, albedo, soldn, stc1, & +! --- outputs: + & t24, etp, rch, epsca, rr, flx2, etpn, flx4 & + & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine penman calculates potential evaporation for the current ! +! point. various partial sums/products are also calculated and passed ! +! back to the calling routine for later use. ! +! ! +! ! +! subprogram called: none ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! sfctmp - real, sfc temperature at 1st level above ground 1 ! +! sfcprs - real, sfc pressure 1 ! +! sfcems - real, sfc emissivity for lw radiation 1 ! +! ch - real, sfc exchange coeff for heat & moisture 1 ! +! t2v - real, sfc virtual temperature 1 ! +! th2 - real, air potential temp at zlvl abv grnd 1 ! +! prcp - real, precip rate 1 ! +! fdown - real, net solar + downward lw flux at sfc 1 ! +! cpx - real, enhanced air heat capacity for heat storage 1 ! +! cpfac - real, ratio air heat capacity to enhanced one 1 ! +! ssoil - real, upward soil heat flux 1 ! +! q2 - real, mixing ratio at hght zlvl abv ground 1 ! +! q2sat - real, sat mixing ratio at zlvl abv ground 1 ! +! dqsdt2 - real, slope of sat specific humidity curve 1 ! +! snowng - logical, snow flag 1 ! +! frzgra - logical, freezing rain flag 1 ! +! ! +! outputs: ! +! t24 - real, sfctmp**4 1 ! +! etp - real, potential evaporation 1 ! +! rch - real, companion coefficient of ch 1 ! +! epsca - real, 1 ! +! rr - real, 1 ! +! flx2 - real, freezing rain latent heat flux 1 ! +! ! +! ==================== end of description ===================== ! +! +! --- inputs: + real (kind=kind_phys), intent(in) :: sfctmp, sfcprs, sfcems, & + & ch, t2v, th2, prcp, fdown, ssoil, q2, q2sat, dqsdt2 + + real (kind=kind_phys), intent(in) :: sncovr, aoasis, albedo & + real (kind=kind_phys), intent(in) :: fvb, gama, stc1 & + + logical, intent(in) :: snowng, frzgra, ua_phys + +! --- outputs: + real (kind=kind_phys), intent(out) :: t24, etp, rch, epsca, & + & rr, flx2, etpn, flx4 + +! --- locals: + real (kind=kind_phys) :: a, delta, fnet, rad, rho + real (kind=kind_phys) :: elcp1, lvs + +! --- parameters: + real (kind=kind_phys) parameter :: elcp = 2.4888e+3, lsubc = & + & 2.501000e+6,cp = 1004.6 + real (kind=kind_phys) parameter :: lsubs = 2.83e+6 & + real (kind=kind_phys) parameter :: algdsn = 0.5, alvgsn = 0.13 & + +! +!===> ... begin here +! + elcp1 = (1.0-sncovr)*elcp + sncovr*elcp*lsubs/lsubc + lvs = (1.0-sncovr)*lsubc + sncovr*lsubs + + flx2 = 0.0 + + delta = elcp1 * dqsdt2 + t24 = sfctmp * sfctmp * sfctmp * sfctmp + rr = sfcems * t24 * 6.48e-8 / (sfcprs*ch) + 1.0 + rho = sfcprs / (rd*t2v) + rch = rho * cp * ch + +! --- ... adjust the partial sums / products with the latent heat +! effects caused by falling precipitation. + + if (.not. snowng) then + if (prcp > 0.0) rr = rr + cph2o*prcp/rch + else + rr = rr + cpice & + & *prcp/rch + endif + + fnet = fdown - sfcems*sigma*t24 - ssoil + + + flx4 = 0.0 + if(ua_phys) then + if(sneqv > 0. .and. fnet > 0. .and. soldn > 0. ) then +! solar radiation absorbed by vegetated fraction + totabs = (1.-albedo)*soldn*fvb ! solar radiation absorbed + ucabs = min(totabs,((1.0-algdsn)*(1.0-alvgsn)*soldn*gama)*fvb) + +! print*,'penman',ucabs,totabs,soldn,gama,fvb +! ucabs -> solar radiation absorbed under canopy +! ucabs = min(totabs,(0.44*soldn*gama)*fvb) + flx4 = min(totabs - ucabs, min(250., 0.5*(1.-albedo)*soldn)) + endif + + signck = (stc1-273.15)*(sfctmp-273.15) + + if(flx4 > 0. .and. (signck <= 0. .or. stc1 < 273.15)) then + if(fnet >= flx4) then + fnetn = fnet - flx4 + else + flx4 = fnet + fnetn = 0. + endif + else + flx4 = 0.0 + fnetn = 0. + endif + endif + + +! --- ... include the latent heat effects of frzng rain converting to ice +! on impact in the calculation of flx2 and fnet. + + if (frzgra) then + flx2 = -lsubf * prcp + fnet = fnet - flx2 + endif + + if(ua_phys) fnetn = fnetn - flx2 +! ---------------------------------------------------------------------- +! finish penman equation calculations. +! ---------------------------------------------------------------------- + endif + + +! --- ... finish penman equation calculations. + + rad = fnet/rch + th2 - sfctmp + a = elcp * (q2sat - q2) + epsca = (a*rr + rad*delta) / (delta + rr) +! Fei-Mike + if (epsca > 0.) epsca = epsca * aoasis + etp = epsca * rch /lvs +! etp = epsca * rch / lsubc + + if (ua_phys) then + radn = fnetn / rch + th2 - sfctmp + epscan = (a * rr + radn * delta) / (delta + rr) + etpn = epscan * rch / lvs + endif +! + return +!................................... + end subroutine penman +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine internally sets default values or optionally read-in +!! via namelist i/o, all soil and vegetation parateters requied for the execusion +!! of the Noah LSM. + subroutine redprm +!................................... +! --- inputs: + & ( nsoil, vegtyp, soiltyp, slopetyp, sldpth, zsoil, & +! --- outputs + & cfactr, cmcmax, rsmin, rsmax, topt, refkdt, kdt, & + & sbeta, shdfac, rgl, hs, zbot, frzx, psisat, slope, & + & snup, salp, bexp, dksat, dwsat, smcmax, smcwlt, & + & smcref, smcdry, f1, quartz, fxexp, rtdis, nroot, & + & czil, xlai, csoil, lvcoef, laimin, laimax, & + & emissmin, emissmax, albedomin, albedomax, z0min, z0max, & + & ztopv, zbotv + & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine redprm internally sets(default valuess), or optionally ! +! read-in via namelist i/o, all soil and vegetation parameters ! +! required for the execusion of the noah lsm. ! +! ! +! optional non-default parameters can be read in, accommodating up to ! +! 30 soil, veg, or slope classes, if the default max number of soil, ! +! veg, and/or slope types is reset. ! +! ! +! future upgrades of routine redprm must expand to incorporate some ! +! of the empirical parameters of the frozen soil and snowpack physics ! +! (such as in routines frh2o, snowpack, and snow_new) not yet set in ! +! this redprm routine, but rather set in lower level subroutines. ! +! ! +! all soil, veg, slope, and universal parameters values are defined ! +! externally (in subroutine "set_soilveg.f") and then accessed via ! +! "use namelist_soilveg" (below) and then set here. ! +! ! +! soil types zobler (1986) cosby et al (1984) (quartz cont.(1)) ! +! 1 coarse loamy sand (0.82) ! +! 2 medium silty clay loam (0.10) ! +! 3 fine light clay (0.25) ! +! 4 coarse-medium sandy loam (0.60) ! +! 5 coarse-fine sandy clay (0.52) ! +! 6 medium-fine clay loam (0.35) ! +! 7 coarse-med-fine sandy clay loam (0.60) ! +! 8 organic loam (0.40) ! +! 9 glacial land ice loamy sand (na using 0.82)! +! 13: - glacial land ice - ! +! 13: glacial-ice (no longer use these parameters), now ! +! treated as ice-only surface and sub-surface ! +! (in subroutine hrtice) ! +! upgraded to statsgo (19-type) +! 1: sand +! 2: loamy sand +! 3: sandy loam +! 4: silt loam +! 5: silt +! 6:loam +! 7:sandy clay loam +! 8:silty clay loam +! 9:clay loam +! 10:sandy clay +! 11: silty clay +! 12: clay +! 13: organic material +! 14: water +! 15: bedrock +! 16: other (land-ice) +! 17: playa +! 18: lava +! 19: white sand +! ! +! ssib vegetation types (dorman and sellers, 1989; jam) ! +! 1: broadleaf-evergreen trees (tropical forest) ! +! 2: broadleaf-deciduous trees ! +! 3: broadleaf and needleleaf trees (mixed forest) ! +! 4: needleleaf-evergreen trees ! +! 5: needleleaf-deciduous trees (larch) ! +! 6: broadleaf trees with groundcover (savanna) ! +! 7: groundcover only (perennial) ! +! 8: broadleaf shrubs with perennial groundcover ! +! 9: broadleaf shrubs with bare soil ! +! 10: dwarf trees and shrubs with groundcover (tundra) ! +! 11: bare soil ! +! 12: cultivations (the same parameters as for type 7) ! +! 13: - glacial (the same parameters as for type 11) - ! +! 13: glacial-ice (no longer use these parameters), now treated as ! +! ice-only surface and sub-surface (in subroutine hrtice) ! +! upgraded to IGBP (20-type) +! 1:Evergreen Needleleaf Forest +! 2:Evergreen Broadleaf Forest +! 3:Deciduous Needleleaf Forest +! 4:Deciduous Broadleaf Forest +! 5:Mixed Forests +! 6:Closed Shrublands +! 7:Open Shrublands +! 8:Woody Savannas +! 9:Savannas +! 10:Grasslands +! 11:Permanent wetlands +! 12:Croplands +! 13:Urban and Built-Up +! 14:Cropland/natural vegetation mosaic +! 15:Snow and Ice +! 16:Barren or Sparsely Vegetated +! 17:Water +! 18:Wooded Tundra +! 19:Mixed Tundra +! 20:Bare Ground Tundra +! ! +! slopetyp is to estimate linear reservoir coefficient slope to the ! +! baseflow runoff out of the bottom layer. lowest class (slopetyp=0) ! +! means highest slope parameter = 1. ! +! ! +! slope class percent slope ! +! 1 0-8 ! +! 2 8-30 ! +! 3 > 30 ! +! 4 0-30 ! +! 5 0-8 & > 30 ! +! 6 8-30 & > 30 ! +! 7 0-8, 8-30, > 30 ! +! 9 glacial ice ! +! blank ocean/sea ! +! ! +! note: class 9 from zobler file should be replaced by 8 and 'blank' 9 ! +! ! +! ! +! subprogram called: none ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs from calling program: size ! +! nsoil - integer, number of soil layers 1 ! +! vegtyp - integer, vegetation type (integer index) 1 ! +! soiltyp - integer, soil type (integer index) 1 ! +! slopetyp - integer, class of sfc slope (integer index) 1 ! +! sldpth - integer, thickness of each soil layer (m) nsoil ! +! zsoil - integer, soil depth (negative sign) (m) nsoil ! +! ! +! outputs to the calling program: ! +! cfactr - real, canopy water parameters 1 ! +! cmcmax - real, maximum canopy water parameters 1 ! +! rsmin - real, mimimum stomatal resistance 1 ! +! rsmax - real, maximum stomatal resistance 1 ! +! topt - real, optimum transpiration air temperature 1 ! +! refkdt - real, =2.e-6 the sat. dk. val for soil type 2 1 ! +! kdt - real, 1 ! +! sbeta - real, param to cal veg effect on soil heat flux 1 ! +! shdfac - real, vegetation greenness fraction 1 ! +! rgl - real, canopy resistance func (in solar rad term) 1 ! +! hs - real, canopy resistance func (vapor deficit term) 1 ! +! zbot - real, specify depth of lower bd soil temp (m) 1 ! +! frzx - real, frozen ground parameter, ice content 1 ! +! threshold above which frozen soil is impermeable ! +! psisat - real, saturated soil potential 1 ! +! slope - real, linear reservoir coefficient 1 ! +! snup - real, threshold snow depth (water equi m) 1 ! +! salp - real, snow cover shape parameter 1 ! +! from anderson's hydro-17 best fit salp = 2.6 ! +! bexp - real, the 'b' parameter 1 ! +! dksat - real, saturated soil hydraulic conductivity 1 ! +! dwsat - real, saturated soil diffusivity 1 ! +! smcmax - real, max soil moisture content (porosity) 1 ! +! smcwlt - real, wilting pt soil moisture contents 1 ! +! smcref - real, reference soil moisture (onset stress) 1 ! +! smcdry - real, air dry soil moist content limits 1 ! +! f1 - real, used to comp soil diffusivity/conductivity 1 ! +! quartz - real, soil quartz content 1 ! +! fxexp - real, bare soil evaporation exponent 1 ! +! rtdis - real, root distribution nsoil ! +! nroot - integer, number of root layers 1 ! +! z0 - real, roughness length (m) 1 ! +! czil - real, param to cal roughness length of heat 1 ! +! xlai - real, leaf area index 1 ! +! csoil - real, soil heat capacity (j m-3 k-1) 1 ! +! laimin - real, Min leaf area index through the year [no dims] ! +! laimax - real, Max leaf area index through the year [no dims] ! +! emissmin - real, Min backgrd emissivity through the year[fraction]! +! emissmax - real, Max backgrd emissivity through the year[fraction]! +! albedomin- real, Min backgrd albedo through the year[fraction] ! +! albedomax- real, Max backgrd albedo through the year[fraction] ! +! z0min - real, Min bkgd roughness len through the year [m] ! +! z0max - real, Max bkgd roughness len through the year [m] ! +! lvcoef - real, user defined coefficient for adjusting snow albe ! +! ! +! ==================== end of description ===================== ! +! + use namelist_soilveg + + implicit none + +! --- input: + integer, intent(in) :: nsoil, vegtyp, soiltyp, slopetyp + + real (kind=kind_phys), intent(in) :: sldpth(nsoil), zsoil(nsoil) + +! --- outputs: + real (kind=kind_phys), intent(out) :: cfactr, cmcmax, rsmin, & + & rsmax, topt, refkdt, kdt, sbeta, shdfac, rgl, hs, zbot, & + & frzx, psisat, slope, snup, salp, bexp, dksat, dwsat, & + & smcmax, smcwlt, smcref, smcdry, f1, quartz, fxexp, & + & czil, xlai, csoil, rtdis(nsoil), lvcoef, laimin, laimax, & + & emissmin, emissmax, albedomin, albedomax, z0min, z0max, & + & ztopv, zbotv + + integer, intent(out) :: nroot +! --- ...parameters: + integer, parameter :: max_slopetyp=30,max_soiltyp=30,max_vegtyp=30 + +! --- ...logical: + logical :: local + +! --- locals: + real (kind=kind_phys) :: frzfact, frzk, refdk + + integer :: i + +! +!===> ... begin here +! + if (soiltyp > defined_soil) then + write(*,*) 'warning: too many soil types,soiltyp=',soiltyp, & + & 'defined_soil=',defined_soil + stop 333 + endif + + if (vegtyp > defined_veg) then + write(*,*) 'warning: too many veg types' + stop 333 + endif + + if (slopetyp > defined_slope) then + write(*,*) 'warning: too many slope types' + stop 333 + endif + + +! --- ... set-up universal parameters (not dependent on soiltyp, vegtyp +! or slopetyp) + + zbot = zbot_data + salp = salp_data + sbeta = sbeta_data + refdk = refdk_data + frzk = frzk_data + fxexp = fxexp_data + refkdt = refkdt_data + czil = czil_data + csoil = csoil_data + kdt = refkdt * dksat / refdk + lvcoef = lvcoef_data + +! --- ... set-up soil parameters + + bexp = bb (soiltyp) + dksat = satdk(soiltyp) + dwsat = satdw(soiltyp) + f1 = f11 (soiltyp) + psisat = satpsi(soiltyp) + quartz = qtz (soiltyp) + smcdry = drysmc(soiltyp) + smcmax = maxsmc(soiltyp) + smcref = refsmc(soiltyp) + smcwlt = wltsmc(soiltyp) + slope = slope_data(slopetyp) + + frzfact = (smcmax / smcref) * (0.412 / 0.468) + +! --- ... to adjust frzk parameter to actual soil type: frzk * frzfact + + frzfact = (smcmax / smcref) * (0.412 / 0.468) + frzx = frzk * frzfact + +! --- ... set-up vegetation parameters + + topt = topt_data + cmcmax = cmcmax_data + cfactr = cfactr_data + rsmax = rsmax_data + nroot = nroot_data(vegtyp) + snup = snupx(vegtyp) + rsmin = rsmtbl(vegtyp) + rgl = rgltbl(vegtyp) + hs = hstbl(vegtyp) +! roughness lengthe is defined in sfcsub +! z0 = z0_data(vegtyp) + xlai= lai_data(vegtyp) + emissmin = emissmintbl (vegtyp) + emissmax = emissmaxtbl (vegtyp) + laimin = laimintbl (vegtyp) + laimax = laimaxtbl (vegtyp) + z0min = z0mintbl (vegtyp) + z0max = z0maxtbl (vegtyp) + albedomin = albedomintbl (vegtyp) + albedomax = albedomaxtbl (vegtyp) + ztopv = ztopvtbl (vegtyp) + zbotv = zbotvtbl (vegtyp) + + if (vegtyp == bare) shdfac = 0.0 + + if (nroot > nsoil) then + write(*,*) 'warning: too many root layers', nsoil, nroot + stop 333 + endif + +! --- ... calculate root distribution. present version assumes uniform +! distribution based on soil layer depths. + + do i = 1, nroot + rtdis(i) = -sldpth(i) / zsoil(nroot) + enddo + +! --- ... set-up slope parameter + + slope = slope_data(slopetyp) +! + return +!................................... + end subroutine redprm +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates surface layer exchange coefficients +!! via iterative process(see Chen et al.(1997) \cite chen_et_al_1997). + subroutine sfcdif +!................................... +! --- inputs: +! & ( zlvl, z0, t1v, th2v, sfcspd, czil, & +! --- input/outputs: +! & cm, ch & +! & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine sfcdif calculates surface layer exchange coefficients ! +! via iterative process. see chen et al (1997, blm) ! +! ! +! subprogram called: none ! +! ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs from the calling program: size ! +! zlvl - real, height abv atmos ground forcing vars (m) 1 ! +! z0 - real, roughness length (m) 1 ! +! t1v - real, surface exchange coefficient 1 ! +! th2v - real, surface exchange coefficient 1 ! +! sfcspd - real, wind speed at height zlvl abv ground (m/s) 1 ! +! czil - real, param to cal roughness length of heat 1 ! +! ! +! input/outputs from and to the calling program: ! +! cm - real, sfc exchange coeff for momentum (m/s) 1 ! +! ch - real, sfc exchange coeff for heat & moisture (m/s)1 ! +! ! +! ==================== end of description ===================== ! +! +! --- constant parameters: + integer, parameter :: itrmx = 5 + real (kind=kind_phys), parameter :: wwst = 1.2 + real (kind=kind_phys), parameter :: wwst2 = wwst*wwst + real (kind=kind_phys), parameter :: vkrm = 0.40 + real (kind=kind_phys), parameter :: excm = 0.001 + real (kind=kind_phys), parameter :: beta = 1.0/270.0 + real (kind=kind_phys), parameter :: btg = beta*gs1 + real (kind=kind_phys), parameter :: elfc = vkrm*btg + real (kind=kind_phys), parameter :: wold = 0.15 + real (kind=kind_phys), parameter :: wnew = 1.0-wold + real (kind=kind_phys), parameter :: pihf = 3.14159265/2.0 ! con_pi/2.0 + + real (kind=kind_phys), parameter :: epsu2 = 1.e-4 + real (kind=kind_phys), parameter :: epsust = 0.07 + real (kind=kind_phys), parameter :: ztmin = -5.0 + real (kind=kind_phys), parameter :: ztmax = 1.0 + real (kind=kind_phys), parameter :: hpbl = 1000.0 + real (kind=kind_phys), parameter :: sqvisc = 258.2 + + real (kind=kind_phys), parameter :: ric = 0.183 + real (kind=kind_phys), parameter :: rric = 1.0/ric + real (kind=kind_phys), parameter :: fhneu = 0.8 + real (kind=kind_phys), parameter :: rfc = 0.191 + real (kind=kind_phys), parameter :: rfac = ric/(fhneu*rfc*rfc) + +! --- inputs: +! real (kind=kind_phys), intent(in) :: zlvl, z0, t1v, th2v, & +! & sfcspd, czil + +! --- input/outputs: +! real (kind=kind_phys), intent(inout) :: cm, ch + +! --- locals: + real (kind=kind_phys) :: zilfc, zu, zt, rdz, cxch, dthv, du2, & + & btgh, wstar2, ustar, zslu, zslt, rlogu, rlogt, rlmo, & + & zetalt, zetalu, zetau, zetat, xlu4, xlt4, xu4, xt4, & + & xlu, xlt, xu, xt, psmz, simm, pshz, simh, ustark, & + & rlmn, rlma + + integer :: ilech, itr + +! --- define local in-line functions: + + real (kind=kind_phys) :: pslmu, pslms, pslhu, pslhs, zz + real (kind=kind_phys) :: pspmu, pspms, psphu, psphs, xx, yy + +! ... 1) lech's surface functions + + pslmu( zz ) = -0.96 * log( 1.0-4.5*zz ) + pslms( zz ) = zz*rric - 2.076*(1.0 - 1.0/(zz + 1.0)) + pslhu( zz ) = -0.96 * log( 1.0-4.5*zz ) + pslhs( zz ) = zz*rfac - 2.076*(1.0 - 1.0/(zz + 1.0)) + +! ... 2) paulson's surface functions + + pspmu( xx ) = -2.0 * log( (xx + 1.0)*0.5 ) & + & - log( (xx*xx + 1.0)*0.5 ) + 2.0*atan(xx) - pihf + pspms( yy ) = 5.0 * yy + psphu( xx ) = -2.0 * log( (xx*xx + 1.0)*0.5 ) + psphs( yy ) = 5.0 * yy + +! +!===> ... begin here +! +! --- ... this routine sfcdif can handle both over open water (sea, ocean) and +! over solid surface (land, sea-ice). + + ilech = 0 + +! --- ... ztfc: ratio of zoh/zom less or equal than 1 +! czil: constant c in zilitinkevich, s. s.1995,:note about zt + + zilfc = -czil * vkrm * sqvisc + + zu = z0 + + rdz = 1.0 / zlvl + cxch = excm * rdz + dthv = th2v - t1v + du2 = max( sfcspd*sfcspd, epsu2 ) + +! --- ... beljars correction of ustar + + btgh = btg * hpbl + +! --- ... if statements to avoid tangent linear problems near zero + if (btgh*ch*dthv /= 0.0) then + wstar2 = wwst2 * abs( btgh*ch*dthv )**(2.0/3.0) + else + wstar2 = 0.0 + endif + + ustar = max( sqrt( cm*sqrt( du2+wstar2 ) ), epsust ) + +! --- ... zilitinkevitch approach for zt + + zt = exp( zilfc*sqrt( ustar*z0 ) ) * z0 + + zslu = zlvl + zu + zslt = zlvl + zt + +! print*,'zslt=',zslt +! print*,'zlvl=',zvll +! print*,'zt=',zt + + rlogu = log( zslu/zu ) + rlogt = log( zslt/zt ) + + rlmo = elfc*ch*dthv / ustar**3 + +! print*,'rlmo=',rlmo +! print*,'elfc=',elfc +! print*,'ch=',ch +! print*,'dthv=',dthv +! print*,'ustar=',ustar + + do itr = 1, itrmx + +! --- ... 1./ monin-obukkhov length-scale + + zetalt = max( zslt*rlmo, ztmin ) + rlmo = zetalt / zslt + zetalu = zslu * rlmo + zetau = zu * rlmo + zetat = zt * rlmo + + if (ilech == 0) then + + if (rlmo < 0.0) then + xlu4 = 1.0 - 16.0 * zetalu + xlt4 = 1.0 - 16.0 * zetalt + xu4 = 1.0 - 16.0 * zetau + xt4 = 1.0 - 16.0* zetat + + xlu = sqrt( sqrt( xlu4 ) ) + xlt = sqrt( sqrt( xlt4 ) ) + xu = sqrt( sqrt( xu4 ) ) + xt = sqrt( sqrt( xt4 ) ) + + psmz = pspmu(xu) + +! print*,'-----------1------------' +! print*,'psmz=',psmz +! print*,'pspmu(zetau)=',pspmu( zetau ) +! print*,'xu=',xu +! print*,'------------------------' + + simm = pspmu( xlu ) - psmz + rlogu + pshz = psphu( xt ) + simh = psphu( xlt ) - pshz + rlogt + else + zetalu = min( zetalu, ztmax ) + zetalt = min( zetalt, ztmax ) + psmz = pspms( zetau ) + +! print*,'-----------2------------' +! print*,'psmz=',psmz +! print*,'pspms(zetau)=',pspms( zetau ) +! print*,'zetau=',zetau +! print*,'------------------------' + + simm = pspms( zetalu ) - psmz + rlogu + pshz = psphs( zetat ) + simh = psphs( zetalt ) - pshz + rlogt + endif ! end if_rlmo_block + + else + +! --- ... lech's functions + + if (rlmo < 0.0) then + psmz = pslmu( zetau ) + +! print*,'-----------3------------' +! print*,'psmz=',psmz +! print*,'pslmu(zetau)=',pslmu( zetau ) +! print*,'zetau=',zetau +! print*,'------------------------' + + simm = pslmu( zetalu ) - psmz + rlogu + pshz = pslhu( zetat ) + simh = pslhu( zetalt ) - pshz + rlogt + else + zetalu = min( zetalu, ztmax ) + zetalt = min( zetalt, ztmax ) + + psmz = pslms( zetau ) + +! print*,'-----------4------------' +! print*,'psmz=',psmz +! print*,'pslms(zetau)=',pslms( zetau ) +! print*,'zetau=',zetau +! print*,'------------------------' + + simm = pslms( zetalu ) - psmz + rlogu + pshz = pslhs( zetat ) + simh = pslhs( zetalt ) - pshz + rlogt + endif ! end if_rlmo_block + + endif ! end if_ilech_block + +! --- ... beljaars correction for ustar + + ustar = max( sqrt( cm*sqrt( du2+wstar2 ) ), epsust ) + +! --- ... zilitinkevitch fix for zt + + zt = exp( zilfc*sqrt( ustar*z0 ) ) * z0 + + zslt = zlvl + zt + rlogt = log( zslt/zt ) + + ustark = ustar * vkrm + cm = max( ustark/simm, cxch ) + ch = max( ustark/simh, cxch ) + +! --- ... if statements to avoid tangent linear problems near zero + + if (btgh*ch*dthv /= 0.0) then + wstar2 = wwst2 * abs(btgh*ch*dthv) ** (2.0/3.0) + else + wstar2 = 0.0 + endif + + rlmn = elfc*ch*dthv / ustar**3 + rlma = rlmo*wold + rlmn*wnew + + rlmo = rlma + + enddo ! end do_itr_loop + +! print*,'----------------------------' +! print*,'sfcdif output ! ! ! ! ! ! ! ! ! ! ! !' +! +! print*,'zlvl=',zlvl +! print*,'z0=',z0 +! print*,'t1v=',t1v +! print*,'th2v=',th2v +! print*,'sfcspd=',sfcspd +! print*,'czil=',czil +! print*,'cm=',cm +! print*,'ch=',ch +! print*,'----------------------------' +! + return +!................................... + end subroutine sfcdif +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates snow fraction (0->1). + subroutine snfrac & +!................................... +! --- inputs: + & ( sneqv, snup, salp, snowh, & + & ztopv, zbotv, shdfac, xlai, shdfac, ua_phys & +! --- outputs: + & sncovr, fvb, gama, fbur, fgsn & + & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine snfrac calculatexsnow fraction (0 -> 1) ! +! ! +! subprogram called: none ! +! ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs from the calling program: size ! +! sneqv - real, snow water equivalent (m) 1 ! +! snup - real, threshold sneqv depth above which sncovr=1 1 ! +! salp - real, tuning parameter 1 ! +! snowh - real, snow depth (m) 1 ! +! ! +! outputs to the calling program: ! +! sncovr - real, fractional snow cover 1 ! +! ! +! ==================== end of description ===================== ! +! + implicit none +! --- inputs: + real (kind=kind_phys), intent(in) :: sneqv, snup, salp, snowh + logical, intent(in) :: ua_phys ! ua: flag for ua option + real (kind=kind_phys), intent(in) :: ztopv ! ua: height of canopy top + real (kind=kind_phys), intent(in) :: zbotv ! ua: height of canopy bottom + real (kind=kind_phys), intent(in) :: shdfac ! ua: vegetation fraction + + real (kind=kind_phys), intent(inout) :: xlai ! ua: lai modified by snow + + real (kind=kind_phys), parameter :: snupgrd = 0.02 ! ua: swe limit for ground cover + +! --- outputs: + real (kind=kind_phys), intent(out) :: sncovr + real (kind=kind_phys), intent(out) :: fvb ! ua: frac. veg. w/snow beneath + real (kind=kind_phys), intent(out) :: gama ! ua: = exp(-1.* xlai) + real (kind=kind_phys), intent(out) :: fbur ! ua: fraction of canopy buried + real (kind=kind_phys), intent(out) :: fgsn ! ua: ground snow cover fraction + +! --- locals: + real (kind=kind_phys) :: rsnow, z0n + +! +!===> ... begin here +! +! --- ... snup is veg-class dependent snowdepth threshhold (set in routine +! redprm) above which snocvr=1. + + if (sneqv < snup) then + rsnow = sneqv / snup + sncovr = 1.0 - (exp(-salp*rsnow) - rsnow*exp(-salp)) + else + sncovr = 1.0 + endif + + z0n = 0.035 + +! --- ... formulation of dickinson et al. 1986 + +! sncovr = snowh / (snowh + 5.0*z0n) + +! --- ... formulation of marshall et al. 1994 + +! sncovr = sneqv / (sneqv + 2.0*z0n) + + if(ua_phys) then + +! ---------------------------------------------------------------------- +! fgsn: fraction of soil covered with snow +! ---------------------------------------------------------------------- + if (sneqv < snupgrd) then + fgsn = sneqv / snupgrd + else + fgsn = 1.0 + end if +! ---------------------------------------------------------------------- +! fbur: vertical fraction of vegetation covered by snow +! grass, crop, and shrub: multiply 0.4 by ztopv and zbotv because +! they will be pressed down by the snow. +! forest: don't need to change ztopv and zbotv. +! ---------------------------------------------------------------------- + + if(zbotv > 0. .and. snowh > zbotv) then + if(zbotv <= 0.5) then + fbur = (snowh - 0.4*zbotv) / (0.4*(ztopv-zbotv)) ! short veg. + else + fbur = (snowh - zbotv) / (ztopv-zbotv) ! tall veg. + endif + else + fbur = 0. + endif + + fbur = min(max(fbur,0.0),1.0) + +! xlai is adjusted for vertical burying by snow + xlai = xlai * (1.0 - fbur) +! ---------------------------------------------------------------------- +! snow-covered soil: (1-shdfac)*fgsn +! vegetation with snow above due to burial fveg_sn_ab = shdfac*fbur +! snow on the ground that can be "seen" by satellite +! (if xlai goes to zero): gama*fvb +! where gama = exp(-xlai) +! ---------------------------------------------------------------------- + +! vegetation with snow below + fvb = shdfac * fgsn * (1.0 - fbur) + +! gama is used to divide fvb into two parts: +! gama=1 for xlai=0 and gama=0 for xlai=6 + gama = exp(-1.* xlai) + else + ! define intent(out) terms for .not. ua_phys case + fvb = 0.0 + gama = 0.0 + fbur = 0.0 + fgsn = 0.0 + end if ! ua_phys + +! + return +!................................... + end subroutine snfrac +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates soil moisture and heat flux values and +!! update soil moisture content and soil heat content values for the +!! case when a snow pack is present. + subroutine snopac +!................................... +! --- inputs: + & ( nsoil, nroot, etp, prcp, smcmax, smcwlt, smcref, smcdry, & + & cmcmax, dt, df1, sfcems, sfctmp, t24, th2, fdown, epsca, & + & bexp, pc, rch, rr, cfactr, slope, kdt, frzx, psisat, & + & zsoil, dwsat, dksat, zbot, shdfac, rtdis, quartz, & + & fxexp, csoil, flx2, snowng, & + & opt_thcnd, & +! --- input for fasdas (FDDA) (Not used for HAFS): + & qfx_phy, hcpct_fasdas, qfx_phy, fasdas, & +! --- input/inout for ua_phys: + & ua_phys, etpn, etpnd1, etp1n, flx4, & +! --- input/outputs: + & prcp1, cmc, t1, stc, sncovr, sneqv, sndens, snowh, & + & sh2o, tbot, beta, ribb, & + & sfhead1rt, infxs1rt, rtpnd1, & +! --- outputs: + & smc, ssoil, runoff1, runoff2, runoff3, edir, ec, et, & + & ett, snomlt, drip, dew, flx1, flx3, esnow, etns & + & hcpct_fasdas & + & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine snopac calculates soil moisture and heat flux values and ! +! update soil moisture content and soil heat content values for the ! +! case when a snow pack is present. ! +! ! +! ! +! subprograms called: evapo, smflx, shflx, snowpack +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs from the calling program: size ! +! nsoil - integer, number of soil layers 1 ! +! nroot - integer, number of root layers 1 ! +! etp - real, potential evaporation 1 ! +! prcp - real, precip rate 1 ! +! smcmax - real, porosity 1 ! +! smcwlt - real, wilting point 1 ! +! smcref - real, soil mois threshold 1 ! +! smcdry - real, dry soil mois threshold 1 ! +! cmcmax - real, maximum canopy water parameters 1 ! +! dt - real, time step 1 ! +! df1 - real, thermal diffusivity m ! +! sfcems - real, lw surface emissivity 1 ! +! sfctmp - real, sfc temperature 1 ! +! t24 - real, sfctmp**4 1 ! +! th2 - real, sfc air potential temperature 1 ! +! fdown - real, net solar + downward lw flux at sfc 1 ! +! epsca - real, 1 ! +! bexp - real, soil type "b" parameter 1 ! +! pc - real, plant coeff 1 ! +! rch - real, companion coefficient of ch 1 ! +! rr - real, 1 ! +! cfactr - real, canopy water parameters 1 ! +! slope - real, linear reservoir coefficient 1 ! +! kdt - real, 1 ! +! frzx - real, frozen ground parameter 1 ! +! psisat - real, saturated soil potential 1 ! +! zsoil - real, soil layer depth below ground (negative) nsoil ! +! dwsat - real, saturated soil diffusivity 1 ! +! dksat - real, saturated soil hydraulic conductivity 1 ! +! zbot - real, specify depth of lower bd soil 1 ! +! shdfac - real, aeral coverage of green vegetation 1 ! +! ice - integer, sea-ice flag (=1: sea-ice, =0: land) 1 ! +! rtdis - real, root distribution nsoil ! +! quartz - real, soil quartz content 1 ! +! fxexp - real, bare soil evaporation exponent 1 ! +! csoil - real, soil heat capacity 1 ! +! flx2 - real, freezing rain latent heat flux 1 ! +! snowng - logical, snow flag 1 ! +! ! +! input/outputs from and to the calling program: ! +! prcp1 - real, effective precip 1 ! +! cmc - real, canopy moisture content 1 ! +! t1 - real, ground/canopy/snowpack eff skin temp 1 ! +! stc - real, soil temperature nsoil ! +! sncovr - real, snow cover 1 ! +! sneqv - real, water-equivalent snow depth 1 ! +! sndens - real, snow density 1 ! +! snowh - real, snow depth 1 ! +! sh2o - real, unfrozen soil moisture nsoil ! +! tbot - real, bottom soil temperature 1 ! +! beta - real, ratio of actual/potential evap 1 ! +! ! +! outputs to the calling program: ! +! smc - real, total soil moisture nsoil ! +! ssoil - real, upward soil heat flux 1 ! +! runoff1 - real, surface runoff not infiltrating sfc 1 ! +! runoff2 - real, sub surface runoff 1 ! +! runoff3 - real, excess of porosity for a given soil layer 1 ! +! edir - real, direct soil evaporation 1 ! +! ec - real, canopy water evaporation 1 ! +! et - real, plant transpiration nsoil ! +! ett - real, total plant transpiration 1 ! +! snomlt - real, snow melt water equivalent 1 ! +! drip - real, through-fall of precip 1 ! +! dew - real, dewfall (or frostfall) 1 ! +! flx1 - real, precip-snow sfc flux 1 ! +! flx3 - real, phase-change heat flux from snowmelt 1 ! +! esnow - real, sublimation from snowpack 1 ! +! ! +! ==================== end of description ===================== ! +! +! --- constant parameters: + real, parameter :: esdmin = 1.e-6, lsubc = 2.501000e+6, & + & lsubs = 2.83e+6, snoexp = 2.0 + +! --- inputs: + integer, intent(in) :: nsoil, nroot, ice, ua_phys + + real (kind=kind_phys), intent(in) :: etp, prcp, smcmax, smcref, & + & smcwlt, smcdry, cmcmax, dt, df1, sfcems, sfctmp, t24, & + & th2, fdown, epsca, bexp, pc, rch, rr, cfactr, slope, kdt, & + & frzx, psisat, dwsat, dksat, zbot, shdfac, quartz, & + & opt_thcnd, csoil, fxexp, flx2, zsoil(nsoil), rtdis(nsoil) + + logical, intent(in) :: snowng + +! ---- ... ua_phys + real (kind=kind_phys), intent(inout) :: etpn + +! --- input/outputs: + real (kind=kind_phys), intent(inout) :: prcp1, t1, sncovr, sneqv, & + & sndens, snowh, cmc, tbot, beta, sh2o(nsoil), stc(nsoil), & + & esd, ribb, qsat + +!djg ndhms/wrf-hydro edit... + real (kind=kind_phys), intent(inout) :: sfhead1rt, infxs1rt, & + & etpnd1 + +! ---- ... ua_phys + real (kind=kind_phys), intent(inout) :: flx4 + + +! --- outputs: + real (kind=kind_phys), intent(out) :: ssoil, runoff1, runoff2, & + & runoff3, edir, ec, et(nsoil), ett, snomlt, drip, dew, & + & flx1, flx3, esnow, smc(nsoil), etns + +! --- locals: + real (kind=kind_phys):: denom, dsoil, dtot, etp1,etp2,etp3,ssoil1,& + & snoexp, ex, t11, t12, t12a, t12b, yy, zz1, seh, t14, & + & ec1, edir1, ett1, etns1, esnow1, esnow2, etanrg, rsnow, & + & et1(nsoil), sncond + +! ---- ... ua_phys + real (kind=kind_phys) :: etp1n + + integer :: k + +! --- ... fasdas + real (kind=kind_phys), dimension(nsoil) :: eft, wetty + real (kind=kind_phys) :: qfx_phy, hcpct_fasdas + integer :: fasdas + + +! --- ... convert potential evap (etp) from kg m-2 s-1 to m s-1 and then to an +! amount (m) given timestep (dt) and call it an effective snowpack +! reduction amount, esnow2 (m) for a snowcover fraction = 1.0. this is +! the amount the snowpack would be reduced due to sublimation from the +! snow sfc during the timestep. sublimation will proceed at the +! potential rate unless the snow depth is less than the expected +! snowpack reduction. for snowcover fraction = 1.0, 0=edir=et=ec, and +! hence total evap = esnow = sublimation (potential evap rate) + +! --- ... if sea-ice (ice=1) or glacial-ice (ice=-1), snowcover fraction = 1.0, +! and sublimation is at the potential rate. +! for non-glacial land (ice=0), if snowcover fraction < 1.0, total +! evaporation < potential due to non-potential contribution from +! non-snow covered fraction. + + prcp1 = prcp1 * 0.001 + + dew = 0.0 + edir = 0.0 + edir1 = 0.0 + + ec = 0.0 + ec1 = 0.0 + + do k = 1, nsoil + et (k) = 0.0 + et1(k) = 0.0 + enddo + + ett = 0.0 + ett1 = 0.0 + etns = 0.0 + etns1 = 0.0 + esnow = 0.0 + esnow1= 0.0 + esnow2= 0.0 + + etp1 = etp * 0.001 + +!djg ndhms/wrf-hydro edit... + etpnd1 = 0.0 + +! ---------------------------------------------------------------------- +! if etp<0 (downward) then dewfall (=frostfall in this case). +! ---------------------------------------------------------------------- + beta = 1.0 + + if (etp < 0.0) then + +! --- ... if etp<0 (downward) then dewfall (=frostfall in this case). + if ( ( ribb >= 0.1 ) .and. ( fdown > 150.0 ) ) then + etp=(min(etp*(1.0-ribb),0.)*sncovr/0.980 + & + & etp*(0.980-sncovr))/0.980 + endif + if(etp == 0.) beta = 0.0 + etp1 = etp * 0.001 + if(ua_phys) etp1n = etpn * 0.001 + dew = -etp1 + esnow2 = etp1*dt + etanrg = etp*((1.-sncovr)*lsubc + sncovr*lsubs) + else + etp1 = etp * 0.001 + if(ua_phys) etp1n = etpn * 0.001 + + ! land case + + if (sncovr < 1.0) then + + call evapo & +! --- inputs: + & ( nsoil, nroot, cmc, cmcmax, etp1, dt, zsoil, & + & sh2o, smcmax, smcwlt, smcref, smcdry, pc, & + & shdfac, cfactr, rtdis, fxexp, & +! --- outputs: + & etns1, edir1, ec1, et1, ett1 & + & ) + + edir1 = edir1 * (1.0 - sncovr) + ec1 = ec1 * (1.0 - sncovr) + + do k = 1, nsoil + et1(k) = et1(k) * (1.0 - sncovr) + enddo + + ett1 = ett1 * (1.0 - sncovr) + etns1 = etns1 * (1.0 - sncovr) + + edir = edir1 * 1000.0 + ec = ec1 * 1000.0 + + do k = 1, nsoil + et(k) = et1(k) * 1000.0 + enddo + +! +! fasdas +! + if( fasdas == 1 ) then + qfx_phy = edir + ec + do k=1,nsoil + qfx_phy = qfx_phy + et(k) + end do + endif +! +! end fasdas +! + + ett = ett1 * 1000.0 + etns = etns1 * 1000.0 + +!djg ndhms/wrf-hydro edit... + etpnd1 = etpnd1*1000. + + + endif ! end if_sncovr_block + + esnow = etp * sncovr +! esnow1 = etp * 0.001 + if(ua_phys) esnow = etpn*sncovr ! use adjusted etp + esnow1 = esnow * 0.001 + esnow2 = esnow1 * dt + etanrg = esnow*lsubs + etns*lsubc + + endif ! end if_etp_block + +! --- ... if precip is falling, calculate heat flux from snow sfc to newly +! accumulating precip. note that this reflects the flux appropriate for +! the not-yet-updated skin temperature (t1). assumes temperature of the +! snowfall striking the gound is =sfctmp (lowest model level air temp). + + flx1 = 0.0 + if ( snowng ) then +! --- ... fractional snowfall/rainfall + flx1 = cpice * prcp * (t1- sfctmp) + else + if (prcp > 0.0) flx1 = cph2o * prcp * (t1 - sfctmp) + endif + +! --- ... calculate an 'effective snow-grnd sfc temp' (t12) based on heat +! fluxes between the snow pack and the soil and on net radiation. +! include flx1 (precip-snow sfc) and flx2 (freezing rain latent +! heat) fluxes. +! flx2 reflects freezing rain latent heat flux using t1 calculated +! in penman. + + dsoil = -0.5 * zsoil(1) + dtot = snowh + dsoil + denom = 1.0 + df1 / (dtot * rr * rch) + +! t12a = ( (fdown - flx1 - flx2 - sigma1*t24) / rch & +! & + th2 - sfctmp - beta*epsca ) / rr + t12a = ( (fdown - flx1 - flx2 - sfcems*sigma*t24) / rch & + & + th2 - sfctmp - etanrg/rch ) / rr + + t12b = df1 * stc(1) / (dtot * rr * rch) + t12 = (sfctmp + t12a + t12b) / denom + +! --- ... if the 'effective snow-grnd sfc temp' is at or below freezing, no snow +! melt will occur. set the skin temp to this effective temp. reduce +! (by sublimination ) or increase (by frost) the depth of the snowpack, +! depending on sign of etp. +! update soil heat flux (ssoil) using new skin temperature (t1) +! since no snowmelt, set accumulated snowmelt to zero, set 'effective' +! precip from snowmelt to zero, set phase-change heat flux from snowmelt +! to zero. + + if (t12 <= tfreez) then + + t1 = t12 + ssoil = df1 * (t1 - stc(1)) / dtot +!wz ssoil = (t1 - stc (1)) * max(7.0, df1/dtot) + sneqv = max(0.0, sneqv-esnow2) + flx3 = 0.0 + ex = 0.0 + snomlt = 0.0 + + if(ua_phys) flx4 = 0.0 + + else + + +! --- ... if the 'effective snow-grnd sfc temp' is above freezing, snow melt +! will occur. call the snow melt rate,ex and amt, snomlt. revise the +! effective snow depth. revise the skin temp because it would have chgd +! due to the latent heat released by the melting. calc the latent heat +! released, flx3. set the effective precip, prcp1 to the snow melt rate, +! ex for use in smflx. adjustment to t1 to account for snow patches. +! calculate qsat valid at freezing point. note that esat (saturation +! vapor pressure) value of 6.11e+2 used here is that valid at frzzing +! point. note that etp from call penman in sflx is ignored here in +! favor of bulk etp over 'open water' at freezing temp. +! update soil heat flux (s) using new skin temperature (t1) + +! --- ... noah v2.7.1 mek feb2004 +! non-linear weighting of snow vs non-snow covered portions of gridbox +! so with snoexp = 2.0 (>1), surface skin temperature is higher than +! for the linear case (snoexp = 1). + +! t1 = tfreez * sncovr**snoexp + t12 * (1.0 - sncovr**snoexp) + t1 = tfreez * max(0.01,sncovr**snoexp) + & + & t12 * (1.0 - max(0.01,sncovr**snoexp)) + + beta = 1.0 + ssoil = df1 * (t1 - stc(1)) / dtot + +! --- ... if potential evap (sublimation) greater than depth of snowpack. +! beta<1 +! snowpack has sublimated away, set depth to zero. + + if (sneqv-esnow2 <= esdmin) then + + sneqv = 0.0 + ex = 0.0 + snomlt = 0.0 + flx3 = 0.0 + if(ua_phys) flx4 = 0.0 +! ---------------------------------------------------------------------- +! sublimation less than depth of snowpack +! snowpack (esd) reduced by esnow2 (depth of sublimated snow) +! ---------------------------------------------------------------------- + else + +! --- ... potential evap (sublimation) less than depth of snowpack, retain +! beta=1. + + sneqv = sneqv - esnow2 + etp3 = etp * lsubc + + seh = rch * (t1 - th2) + + t14 = t1 * t1 + t14 = t14 * t14 + + flx3 = fdown - flx1 - flx2 - sfcems*sigma*t14 & + & - ssoil - seh - etanrg + if (flx3 <= 0.0) flx3 = 0.0 + + + + if(ua_phys .and. flx4 > 0. .and. flx3 > 0.) then + if(flx3 >= flx4) then + flx3 = flx3 - flx4 + else + flx4 = flx3 + flx3 = 0. + endif + else + flx4 = 0.0 + endif + + + + ex = flx3 * 0.001 / lsubf + +! --- ... snowmelt reduction depending on snow cover +! if snow cover less than 5% no snowmelt reduction +! note: does 'if' below fail to match the melt water with the melt +! energy? + +! if (sncovr > 0.05) ex = ex * sncovr + snomlt = ex * dt + +! --- ... esdmin represents a snowpack depth threshold value below which we +! choose not to retain any snowpack, and instead include it in snowmelt. + + if (sneqv-snomlt >= esdmin) then + + sneqv = sneqv - snomlt + + else + +! --- ... snowmelt exceeds snow depth + + ex = sneqv / dt + flx3 = ex * 1000.0 * lsubf + snomlt = sneqv + sneqv = 0.0 + + endif ! end if_sneqv-snomlt_block + + endif ! end if_sneqv-esnow2_block + + prcp1 = prcp1 + ex + +! --- ... if non-glacial land, add snowmelt rate (ex) to precip rate to be used +! in subroutine smflx (soil moisture evolution) via infiltration. + +! --- ... for sea-ice and glacial-ice, the snowmelt will be added to subsurface +! runoff/baseflow later near the end of sflx (after return from call to +! subroutine snopac) + + + endif ! end if_t12<=tfreez_block + +! --- ... final beta now in hand, so compute evaporation. evap equals etp +! unless beta<1. + +! eta = beta * etp + +! --- ... smflx returns updated soil moisture values for non-glacial land. +! if sea-ice (ice=1) or glacial-ice (ice=-1), skip call to smflx, since +! no soil medium for sea-ice or glacial-ice + + + call smflx & +! --- inputs: + & ( nsoil, dt, kdt, smcmax, smcwlt, cmcmax, prcp1, & + & zsoil, slope, frzx, bexp, dksat, dwsat, shdfac, & + & edir1, ec1, et1, & +! --- input/outputs: + & cmc, sh2o, & +! --- wrf hydro input/outputs: + & fhead1rt,infxs1rt, & +! --- outputs: + & smc, runoff1, runoff2, runoff3, drip & + & ) + + endif + +! --- ... before call shflx in this snowpack case, set zz1 and yy arguments to +! special values that ensure that ground heat flux calculated in shflx +! matches that already computed for below the snowpack, thus the sfc +! heat flux to be computed in shflx will effectively be the flux at the +! snow top surface. t11 is a dummy arguement so we will not use the +! skin temp value as revised by shflx. + + zz1 = 1.0 + yy = stc(1) - 0.5*ssoil*zsoil(1)*zz1 / df1 + t11 = t1 + +! --- ... shflx will calc/update the soil temps. note: the sub-sfc heat flux +! (ssoil1) and the skin temp (t11) output from this shflx call are not +! used in any subsequent calculations. rather, they are dummy variables +! here in the snopac case, since the skin temp and sub-sfc heat flux are +! updated instead near the beginning of the call to snopac. + + call shflx & +! --- inputs: + & ( nsoil, smc, smcmax, dt, yy, zz1, zsoil, zbot, & + & psisat, bexp, df1, ice, quartz, csoil, vegtyp, & +! --- input/outputs: + & stc, t11, tbot, sh2o, & +! --- outputs: + & ssoil1 & + & ) + +! --- ... snow depth and density adjustment based on snow compaction. yy is +! assumed to be the soil temperture at the top of the soil column. + + + if (sneqv > 0.0) then + + call snowpack & +! --- inputs: + & ( sneqv, dtsec, tsnow, tsoil, & +! --- ua_phys inputs: + & ( snomlt, ua_phys, & +! --- input/outputs: + & snowh, sndens & + & ) + + else + + sneqv = 0.0 + snowh = 0.0 + sndens = 0.0 + sncond = 1.0 + sncovr = 0.0 + + endif ! end if_sneqv_block + +! + return +!................................... + end subroutine snopac +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates snow depth and densitity to account +!! for the new snowfall. new values of snow depth & density returned. + subroutine snow_new +!................................... +! --- inputs: + & ( sfctmp, sn_new, & +! --- input/outputs: + & snowh, sndens & + & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine snow_new calculates snow depth and densitity to account ! +! for the new snowfall. new values of snow depth & density returned. ! +! ! +! subprogram called: none ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs from the calling program: size ! +! sfctmp - real, surface air temperature (k) 1 ! +! sn_new - real, new snowfall (m) 1 ! +! ! +! input/outputs from and to the calling program: ! +! snowh - real, snow depth (m) 1 ! +! sndens - real, snow density 1 ! +! (g/cm3=dimensionless fraction of h2o density) ! +! ! +! ==================== end of description ===================== ! +! + implicit none +! --- inputs: + real(kind=kind_phys), intent(in) :: sfctmp, sn_new + +! --- input/outputs: + real(kind=kind_phys), intent(inout) :: snowh, sndens + +! --- locals: + real(kind=kind_phys) :: dsnew, snowhc, hnewc, newsnc, tempc + +! +!===> ... begin here +! +! --- ... conversion into simulation units + + snowhc = snowh * 100.0 + newsnc = sn_new * 100.0 + tempc = sfctmp - tfreez + +! --- ... calculating new snowfall density depending on temperature +! equation from gottlib l. 'a general runoff model for +! snowcovered and glacierized basin', 6th nordic hydrological +! conference, vemadolen, sweden, 1980, 172-177pp. + + if (tempc <= -15.0) then + dsnew = 0.05 + else + dsnew = 0.05 + 0.0017*(tempc + 15.0)**1.5 + endif + +! --- ... adjustment of snow density depending on new snowfall + + hnewc = newsnc / dsnew + if (snowhc + hnewc < 1.0e-3) then + sndens = max(dsnew,sndens) + else + sndens = (snowhc * sndens + hnewc * dsnew)/ (snowhc + hnewc) + endif + snowhc = snowhc + hnewc + snowh = snowhc * 0.01 +! + return +!................................... + end subroutine snow_new +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates total roughness length over snow. + subroutine snowz0 +!................................... +! --- inputs: + & ( sncovr,z0brd,snowh,fbur,fgsn,shdmax,ua_phys, & +! --- input/outputs: + & z0 & +! & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine snowz0 calculates total roughness length over snow ! +! ! +! subprogram called: none ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs from the calling program: size ! +! sncovr - real, fractional snow cover 1 ! +! ! +! input/outputs from and to the calling program: ! +! z0 - real, roughness length (m) 1 ! +! ! +! ==================== end of description ===================== ! +! + implicit none +! --- inputs: + real(kind=kind_phys), intent(in) :: sncovr, z0brd, snowh, fbur + real(kind=kind_phys), intent(in) :: fgsn, shdmax, snowh + +! --- outputs: + real(kind=kind_phys), intent(out) :: z0 + +! --- logical: + logical :: ua_phys +! --- parameters: + real(kind=kind_phys), parameter :: z0s = 0.001, z0g = 0.01 +! --- locals: + real (kind_phys) :: burial, z0eff, fv, a1, a2 +! +!===> ... begin here +! + + if(ua_phys) then + + fv = shdmax * (1.-fbur) + a1 = (1.-fv)**2*((1.-fgsn**2)*log(z0g) + (fgsn**2)*log(z0s)) + a2 = (1.-(1.-fv)**2)*log(z0brd) + z0 = exp(a1+a2) + + else + +!m z0 = (1.- sncovr)* z0brd + sncovr * z0s + burial = 7.0*z0brd - snowh + if(burial.le.0.0007) then + z0eff = z0s + else + z0eff = burial/7.0 + endif + + z0 = (1.- sncovr)* z0brd + sncovr * z0eff + + endif + + +! + return +!................................... + end subroutine snowz0 +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates thermal diffusivity and conductivity +!! of the soil for a given point and time. + subroutine tdfcnd & +! --- inputs: + & ( smc, qz, smcmax, sh2o, bexp, psisat, soiltyp, opt_thcnd, & +! --- outputs: + & df & + & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine tdfcnd calculates thermal diffusivity and conductivity ! +! of the soil for a given point and time. ! +! ! +! peters-lidard approach (peters-lidard et al., 1998) ! +! june 2001 changes: frozen soil condition. ! +! ! +! subprogram called: none ! +! ! +! use as in peters-lidard, 1998 (modif. from johansen, 1975). ! +! pablo grunmann, 08/17/98 ! +! refs.: ! +! farouki, o.t.,1986: thermal properties of soils. series on rock ! +! and soil mechanics, vol. 11, trans tech, 136 pp. ! +! johansen, o., 1975: thermal conductivity of soils. ph.d. thesis, ! +! university of trondheim, ! +! peters-lidard, c. d., et al., 1998: the effect of soil thermal ! +! conductivity parameterization on surface energy fluxes ! +! and temperatures. journal of the atmospheric sciences, ! +! vol. 55, pp. 1209-1224. ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! smc - real, top layer total soil moisture 1 ! +! qz - real, quartz content (soil type dependent) 1 ! +! smcmax - real, porosity 1 ! +! sh2o - real, top layer unfrozen soil moisture 1 ! +! bexp - real, soil type "b" parameter 1 ! +! psisat - real, saturated soil potential 1 ! +! soiltyp - integer, soil type 1 ! +! opt_thcnd- integer, option to treat thermal conductivity 1 ! +! ! +! outputs: ! +! df - real, soil thermal diffusivity and conductivity 1 ! +! ! +! locals: ! +! thkw - water thermal conductivity 1 ! +! thkqtz - thermal conductivity for quartz 1 ! +! thko - thermal conductivity for other soil components 1 ! +! thkqtz - thermal conductivity for the solids combined 1 ! +! thkice - ice thermal conductivity 1 ! +! ! +! ! +! ==================== end of description ===================== ! +! + implicit none +! --- input: + real (kind=kind_phys), intent(in) :: smc, qz, smcmax, sh2o + +! --- output: + real (kind=kind_phys), intent(out) :: df + +! --- locals: + real (kind=kind_phys) :: gammd, thkdry, ake, thkice, thko, & + & thkqtz, thksat, thks, thkw, satratio, xu, xunfroz, & + & akei, akel, psif, pf +! +!===> ... begin here +! +! --- ... if the soil has any moisture content compute a partial sum/product +! otherwise use a constant value which works well with most soils + + if ( opt_thcnd == 1 .or. ( opt_thcnd == 2 .and. (soiltyp /= 4 & + & .and. soiltyp /= 3)) )then +! --- ... saturation ratio: +! --- ... parameters w/(m.k) + + satratio = smc / smcmax + +! --- ... ice conductivity + thkice = 2.2 + +! --- ... water conductivity + thkw = 0.57 +! --- ... thermal conductivity of "other" soil components + thko = 2.0 +! if (qz <= 0.2) thko = 3.0 + +! --- ... quartz conductivity + thkqtz = 7.7 + +! --- ... solids' conductivity + + thks = (thkqtz**qz) * (thko**(1.0-qz)) + +! --- ... unfrozen fraction (from 1., i.e., 100%liquid, to 0. (100% frozen)) + + xunfroz = (sh2o) / (smc) + +! --- ... unfrozen volume for saturation (porosity*xunfroz) + + xu=xunfroz*smcmax + +! --- ... saturated thermal conductivity + + thksat = thks**(1.-smcmax) * thkice**(smcmax-xu) * thkw**(xu) + +! --- ... dry density in kg/m3 + + gammd = (1.0 - smcmax) * 2700.0 + +! --- ... dry thermal conductivity in w.m-1.k-1 + + thkdry = (0.135*gammd + 64.7) / (2700.0 - 0.947*gammd) + +! --- ... frozen + akei = satratio + +! --- ... unfrozen + +! --- ... range of validity for the kersten number (ake) + if ( satratio > 0.1 ) then + +! --- ... kersten number (using "fine" formula, valid for soils containing +! at least 5% of particles with diameter less than 2.e-6 meters.) +! (for "coarse" formula, see peters-lidard et al., 1998). + + akel = log10( satratio ) + 1.0 + + else + +! --- ... use k = kdry + akel = 0.0 + + endif ! end if_satratio_block + + ake = ((smc-sh2o)*akei + sh2o*akel)/smc + +! --- ... thermal conductivity + + df = ake * (thksat - thkdry) + thkdry + + else ! opt_thcnd + +! --- ... use the mccumber and pielke approach for silt loam (4), sandy loam (3) + + psif = psisat*100.*(smcmax/(smc))**bexp +! --- ... psif should be in [cm] to compute pf + pf=log10(abs(psif)) +! --- ... hk is for mccumber thermal conductivity + if(pf.le.5.1) then + df=420.*exp(-(pf+2.7)) + else + df=.1744 + end if + + endif ! for opt_thcnd options +! + return +!................................... + end subroutine tdfcnd +!----------------------------------- + + +!*********************************************! +! section-2 2nd level subprograms ! +!*********************************************! + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates soil moisture flux. The soil moisture +!! content (smc - a per unit volume measurement) is a dependent variable +!! that is updated with prognostic equations. The canopy moisture content +!! (cmc) is also updated. Frozen ground version: new states added: sh2o, +!! and frozen ground correction factor, frzfact and paramter slope. + subroutine evapo & +! --- inputs: + & ( nsoil, nroot, cmc, cmcmax, etp1, dt, zsoil, & + & sh2o, smcmax, smcwlt, smcref, smcdry, pc, & + & shdfac, cfactr, rtdis, fxexp, & +! --- outputs: + & eta1, edir1, ec1, et1, ett1 & + & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine evapo calculates soil moisture flux. the soil moisture ! +! content (smc - a per unit volume measurement) is a dependent variable! +! that is updated with prognostic eqns. the canopy moisture content ! +! (cmc) is also updated. frozen ground version: new states added: ! +! sh2o, and frozen ground correction factor, frzfact and parameter ! +! slope. ! +! ! +! ! +! subprogram called: devap, transp ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs from calling program: size ! +! nsoil - integer, number of soil layers 1 ! +! nroot - integer, number of root layers 1 ! +! cmc - real, canopy moisture content 1 ! +! cmcmax - real, maximum canopy water parameters 1 ! +! etp1 - real, potential evaporation 1 ! +! dt - real, time step 1 ! +! zsoil - real, soil layer depth below ground nsoil ! +! sh2o - real, unfrozen soil moisture nsoil ! +! smcmax - real, porosity 1 ! +! smcwlt - real, wilting point 1 ! +! smcref - real, soil mois threshold 1 ! +! smcdry - real, dry soil mois threshold 1 ! +! pc - real, plant coeff 1 ! +! cfactr - real, canopy water parameters 1 ! +! rtdis - real, root distribution nsoil ! +! fxexp - real, bare soil evaporation exponent 1 ! +! ! +! outputs to calling program: ! +! eta1 - real, latent heat flux 1 ! +! edir1 - real, direct soil evaporation 1 ! +! ec1 - real, canopy water evaporation 1 ! +! et1 - real, plant transpiration nsoil ! +! ett1 - real, total plant transpiration 1 ! +! ! +! ==================== end of description ===================== ! +! + implicit none +! --- inputs: + integer, intent(in) :: nsoil, nroot + + real (kind=kind_phys), intent(in) :: cmc, cmcmax, etp1, dt, pc, & + & smcmax, smcwlt, smcref, smcdry, shdfac, cfactr, fxexp, & + & zsoil(nsoil), sh2o(nsoil), rtdis(nsoil) + +! --- outputs: + real (kind=kind_phys), intent(out) :: eta1, edir1, ec1, ett1, & + & et1(nsoil) + +! --- locals: + real (kind=kind_phys) :: cmc2ms + + integer :: i, k + +! +!===> ... begin here +! +! --- ... executable code begins here if the potential evapotranspiration +! is greater than zero. + + edir1 = 0.0 + ec1 = 0.0 + + do k = 1, nsoil + et1(k) = 0.0 + enddo + ett1 = 0.0 + + if (etp1 > 0.0) then + +! --- ... retrieve direct evaporation from soil surface. call this function +! only if veg cover not complete. +! frozen ground version: sh2o states replace smc states. + + if (shdfac < 1.0) then + + call devap & +! --- inputs: + & ( etp1, sh2o(1), shdfac, smcmax, smcdry, fxexp, & +! --- outputs: + & edir1 & + & ) + + endif + +! --- ... initialize plant total transpiration, retrieve plant transpiration, +! and accumulate it for all soil layers. + + if (shdfac > 0.0) then + + call transp & +! --- inputs: + & ( nsoil, nroot, etp1, sh2o, smcwlt, smcref, & + & cmc, cmcmax, zsoil, shdfac, pc, cfactr, rtdis, & +! --- outputs: + & et1 & + & ) + + do k = 1, nsoil + ett1 = ett1 + et1(k) + enddo + +! --- ... calculate canopy evaporation. +! if statements to avoid tangent linear problems near cmc=0.0. + + if (cmc > 0.0) then + ec1 = shdfac * ( (cmc/cmcmax)**cfactr ) * etp1 + else + ec1 = 0.0 + endif + +! --- ... ec should be limited by the total amount of available water +! on the canopy. -f.chen, 18-oct-1994 + + cmc2ms = cmc / dt + ec1 = min ( cmc2ms, ec1 ) + endif + + endif ! end if_etp1_block + +! --- ... total up evap and transp types to obtain actual evapotransp + + eta1 = edir1 + ett1 + ec1 + +! + return +!................................... + end subroutine evapo +!----------------------------------- + + subroutine fac2mit +! --- input + & (smcmax, +! --- output + & flimit) + + implicit none + real, intent(in) :: smcmax + real, intent(out) :: flimit + + flimit = 0.90 + + if ( smcmax == 0.395 ) then + flimit = 0.59 + else if ( ( smcmax == 0.434 ) .or. ( smcmax == 0.404 ) ) then + flimit = 0.85 + else if ( ( smcmax == 0.465 ) .or. ( smcmax == 0.406 ) ) then + flimit = 0.86 + else if ( ( smcmax == 0.476 ) .or. ( smcmax == 0.439 ) ) then + flimit = 0.74 + else if ( ( smcmax == 0.200 ) .or. ( smcmax == 0.464 ) ) then + flimit = 0.80 + endif + +! ---------------------------------------------------------------------- + return +! ---------------------------------------------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine updates the temperature state of the soil column +!! based on the thermal diffusion equation and update the frozen soil +!! moisture content based on the temperature. + subroutine shflx & +! --- inputs: + & ( nsoil, smc, smcmax, dt, yy, zz1, zsoil, zbot, & + & psisat, bexp, df1, ice, quartz, csoil, vegtyp, & +! --- input/outputs: + & stc, t1, tbot, sh2o, & +! --- outputs: + & ssoil & + & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine shflx updates the temperature state of the soil column ! +! based on the thermal diffusion equation and update the frozen soil ! +! moisture content based on the temperature. ! +! ! +! subprogram called: hstep, hrtice, hrt ! +! ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! nsoil - integer, number of soil layers 1 ! +! smc - real, total soil moisture nsoil ! +! smcmax - real, porosity (sat val of soil mois) 1 ! +! dt - real, time step 1 ! +! yy - real, soil temperature at the top of column 1 ! +! zz1 - real, 1 ! +! zsoil - real, soil layer depth below ground (negative) nsoil ! +! zbot - real, specify depth of lower bd soil 1 ! +! psisat - real, saturated soil potential 1 ! +! bexp - real, soil type "b" parameter 1 ! +! df1 - real, thermal diffusivity and conductivity 1 ! +! ice - integer, sea-ice flag (=1: sea-ice, =0: land) 1 ! +! quartz - real, soil quartz content 1 ! +! csoil - real, soil heat capacity 1 ! +! vegtyp - integer, vegtation type 1 ! +! ! +! input/outputs: ! +! stc - real, soil temp nsoil ! +! t1 - real, ground/canopy/snowpack eff skin temp 1 ! +! tbot - real, bottom soil temp 1 ! +! sh2o - real, unfrozen soil moisture nsoil ! +! ! +! outputs: ! +! ssoil - real, upward soil heat flux 1 ! +! ! +! ==================== end of description ===================== ! +! +! --- parameter constants: + real (kind=kind_phys), parameter :: ctfil1 = 0.5 + real (kind=kind_phys), parameter :: ctfil2 = 1.0 - ctfil1 + +! --- inputs: + integer, intent(in) :: nsoil, ice, vegtyp + + real (kind=kind_phys), intent(in) :: smc(nsoil), smcmax, dt, yy, & + & zz1, zsoil(nsoil), zbot, psisat, bexp, df1, quartz, csoil + +! --- input/outputs: + real (kind=kind_phys), intent(inout) :: stc(nsoil), t1, tbot, & + & sh2o(nsoil) + +! --- outputs: + real (kind=kind_phys), intent(out) :: ssoil + +! --- locals: + real (kind=kind_phys) :: ai(nsold), bi(nsold), ci(nsold), oldt1, & + & rhsts(nsold), stcf(nsold), stsoil(nsoil) + + integer :: i + +! +!===> ... begin here +! + oldt1 = t1 + do i = 1, nsoil + stsoil(i) = stc(i) + enddo + +! --- ... hrt routine calcs the right hand side of the soil temp dif eqn + + if (ice /= 0) then + +! --- ... sea-ice case, glacial-ice case + + call hrtice & +! --- inputs: + & ( nsoil, stc, zsoil, yy, zz1, df1, ice, & +! --- input/outputs: + & tbot, & +! --- outputs: + & rhsts, ai, bi, ci & + & ) + + call hstep & +! --- inputs: + & ( nsoil, stc, dt, & +! --- input/outputs: + & rhsts, ai, bi, ci, & +! --- outputs: + & stcf & + & ) + + else + +! --- ... land-mass case + + call hrt & +! --- inputs: + & ( nsoil, stc, smc, smcmax, zsoil, yy, zz1, tbot, & + & zbot, psisat, dt, bexp, df1, quartz, csoil,vegtyp, & + & shdfac, & +! --- input/outputs: + & sh2o, & +! --- outputs: + & rhsts, ai, bi, ci & + & ) + + call hstep & +! --- inputs: + & ( nsoil, stc, dt, & +! --- input/outputs: + & rhsts, ai, bi, ci, & +! --- outputs: + & stcf & + & ) + + endif + + do i = 1, nsoil + stc(i) = stcf(i) + enddo + +! --- ... in the no snowpack case (via routine nopac branch,) update the grnd +! (skin) temperature here in response to the updated soil temperature +! profile above. (note: inspection of routine snopac shows that t1 +! below is a dummy variable only, as skin temperature is updated +! differently in routine snopac) + + t1 = (yy + (zz1 - 1.0)*stc(1)) / zz1 + t1 = ctfil1*t1 + ctfil2*oldt1 + + do i = 1, nsoil + stc(i) = ctfil1*stc(i) + ctfil2*stsoil(i) + enddo + +! --- ... calculate surface soil heat flux + + ssoil = df1*(stc(1) - t1) / (0.5*zsoil(1)) + +! + return +!................................... + end subroutine shflx +!----------------------------------- + + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates soil moisture flux. The soil moisture +!! content (smc - a per unit vulume measurement) is a dependent variable +!! that is updated with prognostic equations. The canopy moisture content +!! (cmc) is also updated. Frozen ground version: new states added: sh2o and +!! frozen ground correction factor, frzx and parameter slope. + subroutine smflx & +! --- inputs: + & ( nsoil, dt, kdt, smcmax, smcwlt, cmcmax, prcp1, & + & zsoil, slope, frzx, bexp, dksat, dwsat, shdfac, & + & edir1, ec1, et1, & +! --- input/outputs: + & cmc, sh2o, & +! --- wrf hydro input/outputs: + & fhead1rt,infxs1rt, & +! --- outputs: + & smc, runoff1, runoff2, runoff3, drip & + & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine smflx calculates soil moisture flux. the soil moisture ! +! content (smc - a per unit volume measurement) is a dependent variable! +! that is updated with prognostic eqns. the canopy moisture content ! +! (cmc) is also updated. frozen ground version: new states added: sh2o! +! and frozen ground correction factor, frzx and parameter slope. ! +! ! +! ! +! subprogram called: srt, sstep ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! nsoil - integer, number of soil layers 1 ! +! dt - real, time step 1 ! +! kdt - real, 1 ! +! smcmax - real, porosity 1 ! +! smcwlt - real, wilting point 1 ! +! cmcmax - real, maximum canopy water parameters 1 ! +! prcp1 - real, effective precip 1 ! +! zsoil - real, soil layer depth below ground (negative) nsoil ! +! slope - real, linear reservoir coefficient 1 ! +! frzx - real, frozen ground parameter 1 ! +! bexp - real, soil type "b" parameter 1 ! +! dksat - real, saturated soil hydraulic conductivity 1 ! +! dwsat - real, saturated soil diffusivity 1 ! +! shdfac - real, aeral coverage of green veg 1 ! +! edir1 - real, direct soil evaporation 1 ! +! ec1 - real, canopy water evaporation 1 ! +! et1 - real, plant transpiration nsoil ! +! ! +! input/outputs: ! +! cmc - real, canopy moisture content 1 ! +! sh2o - real, unfrozen soil moisture nsoil ! +! ! +! outputs: ! +! smc - real, total soil moisture nsoil ! +! runoff1 - real, surface runoff not infiltrating sfc 1 ! +! runoff2 - real, sub surface runoff (baseflow) 1 ! +! runoff3 - real, excess of porosity 1 ! +! drip - real, through-fall of precip and/or dew 1 ! +! ! +! ==================== end of description ===================== ! +! + implicit none +! --- inputs: + integer, intent(in) :: nsoil + + real (kind=kind_phys), intent(in) :: dt, kdt, smcmax, smcwlt, & + & cmcmax, prcp1, slope, frzx, bexp, dksat, dwsat, shdfac, & + & edir1, ec1, et1(nsoil), zsoil(nsoil) + +! --- input/outputs: + real (kind=kind_phys), intent(inout) :: cmc, sh2o(nsoil) + real (kind=kind_phys), intent(inout) :: smc(nsoil) + +! --- wrf hydro input/output + real (kind=kind_phys), intent(inout) :: sfhead1rt,infxs1rt + +! --- outputs: + real (kind=kind_phys), intent(out) :: runoff1, & + & runoff2, runoff3, drip + +! --- locals: + real (kind=kind_phys) :: dummy, excess, pcpdrp, rhsct, trhsct, & + & rhstt(nsoil), sice(nsoil), sh2oa(nsoil), sh2ofg(nsoil), & + & ai(nsoil), bi(nsoil), ci(nsoil), stcf(nsoil), rhsts(nsoil) + + integer :: i, k +! +!===> ... begin here +! +! --- ... executable code begins here. + + dummy = 0.0 + +! --- ... compute the right hand side of the canopy eqn term ( rhsct ) + + rhsct = shdfac*prcp1 - ec1 + +! --- ... convert rhsct (a rate) to trhsct (an amount) and add it to +! existing cmc. if resulting amt exceeds max capacity, it becomes +! drip and will fall to the grnd. + + drip = 0.0 + trhsct = dt * rhsct + excess = cmc + trhsct + + if (excess > cmcmax) drip = excess - cmcmax + +! --- ... pcpdrp is the combined prcp1 and drip (from cmc) that goes into +! the soil + + pcpdrp = (1.0 - shdfac)*prcp1 + drip/dt + +! --- ... store ice content at each soil layer before calling srt & sstep + + do i = 1, nsoil + sice(i) = smc(i) - sh2o(i) + enddo + +! --- ... call subroutines srt and sstep to solve the soil moisture +! tendency equations. + +! --- if the infiltrating precip rate is nontrivial, +! (we consider nontrivial to be a precip total over the time step +! exceeding one one-thousandth of the water holding capacity of +! the first soil layer) +! then call the srt/sstep subroutine pair twice in the manner of +! time scheme "f" (implicit state, averaged coefficient) +! of section 2 of kalnay and kanamitsu (1988, mwr, vol 116, +! pages 1945-1958)to minimize 2-delta-t oscillations in the +! soil moisture value of the top soil layer that can arise because +! of the extreme nonlinear dependence of the soil hydraulic +! diffusivity coefficient and the hydraulic conductivity on the +! soil moisture state +! otherwise call the srt/sstep subroutine pair once in the manner of +! time scheme "d" (implicit state, explicit coefficient) +! of section 2 of kalnay and kanamitsu +! pcpdrp is units of kg/m**2/s or mm/s, zsoil is negative depth in m + +! ---------------------------------------------------------------------- +! according to dr. ken mitchell's suggestion, add the second contraint +! to remove numerical instability of runoff and soil moisture +! flimit is a limit value for fac2 + fac2=0.0 + do i=1,nsoil + fac2=max(fac2,sh2o(i)/smcmax) + enddo + call fac2mit(smcmax,flimit) + +! ---------------------------------------------------------------------- +! frozen ground version: +! smc states replaced by sh2o states in srt subr. sh2o & sice states +! inc&uded in sstep subr. frozen ground correction factor, frzfact +! added. all water balance calculations using unfrozen water +! ---------------------------------------------------------------------- + + +! if ( pcpdrp .gt. 0.0 ) then + if ( ( (pcpdrp * dt) > (0.0001*1000.0* (- zsoil (1))* smcmax) ) & + .or. (fac2 > flimit) ) then + +! --- ... frozen ground version: +! smc states replaced by sh2o states in srt subr. sh2o & sice states +! included in sstep subr. frozen ground correction factor, frzx +! added. all water balance calculations using unfrozen water + + call srt & +! --- inputs: + & ( nsoil, edir1, et1, sh2o, sh2o, pcpdrp, zsoil, dwsat, & + & dksat, smcmax, bexp, dt, smcwlt, slope, kdt, frzx, sice, & +! --- outputs: + & rhstt, runoff1, runoff2, ai, bi, ci & + & ) + + call sstep & +! --- inputs: + & ( nsoil, sh2o, rhsct, dt, smcmax, cmcmax, zsoil, sice, & +! --- input/outputs: + & dummy, rhstt, ai, bi, ci, & +! --- outputs: + & sh2ofg, runoff3, smc & + & ) + + do k = 1, nsoil + sh2oa(k) = (sh2o(k) + sh2ofg(k)) * 0.5 + enddo + + call srt & +! --- inputs: + & ( nsoil, edir1, et1, sh2o, sh2oa, pcpdrp, zsoil, dwsat, & + & dksat, smcmax, bexp, dt, smcwlt, slope, kdt, frzx, sice, & +! --- outputs: + & rhstt, runoff1, runoff2, ai, bi, ci & + & ) + + call sstep & +! --- inputs: + & ( nsoil, sh2o, rhsct, dt, smcmax, cmcmax, zsoil, sice, & +! --- input/outputs: + & cmc, rhstt, ai, bi, ci, & +! --- outputs: + & sh2o, runoff3, smc & + & ) + + else + + call srt & +! --- inputs: + & ( nsoil, edir1, et1, sh2o, sh2o, pcpdrp, zsoil, dwsat, & + & dksat, smcmax, bexp, dt, smcwlt, slope, kdt, frzx, sice, & +! --- outputs: + & rhstt, runoff1, runoff2, ai, bi, ci & + & ) + + call sstep & +! --- inputs: + & ( nsoil, sh2o, rhsct, dt, smcmax, cmcmax, zsoil, sice, & +! --- input/outputs: + & cmc, rhstt, ai, bi, ci, & +! --- outputs: + & sh2o, runoff3, smc & + & ) + + endif + +! + return +!................................... + end subroutine smflx +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates compaction of a snowpack under conditions of +!! increasing snow density, as obtained from an approximate solution of +!! E. Anderson's differential equation (3.29),NOAA technical report NWS 19, +!! by Victor Koren, 03/25/95. subroutine will return new values of \a snowh +!! and \a sndens . + subroutine snowpack & +! --- inputs: + & ( sneqv, dtsec, tsnow, tsoil, & +! --- ua_phys inputs: + & ( snomlt, ua_phys, & +! --- input/outputs: + & snowh, sndens & + & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine snowpack calculates compaction of snowpack under ! +! conditions of increasing snow density, as obtained from an ! +! approximate solution of e. anderson's differential equation (3.29),! +! noaa technical report nws 19, by victor koren, 03/25/95. ! +! subroutine will return new values of snowh and sndens ! +! ! +! ! +! subprogram called: none ! +! ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! esd - real, water equivalent of snow (m) 1 ! +! dtsec - real, time step (sec) 1 ! +! tsnow - real, snow surface temperature (k) 1 ! +! tsoil - real, soil surface temperature (k) 1 ! +! ! +! input/outputs: ! +! snowh - real, snow depth (m) 1 ! +! sndens - real, snow density 1 ! +! (g/cm3=dimensionless fraction of h2o density) ! +! ! +! ==================== end of description ===================== ! +! + implicit none +! --- parameter constants: + real (kind=kind_phys), parameter :: c1 = 0.01 + real (kind=kind_phys), parameter :: c2 = 21.0 + real (kind=kind_phys), parameter :: kn = 4000.0 + +! --- inputs: + real (kind=kind_phys), intent(in) :: sneqv, dtsec, tsnow, tsoil + logical, intent(in) :: ua_phys ! ua: flag for ua option + real (kind=kind_phys), intent(in) :: snomlt ! ua: snow melt [m] + +! --- input/outputs: + real (kind=kind_phys), intent(inout) :: snowh, sndens + +! --- locals: + real (kind=kind_phys) :: bfac, dsx, dthr, dw, snowhc, pexp, & + & tavgc, tsnowc, tsoilc, esdc, esdcx + real (kind=kind_phys) :: snomltc ! ua: snow melt [cm] + + integer :: ipol, j +! +!===> ... begin here +! +! --- ... conversion into simulation units + + snowhc = snowh * 100.0 + esdc = sneqv * 100.0 + dthr = dtsec / 3600.0 + if(ua_phys) snomltc = snomlt * 100.0 + tsnowc = tsnow - tfreez + tsoilc = tsoil - tfreez + +! --- ... calculating of average temperature of snow pack + + tavgc = 0.5 * (tsnowc + tsoilc) + +! --- ... calculating of snow depth and density as a result of compaction +! sndens=ds0*(exp(bfac*esd)-1.)/(bfac*esd) +! bfac=dthr*c1*exp(0.08*tavgc-c2*ds0) +! note: bfac*esd in sndens eqn above has to be carefully treated +! numerically below: +! c1 is the fractional increase in density (1/(cm*hr)) +! c2 is a constant (cm3/g) kojima estimated as 21 cms/g + + if (esdc > 1.e-2) then + esdcx = esdc + else + esdcx = 1.e-2 + endif + + bfac = dthr*c1 * exp(0.08*tavgc - c2*sndens) + +! dsx = sndens * ((dexp(bfac*esdc)-1.0) / (bfac*esdc)) + +! --- ... the function of the form (e**x-1)/x imbedded in above expression +! for dsx was causing numerical difficulties when the denominator "x" +! (i.e. bfac*esdc) became zero or approached zero (despite the fact +! that the analytical function (e**x-1)/x has a well defined limit +! as "x" approaches zero), hence below we replace the (e**x-1)/x +! expression with an equivalent, numerically well-behaved +! polynomial expansion. + +! --- ... number of terms of polynomial expansion, and hence its accuracy, +! is governed by iteration limit "ipol". +! ipol greater than 9 only makes a difference on double +! precision (relative errors given in percent %). +! ipol=9, for rel.error <~ 1.6 e-6 % (8 significant digits) +! ipol=8, for rel.error <~ 1.8 e-5 % (7 significant digits) +! ipol=7, for rel.error <~ 1.8 e-4 % ... + + ipol = 4 + pexp = 0.0 + + do j = ipol, 1, -1 +! pexp = (1.0 + pexp)*bfac*esdc /real(j+1) + pexp = (1.0 + pexp)*bfac*esdcx/real(j+1) + enddo + pexp = pexp + 1. + + dsx = sndens * pexp + +! --- ... above line ends polynomial substitution +! end of koren formulation + +!! --- ... base formulation (cogley et al., 1990) +! convert density from g/cm3 to kg/m3 + +!! dsm = sndens * 1000.0 + +!! dsx = dsm + dtsec*0.5*dsm*gs2*esd / & +!! & (1.e7*exp(-0.02*dsm + kn/(tavgc+273.16)-14.643)) + +!! --- ... convert density from kg/m3 to g/cm3 + +!! dsx = dsx / 1000.0 + +!! --- ... end of cogley et al. formulation + +! --- ... set upper/lower limit on snow density + + dsx = max( min( dsx, 0.40 ), 0.05 ) + sndens = dsx + +! --- ... update of snow depth and density depending on liquid water +! during snowmelt. assumed that 13% of liquid water can be +! stored in snow per day during snowmelt till snow density 0.40. + + if (tsnowc >= 0.0) then + dw = 0.13 * dthr / 24.0 + if ( ua_phys .and. tsoilc >= 0.) then + dw = min (dw, 0.13*snomltc/(esdcx+0.13*snomltc)) + endif + sndens = sndens*(1.0 - dw) + dw + if (sndens >= 0.40) sndens = 0.40 + endif + +! --- ... calculate snow depth (cm) from snow water equivalent and snow +! density. change snow depth units to meters + + snowhc = esdc / sndens + snowh = snowhc * 0.01 + +! + return +!................................... + end subroutine snowpack +!----------------------------------- + + +!*********************************************! +! section-3 3rd or lower level subprograms ! +!*********************************************! + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subrtouine calculates direct soil evaporation. + subroutine devap & +! --- inputs: + & ( etp1, smc, shdfac, smcmax, smcdry, fxexp, & +! --- outputs: + & edir1 & + & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine devap calculates direct soil evaporation ! +! ! +! ! +! subprogram called: none ! +! ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! etp1 - real, potential evaporation 1 ! +! smc - real, unfrozen soil moisture 1 ! +! shdfac - real, aeral coverage of green vegetation 1 ! +! smcmax - real, porosity (sat val of soil mois) 1 ! +! smcdry - real, dry soil mois threshold 1 ! +! fxexp - real, bare soil evaporation exponent 1 ! +! ! +! outputs: ! +! edir1 - real, direct soil evaporation 1 ! +! ! +! ==================== end of description ===================== ! +! +! --- inputs: + real (kind=kind_phys), intent(in) :: etp1, smc, shdfac, smcmax, & + & smcdry, fxexp + +! --- outputs: + real (kind=kind_phys), intent(out) :: edir1 + +! --- locals: + real (kind=kind_phys) :: fx, sratio +! +!===> ... begin here +! +! --- ... direct evap a function of relative soil moisture availability, +! linear when fxexp=1. +! fx > 1 represents demand control +! fx < 1 represents flux control + + sratio = (smc - smcdry) / (smcmax - smcdry) + + if (sratio > 0.0) then + fx = sratio**fxexp + fx = max ( min ( fx, 1.0 ), 0.0 ) + else + fx = 0.0 + endif + +! --- ... allow for the direct-evap-reducing effect of shade + + edir1 = fx * ( 1.0 - shdfac ) * etp1 +! + return +!................................... + end subroutine devap +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates amount of supercooled liquid soil water +!! content if temperature is below 273.15K (t0). It requires Newton-type +!! iteration to solve the nonlinear implicit equation given in eqn 17 +!! of Koren et al.(1999) \cite koren_et_al_1999. +!! +!! New version (June 2001): much faster and more accurate Newton iteration +!! achieved by first taking log of eqn cited above -- less than 4 (typically +!! 1 or 2) iterations achieves convergence. Also, explicit 1-step solution +!! option for special case of paramter ck=0, which reduces the orginal +!! implicit equation to a simpler explicit form, known as the "flerchinger eqn". +!! Improved handling of solution in the limit of freezing point temperature t0. + subroutine frh2o & +! --- inputs: + & ( tkelv, smc, sh2o, smcmax, bexp, psis, & +! --- outputs: + & liqwat & + & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine frh2o calculates amount of supercooled liquid soil water ! +! content if temperature is below 273.15k (t0). requires newton-type ! +! iteration to solve the nonlinear implicit equation given in eqn 17 ! +! of koren et al (1999, jgr, vol 104(d16), 19569-19585). ! +! ! +! new version (june 2001): much faster and more accurate newton ! +! iteration achieved by first taking log of eqn cited above -- less ! +! than 4 (typically 1 or 2) iterations achieves convergence. also, ! +! explicit 1-step solution option for special case of parameter ck=0, ! +! which reduces the original implicit equation to a simpler explicit ! +! form, known as the "flerchinger eqn". improved handling of solution ! +! in the limit of freezing point temperature t0. ! +! ! +! subprogram called: none ! +! ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! tkelv - real, temperature (k) 1 ! +! smc - real, total soil moisture content (volumetric) 1 ! +! sh2o - real, liquid soil moisture content (volumetric) 1 ! +! smcmax - real, saturation soil moisture content 1 ! +! bexp - real, soil type "b" parameter 1 ! +! psis - real, saturated soil matric potential 1 ! +! ! +! outputs: ! +! liqwat - real, supercooled liquid water content 1 ! +! ! +! ==================== end of description ===================== ! +! +! --- constant parameters: + real (kind=kind_phys), parameter :: ck = 8.0 +! real (kind=kind_phys), parameter :: ck = 0.0 + real (kind=kind_phys), parameter :: blim = 5.5 + real (kind=kind_phys), parameter :: error = 0.005 + +! --- inputs: + real (kind=kind_phys), intent(in) :: tkelv, smc, sh2o, smcmax, & + & bexp, psis + +! --- outputs: + real (kind=kind_phys), intent(out) :: liqwat + +! --- locals: + real (kind=kind_phys) :: bx, denom, df, dswl, fk, swl, swlk + + integer :: nlog, kcount +! +!===> ... begin here +! +! --- ... limits on parameter b: b < 5.5 (use parameter blim) +! simulations showed if b > 5.5 unfrozen water content is +! non-realistically high at very low temperatures. + + bx = bexp + if (bexp > blim) bx = blim + +! --- ... initializing iterations counter and iterative solution flag. + + nlog = 0 + kcount= 0 + +! --- ... if temperature not significantly below freezing (t0), sh2o = smc + + if (tkelv > (tfreez-1.e-3)) then + + liqwat = smc + + else + + if (ck /= 0.0) then + +! --- ... option 1: iterated solution for nonzero ck +! in koren et al, jgr, 1999, eqn 17 + +! --- ... initial guess for swl (frozen content) + + swl = smc - sh2o + +! --- ... keep within bounds. + + swl = max( min( swl, smc-0.02 ), 0.0 ) + +! --- ... start of iterations + + if (swl < 0.) swl = 0. + + do while ( (nlog < 10) .and. (kcount == 0) ) + nlog = nlog + 1 + + df = alog( (psis*gs/lsubf) * ( (1.0 + ck*swl)**2.0 ) & + & * (smcmax/(smc-swl))**bx ) - alog(-(tkelv-tfreez)/tkelv) + + denom = 2.0*ck/(1.0 + ck*swl) + bx/(smc - swl) + swlk = swl - df/denom + +! --- ... bounds useful for mathematical solution. + + swlk = max( min( swlk, smc-0.02 ), 0.0 ) + +! --- ... mathematical solution bounds applied. + + dswl = abs(swlk - swl) + swl = swlk + +! --- ... if more than 10 iterations, use explicit method (ck=0 approx.) +! when dswl less or eq. error, no more iterations required. + + if ( dswl <= error ) then + kcount = kcount + 1 + endif + enddo ! end do_while_loop + +! --- ... bounds applied within do-block are valid for physical solution. + + liqwat = smc - swl + + endif ! end if_ck_block + + endif ! end if_ck_block + +! --- ... option 2: explicit solution for flerchinger eq. i.e. ck=0 +! in koren et al., jgr, 1999, eqn 17 +! apply physical bounds to flerchinger solution + + if (kcount == 0) then + fk = ( ( (lsubf/(gs*(-psis))) & + & * ((tkelv-tfreez)/tkelv) )**(-1/bx) ) * smcmax + + fk = max( fk, 0.02 ) + + liqwat = min( fk, smc ) + endif + + endif ! end if_tkelv_block +! + return +!................................... + end subroutine frh2o +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates the right hand side of the time tendency +!! term of the soil thermal diffusion equation. Also to compute (prepare) +!! the matrix coefficients for the tri-diagonal matrix of the implicit time +!! scheme. + subroutine hrt & +! --- inputs: + & ( nsoil, stc, smc, smcmax, zsoil, yy, zz1, tbot, & + & zbot, psisat, dt, bexp, df1, quartz, csoil, vegtyp, & + & shdfac, soiltyp, & +! --- input/outputs: + & sh2o, & +! --- outputs: + & rhsts, ai, bi, ci, & +! --- outputs for fasdas: + & hcpct_fasdasi & + & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine hrt calculates the right hand side of the time tendency ! +! term of the soil thermal diffusion equation. also to compute ! +! (prepare) the matrix coefficients for the tri-diagonal matrix of ! +! the implicit time scheme. ! +! ! +! subprogram called: tbnd, snksrc, tmpavg ! +! ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! nsoil - integer, number of soil layers 1 ! +! stc - real, soil temperature nsoil ! +! smc - real, total soil moisture nsoil ! +! smcmax - real, porosity 1 ! +! zsoil - real, soil layer depth below ground (negative) nsoil ! +! yy - real, 1 ! +! zz1 - real, soil temperture at the top soil column 1 ! +! tbot - real, bottom soil temp 1 ! +! zbot - real, specify depth of lower bd soil 1 ! +! psisat - real, saturated soil potential 1 ! +! dt - real, time step 1 ! +! bexp - real, soil type "b" parameter 1 ! +! df1 - real, thermal diffusivity 1 ! +! quartz - real, soil quartz content 1 ! +! csoil - real, soil heat capacity 1 ! +! vegtyp - integer, vegetation type 1 ! +! ! +! input/outputs: ! +! sh2o - real, unfrozen soil moisture nsoil ! +! ! +! outputs: ! +! rhsts - real, time tendency of soil thermal diffusion nsoil ! +! ai - real, matrix coefficients nsoil ! +! bi - real, matrix coefficients nsoil ! +! ci - real, matrix coefficients nsoil ! +! ! +! ==================== end of description ===================== ! +! +! --- inputs: + integer, intent(in) :: nsoil, vegtyp, soiltyp + + real (kind=kind_phys), intent(in) :: stc(nsoil), smc(nsoil), & + & smcmax, zsoil(nsoil), yy, zz1, tbot, zbot, psisat, dt, & + & bexp, df1, quartz, csoil, shdfac + +! --- input/outputs: + real (kind=kind_phys), intent(inout) :: sh2o(nsoil) + +! --- outputs: + real (kind=kind_phys), intent(out) :: rhsts(nsoil), ai(nsoil), & + & bi(nsoil), ci(nsoil) + +! fasdas +! + real (kind=kind_phys), intent(out) :: hcpct_fasdas + +! --- locals: + real (kind=kind_phys) :: ddz, ddz2, denom, df1n, df1k, dtsdz, & + & dtsdz2, hcpct, qtot, ssoil, sice, tavg, tbk, tbk1, & + & tsnsr, tsurf, csoil_loc + + integer :: i, k + + logical :: itavg + +! +!===> ... begin here +! +!urban + if( vegtyp == 13 ) then + csoil_loc=3.0e6 + else + csoil_loc=csoil + endif + +! --- ... initialize logical for soil layer temperature averaging. + + itavg = .true. +! itavg = .false. + +! === begin section for top soil layer + +! --- ... calc the heat capacity of the top soil layer + + hcpct = sh2o(1)*cph2o2 + (1.0 - smcmax)*csoil_loc & + & + (smcmax - smc(1))*cp2 + (smc(1) - sh2o(1))*cpice1 + +! --- ... calc the matrix coefficients ai, bi, and ci for the top layer + + ddz = 1.0 / ( -0.5*zsoil(2) ) + ai(1) = 0.0 + ci(1) = (df1*ddz) / ( zsoil(1)*hcpct ) + bi(1) = -ci(1) + df1 / ( 0.5*zsoil(1)*zsoil(1)*hcpct*zz1 ) + +! --- ... calculate the vertical soil temp gradient btwn the 1st and 2nd soil +! layers. then calculate the subsurface heat flux. use the temp +! gradient and subsfc heat flux to calc "right-hand side tendency +! terms", or "rhsts", for top soil layer. + + dtsdz = (stc(1) - stc(2)) / (-0.5*zsoil(2)) + ssoil = df1 * (stc(1) - yy) / (0.5*zsoil(1)*zz1) + + denom = (zsoil (1) * hcpct) + +! ---------------------------------------------------------------------- +! next capture the vertical difference of the heat flux at top and +! bottom of first soil layer for use in heat flux constraint applied to +! potential soil freezing/thawing in routine snksrc. +! ---------------------------------------------------------------------- +! rhsts(1) = (df1*dtsdz - ssoil) / (zsoil(1)*hcpct) + rhsts (1) = (df1 * dtsdz - ssoil) / denom + + +! --- ... next capture the vertical difference of the heat flux at top and +! bottom of first soil layer for use in heat flux constraint applied to +! potential soil freezing/thawing in routine snksrc. + + qtot = -1.0* rhsts (1)* denom + +! --- ... if temperature averaging invoked (itavg=true; else skip): +! set temp "tsurf" at top of soil column (for use in freezing soil +! physics later in subroutine snksrc). if snowpack content is +! zero, then tsurf expression below gives tsurf = skin temp. if +! snowpack is nonzero (hence argument zz1=1), then tsurf expression +! below yields soil column top temperature under snowpack. then +! calculate temperature at bottom interface of 1st soil layer for use +! later in subroutine snksrc + + if (itavg) then + + tsurf = (yy + (zz1-1)*stc(1)) / zz1 + + call tbnd & +! --- inputs: + & ( stc(1), stc(2), zsoil, zbot, 1, nsoil, & +! --- outputs: + & tbk & + & ) + + endif + +! --- ... calculate frozen water content in 1st soil layer. + + sice = smc(1) - sh2o(1) + +! --- ... if frozen water present or any of layer-1 mid-point or bounding +! interface temperatures below freezing, then call snksrc to +! compute heat source/sink (and change in frozen water content) +! due to possible soil water phase change + + if ( (sice > 0.0) .or. (tsurf < tfreez) .or. & + & (stc(1) < tfreez) .or. (tbk < tfreez) ) then + + + call tmpavg & +! --- inputs: + & ( tsurf, stc(1), tbk, zsoil, nsoil, 1, & +! --- outputs: + & tavg & + & ) + + call snksrc & +! --- inputs: + & ( nsoil, 1, tavg, smc(1), smcmax, psisat, bexp, dt, & + & qtot, zsoil, & +! --- input/outputs: + & sh2o(1), & +! --- outputs: + & tsnsr & + & ) + + + rhsts(1) = rhsts(1) - tsnsr / denom + + endif ! end if_sice_block + else + if ( (sice > 0.) .or. (stc (1) < t0) ) then + call snksrc & +! --- inputs: + & ( nsoil, 1, tavg, smc(1), smcmax, psisat, bexp, dt, & + & qtot, zsoil, & +! --- input/outputs: + & sh2o(1), & +! --- outputs: + & tsnsr & + & ) +! rhsts(1) = rhsts(1) - tsnsr / ( zsoil(1) * hcpct ) + rhsts (1) = rhsts (1) - tsnsr / denom + endif +! ---------------------------------------------------------------------- +! this ends section for top soil layer. +! ---------------------------------------------------------------------- + endif + + +! === this ends section for top soil layer. + +! --- ... initialize ddz2 + + ddz2 = 0.0 + +! --- ... loop thru the remaining soil layers, repeating the above process +! (except subsfc or "ground" heat flux not repeated in lower layers) + + df1k = df1 + + do k = 2, nsoil + +! --- ... calculate heat capacity for this soil layer. + + hcpct = sh2o(k)*cph2o2 + (1.0 - smcmax)*csoil_loc & + & + (smcmax - smc(k))*cp2 + (smc(k) - sh2o(k))*cpice1 + + if (k /= nsoil) then + +! --- ... this section for layer 2 or greater, but not last layer. +! calculate thermal diffusivity for this layer. + + call tdfcnd & +! --- inputs: + & ( smc(k), quartz, smcmax, sh2o(k), & +! --- outputs: + & df1n & + & ) +!urban +! if (ivegsrc == 1)then + if ( vegtyp == 13 ) df1n = 3.24 +! endif + +! --- ... calc the vertical soil temp gradient thru this layer + + denom = 0.5 * (zsoil(k-1) - zsoil(k+1)) + dtsdz2 = (stc(k) - stc(k+1)) / denom + +! --- ... calc the matrix coef, ci, after calc'ng its partial product + + ddz2 = 2.0 / (zsoil(k-1) - zsoil(k+1)) + ci(k) = -df1n*ddz2 / ((zsoil(k-1) - zsoil(k)) * hcpct) + +! --- ... if temperature averaging invoked (itavg=true; else skip): +! calculate temp at bottom of layer. + + if (itavg) then + + call tbnd & +! --- inputs: + & ( stc(k), stc(k+1), zsoil, zbot, k, nsoil, & +! --- outputs: + & tbk1 & + & ) + + endif + + endif + +! --- ... special case of bottom soil layer: calculate thermal diffusivity +! for bottom layer. + + call tdfcnd & +! --- inputs: + & ( smc(k), quartz, smcmax, sh2o(k), & +! --- outputs: + & df1n & + & ) +!urban +! if (ivegsrc == 1)then +! if ( vegtyp == 13 ) df1n = 3.24 +! endif +!wz only urban for igbp type + if(ivegsrc == 1 .and. vegtyp == 13) then + df1n = 3.24*(1.-shdfac) + shdfac*df1n + endif + +! --- ... calc the vertical soil temp gradient thru bottom layer. + + denom = 0.5 * (zsoil(k-1) + zsoil(k)) - zbot + dtsdz2 = (stc(k) - tbot) / denom + +! --- ... set matrix coef, ci to zero if bottom layer. + + ci(k) = 0.0 + +! --- ... if temperature averaging invoked (itavg=true; else skip): +! calculate temp at bottom of last layer. + + if (itavg) then + + call tbnd & +! --- inputs: + & ( stc(k), tbot, zsoil, zbot, k, nsoil, & +! --- outputs: + & tbk1 & + & ) + + endif + + endif ! end if_k_block + +! --- ... calculate rhsts for this layer after calc'ng a partial product. + + denom = (zsoil(k) - zsoil(k-1)) * hcpct + rhsts(k) = ( df1n*dtsdz2 - df1k*dtsdz ) / denom + + qtot = -1.0 * denom * rhsts(k) + sice = smc(k) - sh2o(k) + + if (itavg) then + call tmpavg & +! --- inputs: + & ( tbk, stc(k), tbk1, zsoil, nsoil, k, & +! --- outputs: + & tavg & + & ) + if ( (sice > 0.0) .or. (tbk < tfreez) .or. & + & (stc(k) < tfreez) .or. (tbk1 < tfreez) ) then + + call snksrc & +! --- inputs: + & ( nsoil, k, tavg, smc(k), smcmax, psisat, bexp, dt, & + & qtot, zsoil, & +! --- input/outputs: + & sh2o(k), & +! --- outputs: + & tsnsr & + & ) + rhsts(k) = rhsts(k) - tsnsr/denom + + endif + + else + if ( (sice > 0.0) .or. (stc(k) < tfreez) ) then + call snksrc & +! --- inputs: + & ( nsoil, k, tavg, smc(k), smcmax, psisat, bexp, dt, & + & qtot, zsoil, & +! --- input/outputs: + & sh2o(k), & +! --- outputs: + & tsnsr & + & ) + rhsts(k) = rhsts(k) - tsnsr/denom + endif + + endif + +! --- ... calc matrix coefs, ai, and bi for this layer. + + ai(k) = - df1 * ddz / ((zsoil(k-1) - zsoil(k)) * hcpct) + bi(k) = -(ai(k) + ci(k)) + +! --- ... reset values of df1, dtsdz, ddz, and tbk for loop to next soil layer. + + tbk = tbk1 + df1k = df1n + dtsdz = dtsdz2 + ddz = ddz2 + + enddo ! end do_k_loop + +! + return +!................................... + end subroutine hrt +!----------------------------------- + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates/updates the soil temperature field. + subroutine hstep & +! --- inputs: + & ( nsoil, stcin, dt, & +! --- input/outputs: + & rhsts, ai, bi, ci, & +! --- outputs: + & stcout & + & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine hstep calculates/updates the soil temperature field. ! +! ! +! subprogram called: rosr12 ! +! ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! nsoil - integer, number of soil layers 1 ! +! stcin - real, soil temperature nsoil ! +! dt - real, time step 1 ! +! ! +! input/outputs: ! +! rhsts - real, time tendency of soil thermal diffusion nsoil ! +! ai - real, matrix coefficients nsoil ! +! bi - real, matrix coefficients nsoil ! +! ci - real, matrix coefficients nsoil ! +! ! +! outputs: ! +! stcout - real, updated soil temperature nsoil ! +! ! +! ==================== end of description ===================== ! +! +! --- inputs: + integer, intent(in) :: nsoil + + real (kind=kind_phys), intent(in) :: stcin(nsoil), dt + +! --- input/outputs: + real (kind=kind_phys), intent(inout) :: rhsts(nsoil), & + & ai(nsoil), bi(nsoil), ci(nsoil) + +! --- outputs: + real (kind=kind_phys), intent(out) :: stcout(nsoil) + +! --- locals: + integer :: k + + real (kind=kind_phys) :: ciin(nsold), rhstsin(nsoil) + +! +!===> ... begin here +! +! --- ... create finite difference values for use in rosr12 routine + + do k = 1, nsoil + rhsts(k) = rhsts(k) * dt + ai(k) = ai(k) * dt + bi(k) = 1.0 + bi(k)*dt + ci(k) = ci(k) * dt + enddo + +! --- ... copy values for input variables before call to rosr12 + + do k = 1, nsoil + rhstsin(k) = rhsts(k) + enddo + + do k = 1, nsoil + ciin(k) = ci(k) + enddo + +! --- ... solve the tri-diagonal matrix equation + + call rosr12 & +! --- inputs: + & ( nsoil, ai, bi, rhstsin, & +! --- input/outputs: + & ciin, & +! --- outputs: + & ci, rhsts & + & ) + +! --- ... calc/update the soil temps using matrix solution + + do k = 1, nsoil + stcout(k) = stcin(k) + ci(k) + enddo +! + return +!................................... + end subroutine hstep +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine inverts (solve) the tri-diagonal matrix problem. + subroutine rosr12 & +! --- inputs: + & ( nsoil, a, b, d, & +! --- input/outputs: + & c, & +! --- outputs: + & p, delta & + & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine rosr12 inverts (solve) the tri-diagonal matrix problem ! +! shown below: ! +! ! +! ### ### ### ### ### ###! +! #b(1), c(1), 0 , 0 , 0 , . . . , 0 # # # # #! +! #a(2), b(2), c(2), 0 , 0 , . . . , 0 # # # # #! +! # 0 , a(3), b(3), c(3), 0 , . . . , 0 # # # # d(3) #! +! # 0 , 0 , a(4), b(4), c(4), . . . , 0 # # p(4) # # d(4) #! +! # 0 , 0 , 0 , a(5), b(5), . . . , 0 # # p(5) # # d(5) #! +! # . . # # . # = # . #! +! # . . # # . # # . #! +! # . . # # . # # . #! +! # 0 , . . . , 0 , a(m-2), b(m-2), c(m-2), 0 # #p(m-2)# #d(m-2)#! +! # 0 , . . . , 0 , 0 , a(m-1), b(m-1), c(m-1)# #p(m-1)# #d(m-1)#! +! # 0 , . . . , 0 , 0 , 0 , a(m) , b(m) # # p(m) # # d(m) #! +! ### ### ### ### ### ###! +! ! +! subprogram called: none ! +! ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! nsoil - integer, number of soil layers 1 ! +! a - real, matrix coefficients nsoil ! +! b - real, matrix coefficients nsoil ! +! d - real, soil water time tendency nsoil ! +! ! +! input/outputs: ! +! c - real, matrix coefficients nsoil ! +! ! +! outputs: ! +! p - real, nsoil ! +! delta - real, nsoil ! +! ! +! ==================== end of description ===================== ! +! + implicit none +! --- inputs: + integer, intent(in) :: nsoil + + real (kind=kind_phys), dimension(nsoil), intent(in) :: a, b, d + +! --- input/outputs: + real (kind=kind_phys), dimension(nsoil), intent(inout) :: c + +! --- outputs: + real (kind=kind_phys), dimension(nsoil), intent(out) :: p, delta + +! --- locals: + integer :: k, kk + +! +!===> ... begin here +! +! --- ... initialize eqn coef c for the lowest soil layer + + c(nsoil) = 0.0 + +! --- ... solve the coefs for the 1st soil layer + + p(1) = -c(1) / b(1) + delta(1) = d(1) / b(1) + +! --- ... solve the coefs for soil layers 2 thru nsoil + + do k = 2, nsoil + p(k) = -c(k) * ( 1.0 / (b(k) + a (k)*p(k-1)) ) + delta(k) = (d(k) - a(k)*delta(k-1)) & + & * ( 1.0 / (b(k) + a(k)*p(k-1)) ) + enddo + +! --- ... set p to delta for lowest soil layer + + p(nsoil) = delta(nsoil) + +! --- ... adjust p for soil layers 2 thru nsoil + + do k = 2, nsoil + kk = nsoil - k + 1 + p(kk) = p(kk)*p(kk+1) + delta(kk) + enddo +! + return +!................................... + end subroutine rosr12 +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates sink/source term of the termal diffusion equation. + subroutine snksrc & +! --- inputs: + & ( nsoil, k, tavg, smc, smcmax, psisat, bexp, dt, & + & qtot, zsoil, & +! --- input/outputs: + & sh2o, & +! --- outputs: + & tsrc & + & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine snksrc calculates sink/source term of the termal ! +! diffusion equation. ! +! ! +! subprograms called: frh2o ! +! ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! nsoil - integer, number of soil layers 1 ! +! k - integer, index of soil layers 1 ! +! tavg - real, soil layer average temperature 1 ! +! smc - real, total soil moisture 1 ! +! smcmax - real, porosity 1 ! +! psisat - real, saturated soil potential 1 ! +! bexp - real, soil type "b" parameter 1 ! +! dt - real, time step 1 ! +! qtot - real, tot vertical diff of heat flux 1 ! +! zsoil - real, soil layer depth below ground (negative) nsoil ! +! ! +! input/outputs: ! +! sh2o - real, available liqued water 1 ! +! ! +! outputs: ! +! tsrc - real, heat source/sink 1 ! +! ! +! ==================== end of description ===================== ! +! +! --- parameter constants: + real (kind=kind_phys), parameter :: dh2o = 1.0000e3 + real (kind=kind_phys), parameter :: t0 = 2.7315e2 + +! --- inputs: + integer, intent(in) :: nsoil, k + + real (kind=kind_phys), intent(in) :: tavg, smc, smcmax, psisat, & + & bexp, dt, qtot, zsoil(nsoil), shdfac + +! --- input/outputs: + real (kind=kind_phys), intent(inout) :: sh2o + +! --- outputs: + real (kind=kind_phys), intent(out) :: tsrc + +! --- locals: + real (kind=kind_phys) :: df, dz, dzh, free, tsnsr, tdn, tm, xh2o + real (kind=kind_phys) :: tup, tz, x0, xdn, xup + +! --- external functions: +! real (kind=kind_phys) :: frh2o + +! +!===> ... begin here +! + if (k == 1) then + dz = -zsoil(1) + else + dz = zsoil(k-1) - zsoil(k) + endif + +! --- ... via function frh2o, compute potential or 'equilibrium' unfrozen +! supercooled free water for given soil type and soil layer temperature. +! function frh20 invokes eqn (17) from v. koren et al (1999, jgr, vol. +! 104, pg 19573). (aside: latter eqn in journal in centigrade units. +! routine frh2o use form of eqn in kelvin units.) + +! free = frh2o( tavg,smc,sh2o,smcmax,bexp,psisat ) + + call frh2o & +! --- inputs: + & (tkelv, smc, sh2o, smcmax, bexp, psisat, & +! --- outputs: + & free & + & ) + + +! --- ... in next block of code, invoke eqn 18 of v. koren et al (1999, jgr, +! vol. 104, pg 19573.) that is, first estimate the new amountof liquid +! water, 'xh2o', implied by the sum of (1) the liquid water at the begin +! of current time step, and (2) the freeze of thaw change in liquid +! water implied by the heat flux 'qtot' passed in from routine hrt. +! second, determine if xh2o needs to be bounded by 'free' (equil amt) or +! if 'free' needs to be bounded by xh2o. + + xh2o = sh2o + qtot*dt / (dh2o*lsubf*dz) + +! --- ... first, if freezing and remaining liquid less than lower bound, then +! reduce extent of freezing, thereby letting some or all of heat flux +! qtot cool the soil temp later in routine hrt. + + if ( xh2o < sh2o .and. xh2o < free) then + if ( free > sh2o ) then + xh2o = sh2o + else + xh2o = free + endif + endif + +! --- ... second, if thawing and the increase in liquid water greater than +! upper bound, then reduce extent of thaw, thereby letting some or +! all of heat flux qtot warm the soil temp later in routine hrt. + + if ( xh2o > sh2o .and. xh2o > free ) then + if ( free < sh2o ) then + xh2o = sh2o + else + xh2o = free + endif + endif + + xh2o = max( min( xh2o, smc ), 0.0 ) + +! --- ... calculate phase-change heat source/sink term for use in routine hrt +! and update liquid water to reflcet final freeze/thaw increment. + + tsrc = -dh2o * lsubf * dz * (xh2o - sh2o) / dt + sh2o = xh2o +! + return +!................................... + end subroutine snksrc +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates the right hand side of the time tendency +!! term of the soil water diffusion equation. Also to compute +!! (prepare) the matrix coefficients for the tri-diagonal matrix of +!! the implicit time scheme. + subroutine srt & +! --- inputs: + & ( nsoil, edir, et, sh2o, sh2oa, pcpdrp, zsoil, dwsat, & + & dksat, smcmax, bexp, dt, smcwlt, slope, kdt, frzx, sice, & +! --- outputs: + & rhstt, runoff1, runoff2, ai, bi, ci & + & ) + +! ===================================================================== ! +! description: ! +! subroutine srt calculates the right hand side of the time tendency ! +! term of the soil water diffusion equation. also to compute ! +! ( prepare ) the matrix coefficients for the tri-diagonal matrix ! +! of the implicit time scheme. ! +! ! +! subprogram called: wdfcnd ! +! ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! nsoil - integer, number of soil layers 1 ! +! edir - real, direct soil evaporation 1 ! +! et - real, plant transpiration nsoil ! +! sh2o - real, unfrozen soil moisture nsoil ! +! sh2oa - real, nsoil ! +! pcpdrp - real, combined prcp and drip 1 ! +! zsoil - real, soil layer depth below ground nsoil ! +! dwsat - real, saturated soil diffusivity 1 ! +! dksat - real, saturated soil hydraulic conductivity 1 ! +! smcmax - real, porosity 1 ! +! bexp - real, soil type "b" parameter 1 ! +! dt - real, time step 1 ! +! smcwlt - real, wilting point 1 ! +! slope - real, linear reservoir coefficient 1 ! +! kdt - real, 1 ! +! frzx - real, frozen ground parameter 1 ! +! sice - real, ice content at each soil layer nsoil ! +! ! +! outputs: ! +! rhstt - real, soil water time tendency nsoil ! +! runoff1 - real, surface runoff not infiltrating sfc 1 ! +! runoff2 - real, sub surface runoff (baseflow) 1 ! +! ai - real, matrix coefficients nsoil ! +! bi - real, matrix coefficients nsoil ! +! ci - real, matrix coefficients nsoil ! +! ! +! ==================== end of description ===================== ! +! + implicit none +! --- inputs: + integer, intent(in) :: nsoil + + real (kind=kind_phys), dimension(nsoil), intent(in) :: et, & + & sh2o, sh2oa, zsoil, sice + + real (kind=kind_phys), intent(in) :: edir, pcpdrp, dwsat, dksat, & + & smcmax, smcwlt, bexp, dt, slope, kdt, frzx + + +! --- outputs: + real (kind=kind_phys), intent(out) :: runoff1, runoff2, & + & rhstt(nsoil), ai(nsoil), bi(nsoil), ci(nsoil) + + +! --- locals: + real (kind=kind_phys) :: acrt, dd, ddt, ddz, ddz2, denom, denom2, & + & dice, dsmdz, dsmdz2, dt1, fcr, infmax, mxsmc, mxsmc2, px, & + & numer, pddum, sicemax, slopx, smcav, sstt, sum, val, wcnd, & + & wcnd2, wdf, wdf2, dmax(nsoil) + +! --- wrf_hydro locals: + real (kind=kind_phys) :: sfcwatr, chcksm + + integer :: ialp1, iohinf, j, jj, k, ks + +! +!===> ... begin here +! +! --- ... frozen ground version: +! reference frozen ground parameter, cvfrz, is a shape parameter +! of areal distribution function of soil ice content which equals +! 1/cv. cv is a coefficient of spatial variation of soil ice content. +! based on field data cv depends on areal mean of frozen depth, and +! it close to constant = 0.6 if areal mean frozen depth is above 20 cm. +! that is why parameter cvfrz = 3 (int{1/0.6*0.6}). current logic +! doesn't allow cvfrz be bigger than 3 + + parameter (cvfrz = 3) + +c ---------------------------------------------------------------------- +! --- ... determine rainfall infiltration rate and runoff. include +! the infiltration formule from schaake and koren model. +! modified by q duan + + iohinf = 1 + +! --- ... let sicemax be the greatest, if any, frozen water content within +! soil layers. + + sicemax = 0.0 + do ks = 1, nsoil + if (sice(ks) > sicemax) sicemax = sice(ks) + enddo + +! --- ... determine rainfall infiltration rate and runoff + + pddum = pcpdrp + runoff1 = 0.0 + + if (pcpdrp /= 0.0) then + +! --- ... modified by q. duan, 5/16/94 + + dt1 = dt/86400. + smcav = smcmax - smcwlt + dmax(1) = -zsoil(1) * smcav + +! --- ... frozen ground version: + + dice = -zsoil(1) * sice(1) + + dmax(1) = dmax(1)*(1.0 - (sh2oa(1)+sice(1)-smcwlt)/smcav) + dd = dmax(1) + + do ks = 2, nsoil + +! --- ... frozen ground version: + + dice = dice + ( zsoil(ks-1) - zsoil(ks) ) * sice(ks) + + dmax(ks) = (zsoil(ks-1)-zsoil(ks))*smcav + dmax(ks) = dmax(ks)*(1.0 - (sh2oa(ks)+sice(ks)-smcwlt)/smcav) + dd = dd + dmax(ks) + enddo + +! --- ... val = (1.-exp(-kdt*sqrt(dt1))) +! in below, remove the sqrt in above + + val = 1.0 - exp(-kdt*dt1) + ddt = dd * val + + px = pcpdrp * dt + if (px < 0.0) px = 0.0 + + infmax = (px*(ddt/(px+ddt)))/dt + +! --- ... frozen ground version: +! reduction of infiltration based on frozen ground parameters + + fcr = 1.0 + + if (dice > 1.e-2) then + acrt = cvfrz * frzx / dice + sum = 1.0 + + ialp1 = cvfrz - 1 + do j = 1, ialp1 + k = 1 + + do jj = j+1,ialp1 + k = k * jj + enddo + + sum = sum + (acrt**( cvfrz-j)) / float (k) + enddo + + fcr = 1.0 - exp(-acrt) * sum + endif + + infmax = infmax * fcr + +! --- ... correction of infiltration limitation: +! if infmax .le. hydrolic conductivity assign infmax the value +! of hydrolic conductivity + +! mxsmc = max ( sh2oa(1), sh2oa(2) ) + mxsmc = sh2oa(1) + + call wdfcnd & +! --- inputs: + & ( mxsmc, smcmax, bexp, dksat, dwsat, sicemax, & +! --- outputs: + & wdf, wcnd & + & ) + + infmax = max( infmax, wcnd ) + infmax = min( infmax, px/dt ) + + if (pcpdrp > infmax) then + runoff1 = pcpdrp - infmax + pddum = infmax + endif + + endif ! end if_pcpdrp_block + +! --- ... to avoid spurious drainage behavior, 'upstream differencing' +! in line below replaced with new approach in 2nd line: +! 'mxsmc = max(sh2oa(1), sh2oa(2))' + + mxsmc = sh2oa(1) + + call wdfcnd & +! --- inputs: + & ( mxsmc, smcmax, bexp, dksat, dwsat, sicemax, & +! --- outputs: + & wdf, wcnd & + & ) + +! --- ... calc the matrix coefficients ai, bi, and ci for the top layer + + ddz = 1.0 / ( -.5*zsoil(2) ) + ai(1) = 0.0 + bi(1) = wdf * ddz / ( -zsoil(1) ) + ci(1) = -bi(1) + +! --- ... calc rhstt for the top layer after calc'ng the vertical soil +! moisture gradient btwn the top and next to top layers. + + dsmdz = ( sh2o(1) - sh2o(2) ) / ( -.5*zsoil(2) ) + rhstt(1) = (wdf*dsmdz + wcnd - pddum + edir + et(1)) / zsoil(1) + sstt = wdf * dsmdz + wcnd + edir + et(1) + +! --- ... initialize ddz2 + + ddz2 = 0.0 + +! --- ... loop thru the remaining soil layers, repeating the abv process + + do k = 2, nsoil + denom2 = (zsoil(k-1) - zsoil(k)) + + if (k /= nsoil) then + slopx = 1.0 + +! --- ... again, to avoid spurious drainage behavior, 'upstream differencing' +! in line below replaced with new approach in 2nd line: +! 'mxsmc2 = max (sh2oa(k), sh2oa(k+1))' + + mxsmc2 = sh2oa(k) + + call wdfcnd & +! --- inputs: + & ( mxsmc2, smcmax, bexp, dksat, dwsat, sicemax, & +! --- outputs: + & wdf2, wcnd2 & + & ) + +! --- ... calc some partial products for later use in calc'ng rhstt + + denom = (zsoil(k-1) - zsoil(k+1)) + dsmdz2 = (sh2o(k) - sh2o(k+1)) / (denom * 0.5) + +! --- ... calc the matrix coef, ci, after calc'ng its partial product + + ddz2 = 2.0 / denom + ci(k) = -wdf2 * ddz2 / denom2 + + else ! if_k_block + +! --- ... slope of bottom layer is introduced + + slopx = slope + +! --- ... retrieve the soil water diffusivity and hydraulic conductivity +! for this layer + + call wdfcnd & +! --- inputs: + & ( sh2oa(nsoil), smcmax, bexp, dksat, dwsat, sicemax, & +! --- outputs: + & wdf2, wcnd2 & + & ) + +! --- ... calc a partial product for later use in calc'ng rhstt + dsmdz2 = 0.0 + +! --- ... set matrix coef ci to zero + + ci(k) = 0.0 + + endif ! end if_k_block + +! --- ... calc rhstt for this layer after calc'ng its numerator + + numer = wdf2*dsmdz2 + slopx*wcnd2 - wdf*dsmdz - wcnd + et(k) + rhstt(k) = numer / (-denom2) + +! --- ... calc matrix coefs, ai, and bi for this layer + + ai(k) = -wdf * ddz / denom2 + bi(k) = -( ai(k) + ci(k) ) + +! --- ... reset values of wdf, wcnd, dsmdz, and ddz for loop to next lyr +! runoff2: sub-surface or baseflow runoff + + if (k == nsoil) then + runoff2 = slopx * wcnd2 + endif + + if (k /= nsoil) then + wdf = wdf2 + wcnd = wcnd2 + dsmdz= dsmdz2 + ddz = ddz2 + endif + enddo ! end do_k_loop +! + return +!................................... + end subroutine srt +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates/updates soil moisture content values and +!! canopy moisture content values. + subroutine sstep & +! --- inputs: + & ( nsoil, sh2oin, rhsct, dt, smcmax, cmcmax, zsoil, sice, & +! --- input/outputs: + & cmc, rhstt, ai, bi, ci, & +! --- outputs: + & sh2oout, runoff3, smc & + & ) + +! ===================================================================== ! +! description: ! +! subroutine sstep calculates/updates soil moisture content values ! +! and canopy moisture content values. ! +! ! +! subprogram called: rosr12 ! +! ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! nsoil - integer, number of soil layers 1 ! +! sh2oin - real, unfrozen soil moisture nsoil ! +! rhsct - real, 1 ! +! dt - real, time step 1 ! +! smcmax - real, porosity 1 ! +! cmcmax - real, maximum canopy water parameters 1 ! +! zsoil - real, soil layer depth below ground nsoil ! +! sice - real, ice content at each soil layer nsoil ! +! ! +! input/outputs: ! +! cmc - real, canopy moisture content 1 ! +! rhstt - real, soil water time tendency nsoil ! +! ai - real, matrix coefficients nsoil ! +! bi - real, matrix coefficients nsoil ! +! ci - real, matrix coefficients nsoil ! +! ! +! outputs: ! +! sh2oout - real, updated soil moisture content nsoil ! +! runoff3 - real, excess of porosity 1 ! +! smc - real, total soil moisture nsoil ! +! ! +! ==================== end of description ===================== ! +! + implicit none +! --- input: + integer, intent(in) :: nsoil + + real (kind=kind_phys), dimension(nsoil), intent(in) :: sh2oin, & + & zsoil, sice + + real (kind=kind_phys), intent(in) :: rhsct, dt, smcmax, cmcmax + +! --- inout/outputs: + real (kind=kind_phys), intent(inout) :: cmc, rhstt(nsoil), & + & ai(nsoil), bi(nsoil), ci(nsoil) + +! --- outputs: + real (kind=kind_phys), intent(out) :: sh2oout(nsoil), runoff3, & + & smc(nsoil) + +! --- locals: + real (kind=kind_phys) :: ciin(nsold), rhsttin(nsoil), ddz, stot, & + & wplus + + integer :: i, k, kk11 +! +!===> ... begin here +! +! --- ... create 'amount' values of variables to be input to the +! tri-diagonal matrix routine. + + do k = 1, nsoil + rhstt(k) = rhstt(k) * dt + ai(k) = ai(k) * dt + bi(k) = 1. + bi(k) * dt + ci(k) = ci(k) * dt + enddo + +! --- ... copy values for input variables before call to rosr12 + + do k = 1, nsoil + rhsttin(k) = rhstt(k) + enddo + + do k = 1, nsoil + ciin(k) = ci(k) + enddo + +! --- ... call rosr12 to solve the tri-diagonal matrix + + call rosr12 & +! --- inputs: + & ( nsoil, ai, bi, rhsttin, & +! --- input/outputs: + & ciin, & +! --- outputs: + & ci, rhstt & + & ) + +! --- ... sum the previous smc value and the matrix solution to get +! a new value. min allowable value of smc will be 0.02. +! runoff3: runoff within soil layers + + wplus = 0.0 + runoff3 = 0.0 + ddz = -zsoil(1) + + do k = 1, nsoil + if (k /= 1) ddz = zsoil(k - 1) - zsoil(k) + + sh2oout(k) = sh2oin(k) + ci(k) + wplus/ddz + + stot = sh2oout(k) + sice(k) + if (stot > smcmax) then + if (k == 1) then + ddz = -zsoil(1) + else + kk11 = k - 1 + ddz = -zsoil(k) + zsoil(kk11) + endif + + wplus = (stot - smcmax) * ddz + else + wplus = 0.0 + endif + + smc(k) = max( min( stot, smcmax ), 0.02 ) + sh2oout(k) = max( smc(k)-sice(k), 0.0 ) + enddo + + runoff3 = wplus + +! --- ... update canopy water content/interception (cmc). convert rhsct to +! an 'amount' value and add to previous cmc value to get new cmc. + + cmc = cmc + dt*rhsct + if (cmc < 1.e-20) cmc = 0.0 + cmc = min( cmc, cmcmax ) +! + return +!................................... + end subroutine sstep +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates temperature on the boundary of the +!! layer by interpolation of the middle layer temperatures. + subroutine tbnd & +! --- inputs: + & ( tu, tb, zsoil, zbot, k, nsoil, & +! --- outputs: + & tbnd1 & + & ) + +! ===================================================================== ! +! description: ! +! ! +! subroutine tbnd calculates temperature on the boundary of the ! +! layer by interpolation of the middle layer temperatures ! +! ! +! subprogram called: none ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! tu - real, soil temperature 1 ! +! tb - real, bottom soil temp 1 ! +! zsoil - real, soil layer depth nsoil ! +! zbot - real, specify depth of lower bd soil 1 ! +! k - integer, soil layer index 1 ! +! nsoil - integer, number of soil layers 1 ! +! ! +! outputs: ! +! tbnd1 - real, temperature at bottom interface of the lyr 1 ! +! ! +! ==================== end of description ===================== ! +! + implicit none +! --- input: + integer, intent(in) :: k, nsoil + + real (kind=kind_phys), intent(in) :: tu, tb, zbot, zsoil(nsoil) + +! --- output: + real (kind=kind_phys), intent(out) :: tbnd1 + +! --- locals: + real (kind=kind_phys) :: zb, zup + +! --- ... use surface temperature on the top of the first layer + + if (k == 1) then + zup = 0.0 + else + zup = zsoil(k-1) + endif + +! --- ... use depth of the constant bottom temperature when interpolate +! temperature into the last layer boundary + + if (k == nsoil) then + zb = 2.0*zbot - zsoil(k) + else + zb = zsoil(k+1) + endif + +! --- ... linear interpolation between the average layer temperatures + + tbnd1 = tu + (tb-tu)*(zup-zsoil(k))/(zup-zb) +! + return +!................................... + end subroutine tbnd +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates soil layer average temperature (tavg) +!! in freezing/thawing layer using up, down, and middle layer +!! temperature (tup, tdn, tm), where tup is at top boundary of layer, +!! tdn is at bottom boundary of layer. tm is layer prognostic state +!! temperature. + subroutine tmpavg & +! --- inputs: + & ( tup, tm, tdn, zsoil, nsoil, k, & +! --- outputs: + & tavg & + & ) + +! ===================================================================== ! +! description: ! +! subroutine tmpavg calculates soil layer average temperature (tavg) ! +! in freezing/thawing layer using up, down, and middle layer ! +! temperatures (tup, tdn, tm), where tup is at top boundary of ! +! layer, tdn is at bottom boundary of layer. tm is layer prognostic ! +! state temperature. ! +! ! +! ! +! subprogram called: none ! +! ! +! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! tup - real, temperature ar top boundary of layer 1 ! +! tm - real, layer prognostic state temperature 1 ! +! tdn - real, temperature ar bottom boundary of layer 1 ! +! zsoil - real, soil layer depth nsoil ! +! nsoil - integer, number of soil layers 1 ! +! k - integer, layer index 1 ! +! outputs: ! +! tavg - real, soil layer average temperature 1 ! +! ! +! ==================== end of description ===================== ! +! + implicit none +! --- input: + integer, intent(in) :: nsoil, k + + real (kind=kind_phys), intent(in) :: tup, tm, tdn, zsoil(nsoil) + +! --- output: + real (kind=kind_phys), intent(out) :: tavg + +! --- locals: + real (kind=kind_phys) :: dz, dzh, x0, xdn, xup, t0 + +! +!===> ... begin here +! + if (k == 1) then + dz = -zsoil(1) + else + dz = zsoil(k-1) - zsoil(k) + endif + + dzh = dz * 0.5 + + if (tup < tfreez) then + + if (tm < tfreez) then + if (tdn < tfreez) then ! tup, tm, tdn < t0 + tavg = (tup + 2.0*tm + tdn) / 4.0 + else ! tup & tm < t0, tdn >= t0 + x0 = (tfreez - tm) * dzh / (tdn - tm) + tavg = 0.5*(tup*dzh + tm*(dzh+x0)+tfreez*(2.*dzh-x0)) / dz + endif + else + if (tdn < tfreez) then ! tup < t0, tm >= t0, tdn < t0 + xup = (tfreez-tup) * dzh / (tm-tup) + xdn = dzh - (tfreez-tm) * dzh / (tdn-tm) + tavg = 0.5*(tup*xup + tfreez*(2.*dz-xup-xdn)+tdn*xdn) / dz + else ! tup < t0, tm >= t0, tdn >= t0 + xup = (tfreez-tup) * dzh / (tm-tup) + tavg = 0.5*(tup*xup + tfreez*(2.*dz-xup)) / dz + endif + endif + + else ! if_tup_block + + if (tm < tfreez) then + if (tdn < tfreez) then ! tup >= t0, tm < t0, tdn < t0 + xup = dzh - (tfreez-tup) * dzh / (tm-tup) + tavg = 0.5*(tfreez*(dz-xup) + tm*(dzh+xup)+tdn*dzh) / dz + else ! tup >= t0, tm < t0, tdn >= t0 + xup = dzh - (tfreez-tup) * dzh / (tm-tup) + xdn = (tfreez-tm) * dzh / (tdn-tm) + tavg = 0.5 * (tfreez*(2.*dz-xup-xdn) + tm*(xup+xdn)) / dz + endif + else + if (tdn < tfreez) then ! tup >= t0, tm >= t0, tdn < t0 + xdn = dzh - (tfreez-tm) * dzh / (tdn-tm) + tavg = (tfreez*(dz-xdn) + 0.5*(tfreez+tdn)*xdn) / dz + else ! tup >= t0, tm >= t0, tdn >= t0 + tavg = (tup + 2.0*tm + tdn) / 4.0 + endif + endif + + endif ! end if_tup_block +! + return +!................................... + end subroutine tmpavg +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates transpiration for the veg class. + subroutine transp & +! --- inputs: + & ( nsoil, nroot, etp1, smc, smcwlt, smcref, & + & cmc, cmcmax, zsoil, shdfac, pc, cfactr, rtdis, & +! --- outputs: + & et1 & + & ) + +! ===================================================================== ! +! description: ! +! subroutine transp calculates transpiration for the veg class. ! +! ! +! subprogram called: none ! +! ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! nsoil - integer, number of soil layers 1 ! +! nroot - integer, number of root layers 1 ! +! etp1 - real, potential evaporation 1 ! +! smc - real, unfrozen soil moisture nsoil ! +! smcwlt - real, wilting point 1 ! +! smcref - real, soil mois threshold 1 ! +! cmc - real, canopy moisture content 1 ! +! cmcmax - real, maximum canopy water parameters 1 ! +! zsoil - real, soil layer depth below ground nsoil ! +! shdfac - real, aeral coverage of green vegetation 1 ! +! pc - real, plant coeff 1 ! +! cfactr - real, canopy water parameters 1 ! +! rtdis - real, root distribution nsoil ! +! ! +! outputs: ! +! et1 - real, plant transpiration nsoil ! +! ! +! ==================== end of description ===================== ! +! + implicit none +! --- input: + integer, intent(in) :: nsoil, nroot + + real (kind=kind_phys), intent(in) :: etp1, smcwlt, smcref, & + & cmc, cmcmax, shdfac, pc, cfactr + + real (kind=kind_phys), dimension(nsoil), intent(in) :: smc, & + & zsoil, rtdis + +! --- output: + real (kind=kind_phys), dimension(nsoil), intent(out) :: et1 + +! --- locals: + real (kind=kind_phys) :: denom, etp1a, rtx, sgx, gx(7) + + integer :: i, k +! +!===> ... begin here +! +! --- ... initialize plant transp to zero for all soil layers. + + do k = 1, nsoil + et1(k) = 0.0 + enddo + +! --- ... calculate an 'adjusted' potential transpiration +! if statement below to avoid tangent linear problems near zero +! note: gx and other terms below redistribute transpiration by layer, +! et(k), as a function of soil moisture availability, while preserving +! total etp1a. + + if (cmc /= 0.0) then + etp1a = shdfac * pc * etp1 * (1.0 - (cmc /cmcmax) ** cfactr) + else + etp1a = shdfac * pc * etp1 + endif + + sgx = 0.0 + do i = 1, nroot + gx(i) = ( smc(i) - smcwlt ) / ( smcref - smcwlt ) + gx(i) = max ( min ( gx(i), 1.0 ), 0.0 ) + sgx = sgx + gx(i) + enddo + sgx = sgx / nroot + + denom = 0.0 + do i = 1, nroot + rtx = rtdis(i) + gx(i) - sgx + gx(i) = gx(i) * max ( rtx, 0.0 ) + denom = denom + gx(i) + enddo + if (denom <= 0.0) denom = 1.0 + + do i = 1, nroot + et1(i) = etp1a * gx(i) / denom + enddo + +! --- ... above code assumes a vertically uniform root distribution +! code below tests a variable root distribution + +! et(1) = ( zsoil(1) / zsoil(nroot) ) * gx * etp1a +! et(1) = ( zsoil(1) / zsoil(nroot) ) * etp1a + +! --- ... using root distribution as weighting factor + +! et(1) = rtdis(1) * etp1a +! et(1) = etp1a * part(1) + +! --- ... loop down thru the soil layers repeating the operation above, +! but using the thickness of the soil layer (rather than the +! absolute depth of each layer) in the final calculation. + +! do k = 2, nroot +! gx = ( smc(k) - smcwlt ) / ( smcref - smcwlt ) +! gx = max ( min ( gx, 1.0 ), 0.0 ) +! --- ... test canopy resistance +! gx = 1.0 +! et(k) = ((zsoil(k)-zsoil(k-1))/zsoil(nroot))*gx*etp1a +! et(k) = ((zsoil(k)-zsoil(k-1))/zsoil(nroot))*etp1a + +! --- ... using root distribution as weighting factor + +! et(k) = rtdis(k) * etp1a +! et(k) = etp1a*part(k) +! enddo + +! + return +!................................... + end subroutine transp +!----------------------------------- + + +!----------------------------------- +!>\ingroup Noah_LSM +!> This subroutine calculates soil water diffusivity and soil +!! hydraulic conductivity. + subroutine wdfcnd & +! --- inputs: + & ( smc, smcmax, bexp, dksat, dwsat, sicemax, & +! --- outputs: + & wdf, wcnd & + & ) + +! ===================================================================== ! +! description: ! +! subroutine wdfcnd calculates soil water diffusivity and soil ! +! hydraulic conductivity. ! +! ! +! subprogram called: none ! +! ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! smc - real, layer total soil moisture 1 ! +! smcmax - real, porosity 1 ! +! bexp - real, soil type "b" parameter 1 ! +! dksat - real, saturated soil hydraulic conductivity 1 ! +! dwsat - real, saturated soil diffusivity 1 ! +! sicemax - real, max frozen water content in soil layer 1 ! +! ! +! outputs: ! +! wdf - real, soil water diffusivity 1 ! +! wcnd - real, soil hydraulic conductivity 1 ! +! ! +! ==================== end of description ===================== ! +! + implicit none +! --- input: + real (kind=kind_phys), intent(in) :: smc, smcmax, bexp, dksat, & + & dwsat, sicemax + +! --- output: + real (kind=kind_phys), intent(out) :: wdf, wcnd + +! --- locals: + real (kind=kind_phys) :: expon, factr1, factr2, vkwgt +! +!===> ... begin here +! +! --- ... calc the ratio of the actual to the max psbl soil h2o content + + factr1 = 0.05 / smcmax + factr2 = smc / smcmax + factr1 = min(factr1,factr2) + +! --- ... prep an expntl coef and calc the soil water diffusivity + + expon = bexp + 2.0 + wdf = dwsat * factr2 ** expon + +! --- ... frozen soil hydraulic diffusivity. very sensitive to the vertical +! gradient of unfrozen water. the latter gradient can become very +! extreme in freezing/thawing situations, and given the relatively +! few and thick soil layers, this gradient sufferes serious +! trunction errors yielding erroneously high vertical transports of +! unfrozen water in both directions from huge hydraulic diffusivity. +! therefore, we found we had to arbitrarily constrain wdf +! +! version d_10cm: ....... factr1 = 0.2/smcmax +! weighted approach....... pablo grunmann, 28_sep_1999. + + if (sicemax > 0.0) then + vkwgt = 1.0 / (1.0 + (500.0*sicemax)**3.0) + wdf = vkwgt*wdf + (1.0- vkwgt)*dwsat*factr1**expon + endif + +! --- ... reset the expntl coef and calc the hydraulic conductivity + + expon = (2.0 * bexp) + 3.0 + wcnd = dksat * factr2 ** expon +! + return +!................................... + end subroutine wdfcnd +!----------------------------------- + +! =========================== ! +! end contain programs ! +! =========================== ! + +!................................... + end subroutine gfssflx_hafs +!! @} +!----------------------------------- diff --git a/physics/sflx_hafs.meta b/physics/sflx_hafs.meta new file mode 100644 index 000000000..ca26c534e --- /dev/null +++ b/physics/sflx_hafs.meta @@ -0,0 +1,1363 @@ +[ccpp-arg-table] + name = lsm_noah_init + type = scheme +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[isot] + standard_name = soil_type_dataset_choice + long_name = soil type dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[ivegsrc] + standard_name = vegetation_type_dataset_choice + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[nlunit] + standard_name = iounit_namelist + long_name = fortran unit number for file opens + units = none + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = lsm_noah_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = lsm_noah_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = soil_vertical_dimension + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rvrdm1] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ps] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature_at_lowest_model_layer + long_name = 1st model layer air temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer + long_name = 1st model layer specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[soiltyp] + standard_name = soil_type_classification + long_name = soil type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[vegtype] + standard_name = vegetation_type_classification + long_name = vegetation type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[sigmaf] + standard_name = bounded_vegetation_area_fraction + long_name = areal fractional cover of green vegetation bounded on the bottom + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcemis] + standard_name = surface_longwave_emissivity_over_land_interstitial + long_name = surface lw emissivity in fraction over land (temporary use as interstitial) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dlwflx] + standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_land + long_name = total sky surface downward longwave flux absorbed by the ground over land + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dswsfc] + standard_name = surface_downwelling_shortwave_flux + long_name = total sky surface downward shortwave flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snet] + standard_name = surface_net_downwelling_shortwave_flux + long_name = total sky surface net shortwave flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[delt] + standard_name = time_step_for_dynamics + long_name = dynamics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[tg3] + standard_name = deep_soil_temperature + long_name = bottom soil temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cm] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_land + long_name = surface exchange coeff for momentum over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ch] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land + long_name = surface exchange coeff heat & moisture over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl1] + standard_name = air_pressure_at_lowest_model_layer + long_name = Model layer 1 mean pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslki] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zf] + standard_name = height_above_ground_at_lowest_model_layer + long_name = height above ground at 1st model layer + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[land] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[slopetyp] + standard_name = surface_slope_classification + long_name = surface slope type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[shdmin] + standard_name = minimum_vegetation_area_fraction + long_name = min fractional coverage of green veg + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[shdmax] + standard_name = maximum_vegetation_area_fraction + long_name = max fractnl cover of green veg (not used) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snoalb] + standard_name = upper_bound_on_max_albedo_over_deep_snow + long_name = upper bound on max albedo over deep snow + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfalb] + standard_name = surface_diffused_shortwave_albedo + long_name = mean surface diffused shortwave albedo + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[flag_guess] + standard_name = flag_for_guess_run + long_name = flag for guess run + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[lheatstrg] + standard_name = flag_for_canopy_heat_storage + long_name = flag for canopy heat storage parameterization + units = flag + dimensions = () + type = logical + intent = in + optional = F +[isot] + standard_name = soil_type_dataset_choice + long_name = soil type dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[ivegsrc] + standard_name = vegetation_type_dataset_choice + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[bexppert] + standard_name = perturbation_of_soil_type_b_parameter + long_name = perturbation of soil type "b" parameter + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xlaipert] + standard_name = perturbation_of_leaf_area_index + long_name = perturbation of leaf area index + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vegfpert] + standard_name = perturbation_of_vegetation_fraction + long_name = perturbation of vegetation fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[pertvegf] + standard_name = magnitude_of_perturbation_of_vegetation_fraction + long_name = magnitude of perturbation of vegetation fraction + units = frac + dimensions = (5) + type = real + kind = kind_phys + intent = in + optional = F +[weasd] + standard_name = water_equivalent_accumulated_snow_depth_over_land + long_name = water equiv of acc snow depth over land + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snwdph] + standard_name = surface_snow_thickness_water_equivalent_over_land + long_name = water equivalent snow depth over land + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tskin] + standard_name = surface_skin_temperature_over_land_interstitial + long_name = surface skin temperature over land (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tprcp] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land + long_name = total precipitation amount in each time step over land + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[srflag] + standard_name = flag_for_precipitation_type + long_name = flag for snow or rain precipitation + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smc] + standard_name = volume_fraction_of_soil_moisture + long_name = volumetric fraction of soil moisture + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[slc] + standard_name = volume_fraction_of_unfrozen_soil_moisture + long_name = volume fraction of unfrozen soil moisture + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[canopy] + standard_name = canopy_water_amount + long_name = canopy moisture content + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[trans] + standard_name = transpiration_flux + long_name = total plant transpiration rate + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsurf] + standard_name = surface_skin_temperature_after_iteration_over_land + long_name = surface skin temperature after iteration over land + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[zorl] + standard_name = surface_roughness_length_over_land_interstitial + long_name = surface roughness length over land (temporary use as interstitial) + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sncovr1] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qsurf] + standard_name = surface_specific_humidity_over_land + long_name = surface air saturation specific humidity over land + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gflux] + standard_name = upward_heat_flux_in_soil_over_land + long_name = soil heat flux over land + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[drain] + standard_name = subsurface_runoff_flux + long_name = subsurface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux_over_land + long_name = kinematic surface upward latent heat flux over land + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_land + long_name = kinematic surface upward sensible heat flux over land + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ep] + standard_name = surface_upward_potential_latent_heat_flux_over_land + long_name = surface upward potential latent heat flux over land + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cmm] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land + long_name = momentum exchange coefficient over land + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[chh] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land + long_name = thermal exchange coefficient over land + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[evbs] + standard_name = soil_upward_latent_heat_flux + long_name = soil upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[evcw] + standard_name = canopy_upward_latent_heat_flux + long_name = canopy upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sbsno] + standard_name = snow_deposition_sublimation_upward_latent_heat_flux + long_name = latent heat flux from snow depo/subl + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snowc] + standard_name = surface_snow_area_fraction + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stm] + standard_name = soil_moisture_content + long_name = soil moisture content + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snohf] + standard_name = snow_freezing_rain_upward_latent_heat_flux + long_name = latent heat flux due to snow and frz rain + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smcwlt2] + standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point + long_name = soil water fraction at wilting point + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smcref2] + standard_name = threshold_volume_fraction_of_condensed_water_in_soil + long_name = soil moisture threshold + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[wet1] + standard_name = normalized_soil_wetness + long_name = normalized soil wetness + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F +************************ +MKB Addition +************************ +[ffrozp] + standard_name = flag_snow_rain_detection + long_name = flag for snow-rain detection(1./0.=snow/rain) + units = flag + dimensions = (horizontal_dimension) + type = real + intent = in + optional = F +[dt] + standard_name = time_step_for_physics + long_name = time step for physics + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[zlvl] + standard_name = height_above_ground_at_lowest_model_layer + long_name = layer 1 height above ground (not MSL) + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sldpth] + standard_name = thickness_of_each_soil_layer + long_name = thickness of each soil layer (nsoil) + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[swdn] + standard_name = downward_shortwave_radiation_flux + long_name = downward shortwave radiation flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[swnet] + standard_name = downward_shortwave_net_flux + long_name = downward shortwave net (dn-up) flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lwdn] + standard_name = downward_longwave_radiation_flux + long_name = downward longwave radiation flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcems] + standard_name = surface_longwave_emissivity_over_land + long_name = surface lw emissivity in fraction over land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcprs] + standard_name = surface_air_pressure_at_height_zlvl_above_ground + long_name = surface pressure at height zlvl above ground + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfctmp] + standard_name = surface_temperature_height_zlvl_above_ground + long_name = surface temperature at height zlvl above ground + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcspd] + standard_name = wind_speed_at_zlvl_above_ground + long_name = wind speed at zlvl above ground + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prcp] + standard_name = precipitation_rate_from_previous_timestep + long_name = precipitation rate from previous timestep + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q2] + standard_name = mixing_ratio_at_zlvl_above_ground + long_name = mixing_ratio_at_zlvl_above_ground + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q2sat] + standard_name = sat_mixing_ratio_at_zlvl_above_ground + long_name = sat mixing ratio at zlvl above ground + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dqsdt2] + standard_name = slope_sat_specific_humidity + long_name = slope of sat specific humidity curve at t=sfctmp + units = kg kg-1 k-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[vegtyp] + standard_name = vegetation_type_classification + long_name = vegetation type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[alb] + standard_name = background_snow_free_surface_albedo + long_name = background snow free surface albedo + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snoalb] + standard_name = max_albedo_deep_snow + long_name = max albedo over deep snow + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tbot] + standard_name = bottom_soil_temperature + long_name = bottom_soil_temperature (local yearly-mean sfc air tmp) + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cmc] + standard_name = canopy_water_amount + long_name = canopy moisture content + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t1] + standard_name = ground_canopy_snowpack_effect_skin_temperature + long_name = ground canopy snowpack effect skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sh2o] + standard_name = volume_fraction_of_unfrozen_soil_moisture_for_land_surface_model + long_name = volume fraction of unfrozen soil moisture for lsm + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[sneqv] + standard_name = surface_snow_thickness_water_equivalent + long_name = water equivalent snow depth + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[z0] + standard_name = time_varying_roughness_length + long_name = time varying roughness length + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[z0brd] + standard_name = background_fixed_roughness_length + long_name = background fixed roughness length + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nroot] + standard_name = number_of_root_layers + long_name = number of root layers function of vegtype + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[shdfac] + standard_name = areal_coverage_vegetation_area_fraction + long_name = areal coverage of green veg + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snowh] + standard_name = actual_snow_depth + long_name = snow depth + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albedo] + standard_name = surface_albedo_incl_snow_effect + long_name = surface albedo incl snow effect + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[eta] + standard_name = instantaneous_downward_latent_heat_flux + long_name = instantaneous downward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[eta_kinematic] + standard_name = actual_latent_heat_flux + long_name = actual latent heat flux + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sheat] + standard_name = instantaneous_sensible_heat_flux + long_name = instantaneous sensible heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[ec] + standard_name = evaporation_from_canopy_intercepted_rainfall + long_name = evaporation from canopy intercepted rainfall + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[edir] + standard_name = direct_evaporation_from_soil + long_name = direct_evaporation_from_soil + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[et] + standard_name = transpiration_through_plant_canopy + long_name = transpiration through plant canopy + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[ett] + standard_name = total_plant_transpiration + long_name = total plant transpiration + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[esnow] + standard_name = sublimation_from_snowpack + long_name = sublimation from snowpack + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[drip] + standard_name = throughfall_of_precip_dew + long_name = through-fall of precip and or dew in excess of canopy water holding capacity + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dew] + standard_name = dewfall + long_name = dewfall or frostfall for t<273.15 + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[beta] + standard_name = ratio_of_actual_potential_evap + long_name = ratio of actual/potential evaporation + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[etp] + standard_name = potential_evap + long_name = potential evaporation + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[ssoil] + standard_name = upward_soil_heat_flux + long_name = upward soil heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[flx1] + standard_name = precip_snow_sfc_flux + long_name = precip snow sfc flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[flx2] + standard_name = freezing_rain_latent_heat_flux + long_name = freezing rain latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[flx3] + standard_name = phase_change_heat_flux_from_snow_melt + long_name = phase change heat flux from snow melt + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[flx4] + standard_name = energy_added_to_sensible_heat + long_name = energy added to sensible heat ua_phys + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[fvb] + standard_name = fraction_of_veg_with_snow_beneath + long_name = fraction of veg with snow beneath ua_phys + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[fbur] + standard_name = fraction_of_canopy_buried + long_name = fraction of canopy buried ua_phys + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[fgsn] + standard_name = fraction_of_ground_snow_cover + long_name = fraction of ground snow cover ua_phys + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[runoff1] + standard_name = surface_runoff + long_name = surface runoff not infiltrating sfc + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[runoff2] + standard_name = sub_surface_runoff + long_name = sub surface runoff baseflow + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[runoff3] + standard_name = excess_porosity + long_name = excess of porosity for a given soil layer + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snowmlt] + standard_name = surface_snow_melt + long_name = snow melt during timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sncovr] + standard_name = fractional_snow_cover + long_name = fractional snow cover + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rc] + standard_name = canopy_resistance + long_name = canopy resistance + units = s m-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[pc] + standard_name = plant_coefficient + long_name = plant coefficient + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rsmin] + standard_name = min_canopy_resistance + long_name = min canopy resistance + units = s m-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[xlai] + standard_name = leaf_area_index + long_name = leaf_area_index + units = index + dimensions = () + type = real + kind = kind_phys + intent = inout + optional = F +[rcs] + standard_name = incoming_solar_rc_factor + long_name = incoming solar rc factor + units = index + dimensions = () + type = real + kind = kind_phys + intent = inout + optional = F +[rct] + standard_name = air_temperature_rc_factor + long_name = air temperature rc factor + units = index + dimensions = () + type = real + kind = kind_phys + intent = inout + optional = F +[rcq] + standard_name = atmospheric_vapor_pressure_deficit_rc_factor + long_name = atmospheric vapor pressure deficit rc factor + units = index + dimensions = () + type = real + kind = kind_phys + intent = inout + optional = F +[rcsoil] + standard_name = soil_moisture_rc_factor + long_name = soil moisture rc factor + units = index + dimensions = () + type = real + kind = kind_phys + intent = inout + optional = F +[soilw] + standard_name = soil_moisture_root_zone + long_name = available soil moisture in root zone + units = frac + dimensions = () + type = real + kind = kind_phys + intent = inout + optional = F +[soilm] + standard_name = total_soil_column_moisture_content + long_name = total soil column moisture content frozen and unfrozen + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[q1] + standard_name = effective_mixing_ratio_at_surface + long_name = effective mixing ratio at surface + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smav] + standard_name = soil_moisture_availability_for_each_layer + long_name = soil moisture availabilty for each layer + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smcwlt] + standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point + long_name = wilting point (volumetric) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[smcref] + standard_name = threshold_volume_fraction_of_condensed_water_in_soil + long_name = soil moisture threshold (volumetric) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[smcdry] + standard_name = threshold_volume_fraction_of_dry_moisture_in_soil + long_name = dry soil moisture threshold where dry evap from top layer ends (volumetric) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[smcmax] + standard_name = porosity + long_name = saturated value of soil moisture (volumetric) + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F