diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 357309b2a..026e91416 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -316,7 +316,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqdt, dusfc_cpl, dvsfc_cpl, dtsfc_cpl, & dqsfc_cpl, dusfci_cpl, dvsfci_cpl, dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, & dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag, dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, dq3dt, & - dq3dt_ozone, rd, cp, fvirt, hvap, t1, q1, prsl, hflx, ushfsfci, oceanfrac, flag_cice, dusfc_cice, dvsfc_cice, & + dq3dt_ozone, rd, cp, fvirt, hvap, t1, q1, prsl, hflx, ushfsfci, oceanfrac, kdt, dusfc_cice, dvsfc_cice, & dtsfc_cice, dqsfc_cice, wet, dry, icy, wind, stress_wat, hflx_wat, evap_wat, ugrs1, vgrs1, dkt_cpl, dkt, hffac, hefac, & ugrs, vgrs, tgrs, qgrs, save_u, save_v, save_t, save_q, errmsg, errflg) @@ -333,7 +333,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires logical, intent(in) :: ltaerosol, cplflx, cplchm, lssav, ldiag3d, qdiag3d, lsidea logical, intent(in) :: hybedmf, do_shoc, satmedmf, shinhong, do_ysu - logical, dimension(:), intent(in) :: flag_cice + integer, intent(in) :: kdt logical, intent(in) :: flag_for_pbl_generic_tend real(kind=kind_phys), dimension(im, levs), intent(in) :: save_u, save_v, save_t @@ -549,7 +549,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, do i=1,im if (oceanfrac(i) > zero) then ! Ocean only, NO LAKES if ( .not. wet(i)) then ! no open water - if (flag_cice(i)) then !use results from CICE + if ( kdt > 1 ) then !use results from CICE dusfci_cpl(i) = dusfc_cice(i) dvsfci_cpl(i) = dvsfc_cice(i) dtsfci_cpl(i) = dtsfc_cice(i) diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 5e83b8ad4..87b3f33b8 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -1194,12 +1194,12 @@ kind = kind_phys intent = in optional = F -[flag_cice] - standard_name = flag_for_cice - long_name = flag for cice - units = flag - dimensions = (horizontal_loop_extent) - type = logical +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer intent = in optional = F [dusfc_cice] diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index e33585ace..94fc5e36b 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -36,6 +36,13 @@ module GFS_phys_time_vary use namelist_soilveg, only: salp_data, snupx use set_soilveg_mod, only: set_soilveg + ! --- needed for Noah MP init + use noahmp_tables, only: laim_table,saim_table,sla_table, & + bexp_table,smcmax_table,smcwlt_table, & + dwsat_table,dksat_table,psisat_table, & + isurban_table,isbarren_table, & + isice_table,iswater_table + implicit none private @@ -44,12 +51,13 @@ module GFS_phys_time_vary logical :: is_initialized = .false. - real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys - real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys - real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys - real(kind=kind_phys), parameter :: drythresh = 1.e-4_kind_phys - real(kind=kind_phys), parameter :: zero = 0.0_kind_phys - real(kind=kind_phys), parameter :: one = 1.0_kind_phys + real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys + real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys + real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys + real(kind=kind_phys), parameter :: missing_value = 9.99e20_kind_phys + real(kind=kind_phys), parameter :: drythresh = 1.e-4_kind_phys + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys + real(kind=kind_phys), parameter :: one = 1.0_kind_phys contains @@ -64,8 +72,13 @@ subroutine GFS_phys_time_vary_init ( jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, imap, jmap, & do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, & - isot, ivegsrc, nlunit, sncovr, sncovr_ice, lsm, lsm_ruc, min_seaice, fice, landfrac, & - vtype, weasd, nthrds, errmsg, errflg) + isot, ivegsrc, nlunit, sncovr, sncovr_ice, lsm, lsm_noahmp, lsm_ruc, min_seaice, & + fice, landfrac, vtype, weasd, lsoil, zs, dzs, lsnow_lsm_lbound, lsnow_lsm_ubound, & + tvxy, tgxy, tahxy, canicexy, canliqxy, eahxy, cmxy, chxy, fwetxy, sneqvoxy, alboldxy,& + qsnowxy, wslakexy, albdvis, albdnir, albivis, albinir, emiss, taussxy, waxy, wtxy, & + zwtxy, xlaixy, xsaixy, lfmassxy, stmassxy, rtmassxy, woodxy, stblcpxy, fastcpxy, & + smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, snliqxy, tsnoxy , smoiseq, zsnsoxy, & + slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, nthrds, errmsg, errflg) implicit none @@ -90,9 +103,63 @@ subroutine GFS_phys_time_vary_init ( integer, intent(in) :: isot, ivegsrc, nlunit real(kind_phys), intent(inout) :: sncovr(:), sncovr_ice(:) - integer, intent(in) :: lsm, lsm_ruc + integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc real(kind_phys), intent(in) :: min_seaice, fice(:) - real(kind_phys), intent(in) :: landfrac(:), vtype(:), weasd(:) + real(kind_phys), intent(in) :: landfrac(:), vtype(:) + real(kind_phys), intent(inout) :: weasd(:) + + ! NoahMP - only allocated when NoahMP is used + integer, intent(in) :: lsoil, lsnow_lsm_lbound, lsnow_lsm_ubound + real(kind_phys), intent(in) :: zs(:) + real(kind_phys), intent(in) :: dzs(:) + real(kind_phys), intent(inout) :: tvxy(:) + real(kind_phys), intent(inout) :: tgxy(:) + real(kind_phys), intent(inout) :: tahxy(:) + real(kind_phys), intent(inout) :: canicexy(:) + real(kind_phys), intent(inout) :: canliqxy(:) + real(kind_phys), intent(inout) :: eahxy(:) + real(kind_phys), intent(inout) :: cmxy(:) + real(kind_phys), intent(inout) :: chxy(:) + real(kind_phys), intent(inout) :: fwetxy(:) + real(kind_phys), intent(inout) :: sneqvoxy(:) + real(kind_phys), intent(inout) :: alboldxy(:) + real(kind_phys), intent(inout) :: qsnowxy(:) + real(kind_phys), intent(inout) :: wslakexy(:) + real(kind_phys), intent(inout) :: albdvis(:) + real(kind_phys), intent(inout) :: albdnir(:) + real(kind_phys), intent(inout) :: albivis(:) + real(kind_phys), intent(inout) :: albinir(:) + real(kind_phys), intent(inout) :: emiss(:) + real(kind_phys), intent(inout) :: taussxy(:) + real(kind_phys), intent(inout) :: waxy(:) + real(kind_phys), intent(inout) :: wtxy(:) + real(kind_phys), intent(inout) :: zwtxy(:) + real(kind_phys), intent(inout) :: xlaixy(:) + real(kind_phys), intent(inout) :: xsaixy(:) + real(kind_phys), intent(inout) :: lfmassxy(:) + real(kind_phys), intent(inout) :: stmassxy(:) + real(kind_phys), intent(inout) :: rtmassxy(:) + real(kind_phys), intent(inout) :: woodxy(:) + real(kind_phys), intent(inout) :: stblcpxy(:) + real(kind_phys), intent(inout) :: fastcpxy(:) + real(kind_phys), intent(inout) :: smcwtdxy(:) + real(kind_phys), intent(inout) :: deeprechxy(:) + real(kind_phys), intent(inout) :: rechxy(:) + real(kind_phys), intent(inout) :: snowxy(:) + real(kind_phys), intent(inout) :: snicexy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout) :: snliqxy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout) :: tsnoxy (:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout) :: smoiseq(:,:) + real(kind_phys), intent(inout) :: zsnsoxy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout) :: slc(:,:) + real(kind_phys), intent(inout) :: smc(:,:) + real(kind_phys), intent(inout) :: stc(:,:) + real(kind_phys), intent(in) :: tsfcl(:) + real(kind_phys), intent(in) :: snowd(:) + real(kind_phys), intent(in) :: canopy(:) + real(kind_phys), intent(in) :: tg3(:) + real(kind_phys), intent(in) :: stype(:) + real(kind_phys), intent(in) :: con_t0c integer, intent(in) :: nthrds character(len=*), intent(out) :: errmsg @@ -102,6 +169,14 @@ subroutine GFS_phys_time_vary_init ( integer :: i, j, ix, vegtyp real(kind_phys) :: rsnow + !--- Noah MP + integer :: soiltyp, isnow, is, imn + real(kind=kind_phys) :: masslai, masssai, snd + real(kind=kind_phys) :: bexp, ddz, smcmax, smcwlt, dwsat, dksat, psisat + + real(kind=kind_phys), dimension(:), allocatable :: dzsno + real(kind=kind_phys), dimension(:), allocatable :: dzsnso + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -293,8 +368,291 @@ subroutine GFS_phys_time_vary_init ( !$OMP end parallel + if (lsm == lsm_noahmp) then + if (all(tvxy < zero)) then + + allocate(dzsno (lsnow_lsm_lbound:lsnow_lsm_ubound)) + allocate(dzsnso(lsnow_lsm_lbound:lsoil) ) + dzsno(:) = missing_value + dzsnso(:) = missing_value + + tvxy(:) = missing_value + tgxy(:) = missing_value + tahxy(:) = missing_value + canicexy(:) = missing_value + canliqxy(:) = missing_value + eahxy(:) = missing_value + cmxy(:) = missing_value + chxy(:) = missing_value + fwetxy(:) = missing_value + sneqvoxy(:) = missing_value + alboldxy(:) = missing_value + qsnowxy(:) = missing_value + wslakexy(:) = missing_value + albdvis(:) = missing_value + albdnir(:) = missing_value + albivis(:) = missing_value + albinir(:) = missing_value + emiss(:) = missing_value + taussxy(:) = missing_value + waxy(:) = missing_value + wtxy(:) = missing_value + zwtxy(:) = missing_value + xlaixy(:) = missing_value + xsaixy(:) = missing_value + + lfmassxy(:) = missing_value + stmassxy(:) = missing_value + rtmassxy(:) = missing_value + woodxy(:) = missing_value + stblcpxy(:) = missing_value + fastcpxy(:) = missing_value + smcwtdxy(:) = missing_value + deeprechxy(:) = missing_value + rechxy(:) = missing_value + + snowxy (:) = missing_value + snicexy(:,:) = missing_value + snliqxy(:,:) = missing_value + tsnoxy (:,:) = missing_value + smoiseq(:,:) = missing_value + zsnsoxy(:,:) = missing_value + + do ix=1,im + if (landfrac(ix) >= drythresh) then + tvxy(ix) = tsfcl(ix) + tgxy(ix) = tsfcl(ix) + tahxy(ix) = tsfcl(ix) + + if (snowd(ix) > 0.01_kind_phys .and. tsfcl(ix) > con_t0c ) tvxy(ix) = con_t0c + if (snowd(ix) > 0.01_kind_phys .and. tsfcl(ix) > con_t0c ) tgxy(ix) = con_t0c + if (snowd(ix) > 0.01_kind_phys .and. tsfcl(ix) > con_t0c ) tahxy(ix) = con_t0c + + canicexy(ix) = 0.0_kind_phys + canliqxy(ix) = canopy(ix) + + eahxy(ix) = 2000.0_kind_phys + +! eahxy = psfc*qv/(0.622+qv); qv is mixing ratio, converted from sepcific +! humidity specific humidity /(1.0 - specific humidity) + + cmxy(ix) = zero + chxy(ix) = zero + fwetxy(ix) = zero + sneqvoxy(ix) = weasd(ix) ! mm + alboldxy(ix) = 0.65_kind_phys + qsnowxy(ix) = zero + +! if (srflag(ix) > 0.001) qsnowxy(ix) = tprcp(ix)/dtp + ! already set to 0.0 + wslakexy(ix) = zero + taussxy(ix) = zero + albdvis(ix) = 0.2_kind_phys + albdnir(ix) = 0.2_kind_phys + albivis(ix) = 0.2_kind_phys + albinir(ix) = 0.2_kind_phys + emiss(ix) = 0.95_kind_phys + + + waxy(ix) = 4900.0_kind_phys + wtxy(ix) = waxy(ix) + zwtxy(ix) = (25.0_kind_phys + 2.0_kind_phys) - waxy(ix) / 1000.0_kind_phys / 0.2_kind_phys + + vegtyp = vtype(ix) + if (vegtyp == 0) vegtyp = 7 + imn = idate(2) + + if ((vegtyp == isbarren_table) .or. (vegtyp == isice_table) .or. (vegtyp == isurban_table) .or. (vegtyp == iswater_table)) then + + xlaixy(ix) = zero + xsaixy(ix) = zero + + lfmassxy(ix) = zero + stmassxy(ix) = zero + rtmassxy(ix) = zero + + woodxy (ix) = zero + stblcpxy (ix) = zero + fastcpxy (ix) = zero + + else + + xlaixy(ix) = max(laim_table(vegtyp, imn),0.05_kind_phys) +! xsaixy(ix) = max(saim_table(vegtyp, imn),0.05) + xsaixy(ix) = max(xlaixy(ix)*0.1_kind_phys,0.05_kind_phys) + + masslai = 1000.0_kind_phys / max(sla_table(vegtyp),one) + lfmassxy(ix) = xlaixy(ix)*masslai + masssai = 1000.0_kind_phys / 3.0_kind_phys + stmassxy(ix) = xsaixy(ix)* masssai + + rtmassxy(ix) = 500.0_kind_phys + + woodxy(ix) = 500.0_kind_phys + stblcpxy(ix) = 1000.0_kind_phys + fastcpxy(ix) = 1000.0_kind_phys + + endif ! non urban ... + + if (vegtyp == isice_table) then + do is = 1,lsoil + stc(ix,is) = min(stc(ix,is),min(tg3(ix),263.15_kind_phys)) + smc(ix,is) = one + slc(ix,is) = zero + enddo + endif + + snd = snowd(ix)/1000.0_kind_phys ! go to m from snwdph + + if (weasd(ix) /= zero .and. snd == zero ) then + snd = weasd(ix)/1000.0 + endif + + if (vegtyp == 15) then ! land ice in MODIS/IGBP + if (weasd(ix) < 0.1_kind_phys) then + weasd(ix) = 0.1_kind_phys + snd = 0.01_kind_phys + endif + endif + + if (snd < 0.025_kind_phys ) then + snowxy(ix) = zero + dzsno(-2:0) = zero + elseif (snd >= 0.025_kind_phys .and. snd <= 0.05_kind_phys ) then + snowxy(ix) = -1.0_kind_phys + dzsno(0) = snd + elseif (snd > 0.05_kind_phys .and. snd <= 0.10_kind_phys ) then + snowxy(ix) = -2.0_kind_phys + dzsno(-1) = 0.5_kind_phys*snd + dzsno(0) = 0.5_kind_phys*snd + elseif (snd > 0.10_kind_phys .and. snd <= 0.25_kind_phys ) then + snowxy(ix) = -2.0_kind_phys + dzsno(-1) = 0.05_kind_phys + dzsno(0) = snd - 0.05_kind_phys + elseif (snd > 0.25_kind_phys .and. snd <= 0.45_kind_phys ) then + snowxy(ix) = -3.0_kind_phys + dzsno(-2) = 0.05_kind_phys + dzsno(-1) = 0.5_kind_phys*(snd-0.05_kind_phys) + dzsno(0) = 0.5_kind_phys*(snd-0.05_kind_phys) + elseif (snd > 0.45_kind_phys) then + snowxy(ix) = -3.0_kind_phys + dzsno(-2) = 0.05_kind_phys + dzsno(-1) = 0.20_kind_phys + dzsno(0) = snd - 0.05_kind_phys - 0.20_kind_phys + else + errmsg = 'Error in GFS_phys_time_vary.fv3.F90: Problem with the logic assigning snow layers in Noah MP initialization' + errflg = 1 + return + endif + +! Now we have the snowxy field +! snice + snliq + tsno allocation and compute them from what we have + + tsnoxy(ix,:) = zero + snicexy(ix,:) = zero + snliqxy(ix,:) = zero + zsnsoxy(ix,:) = zero + + isnow = nint(snowxy(ix))+1 ! snowxy <=0.0, dzsno >= 0.0 + + do is = isnow,0 + tsnoxy(ix,is) = tgxy(ix) + snliqxy(ix,is) = zero + snicexy(ix,is) = one * dzsno(is) * weasd(ix)/snd + enddo +! +!zsnsoxy, all negative ? +! + do is = isnow,0 + dzsnso(is) = -dzsno(is) + enddo + + do is = 1,4 + dzsnso(is) = -dzs(is) + enddo +! +! Assign to zsnsoxy +! + zsnsoxy(ix,isnow) = dzsnso(isnow) + do is = isnow+1,4 + zsnsoxy(ix,is) = zsnsoxy(ix,is-1) + dzsnso(is) + enddo +! +! smoiseq +! Init water table related quantities here +! + soiltyp = stype(ix) + if (soiltyp /= 0) then + bexp = bexp_table(soiltyp) + smcmax = smcmax_table(soiltyp) + smcwlt = smcwlt_table(soiltyp) + dwsat = dwsat_table(soiltyp) + dksat = dksat_table(soiltyp) + psisat = -psisat_table(soiltyp) + endif + + if (vegtyp == isurban_table) then + smcmax = 0.45_kind_phys + smcwlt = 0.40_kind_phys + endif + + if ((bexp > zero) .and. (smcmax > zero) .and. (-psisat > zero)) then + do is = 1, lsoil + if ( is == 1 )then + ddz = -zs(is+1) * 0.5_kind_phys + elseif ( is < lsoil ) then + ddz = ( zs(is-1) - zs(is+1) ) * 0.5_kind_phys + else + ddz = zs(is-1) - zs(is) + endif + smoiseq(ix,is) = min(max(find_eq_smc(bexp, dwsat, dksat, ddz, smcmax),1.e-4_kind_phys),smcmax*0.99_kind_phys) + enddo + else ! bexp <= 0.0 + smoiseq(ix,1:4) = smcmax + endif ! end the bexp condition + + smcwtdxy(ix) = smcmax + deeprechxy(ix) = zero + rechxy(ix) = zero + + endif + + enddo ! ix + + deallocate(dzsno) + deallocate(dzsnso) + + endif + endif !if Noah MP cold start ends + is_initialized = .true. + contains + +! +! Use newton-raphson method to find eq soil moisture +! + function find_eq_smc(bexp, dwsat, dksat, ddz, smcmax) result(smc) + implicit none + real(kind=kind_phys), intent(in) :: bexp, dwsat, dksat, ddz, smcmax + real(kind=kind_phys) :: smc + real(kind=kind_phys) :: expon, aa, bb, func, dfunc, dx + integer :: iter + ! + expon = bexp + 1. + aa = dwsat / ddz + bb = dksat / smcmax ** expon + smc = 0.5 * smcmax + ! + do iter = 1,100 + func = (smc - smcmax) * aa + bb * smc ** expon + dfunc = aa + bb * expon * smc ** bexp + dx = func / dfunc + smc = smc - dx + if ( abs (dx) < 1.e-6_kind_phys) return + enddo + end function find_eq_smc + end subroutine GFS_phys_time_vary_init !! @} diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index 393874cae..06192eb6a 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -2,7 +2,7 @@ name = GFS_phys_time_vary type = scheme dependencies = aerclm_def.F,aerinterp.F90,gcycle.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f - dependencies = namelist_soilveg.f,set_soilveg.f,ozinterp.f90,ozne_def.f,sfcsub.F,cires_tauamf_data.F90 + dependencies = namelist_soilveg.f,set_soilveg.f,ozinterp.f90,ozne_def.f,sfcsub.F,cires_tauamf_data.F90,noahmp_tables.f90 ######################################################################## [ccpp-arg-table] @@ -320,7 +320,7 @@ standard_name = lower_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation long_name = index1 for weight1 for tau NGWs units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = integer intent = inout optional = F @@ -328,7 +328,7 @@ standard_name = upper_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation long_name = index2 for weight2 for tau NGWs units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = integer intent = inout optional = F @@ -336,7 +336,7 @@ standard_name = latitude_interpolation_weight_complement_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight1 for tau NGWs units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real intent = inout kind = kind_phys @@ -345,7 +345,7 @@ standard_name = latitude_interpolation_weight_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight2 for tau NGWs units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real intent = inout kind = kind_phys @@ -400,18 +400,18 @@ type = integer intent = in optional = F -[lsm_ruc] - standard_name = flag_for_ruc_land_surface_scheme - long_name = flag for RUC land surface model +[lsm_noahmp] + standard_name = flag_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model units = flag dimensions = () type = integer intent = in optional = F -[nthrds] - standard_name = omp_threads - long_name = number of OpenMP threads available for physics schemes - units = count +[lsm_ruc] + standard_name = flag_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag dimensions = () type = integer intent = in @@ -459,6 +459,488 @@ dimensions = (horizontal_dimension) type = real kind = kind_phys + intent = inout + optional = F +[lsoil] + standard_name = soil_vertical_dimension + long_name = number of soil layers + units = count + dimensions = () + type = integer + intent = in + optional = F +[zs] + standard_name = depth_of_soil_levels_for_land_surface_model + long_name = depth of soil levels for land surface model + units = m + dimensions = (soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = in + optional = F +[dzs] + standard_name = thickness_of_soil_levels_for_land_surface_model + long_name = thickness of soil levels for land surface model + units = m + dimensions = (soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = in + optional = F +[lsnow_lsm_lbound] + standard_name = lower_bound_of_snow_vertical_dimension_for_land_surface_model + long_name = lower bound of of snow-related arrays for land surface model + units = count + dimensions = () + type = integer + intent = in + optional = F +[lsnow_lsm_ubound] + standard_name = upper_bound_of_snow_vertical_dimension_for_land_surface_model + long_name = upper bound of of snow-related arrays for land surface model + units = count + dimensions = () + type = integer + intent = in + optional = F +[tvxy] + standard_name = vegetation_temperature + long_name = vegetation temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tgxy] + standard_name = ground_temperature_for_noahmp + long_name = ground temperature for noahmp + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tahxy] + standard_name = canopy_air_temperature + long_name = canopy air temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[canicexy] + standard_name = canopy_intercepted_ice_mass + long_name = canopy intercepted ice mass + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[canliqxy] + standard_name = canopy_intercepted_liquid_water + long_name = canopy intercepted liquid water + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[eahxy] + standard_name = canopy_air_vapor_pressure + long_name = canopy air vapor pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cmxy] + standard_name = surface_drag_coefficient_for_momentum_for_noahmp + long_name = surface drag coefficient for momentum for noahmp + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[chxy] + standard_name = surface_drag_coefficient_for_heat_and_moisture_for_noahmp + long_name = surface exchange coeff heat & moisture for noahmp + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fwetxy] + standard_name = area_fraction_of_wet_canopy + long_name = area fraction of canopy that is wetted/snowed + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sneqvoxy] + standard_name = snow_mass_at_previous_time_step + long_name = snow mass at previous time step + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[alboldxy] + standard_name = snow_albedo_at_previous_time_step + long_name = snow albedo at previous time step + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qsnowxy] + standard_name = snow_precipitation_rate_at_surface + long_name = snow precipitation rate at surface + units = mm s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[wslakexy] + standard_name = lake_water_storage + long_name = lake water storage + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[taussxy] + standard_name = nondimensional_snow_age + long_name = non-dimensional snow age + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[waxy] + standard_name = water_storage_in_aquifer + long_name = water storage in aquifer + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[wtxy] + standard_name = water_storage_in_aquifer_and_saturated_soil + long_name = water storage in aquifer and saturated soil + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[zwtxy] + standard_name = water_table_depth + long_name = water table depth + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[xlaixy] + standard_name = leaf_area_index + long_name = leaf area index + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[xsaixy] + standard_name = stem_area_index + long_name = stem area index + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[lfmassxy] + standard_name = leaf_mass + long_name = leaf mass + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stmassxy] + standard_name = stem_mass + long_name = stem mass + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rtmassxy] + standard_name = fine_root_mass + long_name = fine root mass + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[woodxy] + standard_name = wood_mass + long_name = wood mass including woody roots + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stblcpxy] + standard_name = slow_soil_pool_mass_content_of_carbon + long_name = stable carbon in deep soil + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fastcpxy] + standard_name = fast_soil_pool_mass_content_of_carbon + long_name = short-lived carbon in shallow soil + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smcwtdxy] + standard_name = soil_water_content_between_soil_bottom_and_water_table + long_name = soil water content between the bottom of the soil and the water table + units = m3 m-3 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[deeprechxy] + standard_name = water_table_recharge_when_deep + long_name = recharge to or from the water table when deep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rechxy] + standard_name = water_table_recharge_when_shallow + long_name = recharge to or from the water table when shallow + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albdvis] + standard_name = surface_albedo_direct_visible + long_name = direct surface albedo visible band + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albdnir] + standard_name = surface_albedo_direct_NIR + long_name = direct surface albedo NIR band + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albivis] + standard_name = surface_albedo_diffuse_visible + long_name = diffuse surface albedo visible band + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albinir] + standard_name = surface_albedo_diffuse_NIR + long_name = diffuse surface albedo NIR band + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[emiss] + standard_name = surface_emissivity_lsm + long_name = surface emissivity from lsm + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snowxy] + standard_name = number_of_snow_layers + long_name = number of snow layers + units = count + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snicexy] + standard_name = snow_layer_ice + long_name = snow layer ice + units = mm + dimensions = (horizontal_dimension,lower_bound_of_snow_vertical_dimension_for_land_surface_model:upper_bound_of_snow_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[snliqxy] + standard_name = snow_layer_liquid_water + long_name = snow layer liquid water + units = mm + dimensions = (horizontal_dimension,lower_bound_of_snow_vertical_dimension_for_land_surface_model:upper_bound_of_snow_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[tsnoxy] + standard_name = snow_temperature + long_name = snow_temperature + units = K + dimensions = (horizontal_dimension,lower_bound_of_snow_vertical_dimension_for_land_surface_model:upper_bound_of_snow_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[smoiseq] + standard_name = equilibrium_soil_water_content + long_name = equilibrium soil water content + units = m3 m-3 + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[zsnsoxy] + standard_name = layer_bottom_depth_from_snow_surface + long_name = depth from the top of the snow surface at the bottom of the layer + units = m + dimensions = (horizontal_dimension,lower_bound_of_snow_vertical_dimension_for_land_surface_model:soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[slc] + standard_name = volume_fraction_of_unfrozen_soil_moisture + long_name = liquid soil moisture + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smc] + standard_name = volume_fraction_of_soil_moisture + long_name = total 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 +[tsfcl] + standard_name = surface_skin_temperature_over_land + long_name = surface skin temperature over land + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snowd] + standard_name = surface_snow_thickness_water_equivalent + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[canopy] + standard_name = canopy_water_amount + long_name = canopy water amount + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tg3] + standard_name = deep_soil_temperature + long_name = deep soil temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stype] + standard_name = soil_type_classification_real + long_name = soil type for lsm + units = index + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[con_t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degree Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[nthrds] + standard_name = omp_threads + long_name = number of OpenMP threads available for physics schemes + units = count + dimensions = () + type = integer intent = in optional = F [errmsg] @@ -1142,7 +1624,7 @@ standard_name = volume_fraction_of_soil_moisture_for_land_surface_model long_name = volumetric fraction of soil moisture for lsm units = frac - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -1151,7 +1633,7 @@ 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_loop_extent,soil_vertical_dimension_for_land_surface_model) + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -1160,7 +1642,7 @@ standard_name = soil_temperature_for_land_surface_model long_name = soil temperature for land surface model units = K - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -1493,7 +1975,7 @@ standard_name = lower_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation long_name = index1 for weight1 for tau NGWs units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = integer intent = in optional = F @@ -1501,7 +1983,7 @@ standard_name = upper_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation long_name = index2 for weight2 for tau NGWs units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = integer intent = in optional = F @@ -1509,7 +1991,7 @@ standard_name = latitude_interpolation_weight_complement_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight1 for tau NGWs units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real intent = in kind = kind_phys @@ -1518,7 +2000,7 @@ standard_name = latitude_interpolation_weight_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight2 for tau NGWs units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real intent = in kind = kind_phys @@ -1527,7 +2009,7 @@ standard_name = absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = ngw_absolute_momentum_flux units = various - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index 538d30417..457080536 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -10,7 +10,7 @@ module GFS_rrtmgp_sw_pre cdfnor ! Routine to compute CDF (used to compute percentiles) use mo_gas_optics_rrtmgp, only: & ty_gas_optics_rrtmgp - use rrtmgp_sw_gas_optics, only: sw_gas_props + use rrtmgp_sw_gas_optics, only: sw_gas_props public GFS_rrtmgp_sw_pre_run,GFS_rrtmgp_sw_pre_init,GFS_rrtmgp_sw_pre_finalize contains @@ -29,11 +29,11 @@ end subroutine GFS_rrtmgp_sw_pre_init !! subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_list, & lndp_prt_list, doSWrad, solhr, lon, coslat, sinlat, snowd, sncovr, snoalb, zorl, & - tsfg, tsfa, hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, lsmask, & - sfc_wts, p_lay, tv_lay, relhum, p_lev, nday, idxday, coszen, coszdg, & - sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, & - errmsg, errflg) - + tsfg, tsfa, hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, albdvis, & + albdnir, albivis, albinir, lsmask, sfc_wts, p_lay, tv_lay, relhum, p_lev, & + nday, idxday, coszen, coszdg, sfc_alb_nir_dir, sfc_alb_nir_dif, & + sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, errmsg, errflg) + ! Inputs integer, intent(in) :: & me, & ! Current MPI rank @@ -69,6 +69,12 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ facwf, & ! Fractional coverage with weak cosz dependency (frac) fice, & ! Ice fraction over open water (frac) tisfc ! Sea ice surface skin temperature (K) + real(kind_phys), dimension(:), intent(in) :: & + albdvis, & ! surface albedo from lsm (direct,vis) (frac) + albdnir, & ! surface albedo from lsm (direct,nir) (frac) + albivis, & ! surface albedo from lsm (diffuse,vis) (frac) + albinir ! surface albedo from lsm (diffuse,nir) (frac) + real(kind_phys), dimension(nCol,n_var_lndp), intent(in) :: & sfc_wts ! Weights for stochastic surface physics perturbation () real(kind_phys), dimension(nCol,nLev),intent(in) :: & @@ -132,7 +138,8 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ alb1d(:) = 0. lndp_alb = -999. call setalb (lsmask, snowd, sncovr, snoalb, zorl, coszen, tsfg, tsfa, hprime, alvsf, & - alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, NCOL, alb1d, lndp_alb, sfcalb) + alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, albdvis, albdnir, albivis, & + albinir, NCOL, alb1d, lndp_alb, sfcalb) ! Approximate mean surface albedo from vis- and nir- diffuse values. sfc_alb_dif(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index 07fdf8957..5a165f9ad 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -253,6 +253,42 @@ kind = kind_phys intent = in optional = F +[albdvis] + standard_name = surface_albedo_direct_visible + long_name = direct surface albedo visible band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albdnir] + standard_name = surface_albedo_direct_NIR + long_name = direct surface albedo NIR band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albivis] + standard_name = surface_albedo_diffuse_visible + long_name = diffuse surface albedo visible band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albinir] + standard_name = surface_albedo_diffuse_NIR + long_name = diffuse surface albedo NIR band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [sfc_wts] standard_name = weights_for_stochastic_surface_physics_perturbation long_name = weights for stochastic surface physics perturbation diff --git a/physics/module_sf_noahmp_glacier.f90 b/physics/module_sf_noahmp_glacier.f90 index 0b3749b5a..ebe4654bd 100644 --- a/physics/module_sf_noahmp_glacier.f90 +++ b/physics/module_sf_noahmp_glacier.f90 @@ -5,6 +5,7 @@ !>\ingroup NoahMP_LSM module noahmp_glacier_globals + use machine , only : kind_phys implicit none ! ================================================================================================== @@ -12,102 +13,57 @@ module noahmp_glacier_globals ! physical constants: ! !------------------------------------------------------------------------------------------! - real, parameter :: grav = 9.80616 !acceleration due to gravity (m/s2) - real, parameter :: sb = 5.67e-08 !stefan-boltzmann constant (w/m2/k4) - real, parameter :: vkc = 0.40 !von karman constant - real, parameter :: tfrz = 273.16 !freezing/melting point (k) - real, parameter :: hsub = 2.8440e06 !latent heat of sublimation (j/kg) - real, parameter :: hvap = 2.5104e06 !latent heat of vaporization (j/kg) - real, parameter :: hfus = 0.3336e06 !latent heat of fusion (j/kg) - real, parameter :: cwat = 4.188e06 !specific heat capacity of water (j/m3/k) - real, parameter :: cice = 2.094e06 !specific heat capacity of ice (j/m3/k) - real, parameter :: cpair = 1004.64 !heat capacity dry air at const pres (j/kg/k) - real, parameter :: tkwat = 0.6 !thermal conductivity of water (w/m/k) - real, parameter :: tkice = 2.2 !thermal conductivity of ice (w/m/k) - real, parameter :: tkair = 0.023 !thermal conductivity of air (w/m/k) - real, parameter :: rair = 287.04 !gas constant for dry air (j/kg/k) - real, parameter :: rw = 461.269 !gas constant for water vapor (j/kg/k) - real, parameter :: denh2o = 1000. !density of water (kg/m3) - real, parameter :: denice = 917. !density of ice (kg/m3) + real (kind=kind_phys), parameter :: grav = 9.80616 !acceleration due to gravity (m/s2) + real (kind=kind_phys), parameter :: sb = 5.67e-08 !stefan-boltzmann constant (w/m2/k4) + real (kind=kind_phys), parameter :: vkc = 0.40 !von karman constant + real (kind=kind_phys), parameter :: tfrz = 273.16 !freezing/melting point (k) + real (kind=kind_phys), parameter :: hsub = 2.8440e06 !latent heat of sublimation (j/kg) + real (kind=kind_phys), parameter :: hvap = 2.5104e06 !latent heat of vaporization (j/kg) + real (kind=kind_phys), parameter :: hfus = 0.3336e06 !latent heat of fusion (j/kg) + real (kind=kind_phys), parameter :: cwat = 4.188e06 !specific heat capacity of water (j/m3/k) + real (kind=kind_phys), parameter :: cice = 2.094e06 !specific heat capacity of ice (j/m3/k) + real (kind=kind_phys), parameter :: cpair = 1004.64 !heat capacity dry air at const pres (j/kg/k) + real (kind=kind_phys), parameter :: tkwat = 0.6 !thermal conductivity of water (w/m/k) + real (kind=kind_phys), parameter :: tkice = 2.2 !thermal conductivity of ice (w/m/k) + real (kind=kind_phys), parameter :: tkair = 0.023 !thermal conductivity of air (w/m/k) + real (kind=kind_phys), parameter :: rair = 287.04 !gas constant for dry air (j/kg/k) + real (kind=kind_phys), parameter :: rw = 461.269 !gas constant for water vapor (j/kg/k) + real (kind=kind_phys), parameter :: denh2o = 1000. !density of water (kg/m3) + real (kind=kind_phys), parameter :: denice = 917. !density of ice (kg/m3) ! =====================================options for different schemes================================ -! options for dynamic vegetation: -! 1 -> off (use table lai; use fveg = shdfac from input) -! 2 -> on (together with opt_crs = 1) -! 3 -> off (use table lai; calculate fveg) -! 4 -> off (use table lai; use maximum vegetation fraction) - - integer :: dveg != 2 ! - -! options for canopy stomatal resistance -! 1-> ball-berry; 2->jarvis - - integer :: opt_crs != 1 !(must 1 when dveg = 2) - -! options for soil moisture factor for stomatal resistance -! 1-> noah (soil moisture) -! 2-> clm (matric potential) -! 3-> ssib (matric potential) - - integer :: opt_btr != 1 !(suggested 1) - -! options for runoff and groundwater -! 1 -> topmodel with groundwater (niu et al. 2007 jgr) ; -! 2 -> topmodel with an equilibrium water table (niu et al. 2005 jgr) ; -! 3 -> original surface and subsurface runoff (free drainage) -! 4 -> bats surface and subsurface runoff (free drainage) - - integer :: opt_run != 1 !(suggested 1) - -! options for surface layer drag coeff (ch & cm) -! 1->m-o ; 2->original noah (chen97); 3->myj consistent; 4->ysu consistent. - - integer :: opt_sfc != 1 !(1 or 2 or 3 or 4) - -! options for supercooled liquid water (or ice fraction) -! 1-> no iteration (niu and yang, 2006 jhm); 2: koren's iteration - - integer :: opt_frz != 1 !(1 or 2) - -! options for frozen soil permeability -! 1 -> linear effects, more permeable (niu and yang, 2006, jhm) -! 2 -> nonlinear effects, less permeable (old) - - integer :: opt_inf != 1 !(suggested 1) - -! options for radiation transfer -! 1 -> modified two-stream (gap = f(solar angle, 3d structure ...)<1-fveg) -! 2 -> two-stream applied to grid-cell (gap = 0) -! 3 -> two-stream applied to vegetated fraction (gap=1-fveg) - - integer :: opt_rad != 1 !(suggested 1) ! options for ground snow surface albedo -! 1-> bats; 2 -> class +! 1-> BATS; 2 -> CLASS - integer :: opt_alb != 2 !(suggested 2) + INTEGER :: OPT_ALB != 2 !(suggested 2) ! options for partitioning precipitation into rainfall & snowfall -! 1 -> jordan (1991); 2 -> bats: when sfctmp sfctmp Jordan (1991); 2 -> BATS: when SFCTMP SFCTMP zero heat flux from bottom (zbot and tbot not used) -! 2 -> tbot at zbot (8m) read from a file (original noah) +! 1 -> zero heat flux from bottom (ZBOT and TBOT not used) +! 2 -> TBOT at ZBOT (8m) read from a file (original Noah) - integer :: opt_tbot != 2 !(suggested 2) + INTEGER :: OPT_TBOT != 2 !(suggested 2) ! options for snow/soil temperature time scheme (only layer 1) -! 1 -> semi-implicit; 2 -> full implicit (original noah) +! 1 -> semi-implicit; 2 -> full implicit (original Noah) + + INTEGER :: OPT_STC != 1 !(suggested 1) - integer :: opt_stc != 1 !(suggested 1) +! options for glacier treatment +! 1 -> include phase change of ice; 2 -> ice treatment more like original Noah + + INTEGER :: OPT_GLA != 1 !(suggested 1) ! adjustable parameters for snow processes - real, parameter :: z0sno = 0.002 !snow surface roughness length (m) (0.002) - real, parameter :: ssi = 0.03 !liquid water holding capacity for snowpack (m3/m3) (0.03) - real, parameter :: swemx = 1.00 !new snow mass to fully cover old snow (mm) + REAL, PARAMETER :: Z0SNO = 0.002 !snow surface roughness length (m) (0.002) + REAL, PARAMETER :: SSI = 0.03 !liquid water holding capacity for snowpack (m3/m3) (0.03) + REAL, PARAMETER :: SWEMX = 1.00 !new snow mass to fully cover old snow (mm) !equivalent to 10mm depth (density = 100 kg/m3) !------------------------------------------------------------------------------------------! @@ -168,9 +124,10 @@ subroutine noahmp_glacier (& trad ,edir ,runsrf ,runsub ,sag ,albedo , & ! out : qsnbot ,ponding ,ponding1,ponding2,t2m ,q2e , & ! out : #ifdef CCPP - emissi, fpice ,ch2b , esnow, errmsg, errflg) + emissi, fpice ,ch2b , esnow, albsnd, albsni , & + errmsg, errflg) #else - emissi, fpice ,ch2b , esnow) + emissi, fpice ,ch2b , esnow, albsnd, albsni) #endif @@ -183,68 +140,71 @@ subroutine noahmp_glacier (& ! input integer , intent(in) :: iloc !grid index integer , intent(in) :: jloc !grid index - real , intent(in) :: cosz !cosine solar zenith angle [0-1] + real (kind=kind_phys) , intent(in) :: cosz !cosine solar zenith angle [0-1] integer , intent(in) :: nsnow !maximum no. of snow layers integer , intent(in) :: nsoil !no. of soil layers - real , intent(in) :: dt !time step [sec] - real , intent(in) :: sfctmp !surface air temperature [k] - real , intent(in) :: sfcprs !pressure (pa) - real , intent(in) :: uu !wind speed in eastward dir (m/s) - real , intent(in) :: vv !wind speed in northward dir (m/s) - real , intent(in) :: q2 !mixing ratio (kg/kg) lowest model layer - real , intent(in) :: soldn !downward shortwave radiation (w/m2) - real , intent(in) :: prcp !precipitation rate (kg m-2 s-1) - real , intent(in) :: lwdn !downward longwave radiation (w/m2) - real , intent(in) :: tbot !bottom condition for soil temp. [k] - real , intent(in) :: zlvl !reference height (m) - real, dimension(-nsnow+1: 0), intent(in) :: ficeold!ice fraction at last timestep - real, dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf (m) + real (kind=kind_phys) , intent(in) :: dt !time step [sec] + real (kind=kind_phys) , intent(in) :: sfctmp !surface air temperature [k] + real (kind=kind_phys) , intent(in) :: sfcprs !pressure (pa) + real (kind=kind_phys) , intent(in) :: uu !wind speed in eastward dir (m/s) + real (kind=kind_phys) , intent(in) :: vv !wind speed in northward dir (m/s) + real (kind=kind_phys) , intent(in) :: q2 !mixing ratio (kg/kg) lowest model layer + real (kind=kind_phys) , intent(in) :: soldn !downward shortwave radiation (w/m2) + real (kind=kind_phys) , intent(in) :: prcp !precipitation rate (kg m-2 s-1) + real (kind=kind_phys) , intent(in) :: lwdn !downward longwave radiation (w/m2) + real (kind=kind_phys) , intent(in) :: tbot !bottom condition for soil temp. [k] + real (kind=kind_phys) , intent(in) :: zlvl !reference height (m) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: ficeold!ice fraction at last timestep + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf (m) ! input/output : need arbitary intial values - real , intent(inout) :: qsnow !snowfall [mm/s] - real , intent(inout) :: sneqvo !snow mass at last time step (mm) - real , intent(inout) :: albold !snow albedo at last time step (class type) - real , intent(inout) :: cm !momentum drag coefficient - real , intent(inout) :: ch !sensible heat exchange coefficient + real (kind=kind_phys) , intent(inout) :: qsnow !snowfall [mm/s] + real (kind=kind_phys) , intent(inout) :: sneqvo !snow mass at last time step (mm) + real (kind=kind_phys) , intent(inout) :: albold !snow albedo at last time step (class type) + real (kind=kind_phys) , intent(inout) :: cm !momentum drag coefficient + real (kind=kind_phys) , intent(inout) :: ch !sensible heat exchange coefficient ! prognostic variables integer , intent(inout) :: isnow !actual no. of snow layers [-] - real , intent(inout) :: sneqv !snow water eqv. [mm] - real, dimension( 1:nsoil), intent(inout) :: smc !soil moisture (ice + liq.) [m3/m3] - real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !layer-bottom depth from snow surf [m] - real , intent(inout) :: snowh !snow height [m] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] - real , intent(inout) :: tg !ground temperature (k) - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] - real, dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil moisture [m3/m3] - real , intent(inout) :: tauss !non-dimensional snow age - real , intent(inout) :: qsfc !mixing ratio at lowest model layer + real (kind=kind_phys) , intent(inout) :: sneqv !snow water eqv. [mm] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: smc !soil moisture (ice + liq.) [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !layer-bottom depth from snow surf [m] + real (kind=kind_phys) , intent(inout) :: snowh !snow height [m] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys) , intent(inout) :: tg !ground temperature (k) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil moisture [m3/m3] + real (kind=kind_phys) , intent(inout) :: tauss !non-dimensional snow age + real (kind=kind_phys) , intent(inout) :: qsfc !mixing ratio at lowest model layer ! output - real , intent(out) :: fsa !total absorbed solar radiation (w/m2) - real , intent(out) :: fsr !total reflected solar radiation (w/m2) - real , intent(out) :: fira !total net lw rad (w/m2) [+ to atm] - real , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] - real , intent(out) :: fgev !ground evap heat (w/m2) [+ to atm] - real , intent(out) :: ssoil !ground heat flux (w/m2) [+ to soil] - real , intent(out) :: trad !surface radiative temperature (k) - real , intent(out) :: edir !soil surface evaporation rate (mm/s] - real , intent(out) :: runsrf !surface runoff [mm/s] - real , intent(out) :: runsub !baseflow (saturation excess) [mm/s] - real , intent(out) :: sag !solar rad absorbed by ground (w/m2) - real , intent(out) :: albedo !surface albedo [-] - real , intent(out) :: qsnbot !snowmelt [mm/s] - real , intent(out) :: ponding!surface ponding [mm] - real , intent(out) :: ponding1!surface ponding [mm] - real , intent(out) :: ponding2!surface ponding [mm] - real , intent(out) :: t2m !2-m air temperature over bare ground part [k] - real , intent(out) :: q2e - real , intent(out) :: emissi - real , intent(out) :: fpice - real , intent(out) :: ch2b - real , intent(out) :: esnow + real (kind=kind_phys) , intent(out) :: fsa !total absorbed solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: fsr !total reflected solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: fira !total net lw rad (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fgev !ground evap heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: ssoil !ground heat flux (w/m2) [+ to soil] + real (kind=kind_phys) , intent(out) :: trad !surface radiative temperature (k) + real (kind=kind_phys) , intent(out) :: edir !soil surface evaporation rate (mm/s] + real (kind=kind_phys) , intent(out) :: runsrf !surface runoff [mm/s] + real (kind=kind_phys) , intent(out) :: runsub !baseflow (saturation excess) [mm/s] + real (kind=kind_phys) , intent(out) :: sag !solar rad absorbed by ground (w/m2) + real (kind=kind_phys) , intent(out) :: albedo !surface albedo [-] + real (kind=kind_phys) , intent(out) :: qsnbot !snowmelt [mm/s] + real (kind=kind_phys) , intent(out) :: ponding!surface ponding [mm] + real (kind=kind_phys) , intent(out) :: ponding1!surface ponding [mm] + real (kind=kind_phys) , intent(out) :: ponding2!surface ponding [mm] + real (kind=kind_phys) , intent(out) :: t2m !2-m air temperature over bare ground part [k] + real (kind=kind_phys) , intent(out) :: q2e + real (kind=kind_phys) , intent(out) :: emissi + real (kind=kind_phys) , intent(out) :: fpice + real (kind=kind_phys) , intent(out) :: ch2b + real (kind=kind_phys) , intent(out) :: esnow + real (kind=kind_phys), dimension(1:2) , intent(out) :: albsnd !snow albedo (direct) + real (kind=kind_phys), dimension(1:2) , intent(out) :: albsni !snow albedo (diffuse) + #ifdef CCPP character(len=*), intent(inout) :: errmsg @@ -254,24 +214,24 @@ subroutine noahmp_glacier (& ! local integer :: iz !do-loop index integer, dimension(-nsnow+1:nsoil) :: imelt !phase change index [1-melt; 2-freeze] - real :: rhoair !density air (kg/m3) - real, dimension(-nsnow+1:nsoil) :: dzsnso !snow/soil layer thickness [m] - real :: thair !potential temperature (k) - real :: qair !specific humidity (kg/kg) (q2/(1+q2)) - real :: eair !vapor pressure air (pa) - real, dimension( 1: 2) :: solad !incoming direct solar rad (w/m2) - real, dimension( 1: 2) :: solai !incoming diffuse solar rad (w/m2) - real, dimension( 1:nsoil) :: sice !soil ice content (m3/m3) - real, dimension(-nsnow+1: 0) :: snicev !partial volume ice of snow [m3/m3] - real, dimension(-nsnow+1: 0) :: snliqv !partial volume liq of snow [m3/m3] - real, dimension(-nsnow+1: 0) :: epore !effective porosity [m3/m3] - real :: qdew !ground surface dew rate [mm/s] - real :: qvap !ground surface evap. rate [mm/s] - real :: lathea !latent heat [j/kg] - real :: qmelt !internal pack melt - real :: swdown !downward solar [w/m2] - real :: beg_wb !beginning water for error check - real :: zbot = -8.0 + real (kind=kind_phys) :: rhoair !density air (kg/m3) + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys) :: thair !potential temperature (k) + real (kind=kind_phys) :: qair !specific humidity (kg/kg) (q2/(1+q2)) + real (kind=kind_phys) :: eair !vapor pressure air (pa) + real (kind=kind_phys), dimension( 1: 2) :: solad !incoming direct solar rad (w/m2) + real (kind=kind_phys), dimension( 1: 2) :: solai !incoming diffuse solar rad (w/m2) + real (kind=kind_phys), dimension( 1:nsoil) :: sice !soil ice content (m3/m3) + real (kind=kind_phys), dimension(-nsnow+1: 0) :: snicev !partial volume ice of snow [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0) :: snliqv !partial volume liq of snow [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0) :: epore !effective porosity [m3/m3] + real (kind=kind_phys) :: qdew !ground surface dew rate [mm/s] + real (kind=kind_phys) :: qvap !ground surface evap. rate [mm/s] + real (kind=kind_phys) :: lathea !latent heat [j/kg] + real (kind=kind_phys) :: qmelt !internal pack melt + real (kind=kind_phys) :: swdown !downward solar [w/m2] + real (kind=kind_phys) :: beg_wb !beginning water for error check + real (kind=kind_phys) :: zbot = -8.0 character*256 message @@ -308,7 +268,8 @@ subroutine noahmp_glacier (& #endif imelt ,snicev ,snliqv ,epore ,qmelt ,ponding, & !out sag ,fsa ,fsr ,fira ,fsh ,fgev , & !out - trad ,t2m ,ssoil ,lathea ,q2e ,emissi, ch2b ) !out + trad ,t2m ,ssoil ,lathea ,q2e ,emissi, & !out + ch2b ,albsnd ,albsni ) !out #ifdef CCPP if (errflg /= 0) return @@ -326,10 +287,15 @@ subroutine noahmp_glacier (& call water_glacier (nsnow ,nsoil ,imelt ,dt ,prcp ,sfctmp , & !in qvap ,qdew ,ficeold,zsoil , & !in isnow ,snowh ,sneqv ,snice ,snliq ,stc , & !inout - dzsnso ,sh2o ,sice ,ponding,zsnso , & !inout + dzsnso ,sh2o ,sice ,ponding,zsnso ,fsh , & !inout runsrf ,runsub ,qsnow ,ponding1 ,ponding2,qsnbot,fpice,esnow & !out ) + if(opt_gla == 2) then + edir = qvap - qdew + fgev = edir * lathea + end if + ! if(maxval(sice) < 0.0001) then ! write(message,*) "glacier has melted at:",iloc,jloc," are you sure this should be a glacier point?" ! call wrf_debug(10,trim(message)) @@ -374,25 +340,25 @@ subroutine atm_glacier (sfcprs ,sfctmp ,q2 ,soldn ,cosz ,thair , & ! -------------------------------------------------------------------------------------------------- ! inputs - real , intent(in) :: sfcprs !pressure (pa) - real , intent(in) :: sfctmp !surface air temperature [k] - real , intent(in) :: q2 !mixing ratio (kg/kg) - real , intent(in) :: soldn !downward shortwave radiation (w/m2) - real , intent(in) :: cosz !cosine solar zenith angle [0-1] + real (kind=kind_phys) , intent(in) :: sfcprs !pressure (pa) + real (kind=kind_phys) , intent(in) :: sfctmp !surface air temperature [k] + real (kind=kind_phys) , intent(in) :: q2 !mixing ratio (kg/kg) + real (kind=kind_phys) , intent(in) :: soldn !downward shortwave radiation (w/m2) + real (kind=kind_phys) , intent(in) :: cosz !cosine solar zenith angle [0-1] ! outputs - real , intent(out) :: thair !potential temperature (k) - real , intent(out) :: qair !specific humidity (kg/kg) (q2/(1+q2)) - real , intent(out) :: eair !vapor pressure air (pa) - real, dimension( 1: 2), intent(out) :: solad !incoming direct solar radiation (w/m2) - real, dimension( 1: 2), intent(out) :: solai !incoming diffuse solar radiation (w/m2) - real , intent(out) :: rhoair !density air (kg/m3) - real , intent(out) :: swdown !downward solar filtered by sun angle [w/m2] + real (kind=kind_phys) , intent(out) :: thair !potential temperature (k) + real (kind=kind_phys) , intent(out) :: qair !specific humidity (kg/kg) (q2/(1+q2)) + real (kind=kind_phys) , intent(out) :: eair !vapor pressure air (pa) + real (kind=kind_phys), dimension( 1: 2), intent(out) :: solad !incoming direct solar radiation (w/m2) + real (kind=kind_phys), dimension( 1: 2), intent(out) :: solai !incoming diffuse solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: rhoair !density air (kg/m3) + real (kind=kind_phys) , intent(out) :: swdown !downward solar filtered by sun angle [w/m2] !locals - real :: pair !atm bottom level pressure (pa) + real (kind=kind_phys) :: pair !atm bottom level pressure (pa) ! -------------------------------------------------------------------------------------------------- pair = sfcprs ! atm bottom level pressure (pa) @@ -431,7 +397,8 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !i #endif imelt ,snicev ,snliqv ,epore ,qmelt ,ponding, & !out sag ,fsa ,fsr ,fira ,fsh ,fgev , & !out - trad ,t2m ,ssoil ,lathea ,q2e ,emissi, ch2b ) !out + trad ,t2m ,ssoil ,lathea ,q2e ,emissi, & !out + ch2b ,albsnd ,albsni ) !out ! -------------------------------------------------------------------------------------------------- ! -------------------------------------------------------------------------------------------------- @@ -444,40 +411,40 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !i integer , intent(in) :: nsnow !maximum no. of snow layers integer , intent(in) :: nsoil !number of soil layers integer , intent(in) :: isnow !actual no. of snow layers - real , intent(in) :: dt !time step [sec] - real , intent(in) :: qsnow !snowfall on the ground (mm/s) - real , intent(in) :: rhoair !density air (kg/m3) - real , intent(in) :: eair !vapor pressure air (pa) - real , intent(in) :: sfcprs !pressure (pa) - real , intent(in) :: qair !specific humidity (kg/kg) - real , intent(in) :: sfctmp !air temperature (k) - real , intent(in) :: lwdn !downward longwave radiation (w/m2) - real , intent(in) :: uu !wind speed in e-w dir (m/s) - real , intent(in) :: vv !wind speed in n-s dir (m/s) - real , dimension( 1: 2), intent(in) :: solad !incoming direct solar rad. (w/m2) - real , dimension( 1: 2), intent(in) :: solai !incoming diffuse solar rad. (w/m2) - real , intent(in) :: cosz !cosine solar zenith angle (0-1) - real , intent(in) :: zref !reference height (m) - real , intent(in) :: tbot !bottom condition for soil temp. (k) - real , intent(in) :: zbot !depth for tbot [m] - real , dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bottom depth from snow surf [m] - real , dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !depth of snow & soil layer-bottom [m] + real (kind=kind_phys) , intent(in) :: dt !time step [sec] + real (kind=kind_phys) , intent(in) :: qsnow !snowfall on the ground (mm/s) + real (kind=kind_phys) , intent(in) :: rhoair !density air (kg/m3) + real (kind=kind_phys) , intent(in) :: eair !vapor pressure air (pa) + real (kind=kind_phys) , intent(in) :: sfcprs !pressure (pa) + real (kind=kind_phys) , intent(in) :: qair !specific humidity (kg/kg) + real (kind=kind_phys) , intent(in) :: sfctmp !air temperature (k) + real (kind=kind_phys) , intent(in) :: lwdn !downward longwave radiation (w/m2) + real (kind=kind_phys) , intent(in) :: uu !wind speed in e-w dir (m/s) + real (kind=kind_phys) , intent(in) :: vv !wind speed in n-s dir (m/s) + real (kind=kind_phys) , dimension( 1: 2), intent(in) :: solad !incoming direct solar rad. (w/m2) + real (kind=kind_phys) , dimension( 1: 2), intent(in) :: solai !incoming diffuse solar rad. (w/m2) + real (kind=kind_phys) , intent(in) :: cosz !cosine solar zenith angle (0-1) + real (kind=kind_phys) , intent(in) :: zref !reference height (m) + real (kind=kind_phys) , intent(in) :: tbot !bottom condition for soil temp. (k) + real (kind=kind_phys) , intent(in) :: zbot !depth for tbot [m] + real (kind=kind_phys) , dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bottom depth from snow surf [m] + real (kind=kind_phys) , dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !depth of snow & soil layer-bottom [m] ! input & output - real , intent(inout) :: tg !ground temperature (k) - real , dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] - real , intent(inout) :: snowh !snow height [m] - real , intent(inout) :: sneqv !snow mass (mm) - real , intent(inout) :: sneqvo !snow mass at last time step (mm) - real , dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil moisture [m3/m3] - real , dimension( 1:nsoil), intent(inout) :: smc !soil moisture (ice + liq.) [m3/m3] - real , dimension(-nsnow+1: 0), intent(inout) :: snice !snow ice mass (kg/m2) - real , dimension(-nsnow+1: 0), intent(inout) :: snliq !snow liq mass (kg/m2) - real , intent(inout) :: albold !snow albedo at last time step(class type) - real , intent(inout) :: cm !momentum drag coefficient - real , intent(inout) :: ch !sensible heat exchange coefficient - real , intent(inout) :: tauss !snow aging factor - real , intent(inout) :: qsfc !mixing ratio at lowest model layer + real (kind=kind_phys) , intent(inout) :: tg !ground temperature (k) + real (kind=kind_phys) , dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] + real (kind=kind_phys) , intent(inout) :: snowh !snow height [m] + real (kind=kind_phys) , intent(inout) :: sneqv !snow mass (mm) + real (kind=kind_phys) , intent(inout) :: sneqvo !snow mass at last time step (mm) + real (kind=kind_phys) , dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil moisture [m3/m3] + real (kind=kind_phys) , dimension( 1:nsoil), intent(inout) :: smc !soil moisture (ice + liq.) [m3/m3] + real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(inout) :: snice !snow ice mass (kg/m2) + real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(inout) :: snliq !snow liq mass (kg/m2) + real (kind=kind_phys) , intent(inout) :: albold !snow albedo at last time step(class type) + real (kind=kind_phys) , intent(inout) :: cm !momentum drag coefficient + real (kind=kind_phys) , intent(inout) :: ch !sensible heat exchange coefficient + real (kind=kind_phys) , intent(inout) :: tauss !snow aging factor + real (kind=kind_phys) , intent(inout) :: qsfc !mixing ratio at lowest model layer #ifdef CCPP character(len=*) , intent(inout) :: errmsg @@ -486,39 +453,41 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !i ! outputs integer, dimension(-nsnow+1:nsoil), intent(out) :: imelt !phase change index [1-melt; 2-freeze] - real , dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume ice [m3/m3] - real , dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume liq. water [m3/m3] - real , dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] - real , intent(out) :: qmelt !snowmelt [mm/s] - real , intent(out) :: ponding!pounding at ground [mm] - real , intent(out) :: sag !solar rad. absorbed by ground (w/m2) - real , intent(out) :: fsa !tot. absorbed solar radiation (w/m2) - real , intent(out) :: fsr !tot. reflected solar radiation (w/m2) - real , intent(out) :: fira !total net lw. rad (w/m2) [+ to atm] - real , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] - real , intent(out) :: fgev !ground evaporation (w/m2) [+ to atm] - real , intent(out) :: trad !radiative temperature (k) - real , intent(out) :: t2m !2 m height air temperature (k) - real , intent(out) :: ssoil !ground heat flux (w/m2) [+ to soil] - real , intent(out) :: lathea !latent heat vap./sublimation (j/kg) - real , intent(out) :: q2e - real , intent(out) :: emissi - real , intent(out) :: ch2b !sensible heat conductance, canopy air to zlvl air (m/s) + real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume ice [m3/m3] + real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume liq. water [m3/m3] + real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] + real (kind=kind_phys) , intent(out) :: qmelt !snowmelt [mm/s] + real (kind=kind_phys) , intent(out) :: ponding!pounding at ground [mm] + real (kind=kind_phys) , intent(out) :: sag !solar rad. absorbed by ground (w/m2) + real (kind=kind_phys) , intent(out) :: fsa !tot. absorbed solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: fsr !tot. reflected solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: fira !total net lw. rad (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fgev !ground evaporation (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: trad !radiative temperature (k) + real (kind=kind_phys) , intent(out) :: t2m !2 m height air temperature (k) + real (kind=kind_phys) , intent(out) :: ssoil !ground heat flux (w/m2) [+ to soil] + real (kind=kind_phys) , intent(out) :: lathea !latent heat vap./sublimation (j/kg) + real (kind=kind_phys) , intent(out) :: q2e + real (kind=kind_phys) , intent(out) :: emissi + real (kind=kind_phys) , intent(out) :: ch2b !sensible heat conductance, canopy air to zlvl air (m/s) + real (kind=kind_phys), dimension(1:2) , intent(out) :: albsnd !snow albedo (direct) + real (kind=kind_phys), dimension(1:2) , intent(out) :: albsni !snow albedo (diffuse) ! local - real :: ur !wind speed at height zlvl (m/s) - real :: zlvl !reference height (m) - real :: rsurf !ground surface resistance (s/m) - real :: zpd !zero plane displacement (m) - real :: z0mg !z0 momentum, ground (m) - real :: emg !ground emissivity - real :: fire !emitted ir (w/m2) - real, dimension(-nsnow+1:nsoil) :: fact !temporary used in phase change - real, dimension(-nsnow+1:nsoil) :: df !thermal conductivity [w/m/k] - real, dimension(-nsnow+1:nsoil) :: hcpct !heat capacity [j/m3/k] - real :: gamma !psychrometric constant (pa/k) - real :: rhsur !raltive humidity in surface soil/snow air space (-) + real (kind=kind_phys) :: ur !wind speed at height zlvl (m/s) + real (kind=kind_phys) :: zlvl !reference height (m) + real (kind=kind_phys) :: rsurf !ground surface resistance (s/m) + real (kind=kind_phys) :: zpd !zero plane displacement (m) + real (kind=kind_phys) :: z0mg !z0 momentum, ground (m) + real (kind=kind_phys) :: emg !ground emissivity + real (kind=kind_phys) :: fire !emitted ir (w/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: fact !temporary used in phase change + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: df !thermal conductivity [w/m/k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: hcpct !heat capacity [j/m3/k] + real (kind=kind_phys) :: gamma !psychrometric constant (pa/k) + real (kind=kind_phys) :: rhsur !raltive humidity in surface soil/snow air space (-) ! --------------------------------------------------------------------------------------------------- @@ -545,7 +514,7 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !i call radiation_glacier (dt ,tg ,sneqvo ,sneqv ,cosz , & !in qsnow ,solad ,solai , & !in albold ,tauss , & !inout - sag ,fsr ,fsa) !out + sag ,fsr ,fsa , albsnd ,albsni) !out ! vegetation and ground emissivity @@ -610,7 +579,7 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !i if (snowh > 0.05 .and. tg > tfrz) tg = tfrz end if -! energy released or consumed by snow & frozen soil +! energy released or consumed by snow & ice call phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & !in dzsnso , & !in @@ -634,26 +603,26 @@ subroutine thermoprop_glacier (nsoil ,nsnow ,isnow ,dzsnso , & !in integer , intent(in) :: nsoil !number of soil layers integer , intent(in) :: nsnow !maximum no. of snow layers integer , intent(in) :: isnow !actual no. of snow layers - real , intent(in) :: dt !time step [s] - real, dimension(-nsnow+1: 0), intent(in) :: snice !snow ice mass (kg/m2) - real, dimension(-nsnow+1: 0), intent(in) :: snliq !snow liq mass (kg/m2) - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thickness of snow/soil layers [m] - real , intent(in) :: snowh !snow height [m] + real (kind=kind_phys) , intent(in) :: dt !time step [s] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snice !snow ice mass (kg/m2) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snliq !snow liq mass (kg/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thickness of snow/soil layers [m] + real (kind=kind_phys) , intent(in) :: snowh !snow height [m] ! outputs - real, dimension(-nsnow+1:nsoil), intent(out) :: df !thermal conductivity [w/m/k] - real, dimension(-nsnow+1:nsoil), intent(out) :: hcpct !heat capacity [j/m3/k] - real, dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume of ice [m3/m3] - real, dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume of liquid water [m3/m3] - real, dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] - real, dimension(-nsnow+1:nsoil), intent(out) :: fact !computing energy for phase change + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: df !thermal conductivity [w/m/k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: hcpct !heat capacity [j/m3/k] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume of ice [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume of liquid water [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: fact !computing energy for phase change ! -------------------------------------------------------------------------------------------------- ! locals integer :: iz, iz2 - real, dimension(-nsnow+1: 0) :: cvsno !volumetric specific heat (j/m3/k) - real, dimension(-nsnow+1: 0) :: tksno !snow thermal conductivity (j/m3/k) - real :: zmid !mid-point soil depth + real (kind=kind_phys), dimension(-nsnow+1: 0) :: cvsno !volumetric specific heat (j/m3/k) + real (kind=kind_phys), dimension(-nsnow+1: 0) :: tksno !snow thermal conductivity (j/m3/k) + real (kind=kind_phys) :: zmid !mid-point soil depth ! -------------------------------------------------------------------------------------------------- ! compute snow thermal conductivity and heat capacity @@ -708,22 +677,22 @@ subroutine csnow_glacier (isnow ,nsnow ,nsoil ,snice ,snliq ,dzsnso , integer, intent(in) :: isnow !number of snow layers (-) integer , intent(in) :: nsnow !maximum no. of snow layers integer , intent(in) :: nsoil !number of soil layers - real, dimension(-nsnow+1: 0), intent(in) :: snice !snow ice mass (kg/m2) - real, dimension(-nsnow+1: 0), intent(in) :: snliq !snow liq mass (kg/m2) - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snice !snow ice mass (kg/m2) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snliq !snow liq mass (kg/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] ! outputs - real, dimension(-nsnow+1: 0), intent(out) :: cvsno !volumetric specific heat (j/m3/k) - real, dimension(-nsnow+1: 0), intent(out) :: tksno !thermal conductivity (w/m/k) - real, dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume of ice [m3/m3] - real, dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume of liquid water [m3/m3] - real, dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: cvsno !volumetric specific heat (j/m3/k) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: tksno !thermal conductivity (w/m/k) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume of ice [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume of liquid water [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] ! locals integer :: iz - real, dimension(-nsnow+1: 0) :: bdsnoi !bulk density of snow(kg/m3) + real (kind=kind_phys), dimension(-nsnow+1: 0) :: bdsnoi !bulk density of snow(kg/m3) !--------------------------------------------------------------------------------------------------- ! thermal capacity of snow @@ -756,42 +725,42 @@ end subroutine csnow_glacier subroutine radiation_glacier (dt ,tg ,sneqvo ,sneqv ,cosz , & !in qsnow ,solad ,solai , & !in albold ,tauss , & !inout - sag ,fsr ,fsa) !out + sag ,fsr ,fsa,albsnd ,albsni) !out ! -------------------------------------------------------------------------------------------------- implicit none ! -------------------------------------------------------------------------------------------------- ! input - real, intent(in) :: dt !time step [s] - real, intent(in) :: tg !ground temperature (k) - real, intent(in) :: sneqvo !snow mass at last time step(mm) - real, intent(in) :: sneqv !snow mass (mm) - real, intent(in) :: cosz !cosine solar zenith angle (0-1) - real, intent(in) :: qsnow !snowfall (mm/s) - real, dimension(1:2) , intent(in) :: solad !incoming direct solar radiation (w/m2) - real, dimension(1:2) , intent(in) :: solai !incoming diffuse solar radiation (w/m2) + real (kind=kind_phys), intent(in) :: dt !time step [s] + real (kind=kind_phys), intent(in) :: tg !ground temperature (k) + real (kind=kind_phys), intent(in) :: sneqvo !snow mass at last time step(mm) + real (kind=kind_phys), intent(in) :: sneqv !snow mass (mm) + real (kind=kind_phys), intent(in) :: cosz !cosine solar zenith angle (0-1) + real (kind=kind_phys), intent(in) :: qsnow !snowfall (mm/s) + real (kind=kind_phys), dimension(1:2) , intent(in) :: solad !incoming direct solar radiation (w/m2) + real (kind=kind_phys), dimension(1:2) , intent(in) :: solai !incoming diffuse solar radiation (w/m2) ! inout - real, intent(inout) :: albold !snow albedo at last time step (class type) - real, intent(inout) :: tauss !non-dimensional snow age + real (kind=kind_phys), intent(inout) :: albold !snow albedo at last time step (class type) + real (kind=kind_phys), intent(inout) :: tauss !non-dimensional snow age + real (kind=kind_phys), dimension(1:2) :: albsnd !snow albedo (direct) + real (kind=kind_phys), dimension(1:2) :: albsni !snow albedo (diffuse) ! output - real, intent(out) :: sag !solar radiation absorbed by ground (w/m2) - real, intent(out) :: fsr !total reflected solar radiation (w/m2) - real, intent(out) :: fsa !total absorbed solar radiation (w/m2) + real (kind=kind_phys), intent(out) :: sag !solar radiation absorbed by ground (w/m2) + real (kind=kind_phys), intent(out) :: fsr !total reflected solar radiation (w/m2) + real (kind=kind_phys), intent(out) :: fsa !total absorbed solar radiation (w/m2) ! local integer :: ib !number of radiation bands integer :: nband !number of radiation bands - real :: fage !snow age function (0 - new snow) - real, dimension(1:2) :: albsnd !snow albedo (direct) - real, dimension(1:2) :: albsni !snow albedo (diffuse) - real :: alb !current class albedo - real :: abs !temporary absorbed rad - real :: ref !temporary reflected rad - real :: fsno !snow-cover fraction, = 1 if any snow - real, dimension(1:2) :: albice !albedo land ice: 1=vis, 2=nir + real (kind=kind_phys) :: fage !snow age function (0 - new snow) + real (kind=kind_phys) :: alb !current class albedo + real (kind=kind_phys) :: abs !temporary absorbed rad + real (kind=kind_phys) :: ref !temporary reflected rad + real (kind=kind_phys) :: fsno !snow-cover fraction, = 1 if any snow + real (kind=kind_phys), dimension(1:2) :: albice !albedo land ice: 1=vis, 2=nir - real,parameter :: mpe = 1.e-6 + real (kind=kind_phys),parameter :: mpe = 1.e-6 ! -------------------------------------------------------------------------------------------------- @@ -851,27 +820,27 @@ subroutine snow_age_glacier (dt,tg,sneqvo,sneqv,tauss,fage) ! from bats ! ------------------------ input/output variables -------------------------------------------------- !input - real, intent(in) :: dt !main time step (s) - real, intent(in) :: tg !ground temperature (k) - real, intent(in) :: sneqvo !snow mass at last time step(mm) - real, intent(in) :: sneqv !snow water per unit ground area (mm) + real (kind=kind_phys), intent(in) :: dt !main time step (s) + real (kind=kind_phys), intent(in) :: tg !ground temperature (k) + real (kind=kind_phys), intent(in) :: sneqvo !snow mass at last time step(mm) + real (kind=kind_phys), intent(in) :: sneqv !snow water per unit ground area (mm) ! inout - real, intent(inout) :: tauss !non-dimensional snow age + real (kind=kind_phys), intent(inout) :: tauss !non-dimensional snow age !output - real, intent(out) :: fage !snow age + real (kind=kind_phys), intent(out) :: fage !snow age !local - real :: tage !total aging effects - real :: age1 !effects of grain growth due to vapor diffusion - real :: age2 !effects of grain growth at freezing of melt water - real :: age3 !effects of soot - real :: dela !temporary variable - real :: sge !temporary variable - real :: dels !temporary variable - real :: dela0 !temporary variable - real :: arg !temporary variable + real (kind=kind_phys) :: tage !total aging effects + real (kind=kind_phys) :: age1 !effects of grain growth due to vapor diffusion + real (kind=kind_phys) :: age2 !effects of grain growth at freezing of melt water + real (kind=kind_phys) :: age3 !effects of soot + real (kind=kind_phys) :: dela !temporary variable + real (kind=kind_phys) :: sge !temporary variable + real (kind=kind_phys) :: dels !temporary variable + real (kind=kind_phys) :: dela0 !temporary variable + real (kind=kind_phys) :: arg !temporary variable ! see yang et al. (1997) j.of climate for detail. !--------------------------------------------------------------------------------------------------- @@ -907,24 +876,24 @@ subroutine snowalb_bats_glacier (nband,cosz,fage,albsnd,albsni) integer,intent(in) :: nband !number of waveband classes - real,intent(in) :: cosz !cosine solar zenith angle - real,intent(in) :: fage !snow age correction + real (kind=kind_phys),intent(in) :: cosz !cosine solar zenith angle + real (kind=kind_phys),intent(in) :: fage !snow age correction ! output - real, dimension(1:2),intent(out) :: albsnd !snow albedo for direct(1=vis, 2=nir) - real, dimension(1:2),intent(out) :: albsni !snow albedo for diffuse + real (kind=kind_phys), dimension(1:2),intent(out) :: albsnd !snow albedo for direct(1=vis, 2=nir) + real (kind=kind_phys), dimension(1:2),intent(out) :: albsni !snow albedo for diffuse ! --------------------------------------------------------------------------------------------- - real :: fzen !zenith angle correction - real :: cf1 !temperary variable - real :: sl2 !2.*sl - real :: sl1 !1/sl - real :: sl !adjustable parameter - real, parameter :: c1 = 0.2 !default in bats - real, parameter :: c2 = 0.5 !default in bats -! real, parameter :: c1 = 0.2 * 2. ! double the default to match sleepers river's -! real, parameter :: c2 = 0.5 * 2. ! snow surface albedo (double aging effects) + real (kind=kind_phys) :: fzen !zenith angle correction + real (kind=kind_phys) :: cf1 !temperary variable + real (kind=kind_phys) :: sl2 !2.*sl + real (kind=kind_phys) :: sl1 !1/sl + real (kind=kind_phys) :: sl !adjustable parameter + real (kind=kind_phys), parameter :: c1 = 0.2 !default in bats + real (kind=kind_phys), parameter :: c2 = 0.5 !default in bats +! real (kind=kind_phys), parameter :: c1 = 0.2 * 2. ! double the default to match sleepers river's +! real (kind=kind_phys), parameter :: c2 = 0.5 * 2. ! snow surface albedo (double aging effects) ! --------------------------------------------------------------------------------------------- ! zero albedos for all points @@ -957,17 +926,17 @@ subroutine snowalb_class_glacier (nband,qsnow,dt,alb,albold,albsnd,albsni) integer,intent(in) :: nband !number of waveband classes - real,intent(in) :: qsnow !snowfall (mm/s) - real,intent(in) :: dt !time step (sec) - real,intent(in) :: albold !snow albedo at last time step + real (kind=kind_phys),intent(in) :: qsnow !snowfall (mm/s) + real (kind=kind_phys),intent(in) :: dt !time step (sec) + real (kind=kind_phys),intent(in) :: albold !snow albedo at last time step ! in & out - real, intent(inout) :: alb ! + real (kind=kind_phys), intent(inout) :: alb ! ! output - real, dimension(1:2),intent(out) :: albsnd !snow albedo for direct(1=vis, 2=nir) - real, dimension(1:2),intent(out) :: albsni !snow albedo for diffuse + real (kind=kind_phys), dimension(1:2),intent(out) :: albsnd !snow albedo for direct(1=vis, 2=nir) + real (kind=kind_phys), dimension(1:2),intent(out) :: albsni !snow albedo for diffuse ! --------------------------------------------------------------------------------------------- ! --------------------------------------------------------------------------------------------- @@ -1021,35 +990,35 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z ! input integer, intent(in) :: nsnow !maximum no. of snow layers integer, intent(in) :: nsoil !number of soil layers - real, intent(in) :: emg !ground emissivity + real (kind=kind_phys), intent(in) :: emg !ground emissivity integer, intent(in) :: isnow !actual no. of snow layers - real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity of snow/soil (w/m/k) - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thickness of snow/soil layers (m) - real, intent(in) :: z0m !roughness length, momentum, ground (m) - real, intent(in) :: zlvl !reference height (m) - real, intent(in) :: zpd !zero plane displacement (m) - real, intent(in) :: qair !specific humidity at height zlvl (kg/kg) - real, intent(in) :: sfctmp !air temperature at reference height (k) - real, intent(in) :: rhoair !density air (kg/m3) - real, intent(in) :: sfcprs !density air (kg/m3) - real, intent(in) :: ur !wind speed at height zlvl (m/s) - real, intent(in) :: gamma !psychrometric constant (pa/k) - real, intent(in) :: rsurf !ground surface resistance (s/m) - real, intent(in) :: lwdn !atmospheric longwave radiation (w/m2) - real, intent(in) :: rhsur !raltive humidity in surface soil/snow air space (-) - real, intent(in) :: eair !vapor pressure air at height (pa) - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !soil/snow temperature (k) - real, dimension( 1:nsoil), intent(in) :: smc !soil moisture - real, dimension( 1:nsoil), intent(in) :: sh2o !soil liquid water - real, intent(in) :: sag !solar radiation absorbed by ground (w/m2) - real, intent(in) :: snowh !actual snow depth [m] - real, intent(in) :: lathea !latent heat of vaporization/subli (j/kg) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity of snow/soil (w/m/k) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thickness of snow/soil layers (m) + real (kind=kind_phys), intent(in) :: z0m !roughness length, momentum, ground (m) + real (kind=kind_phys), intent(in) :: zlvl !reference height (m) + real (kind=kind_phys), intent(in) :: zpd !zero plane displacement (m) + real (kind=kind_phys), intent(in) :: qair !specific humidity at height zlvl (kg/kg) + real (kind=kind_phys), intent(in) :: sfctmp !air temperature at reference height (k) + real (kind=kind_phys), intent(in) :: rhoair !density air (kg/m3) + real (kind=kind_phys), intent(in) :: sfcprs !density air (kg/m3) + real (kind=kind_phys), intent(in) :: ur !wind speed at height zlvl (m/s) + real (kind=kind_phys), intent(in) :: gamma !psychrometric constant (pa/k) + real (kind=kind_phys), intent(in) :: rsurf !ground surface resistance (s/m) + real (kind=kind_phys), intent(in) :: lwdn !atmospheric longwave radiation (w/m2) + real (kind=kind_phys), intent(in) :: rhsur !raltive humidity in surface soil/snow air space (-) + real (kind=kind_phys), intent(in) :: eair !vapor pressure air at height (pa) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !soil/snow temperature (k) + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: smc !soil moisture + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: sh2o !soil liquid water + real (kind=kind_phys), intent(in) :: sag !solar radiation absorbed by ground (w/m2) + real (kind=kind_phys), intent(in) :: snowh !actual snow depth [m] + real (kind=kind_phys), intent(in) :: lathea !latent heat of vaporization/subli (j/kg) ! input/output - real, intent(inout) :: cm !momentum drag coefficient - real, intent(inout) :: ch !sensible heat exchange coefficient - real, intent(inout) :: tgb !ground temperature (k) - real, intent(inout) :: qsfc !mixing ratio at lowest model layer + real (kind=kind_phys), intent(inout) :: cm !momentum drag coefficient + real (kind=kind_phys), intent(inout) :: ch !sensible heat exchange coefficient + real (kind=kind_phys), intent(inout) :: tgb !ground temperature (k) + real (kind=kind_phys), intent(inout) :: qsfc !mixing ratio at lowest model layer #ifdef CCPP character(len=*), intent(inout) :: errmsg @@ -1058,49 +1027,49 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z ! output ! -sab + irb[tg] + shb[tg] + evb[tg] + ghb[tg] = 0 - real, intent(out) :: irb !net longwave rad (w/m2) [+ to atm] - real, intent(out) :: shb !sensible heat flux (w/m2) [+ to atm] - real, intent(out) :: evb !latent heat flux (w/m2) [+ to atm] - real, intent(out) :: ghb !ground heat flux (w/m2) [+ to soil] - real, intent(out) :: t2mb !2 m height air temperature (k) - real, intent(out) :: q2b !bare ground heat conductance - real, intent(out) :: ehb2 !sensible heat conductance for diagnostics + real (kind=kind_phys), intent(out) :: irb !net longwave rad (w/m2) [+ to atm] + real (kind=kind_phys), intent(out) :: shb !sensible heat flux (w/m2) [+ to atm] + real (kind=kind_phys), intent(out) :: evb !latent heat flux (w/m2) [+ to atm] + real (kind=kind_phys), intent(out) :: ghb !ground heat flux (w/m2) [+ to soil] + real (kind=kind_phys), intent(out) :: t2mb !2 m height air temperature (k) + real (kind=kind_phys), intent(out) :: q2b !bare ground heat conductance + real (kind=kind_phys), intent(out) :: ehb2 !sensible heat conductance for diagnostics ! local variables integer :: niterb !number of iterations for surface temperature - real :: mpe !prevents overflow error if division by zero - real :: dtg !change in tg, last iteration (k) + real (kind=kind_phys) :: mpe !prevents overflow error if division by zero + real (kind=kind_phys) :: dtg !change in tg, last iteration (k) integer :: mozsgn !number of times moz changes sign - real :: mozold !monin-obukhov stability parameter from prior iteration - real :: fm2 !monin-obukhov momentum adjustment at 2m - real :: fh2 !monin-obukhov heat adjustment at 2m - real :: ch2 !surface exchange at 2m - real :: h !temporary sensible heat flux (w/m2) - real :: fv !friction velocity (m/s) - real :: cir !coefficients for ir as function of ts**4 - real :: cgh !coefficients for st as function of ts - real :: csh !coefficients for sh as function of ts - real :: cev !coefficients for ev as function of esat[ts] - real :: cq2b ! + real (kind=kind_phys) :: mozold !monin-obukhov stability parameter from prior iteration + real (kind=kind_phys) :: fm2 !monin-obukhov momentum adjustment at 2m + real (kind=kind_phys) :: fh2 !monin-obukhov heat adjustment at 2m + real (kind=kind_phys) :: ch2 !surface exchange at 2m + real (kind=kind_phys) :: h !temporary sensible heat flux (w/m2) + real (kind=kind_phys) :: fv !friction velocity (m/s) + real (kind=kind_phys) :: cir !coefficients for ir as function of ts**4 + real (kind=kind_phys) :: cgh !coefficients for st as function of ts + real (kind=kind_phys) :: csh !coefficients for sh as function of ts + real (kind=kind_phys) :: cev !coefficients for ev as function of esat[ts] + real (kind=kind_phys) :: cq2b ! integer :: iter !iteration index - real :: z0h !roughness length, sensible heat, ground (m) - real :: moz !monin-obukhov stability parameter - real :: fm !momentum stability correction, weighted by prior iters - real :: fh !sen heat stability correction, weighted by prior iters - real :: ramb !aerodynamic resistance for momentum (s/m) - real :: rahb !aerodynamic resistance for sensible heat (s/m) - real :: rawb !aerodynamic resistance for water vapor (s/m) - real :: estg !saturation vapor pressure at tg (pa) - real :: destg !d(es)/dt at tg (pa/k) - real :: esatw !es for water - real :: esati !es for ice - real :: dsatw !d(es)/dt at tg (pa/k) for water - real :: dsati !d(es)/dt at tg (pa/k) for ice - real :: a !temporary calculation - real :: b !temporary calculation - real :: t, tdc !kelvin to degree celsius with limit -50 to +50 - real, dimension( 1:nsoil) :: sice !soil ice + real (kind=kind_phys) :: z0h !roughness length, sensible heat, ground (m) + real (kind=kind_phys) :: moz !monin-obukhov stability parameter + real (kind=kind_phys) :: fm !momentum stability correction, weighted by prior iters + real (kind=kind_phys) :: fh !sen heat stability correction, weighted by prior iters + real (kind=kind_phys) :: ramb !aerodynamic resistance for momentum (s/m) + real (kind=kind_phys) :: rahb !aerodynamic resistance for sensible heat (s/m) + real (kind=kind_phys) :: rawb !aerodynamic resistance for water vapor (s/m) + real (kind=kind_phys) :: estg !saturation vapor pressure at tg (pa) + real (kind=kind_phys) :: destg !d(es)/dt at tg (pa/k) + real (kind=kind_phys) :: esatw !es for water + real (kind=kind_phys) :: esati !es for ice + real (kind=kind_phys) :: dsatw !d(es)/dt at tg (pa/k) for water + real (kind=kind_phys) :: dsati !d(es)/dt at tg (pa/k) for ice + real (kind=kind_phys) :: a !temporary calculation + real (kind=kind_phys) :: b !temporary calculation + real (kind=kind_phys) :: t, tdc !kelvin to degree celsius with limit -50 to +50 + real (kind=kind_phys), dimension( 1:nsoil) :: sice !soil ice tdc(t) = min( 50., max(-50.,(t-tfrz)) ) @@ -1156,7 +1125,11 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z end if csh = rhoair*cpair/rahb - cev = rhoair*cpair/gamma/(rsurf+rawb) + if(snowh > 0.0 .or. opt_gla == 1) then + cev = rhoair*cpair/gamma/(rsurf+rawb) + else + cev = 0.0 ! don't allow any sublimation of glacier in opt_gla=2 + end if ! surface fluxes and dtg @@ -1195,9 +1168,13 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z ! if snow on ground and tg > tfrz: reset tg = tfrz. reevaluate ground fluxes. sice = smc - sh2o - if(opt_stc == 1) then - if ((maxval(sice) > 0.0 .or. snowh > 0.0) .and. tgb > tfrz) then + if(opt_stc == 1 .or. opt_stc ==3) then + if ((maxval(sice) > 0.0 .or. snowh > 0.0) .and. tgb > tfrz .and. opt_gla == 1) then tgb = tfrz + t = tdc(tgb) ! mb: recalculate estg + call esat(t, esatw, esati, dsatw, dsati) + estg = esati + qsfc = 0.622*(estg*rhsur)/(sfcprs-0.378*(estg*rhsur)) irb = cir * tgb**4 - emg*lwdn shb = csh * (tgb - sfctmp) evb = cev * (estg*rhsur - eair ) !estg reevaluate ? @@ -1230,21 +1207,21 @@ subroutine esat(t, esw, esi, desw, desi) !--------------------------------------------------------------------------------------------------- ! in - real, intent(in) :: t !temperature + real (kind=kind_phys), intent(in) :: t !temperature !out - real, intent(out) :: esw !saturation vapor pressure over water (pa) - real, intent(out) :: esi !saturation vapor pressure over ice (pa) - real, intent(out) :: desw !d(esat)/dt over water (pa/k) - real, intent(out) :: desi !d(esat)/dt over ice (pa/k) + real (kind=kind_phys), intent(out) :: esw !saturation vapor pressure over water (pa) + real (kind=kind_phys), intent(out) :: esi !saturation vapor pressure over ice (pa) + real (kind=kind_phys), intent(out) :: desw !d(esat)/dt over water (pa/k) + real (kind=kind_phys), intent(out) :: desi !d(esat)/dt over ice (pa/k) ! local - real :: a0,a1,a2,a3,a4,a5,a6 !coefficients for esat over water - real :: b0,b1,b2,b3,b4,b5,b6 !coefficients for esat over ice - real :: c0,c1,c2,c3,c4,c5,c6 !coefficients for dsat over water - real :: d0,d1,d2,d3,d4,d5,d6 !coefficients for dsat over ice + real (kind=kind_phys) :: a0,a1,a2,a3,a4,a5,a6 !coefficients for esat over water + real (kind=kind_phys) :: b0,b1,b2,b3,b4,b5,b6 !coefficients for esat over ice + real (kind=kind_phys) :: c0,c1,c2,c3,c4,c5,c6 !coefficients for dsat over water + real (kind=kind_phys) :: d0,d1,d2,d3,d4,d5,d6 !coefficients for dsat over ice parameter (a0=6.107799961 , a1=4.436518521e-01, & a2=1.428945805e-02, a3=2.650648471e-04, & @@ -1289,24 +1266,24 @@ subroutine sfcdif1_glacier(iter ,zlvl ,zpd ,z0h ,z0m , & !in ! ------------------------------------------------------------------------------------------------- ! inputs integer, intent(in) :: iter !iteration index - real, intent(in) :: zlvl !reference height (m) - real, intent(in) :: zpd !zero plane displacement (m) - real, intent(in) :: z0h !roughness length, sensible heat, ground (m) - real, intent(in) :: z0m !roughness length, momentum, ground (m) - real, intent(in) :: qair !specific humidity at reference height (kg/kg) - real, intent(in) :: sfctmp !temperature at reference height (k) - real, intent(in) :: h !sensible heat flux (w/m2) [+ to atm] - real, intent(in) :: rhoair !density air (kg/m**3) - real, intent(in) :: mpe !prevents overflow error if division by zero - real, intent(in) :: ur !wind speed (m/s) + real (kind=kind_phys), intent(in) :: zlvl !reference height (m) + real (kind=kind_phys), intent(in) :: zpd !zero plane displacement (m) + real (kind=kind_phys), intent(in) :: z0h !roughness length, sensible heat, ground (m) + real (kind=kind_phys), intent(in) :: z0m !roughness length, momentum, ground (m) + real (kind=kind_phys), intent(in) :: qair !specific humidity at reference height (kg/kg) + real (kind=kind_phys), intent(in) :: sfctmp !temperature at reference height (k) + real (kind=kind_phys), intent(in) :: h !sensible heat flux (w/m2) [+ to atm] + real (kind=kind_phys), intent(in) :: rhoair !density air (kg/m**3) + real (kind=kind_phys), intent(in) :: mpe !prevents overflow error if division by zero + real (kind=kind_phys), intent(in) :: ur !wind speed (m/s) ! in & out - real, intent(inout) :: moz !monin-obukhov stability (z/l) + real (kind=kind_phys), intent(inout) :: moz !monin-obukhov stability (z/l) integer, intent(inout) :: mozsgn !number of times moz changes sign - real, intent(inout) :: fm !momentum stability correction, weighted by prior iters - real, intent(inout) :: fh !sen heat stability correction, weighted by prior iters - real, intent(inout) :: fm2 !sen heat stability correction, weighted by prior iters - real, intent(inout) :: fh2 !sen heat stability correction, weighted by prior iters + real (kind=kind_phys), intent(inout) :: fm !momentum stability correction, weighted by prior iters + real (kind=kind_phys), intent(inout) :: fh !sen heat stability correction, weighted by prior iters + real (kind=kind_phys), intent(inout) :: fm2 !sen heat stability correction, weighted by prior iters + real (kind=kind_phys), intent(inout) :: fh2 !sen heat stability correction, weighted by prior iters #ifdef CCPP character(len=*), intent(inout) :: errmsg @@ -1314,28 +1291,28 @@ subroutine sfcdif1_glacier(iter ,zlvl ,zpd ,z0h ,z0m , & !in #endif ! outputs - real, intent(out) :: fv !friction velocity (m/s) - real, intent(out) :: cm !drag coefficient for momentum - real, intent(out) :: ch !drag coefficient for heat - real, intent(out) :: ch2 !drag coefficient for heat + real (kind=kind_phys), intent(out) :: fv !friction velocity (m/s) + real (kind=kind_phys), intent(out) :: cm !drag coefficient for momentum + real (kind=kind_phys), intent(out) :: ch !drag coefficient for heat + real (kind=kind_phys), intent(out) :: ch2 !drag coefficient for heat ! locals - real :: mozold !monin-obukhov stability parameter from prior iteration - real :: tmpcm !temporary calculation for cm - real :: tmpch !temporary calculation for ch - real :: mol !monin-obukhov length (m) - real :: tvir !temporary virtual temperature (k) - real :: tmp1,tmp2,tmp3 !temporary calculation - real :: fmnew !stability correction factor, momentum, for current moz - real :: fhnew !stability correction factor, sen heat, for current moz - real :: moz2 !2/l - real :: tmpcm2 !temporary calculation for cm2 - real :: tmpch2 !temporary calculation for ch2 - real :: fm2new !stability correction factor, momentum, for current moz - real :: fh2new !stability correction factor, sen heat, for current moz - real :: tmp12,tmp22,tmp32 !temporary calculation - - real :: cmfm, chfh, cm2fm2, ch2fh2 + real (kind=kind_phys) :: mozold !monin-obukhov stability parameter from prior iteration + real (kind=kind_phys) :: tmpcm !temporary calculation for cm + real (kind=kind_phys) :: tmpch !temporary calculation for ch + real (kind=kind_phys) :: mol !monin-obukhov length (m) + real (kind=kind_phys) :: tvir !temporary virtual temperature (k) + real (kind=kind_phys) :: tmp1,tmp2,tmp3 !temporary calculation + real (kind=kind_phys) :: fmnew !stability correction factor, momentum, for current moz + real (kind=kind_phys) :: fhnew !stability correction factor, sen heat, for current moz + real (kind=kind_phys) :: moz2 !2/l + real (kind=kind_phys) :: tmpcm2 !temporary calculation for cm2 + real (kind=kind_phys) :: tmpch2 !temporary calculation for ch2 + real (kind=kind_phys) :: fm2new !stability correction factor, momentum, for current moz + real (kind=kind_phys) :: fh2new !stability correction factor, sen heat, for current moz + real (kind=kind_phys) :: tmp12,tmp22,tmp32 !temporary calculation + + real (kind=kind_phys) :: cmfm, chfh, cm2fm2, ch2fh2 ! ------------------------------------------------------------------------------------------------- @@ -1465,26 +1442,26 @@ subroutine tsnosoi_glacier (nsoil ,nsnow ,isnow ,dt ,tbot , & !in integer, intent(in) :: nsnow !maximum no of snow layers (3) integer, intent(in) :: isnow !actual no of snow layers - real, intent(in) :: dt !time step (s) - real, intent(in) :: tbot ! - real, intent(in) :: ssoil !ground heat flux (w/m2) - real, intent(in) :: snowh !snow depth (m) - real, intent(in) :: zbot !from soil surface (m) - real, dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bot. depth from snow surf.(m) - real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity - real, dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity (j/m3/k) + real (kind=kind_phys), intent(in) :: dt !time step (s) + real (kind=kind_phys), intent(in) :: tbot ! + real (kind=kind_phys), intent(in) :: ssoil !ground heat flux (w/m2) + real (kind=kind_phys), intent(in) :: snowh !snow depth (m) + real (kind=kind_phys), intent(in) :: zbot !from soil surface (m) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bot. depth from snow surf.(m) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity (j/m3/k) !input and output - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !local integer :: iz - real :: zbotsno !zbot from snow surface - real, dimension(-nsnow+1:nsoil) :: ai, bi, ci, rhsts - real :: eflxb !energy influx from soil bottom (w/m2) - real, dimension(-nsnow+1:nsoil) :: phi !light through water (w/m2) + real (kind=kind_phys) :: zbotsno !zbot from snow surface + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: ai, bi, ci, rhsts + real (kind=kind_phys) :: eflxb !energy influx from soil bottom (w/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: phi !light through water (w/m2) ! ---------------------------------------------------------------------- @@ -1530,32 +1507,32 @@ subroutine hrt_glacier (nsnow ,nsoil ,isnow ,zsnso , & !in integer, intent(in) :: nsoil !no of soil layers (4) integer, intent(in) :: nsnow !maximum no of snow layers (3) integer, intent(in) :: isnow !actual no of snow layers - real, intent(in) :: tbot !bottom soil temp. at zbot (k) - real, intent(in) :: zbot !depth of lower boundary condition (m) + real (kind=kind_phys), intent(in) :: tbot !bottom soil temp. at zbot (k) + real (kind=kind_phys), intent(in) :: zbot !depth of lower boundary condition (m) !from soil surface not snow surface - real, intent(in) :: ssoil !ground heat flux (w/m2) - real, dimension(-nsnow+1:nsoil), intent(in) :: zsnso !depth of layer-bottom of snow/soil (m) - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature (k) - real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity [w/m/k] - real, dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity [j/m3/k] - real, dimension(-nsnow+1:nsoil), intent(in) :: phi !light through water (w/m2) + real (kind=kind_phys), intent(in) :: ssoil !ground heat flux (w/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: zsnso !depth of layer-bottom of snow/soil (m) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature (k) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity [w/m/k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity [j/m3/k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: phi !light through water (w/m2) ! output - real, dimension(-nsnow+1:nsoil), intent(out) :: rhsts !right-hand side of the matrix - real, dimension(-nsnow+1:nsoil), intent(out) :: ai !left-hand side coefficient - real, dimension(-nsnow+1:nsoil), intent(out) :: bi !left-hand side coefficient - real, dimension(-nsnow+1:nsoil), intent(out) :: ci !left-hand side coefficient - real, intent(out) :: botflx !energy influx from soil bottom (w/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: rhsts !right-hand side of the matrix + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: ai !left-hand side coefficient + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: bi !left-hand side coefficient + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: ci !left-hand side coefficient + real (kind=kind_phys), intent(out) :: botflx !energy influx from soil bottom (w/m2) ! local integer :: k - real, dimension(-nsnow+1:nsoil) :: ddz - real, dimension(-nsnow+1:nsoil) :: denom - real, dimension(-nsnow+1:nsoil) :: dtsdz - real, dimension(-nsnow+1:nsoil) :: eflux - real :: temp1 + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: ddz + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: denom + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: dtsdz + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: eflux + real (kind=kind_phys) :: temp1 ! ---------------------------------------------------------------------- do k = isnow+1, nsoil @@ -1589,7 +1566,7 @@ subroutine hrt_glacier (nsnow ,nsoil ,isnow ,zsnso , & !in if (k == isnow+1) then ai(k) = 0.0 ci(k) = - df(k) * ddz(k) / denom(k) - if (opt_stc == 1) then + if (opt_stc == 1 .or. opt_stc == 3) then bi(k) = - ci(k) end if if (opt_stc == 2) then @@ -1624,19 +1601,19 @@ subroutine hstep_glacier (nsnow ,nsoil ,isnow ,dt , & !in integer, intent(in) :: nsoil integer, intent(in) :: nsnow integer, intent(in) :: isnow - real, intent(in) :: dt + real (kind=kind_phys), intent(in) :: dt ! output & input - real, dimension(-nsnow+1:nsoil), intent(inout) :: ai - real, dimension(-nsnow+1:nsoil), intent(inout) :: bi - real, dimension(-nsnow+1:nsoil), intent(inout) :: ci - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc - real, dimension(-nsnow+1:nsoil), intent(inout) :: rhsts + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: ai + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: bi + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: ci + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: rhsts ! local integer :: k - real, dimension(-nsnow+1:nsoil) :: rhstsin - real, dimension(-nsnow+1:nsoil) :: ciin + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: rhstsin + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: ciin ! ---------------------------------------------------------------------- do k = isnow+1,nsoil @@ -1691,8 +1668,8 @@ subroutine rosr12_glacier (p,a,b,c,d,delta,ntop,nsoil,nsnow) integer, intent(in) :: nsoil,nsnow integer :: k, kk - real, dimension(-nsnow+1:nsoil),intent(in):: a, b, d - real, dimension(-nsnow+1:nsoil),intent(inout):: c,p,delta + real (kind=kind_phys), dimension(-nsnow+1:nsoil),intent(in):: a, b, d + real (kind=kind_phys), dimension(-nsnow+1:nsoil),intent(inout):: c,p,delta ! ---------------------------------------------------------------------- ! initialize eqn coef c for the lowest soil layer @@ -1742,39 +1719,39 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & integer, intent(in) :: nsnow !maximum no. of snow layers [=3] integer, intent(in) :: nsoil !no. of soil layers [=4] integer, intent(in) :: isnow !actual no. of snow layers [<=3] - real, intent(in) :: dt !land model time step (sec) - real, dimension(-nsnow+1:nsoil), intent(in) :: fact !temporary - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys), intent(in) :: dt !land model time step (sec) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: fact !temporary + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] ! inputs/outputs - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil layer temperature [k] - real, dimension(-nsnow+1:0) , intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1:0) , intent(inout) :: snliq !snow layer liquid water [mm] - real, intent(inout) :: sneqv - real, intent(inout) :: snowh - real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid water [m3/m3] - real, dimension( 1:nsoil), intent(inout) :: smc !total soil water [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1:0) , intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1:0) , intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), intent(inout) :: sneqv + real (kind=kind_phys), intent(inout) :: snowh + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid water [m3/m3] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: smc !total soil water [m3/m3] ! outputs - real, intent(out) :: qmelt !snowmelt rate [mm/s] + real (kind=kind_phys), intent(out) :: qmelt !snowmelt rate [mm/s] integer, dimension(-nsnow+1:nsoil), intent(out) :: imelt !phase change index - real, intent(out) :: ponding!snowmelt when snow has no layer [mm] + real (kind=kind_phys), intent(out) :: ponding!snowmelt when snow has no layer [mm] ! local integer :: j,k !do loop index - real, dimension(-nsnow+1:nsoil) :: hm !energy residual [w/m2] - real, dimension(-nsnow+1:nsoil) :: xm !melting or freezing water [kg/m2] - real, dimension(-nsnow+1:nsoil) :: wmass0 - real, dimension(-nsnow+1:nsoil) :: wice0 - real, dimension(-nsnow+1:nsoil) :: wliq0 - real, dimension(-nsnow+1:nsoil) :: mice !soil/snow ice mass [mm] - real, dimension(-nsnow+1:nsoil) :: mliq !soil/snow liquid water mass [mm] - real, dimension(-nsnow+1:nsoil) :: heatr !energy residual or loss after melting/freezing - real :: temp1 !temporary variables [kg/m2] - real :: propor - real :: xmf !total latent heat of phase change + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: hm !energy residual [w/m2] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: xm !melting or freezing water [kg/m2] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: wmass0 + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: wice0 + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: wliq0 + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: mice !soil/snow ice mass [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: mliq !soil/snow liquid water mass [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: heatr !energy residual or loss after melting/freezing + real (kind=kind_phys) :: temp1 !temporary variables [kg/m2] + real (kind=kind_phys) :: propor + real (kind=kind_phys) :: xmf !total latent heat of phase change ! ---------------------------------------------------------------------- ! initialization @@ -1788,12 +1765,106 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & mliq(j) = snliq(j) end do + do j = isnow+1,0 ! all snow layers; do ice later + imelt(j) = 0 + hm(j) = 0. + xm(j) = 0. + wice0(j) = mice(j) + wliq0(j) = mliq(j) + wmass0(j) = mice(j) + mliq(j) + enddo + + do j = isnow+1,0 + if (mice(j) > 0. .and. stc(j) >= tfrz) then ! melting + imelt(j) = 1 + endif + if (mliq(j) > 0. .and. stc(j) < tfrz) then ! freezing + imelt(j) = 2 + endif + + enddo + +! calculate the energy surplus and loss for melting and freezing + + do j = isnow+1,0 + if (imelt(j) > 0) then + hm(j) = (stc(j)-tfrz)/fact(j) + stc(j) = tfrz + endif + + if (imelt(j) == 1 .and. hm(j) < 0.) then + hm(j) = 0. + imelt(j) = 0 + endif + if (imelt(j) == 2 .and. hm(j) > 0.) then + hm(j) = 0. + imelt(j) = 0 + endif + xm(j) = hm(j)*dt/hfus + enddo + +! the rate of melting and freezing for snow without a layer, opt_gla==1 treated below + +if (opt_gla == 2) then + + if (isnow == 0 .and. sneqv > 0. .and. stc(1) >= tfrz) then + hm(1) = (stc(1)-tfrz)/fact(1) ! available heat + stc(1) = tfrz ! set t to freezing + xm(1) = hm(1)*dt/hfus ! total snow melt possible + + temp1 = sneqv + sneqv = max(0.,temp1-xm(1)) ! snow remaining + propor = sneqv/temp1 ! fraction melted + snowh = max(0.,propor * snowh) ! new snow height + heatr(1) = hm(1) - hfus*(temp1-sneqv)/dt ! excess heat + if (heatr(1) > 0.) then + xm(1) = heatr(1)*dt/hfus + stc(1) = stc(1) + fact(1)*heatr(1) ! re-heat ice + else + xm(1) = 0. ! heat used up + hm(1) = 0. + endif + qmelt = max(0.,(temp1-sneqv))/dt ! melted snow rate + xmf = hfus*qmelt ! melted snow energy + ponding = temp1-sneqv ! melt water + endif + +end if ! opt_gla == 2 + +! the rate of melting and freezing for snow + + do j = isnow+1,0 + if (imelt(j) > 0 .and. abs(hm(j)) > 0.) then + + heatr(j) = 0. + if (xm(j) > 0.) then + mice(j) = max(0., wice0(j)-xm(j)) + heatr(j) = hm(j) - hfus*(wice0(j)-mice(j))/dt + else if (xm(j) < 0.) then + mice(j) = min(wmass0(j), wice0(j)-xm(j)) + heatr(j) = hm(j) - hfus*(wice0(j)-mice(j))/dt + endif + + mliq(j) = max(0.,wmass0(j)-mice(j)) + + if (abs(heatr(j)) > 0.) then + stc(j) = stc(j) + fact(j)*heatr(j) + if (mliq(j)*mice(j)>0.) stc(j) = tfrz + endif + + qmelt = qmelt + max(0.,(wice0(j)-mice(j)))/dt + + endif + enddo + +if (opt_gla == 1) then ! operate on the ice layers + do j = 1, nsoil ! all soil layers mliq(j) = sh2o(j) * dzsnso(j) * 1000. mice(j) = (smc(j) - sh2o(j)) * dzsnso(j) * 1000. end do - do j = isnow+1,nsoil ! all layers + do j = 1,nsoil ! all layers imelt(j) = 0 hm(j) = 0. xm(j) = 0. @@ -1802,7 +1873,7 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & wmass0(j) = mice(j) + mliq(j) enddo - do j = isnow+1,nsoil + do j = 1,nsoil if (mice(j) > 0. .and. stc(j) >= tfrz) then ! melting imelt(j) = 1 endif @@ -1820,7 +1891,7 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & ! calculate the energy surplus and loss for melting and freezing - do j = isnow+1,nsoil + do j = 1,nsoil if (imelt(j) > 0) then hm(j) = (stc(j)-tfrz)/fact(j) stc(j) = tfrz @@ -1859,9 +1930,9 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & ponding = temp1-sneqv endif -! the rate of melting and freezing for snow and soil +! the rate of melting and freezing for soil - do j = isnow+1,nsoil + do j = 1,nsoil if (imelt(j) > 0 .and. abs(hm(j)) > 0.) then heatr(j) = 0. @@ -2001,6 +2072,8 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & end if end do end if + +end if ! opt_gla == 1 do j = isnow+1,0 ! snow snliq(j) = mliq(j) @@ -2008,10 +2081,14 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & end do do j = 1, nsoil ! soil + if(opt_gla == 1) then sh2o(j) = mliq(j) / (1000. * dzsnso(j)) sh2o(j) = max(0.0,min(1.0,sh2o(j))) ! smc(j) = (mliq(j) + mice(j)) / (1000. * dzsnso(j)) - smc(j) = 1.0 + elseif(opt_gla == 2) then + sh2o(j) = 0.0 ! ice, assume all frozen...forever + end if + smc(j) = 1.0 end do end subroutine phasechange_glacier @@ -2020,7 +2097,7 @@ end subroutine phasechange_glacier subroutine water_glacier (nsnow ,nsoil ,imelt ,dt ,prcp ,sfctmp , & !in qvap ,qdew ,ficeold,zsoil , & !in isnow ,snowh ,sneqv ,snice ,snliq ,stc , & !inout - dzsnso ,sh2o ,sice ,ponding,zsnso , & !inout + dzsnso ,sh2o ,sice ,ponding,zsnso ,fsh , & !inout runsrf ,runsub ,qsnow ,ponding1 ,ponding2,qsnbot,fpice,esnow & !out ) !out ! ---------------------------------------------------------------------- @@ -2033,49 +2110,50 @@ subroutine water_glacier (nsnow ,nsoil ,imelt ,dt ,prcp ,sfctmp , & !in integer, intent(in) :: nsnow !maximum no. of snow layers integer, intent(in) :: nsoil !no. of soil layers integer, dimension(-nsnow+1:0) , intent(in) :: imelt !melting state index [1-melt; 2-freeze] - real, intent(in) :: dt !main time step (s) - real, intent(in) :: prcp !precipitation (mm/s) - real, intent(in) :: sfctmp !surface air temperature [k] - real, intent(in) :: qvap !soil surface evaporation rate[mm/s] - real, intent(in) :: qdew !soil surface dew rate[mm/s] - real, dimension(-nsnow+1: 0), intent(in) :: ficeold !ice fraction at last timestep - real, dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf (m) + real (kind=kind_phys), intent(in) :: dt !main time step (s) + real (kind=kind_phys), intent(in) :: prcp !precipitation (mm/s) + real (kind=kind_phys), intent(in) :: sfctmp !surface air temperature [k] + real (kind=kind_phys), intent(inout) :: qvap !soil surface evaporation rate[mm/s] + real (kind=kind_phys), intent(inout) :: qdew !soil surface dew rate[mm/s] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: ficeold !ice fraction at last timestep + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf (m) ! input/output integer, intent(inout) :: isnow !actual no. of snow layers - real, intent(inout) :: snowh !snow height [m] - real, intent(inout) :: sneqv !snow water eqv. [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil layer temperature [k] - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !snow/soil layer thickness [m] - real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid water content [m3/m3] - real, dimension( 1:nsoil), intent(inout) :: sice !soil ice content [m3/m3] - real , intent(inout) :: ponding ![mm] - real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !layer-bottom depth from snow surf [m] + real (kind=kind_phys), intent(inout) :: snowh !snow height [m] + real (kind=kind_phys), intent(inout) :: sneqv !snow water eqv. [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid water content [m3/m3] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sice !soil ice content [m3/m3] + real (kind=kind_phys) , intent(inout) :: ponding ![mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !layer-bottom depth from snow surf [m] + real (kind=kind_phys) , intent(inout) :: fsh !total sensible heat (w/m2) [+ to atm] ! output - real, intent(out) :: runsrf !surface runoff [mm/s] - real, intent(out) :: runsub !baseflow (sturation excess) [mm/s] - real, intent(out) :: qsnow !snow at ground srf (mm/s) [+] - real, intent(out) :: ponding1 - real, intent(out) :: ponding2 - real, intent(out) :: qsnbot !melting water out of snow bottom [mm/s] - real, intent(out) :: fpice !precipitation frozen fraction - real, intent(out) :: esnow ! + real (kind=kind_phys), intent(out) :: runsrf !surface runoff [mm/s] + real (kind=kind_phys), intent(out) :: runsub !baseflow (sturation excess) [mm/s] + real (kind=kind_phys), intent(out) :: qsnow !snow at ground srf (mm/s) [+] + real (kind=kind_phys), intent(out) :: ponding1 + real (kind=kind_phys), intent(out) :: ponding2 + real (kind=kind_phys), intent(out) :: qsnbot !melting water out of snow bottom [mm/s] + real (kind=kind_phys), intent(out) :: fpice !precipitation frozen fraction + real (kind=kind_phys), intent(out) :: esnow ! ! local - real :: qrain !rain at ground srf (mm) [+] - real :: qseva !soil surface evap rate [mm/s] - real :: qsdew !soil surface dew rate [mm/s] - real :: qsnfro !snow surface frost rate[mm/s] - real :: qsnsub !snow surface sublimation rate [mm/s] - real :: snowhin !snow depth increasing rate (m/s) - real :: snoflow !glacier flow [mm/s] - real :: bdfall !density of new snow (mm water/m snow) - real :: replace !replacement water due to sublimation of glacier - real, dimension( 1:nsoil) :: sice_save !soil ice content [m3/m3] - real, dimension( 1:nsoil) :: sh2o_save !soil liquid water content [m3/m3] + real (kind=kind_phys) :: qrain !rain at ground srf (mm) [+] + real (kind=kind_phys) :: qseva !soil surface evap rate [mm/s] + real (kind=kind_phys) :: qsdew !soil surface dew rate [mm/s] + real (kind=kind_phys) :: qsnfro !snow surface frost rate[mm/s] + real (kind=kind_phys) :: qsnsub !snow surface sublimation rate [mm/s] + real (kind=kind_phys) :: snowhin !snow depth increasing rate (m/s) + real (kind=kind_phys) :: snoflow !glacier flow [mm/s] + real (kind=kind_phys) :: bdfall !density of new snow (mm water/m snow) + real (kind=kind_phys) :: replace !replacement water due to sublimation of glacier + real (kind=kind_phys), dimension( 1:nsoil) :: sice_save !soil ice content [m3/m3] + real (kind=kind_phys), dimension( 1:nsoil) :: sh2o_save !soil liquid water content [m3/m3] integer :: ilev @@ -2136,38 +2214,17 @@ subroutine water_glacier (nsnow ,nsoil ,imelt ,dt ,prcp ,sfctmp , & !in ! sublimation, frost, evaporation, and dew -! qsnsub = 0. -! if (sneqv > 0.) then -! qsnsub = min(qvap, sneqv/dt) -! endif -! qseva = qvap-qsnsub - -! qsnfro = 0. -! if (sneqv > 0.) then -! qsnfro = qdew -! endif -! qsdew = qdew - qsnfro - qsnsub = qvap ! send total sublimation/frost to snowwater and deal with it there qsnfro = qdew esnow = qsnsub*2.83e+6 - -! print *, 'qvap',qvap,qvap*dt -! print *, 'qsnsub',qsnsub,qsnsub*dt -! print *, 'qseva',qseva,qseva*dt -! print *, 'qsnfro',qsnfro,qsnfro*dt -! print *, 'qdew',qdew,qdew*dt -! print *, 'qsdew',qsdew,qsdew*dt -!print *, 'before snowwater', sneqv,snowh,snice,snliq,sh2o,sice call snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in snowhin,qsnow ,qsnfro ,qsnsub ,qrain , & !in ficeold,zsoil , & !in isnow ,snowh ,sneqv ,snice ,snliq , & !inout sh2o ,sice ,stc ,dzsnso ,zsnso , & !inout + fsh , & !inout qsnbot ,snoflow,ponding1 ,ponding2) !out -!print *, 'after snowwater', sneqv,snowh,snice,snliq,sh2o,sice -!print *, 'ponding', ponding,ponding1,ponding2 !ponding: melting water from snow when there is no layer @@ -2180,20 +2237,29 @@ subroutine water_glacier (nsnow ,nsoil ,imelt ,dt ,prcp ,sfctmp , & !in endif - replace = 0.0 - do ilev = 1,nsoil + if(opt_gla == 1) then + replace = 0.0 + do ilev = 1,nsoil replace = replace + dzsnso(ilev)*(sice(ilev) - sice_save(ilev) + sh2o(ilev) - sh2o_save(ilev)) - end do - replace = replace * 1000.0 / dt ! convert to [mm/s] + end do + replace = replace * 1000.0 / dt ! convert to [mm/s] - sice = min(1.0,sice_save) + sice = min(1.0,sice_save) + elseif(opt_gla == 2) then + sice = 1.0 + end if sh2o = 1.0 - sice -!print *, 'replace', replace ! use runsub as a water balancer, snoflow is snow that disappears, replace is ! water from below that replaces glacier loss - runsub = snoflow + replace + if(opt_gla == 1) then + runsub = snoflow + replace + elseif(opt_gla == 2) then + runsub = snoflow + qvap = qsnsub + qdew = qsnfro + end if end subroutine water_glacier ! ================================================================================================== @@ -2204,6 +2270,7 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in ficeold,zsoil , & !in isnow ,snowh ,sneqv ,snice ,snliq , & !inout sh2o ,sice ,stc ,dzsnso ,zsnso , & !inout + fsh , & !inout qsnbot ,snoflow,ponding1 ,ponding2) !out ! ---------------------------------------------------------------------- implicit none @@ -2212,37 +2279,38 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in integer, intent(in) :: nsnow !maximum no. of snow layers integer, intent(in) :: nsoil !no. of soil layers integer, dimension(-nsnow+1:0) , intent(in) :: imelt !melting state index [0-no melt;1-melt] - real, intent(in) :: dt !time step (s) - real, intent(in) :: sfctmp !surface air temperature [k] - real, intent(in) :: snowhin!snow depth increasing rate (m/s) - real, intent(in) :: qsnow !snow at ground srf (mm/s) [+] - real, intent(in) :: qsnfro !snow surface frost rate[mm/s] - real, intent(in) :: qsnsub !snow surface sublimation rate[mm/s] - real, intent(in) :: qrain !snow surface rain rate[mm/s] - real, dimension(-nsnow+1:0) , intent(in) :: ficeold!ice fraction at last timestep - real, dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf (m) + real (kind=kind_phys), intent(in) :: dt !time step (s) + real (kind=kind_phys), intent(in) :: sfctmp !surface air temperature [k] + real (kind=kind_phys), intent(in) :: snowhin!snow depth increasing rate (m/s) + real (kind=kind_phys), intent(in) :: qsnow !snow at ground srf (mm/s) [+] + real (kind=kind_phys), intent(inout) :: qsnfro !snow surface frost rate[mm/s] + real (kind=kind_phys), intent(inout) :: qsnsub !snow surface sublimation rate[mm/s] + real (kind=kind_phys), intent(in) :: qrain !snow surface rain rate[mm/s] + real (kind=kind_phys), dimension(-nsnow+1:0) , intent(in) :: ficeold!ice fraction at last timestep + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf (m) ! input & output integer, intent(inout) :: isnow !actual no. of snow layers - real, intent(inout) :: snowh !snow height [m] - real, intent(inout) :: sneqv !snow water eqv. [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] - real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) - real, dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !snow/soil layer thickness [m] - real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !layer-bottom depth from snow surf [m] + real (kind=kind_phys), intent(inout) :: snowh !snow height [m] + real (kind=kind_phys), intent(inout) :: sneqv !snow water eqv. [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !layer-bottom depth from snow surf [m] + real (kind=kind_phys), intent(inout) :: fsh !total sensible heat (w/m2) [+ to atm] ! output - real, intent(out) :: qsnbot !melting water out of snow bottom [mm/s] - real, intent(out) :: snoflow!glacier flow [mm] - real, intent(out) :: ponding1 - real, intent(out) :: ponding2 + real (kind=kind_phys), intent(out) :: qsnbot !melting water out of snow bottom [mm/s] + real (kind=kind_phys), intent(out) :: snoflow!glacier flow [mm] + real (kind=kind_phys), intent(out) :: ponding1 + real (kind=kind_phys), intent(out) :: ponding2 ! local integer :: iz - real :: bdsnow !bulk density of snow (kg/m3) + real (kind=kind_phys) :: bdsnow !bulk density of snow (kg/m3) ! ---------------------------------------------------------------------- snoflow = 0.0 ponding1 = 0.0 @@ -2281,7 +2349,7 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in qrain , & !in isnow ,dzsnso ,snowh ,sneqv ,snice , & !inout snliq ,sh2o ,sice ,stc , & !inout - ponding1 ,ponding2 , & !inout + ponding1 ,ponding2 ,fsh , & !inout qsnbot ) !out !to obtain equilibrium state of snow in glacier region @@ -2340,20 +2408,20 @@ subroutine snowfall_glacier (nsoil ,nsnow ,dt ,qsnow ,snowhin , & !in integer, intent(in) :: nsoil !no. of soil layers integer, intent(in) :: nsnow !maximum no. of snow layers - real, intent(in) :: dt !main time step (s) - real, intent(in) :: qsnow !snow at ground srf (mm/s) [+] - real, intent(in) :: snowhin!snow depth increasing rate (m/s) - real, intent(in) :: sfctmp !surface air temperature [k] + real (kind=kind_phys), intent(in) :: dt !main time step (s) + real (kind=kind_phys), intent(in) :: qsnow !snow at ground srf (mm/s) [+] + real (kind=kind_phys), intent(in) :: snowhin!snow depth increasing rate (m/s) + real (kind=kind_phys), intent(in) :: sfctmp !surface air temperature [k] ! input and output integer, intent(inout) :: isnow !actual no. of snow layers - real, intent(inout) :: snowh !snow depth [m] - real, intent(inout) :: sneqv !swow water equivalent [m] - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !thickness of snow/soil layers (m) - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), intent(inout) :: snowh !snow depth [m] + real (kind=kind_phys), intent(inout) :: sneqv !swow water equivalent [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !thickness of snow/soil layers (m) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] ! local @@ -2403,35 +2471,35 @@ subroutine compact_glacier (nsnow ,nsoil ,dt ,stc ,snice , & !in integer, intent(in) :: nsoil !no. of soil layers [ =4] integer, intent(in) :: nsnow !maximum no. of snow layers [ =3] integer, dimension(-nsnow+1:0) , intent(in) :: imelt !melting state index [0-no melt;1-melt] - real, intent(in) :: dt !time step (sec) - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow layer temperature [k] - real, dimension(-nsnow+1: 0), intent(in) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(in) :: snliq !snow layer liquid water [mm] - real, dimension(-nsnow+1: 0), intent(in) :: ficeold!ice fraction at last timestep + real (kind=kind_phys), intent(in) :: dt !time step (sec) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: ficeold!ice fraction at last timestep ! input and output integer, intent(inout) :: isnow ! actual no. of snow layers - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso ! snow layer thickness [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso ! snow layer thickness [m] ! local - real, parameter :: c2 = 21.e-3 ![m3/kg] ! default 21.e-3 - real, parameter :: c3 = 2.5e-6 ![1/s] - real, parameter :: c4 = 0.04 ![1/k] - real, parameter :: c5 = 2.0 ! - real, parameter :: dm = 100.0 !upper limit on destructive metamorphism compaction [kg/m3] - real, parameter :: eta0 = 0.8e+6 !viscosity coefficient [kg-s/m2] + real (kind=kind_phys), parameter :: c2 = 21.e-3 ![m3/kg] ! default 21.e-3 + real (kind=kind_phys), parameter :: c3 = 2.5e-6 ![1/s] + real (kind=kind_phys), parameter :: c4 = 0.04 ![1/k] + real (kind=kind_phys), parameter :: c5 = 2.0 ! + real (kind=kind_phys), parameter :: dm = 100.0 !upper limit on destructive metamorphism compaction [kg/m3] + real (kind=kind_phys), parameter :: eta0 = 0.8e+6 !viscosity coefficient [kg-s/m2] !according to anderson, it is between 0.52e6~1.38e6 - real :: burden !pressure of overlying snow [kg/m2] - real :: ddz1 !rate of settling of snow pack due to destructive metamorphism. - real :: ddz2 !rate of compaction of snow pack due to overburden. - real :: ddz3 !rate of compaction of snow pack due to melt [1/s] - real :: dexpf !expf=exp(-c4*(273.15-stc)). - real :: td !stc - tfrz [k] - real :: pdzdtc !nodal rate of change in fractional-thickness due to compaction [fraction/s] - real :: void !void (1 - snice - snliq) - real :: wx !water mass (ice + liquid) [kg/m2] - real :: bi !partial density of ice [kg/m3] - real, dimension(-nsnow+1:0) :: fice !fraction of ice at current time step + real (kind=kind_phys) :: burden !pressure of overlying snow [kg/m2] + real (kind=kind_phys) :: ddz1 !rate of settling of snow pack due to destructive metamorphism. + real (kind=kind_phys) :: ddz2 !rate of compaction of snow pack due to overburden. + real (kind=kind_phys) :: ddz3 !rate of compaction of snow pack due to melt [1/s] + real (kind=kind_phys) :: dexpf !expf=exp(-c4*(273.15-stc)). + real (kind=kind_phys) :: td !stc - tfrz [k] + real (kind=kind_phys) :: pdzdtc !nodal rate of change in fractional-thickness due to compaction [fraction/s] + real (kind=kind_phys) :: void !void (1 - snice - snliq) + real (kind=kind_phys) :: wx !water mass (ice + liquid) [kg/m2] + real (kind=kind_phys) :: bi !partial density of ice [kg/m3] + real (kind=kind_phys), dimension(-nsnow+1:0) :: fice !fraction of ice at current time step integer :: j @@ -2507,16 +2575,16 @@ subroutine combine_glacier (nsnow ,nsoil , & !in ! input and output integer, intent(inout) :: isnow !actual no. of snow layers - real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) - real, dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso!snow layer depth [m] - real, intent(inout) :: sneqv !snow water equivalent [m] - real, intent(inout) :: snowh !snow depth [m] - real, intent(inout) :: ponding1 - real, intent(inout) :: ponding2 + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso!snow layer depth [m] + real (kind=kind_phys), intent(inout) :: sneqv !snow water equivalent [m] + real (kind=kind_phys), intent(inout) :: snowh !snow depth [m] + real (kind=kind_phys), intent(inout) :: ponding1 + real (kind=kind_phys), intent(inout) :: ponding2 ! local variables: @@ -2524,9 +2592,9 @@ subroutine combine_glacier (nsnow ,nsoil , & !in integer :: isnow_old ! number of top snow layer integer :: mssi ! node index integer :: neibor ! adjacent node selected for combination - real :: zwice ! total ice mass in snow - real :: zwliq ! total liquid water in snow - real :: dzmin(3) ! minimum of top snow layer + real (kind=kind_phys) :: zwice ! total ice mass in snow + real (kind=kind_phys) :: zwliq ! total liquid water in snow + real (kind=kind_phys) :: dzmin(3) ! minimum of top snow layer data dzmin /0.045, 0.05, 0.2/ ! data dzmin /0.025, 0.025, 0.1/ ! mb: change limit !----------------------------------------------------------------------- @@ -2673,24 +2741,24 @@ subroutine combo_glacier(dz, wliq, wice, t, dz2, wliq2, wice2, t2) ! ----------------------------------------------------------------------s ! input - real, intent(in) :: dz2 !nodal thickness of 2 elements being combined [m] - real, intent(in) :: wliq2 !liquid water of element 2 [kg/m2] - real, intent(in) :: wice2 !ice of element 2 [kg/m2] - real, intent(in) :: t2 !nodal temperature of element 2 [k] - real, intent(inout) :: dz !nodal thickness of 1 elements being combined [m] - real, intent(inout) :: wliq !liquid water of element 1 - real, intent(inout) :: wice !ice of element 1 [kg/m2] - real, intent(inout) :: t !node temperature of element 1 [k] + real (kind=kind_phys), intent(in) :: dz2 !nodal thickness of 2 elements being combined [m] + real (kind=kind_phys), intent(in) :: wliq2 !liquid water of element 2 [kg/m2] + real (kind=kind_phys), intent(in) :: wice2 !ice of element 2 [kg/m2] + real (kind=kind_phys), intent(in) :: t2 !nodal temperature of element 2 [k] + real (kind=kind_phys), intent(inout) :: dz !nodal thickness of 1 elements being combined [m] + real (kind=kind_phys), intent(inout) :: wliq !liquid water of element 1 + real (kind=kind_phys), intent(inout) :: wice !ice of element 1 [kg/m2] + real (kind=kind_phys), intent(inout) :: t !node temperature of element 1 [k] ! local - real :: dzc !total thickness of nodes 1 and 2 (dzc=dz+dz2). - real :: wliqc !combined liquid water [kg/m2] - real :: wicec !combined ice [kg/m2] - real :: tc !combined node temperature [k] - real :: h !enthalpy of element 1 [j/m2] - real :: h2 !enthalpy of element 2 [j/m2] - real :: hc !temporary + real (kind=kind_phys) :: dzc !total thickness of nodes 1 and 2 (dzc=dz+dz2). + real (kind=kind_phys) :: wliqc !combined liquid water [kg/m2] + real (kind=kind_phys) :: wicec !combined ice [kg/m2] + real (kind=kind_phys) :: tc !combined node temperature [k] + real (kind=kind_phys) :: h !enthalpy of element 1 [j/m2] + real (kind=kind_phys) :: h2 !enthalpy of element 2 [j/m2] + real (kind=kind_phys) :: hc !temporary !----------------------------------------------------------------------- @@ -2730,24 +2798,24 @@ subroutine divide_glacier (nsnow ,nsoil , & !in ! input and output integer , intent(inout) :: isnow !actual no. of snow layers - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso!snow layer depth [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso!snow layer depth [m] ! local variables: integer :: j !indices integer :: msno !number of layer (top) to msno (bot) - real :: drr !thickness of the combined [m] - real, dimension( 1:nsnow) :: dz !snow layer thickness [m] - real, dimension( 1:nsnow) :: swice !partial volume of ice [m3/m3] - real, dimension( 1:nsnow) :: swliq !partial volume of liquid water [m3/m3] - real, dimension( 1:nsnow) :: tsno !node temperature [k] - real :: zwice !temporary - real :: zwliq !temporary - real :: propor!temporary - real :: dtdz !temporary + real (kind=kind_phys) :: drr !thickness of the combined [m] + real (kind=kind_phys), dimension( 1:nsnow) :: dz !snow layer thickness [m] + real (kind=kind_phys), dimension( 1:nsnow) :: swice !partial volume of ice [m3/m3] + real (kind=kind_phys), dimension( 1:nsnow) :: swliq !partial volume of liquid water [m3/m3] + real (kind=kind_phys), dimension( 1:nsnow) :: tsno !node temperature [k] + real (kind=kind_phys) :: zwice !temporary + real (kind=kind_phys) :: zwliq !temporary + real (kind=kind_phys) :: propor!temporary + real (kind=kind_phys) :: dtdz !temporary ! ---------------------------------------------------------------------- do j = 1,nsnow @@ -2847,7 +2915,7 @@ subroutine snowh2o_glacier (nsnow ,nsoil ,dt ,qsnfro ,qsnsub , & !in qrain , & !in isnow ,dzsnso ,snowh ,sneqv ,snice , & !inout snliq ,sh2o ,sice ,stc , & !inout - ponding1 ,ponding2 , & !inout + ponding1 ,ponding2 ,fsh , & !inout qsnbot ) !out ! ---------------------------------------------------------------------- ! renew the mass of ice lens (snice) and liquid (snliq) of the @@ -2859,45 +2927,52 @@ subroutine snowh2o_glacier (nsnow ,nsoil ,dt ,qsnfro ,qsnsub , & !in integer, intent(in) :: nsnow !maximum no. of snow layers[=3] integer, intent(in) :: nsoil !no. of soil layers[=4] - real, intent(in) :: dt !time step - real, intent(in) :: qsnfro !snow surface frost rate[mm/s] - real, intent(in) :: qsnsub !snow surface sublimation rate[mm/s] - real, intent(in) :: qrain !snow surface rain rate[mm/s] + real (kind=kind_phys), intent(in) :: dt !time step + real (kind=kind_phys), intent(inout) :: qsnfro !snow surface frost rate[mm/s] + real (kind=kind_phys), intent(inout) :: qsnsub !snow surface sublimation rate[mm/s] + real (kind=kind_phys), intent(in) :: qrain !snow surface rain rate[mm/s] ! output - real, intent(out) :: qsnbot !melting water out of snow bottom [mm/s] + real (kind=kind_phys), intent(out) :: qsnbot !melting water out of snow bottom [mm/s] ! input and output integer, intent(inout) :: isnow !actual no. of snow layers - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso ! snow layer depth [m] - real, intent(inout) :: snowh !snow height [m] - real, intent(inout) :: sneqv !snow water eqv. [mm] - real, dimension(-nsnow+1:0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1:0), intent(inout) :: snliq !snow layer liquid water [mm] - real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) - real, dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] - real, intent(inout) :: ponding1 - real, intent(inout) :: ponding2 + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso ! snow layer depth [m] + real (kind=kind_phys), intent(inout) :: snowh !snow height [m] + real (kind=kind_phys), intent(inout) :: sneqv !snow water eqv. [mm] + real (kind=kind_phys), dimension(-nsnow+1:0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1:0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real (kind=kind_phys), intent(inout) :: ponding1 + real (kind=kind_phys), intent(inout) :: ponding2 + real (kind=kind_phys), intent(inout) :: fsh !total sensible heat (w/m2) [+ to atm] ! local variables: integer :: j !do loop/array indices - real :: qin !water flow into the element (mm/s) - real :: qout !water flow out of the element (mm/s) - real :: wgdif !ice mass after minus sublimation - real, dimension(-nsnow+1:0) :: vol_liq !partial volume of liquid water in layer - real, dimension(-nsnow+1:0) :: vol_ice !partial volume of ice lens in layer - real, dimension(-nsnow+1:0) :: epore !effective porosity = porosity - vol_ice - real :: propor, temp + real (kind=kind_phys) :: qin !water flow into the element (mm/s) + real (kind=kind_phys) :: qout !water flow out of the element (mm/s) + real (kind=kind_phys) :: wgdif !ice mass after minus sublimation + real (kind=kind_phys), dimension(-nsnow+1:0) :: vol_liq !partial volume of liquid water in layer + real (kind=kind_phys), dimension(-nsnow+1:0) :: vol_ice !partial volume of ice lens in layer + real (kind=kind_phys), dimension(-nsnow+1:0) :: epore !effective porosity = porosity - vol_ice + real (kind=kind_phys) :: propor, temp ! ---------------------------------------------------------------------- !for the case when sneqv becomes '0' after 'combine' if(sneqv == 0.) then - sice(1) = sice(1) + (qsnfro-qsnsub)*dt/(dzsnso(1)*1000.) + if(opt_gla == 1) then + sice(1) = sice(1) + (qsnfro-qsnsub)*dt/(dzsnso(1)*1000.) + elseif(opt_gla == 2) then + fsh = fsh - (qsnfro-qsnsub)*hsub + qsnfro = 0.0 + qsnsub = 0.0 + end if end if ! for shallow snow without a layer @@ -2906,10 +2981,16 @@ subroutine snowh2o_glacier (nsnow ,nsoil ,dt ,qsnfro ,qsnsub , & !in ! to aviod this problem. if(isnow == 0 .and. sneqv > 0.) then - temp = sneqv - sneqv = sneqv - qsnsub*dt + qsnfro*dt - propor = sneqv/temp - snowh = max(0.,propor * snowh) + if(opt_gla == 1) then + temp = sneqv + sneqv = sneqv - qsnsub*dt + qsnfro*dt + propor = sneqv/temp + snowh = max(0.,propor * snowh) + elseif(opt_gla == 2) then + fsh = fsh - (qsnfro-qsnsub)*hsub + qsnfro = 0.0 + qsnsub = 0.0 + end if if(sneqv < 0.) then sice(1) = sice(1) + sneqv/(dzsnso(1)*1000.) @@ -3006,32 +3087,32 @@ subroutine error_glacier (iloc ,jloc ,swdown ,fsa ,fsr ,fira , & ! inputs integer , intent(in) :: iloc !grid index integer , intent(in) :: jloc !grid index - real , intent(in) :: swdown !downward solar filtered by sun angle [w/m2] - real , intent(in) :: fsa !total absorbed solar radiation (w/m2) - real , intent(in) :: fsr !total reflected solar radiation (w/m2) - real , intent(in) :: fira !total net longwave rad (w/m2) [+ to atm] - real , intent(in) :: fsh !total sensible heat (w/m2) [+ to atm] - real , intent(in) :: fgev !ground evaporation heat (w/m2) [+ to atm] - real , intent(in) :: ssoil !ground heat flux (w/m2) [+ to soil] - real , intent(in) :: sag - - real , intent(in) :: prcp !precipitation rate (kg m-2 s-1) - real , intent(in) :: edir !soil surface evaporation rate[mm/s] - real , intent(in) :: runsrf !surface runoff [mm/s] - real , intent(in) :: runsub !baseflow (saturation excess) [mm/s] - real , intent(in) :: sneqv !snow water eqv. [mm] - real , intent(in) :: dt !time step [sec] - real , intent(in) :: beg_wb !water storage at begin of a timesetp [mm] + real (kind=kind_phys) , intent(in) :: swdown !downward solar filtered by sun angle [w/m2] + real (kind=kind_phys) , intent(in) :: fsa !total absorbed solar radiation (w/m2) + real (kind=kind_phys) , intent(in) :: fsr !total reflected solar radiation (w/m2) + real (kind=kind_phys) , intent(in) :: fira !total net longwave rad (w/m2) [+ to atm] + real (kind=kind_phys) , intent(in) :: fsh !total sensible heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(in) :: fgev !ground evaporation heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(in) :: ssoil !ground heat flux (w/m2) [+ to soil] + real (kind=kind_phys) , intent(in) :: sag + + real (kind=kind_phys) , intent(in) :: prcp !precipitation rate (kg m-2 s-1) + real (kind=kind_phys) , intent(in) :: edir !soil surface evaporation rate[mm/s] + real (kind=kind_phys) , intent(in) :: runsrf !surface runoff [mm/s] + real (kind=kind_phys) , intent(in) :: runsub !baseflow (saturation excess) [mm/s] + real (kind=kind_phys) , intent(in) :: sneqv !snow water eqv. [mm] + real (kind=kind_phys) , intent(in) :: dt !time step [sec] + real (kind=kind_phys) , intent(in) :: beg_wb !water storage at begin of a timesetp [mm] #ifdef CCPP character(len=*) , intent(inout) :: errmsg integer , intent(inout) :: errflg #endif - real :: end_wb !water storage at end of a timestep [mm] - real :: errwat !error in water balance [mm/timestep] - real :: erreng !error in surface energy balance [w/m2] - real :: errsw !error in shortwave radiation balance [w/m2] + real (kind=kind_phys) :: end_wb !water storage at end of a timestep [mm] + real (kind=kind_phys) :: errwat !error in water balance [mm/timestep] + real (kind=kind_phys) :: erreng !error in surface energy balance [w/m2] + real (kind=kind_phys) :: errsw !error in shortwave radiation balance [w/m2] character(len=256) :: message ! -------------------------------------------------------------------------------------------------- errsw = swdown - (fsa + fsr) @@ -3077,41 +3158,24 @@ end subroutine error_glacier ! ================================================================================================== !>\ingroup NoahMP_LSM - subroutine noahmp_options_glacier(idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc ,iopt_frz , & - iopt_inf ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc ) + subroutine noahmp_options_glacier(iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc, iopt_gla ) implicit none - integer, intent(in) :: idveg !dynamic vegetation (1 -> off ; 2 -> on) with opt_crs = 1 - integer, intent(in) :: iopt_crs !canopy stomatal resistance (1-> ball-berry; 2->jarvis) - integer, intent(in) :: iopt_btr !soil moisture factor for stomatal resistance (1-> noah; 2-> clm; 3-> ssib) - integer, intent(in) :: iopt_run !runoff and groundwater (1->simgm; 2->simtop; 3->schaake96; 4->bats) - integer, intent(in) :: iopt_sfc !surface layer drag coeff (ch & cm) (1->m-o; 2->chen97) - integer, intent(in) :: iopt_frz !supercooled liquid water (1-> ny06; 2->koren99) - integer, intent(in) :: iopt_inf !frozen soil permeability (1-> ny06; 2->koren99) - integer, intent(in) :: iopt_rad !radiation transfer (1->gap=f(3d,cosz); 2->gap=0; 3->gap=1-fveg) integer, intent(in) :: iopt_alb !snow surface albedo (1->bats; 2->class) integer, intent(in) :: iopt_snf !rainfall & snowfall (1-jordan91; 2->bats; 3->noah) integer, intent(in) :: iopt_tbot !lower boundary of soil temperature (1->zero-flux; 2->noah) - integer, intent(in) :: iopt_stc !snow/soil temperature time scheme (only layer 1) ! 1 -> semi-implicit; 2 -> full implicit (original noah) + integer, intent(in) :: iopt_gla ! glacier option (1->phase change; 2->simple) ! ------------------------------------------------------------------------------------------------- - dveg = idveg - - opt_crs = iopt_crs - opt_btr = iopt_btr - opt_run = iopt_run - opt_sfc = iopt_sfc - opt_frz = iopt_frz - opt_inf = iopt_inf - opt_rad = iopt_rad opt_alb = iopt_alb opt_snf = iopt_snf opt_tbot = iopt_tbot opt_stc = iopt_stc + opt_gla = iopt_gla end subroutine noahmp_options_glacier diff --git a/physics/module_sf_noahmplsm.f90 b/physics/module_sf_noahmplsm.f90 index 567f4a0cf..8cba5871e 100644 --- a/physics/module_sf_noahmplsm.f90 +++ b/physics/module_sf_noahmplsm.f90 @@ -4,9 +4,10 @@ !>\ingroup NoahMP_LSM module module_sf_noahmplsm -#ifndef CCPP +#ifndef CCPP use module_wrf_utl #endif +use machine , only : kind_phys implicit none @@ -78,6 +79,11 @@ module module_sf_noahmplsm ! 3 -> off (use table lai; calculate fveg) ! **4 -> off (use table lai; use maximum vegetation fraction) ! **5 -> on (use maximum vegetation fraction) + ! 6 -> on (use FVEG = SHDFAC from input) + ! 7 -> off (use input LAI; use FVEG = SHDFAC from input) + ! 8 -> off (use input LAI; calculate FVEG) + ! 9 -> off (use input LAI; use maximum vegetation fraction) + ! 10 -> crop model on (use maximum vegetation fraction) integer :: opt_crs ! options for canopy stomatal resistance ! **1 -> ball-berry @@ -133,29 +139,50 @@ module module_sf_noahmplsm ! 2 -> full implicit (original noah); temperature top boundary condition ! 3 -> same as 1, but fsno for ts calculation (generally improves snow; v3.7) + integer :: opt_rsf ! options for surface resistent to evaporation/sublimation + ! **1 -> sakaguchi and zeng, 2009 + ! 2 -> sellers (1992) + ! 3 -> adjusted sellers to decrease rsurf for wet soil + ! 4 -> option 1 for non-snow; rsurf = rsurf_snow for snow (set in mptable); ad v3.8 + + integer :: opt_soil ! options for defining soil properties + ! **1 -> use input dominant soil texture + ! 2 -> use input soil texture that varies with depth + ! 3 -> use soil composition (sand, clay, orgm) and pedotransfer functions (opt_pedo) + ! 4 -> use input soil properties (bexp_3d, smcmax_3d, etc.) + + integer :: opt_pedo ! options for pedotransfer functions (used when opt_soil = 3) + ! **1 -> saxton and rawls (2006) + + integer :: opt_crop ! options for crop model + ! **0 -> no crop model, will run default dynamic vegetation + ! 1 -> liu, et al. 2016 + !------------------------------------------------------------------------------------------! ! physical constants: ! !------------------------------------------------------------------------------------------! - real, parameter :: grav = 9.80616 !acceleration due to gravity (m/s2) - real, parameter :: sb = 5.67e-08 !stefan-boltzmann constant (w/m2/k4) - real, parameter :: vkc = 0.40 !von karman constant - real, parameter :: tfrz = 273.16 !freezing/melting point (k) - real, parameter :: hsub = 2.8440e06 !latent heat of sublimation (j/kg) - real, parameter :: hvap = 2.5104e06 !latent heat of vaporization (j/kg) - real, parameter :: hfus = 0.3336e06 !latent heat of fusion (j/kg) - real, parameter :: cwat = 4.188e06 !specific heat capacity of water (j/m3/k) - real, parameter :: cice = 2.094e06 !specific heat capacity of ice (j/m3/k) - real, parameter :: cpair = 1004.64 !heat capacity dry air at const pres (j/kg/k) - real, parameter :: tkwat = 0.6 !thermal conductivity of water (w/m/k) - real, parameter :: tkice = 2.2 !thermal conductivity of ice (w/m/k) - real, parameter :: tkair = 0.023 !thermal conductivity of air (w/m/k) (not used mb: 20140718) - real, parameter :: rair = 287.04 !gas constant for dry air (j/kg/k) - real, parameter :: rw = 461.269 !gas constant for water vapor (j/kg/k) - real, parameter :: denh2o = 1000. !density of water (kg/m3) - real, parameter :: denice = 917. !density of ice (kg/m3) + real (kind=kind_phys), parameter :: grav = 9.80616 !acceleration due to gravity (m/s2) + real (kind=kind_phys), parameter :: sb = 5.67e-08 !stefan-boltzmann constant (w/m2/k4) + real (kind=kind_phys), parameter :: vkc = 0.40 !von karman constant + real (kind=kind_phys), parameter :: tfrz = 273.16 !freezing/melting point (k) + real (kind=kind_phys), parameter :: hsub = 2.8440e06 !latent heat of sublimation (j/kg) + real (kind=kind_phys), parameter :: hvap = 2.5104e06 !latent heat of vaporization (j/kg) + real (kind=kind_phys), parameter :: hfus = 0.3336e06 !latent heat of fusion (j/kg) + real (kind=kind_phys), parameter :: cwat = 4.188e06 !specific heat capacity of water (j/m3/k) + real (kind=kind_phys), parameter :: cice = 2.094e06 !specific heat capacity of ice (j/m3/k) + real (kind=kind_phys), parameter :: cpair = 1004.64 !heat capacity dry air at const pres (j/kg/k) + real (kind=kind_phys), parameter :: tkwat = 0.6 !thermal conductivity of water (w/m/k) + real (kind=kind_phys), parameter :: tkice = 2.2 !thermal conductivity of ice (w/m/k) + real (kind=kind_phys), parameter :: tkair = 0.023 !thermal conductivity of air (w/m/k) (not used mb: 20140718) + real (kind=kind_phys), parameter :: rair = 287.04 !gas constant for dry air (j/kg/k) + real (kind=kind_phys), parameter :: rw = 461.269 !gas constant for water vapor (j/kg/k) + real (kind=kind_phys), parameter :: denh2o = 1000. !density of water (kg/m3) + real (kind=kind_phys), parameter :: denice = 917. !density of ice (kg/m3) integer, private, parameter :: mband = 2 + integer, private, parameter :: nsoil = 4 + integer, private, parameter :: nstage = 8 type noahmp_parameters ! define a noahmp parameters type @@ -167,114 +194,176 @@ module module_sf_noahmplsm integer :: iswater integer :: isbarren integer :: isice + integer :: iscrop integer :: eblforest - real :: ch2op !maximum intercepted h2o per unit lai+sai (mm) - real :: dleaf !characteristic leaf dimension (m) - real :: z0mvt !momentum roughness length (m) - real :: hvt !top of canopy (m) - real :: hvb !bottom of canopy (m) - real :: den !tree density (no. of trunks per m2) - real :: rc !tree crown radius (m) - real :: mfsno !snowmelt m parameter () - real :: saim(12) !monthly stem area index, one-sided - real :: laim(12) !monthly leaf area index, one-sided - real :: sla !single-side leaf area per kg [m2/kg] - real :: dilefc !coeficient for leaf stress death [1/s] - real :: dilefw !coeficient for leaf stress death [1/s] - real :: fragr !fraction of growth respiration !original was 0.3 - real :: ltovrc !leaf turnover [1/s] - - real :: c3psn !photosynthetic pathway: 0. = c4, 1. = c3 - real :: kc25 !co2 michaelis-menten constant at 25c (pa) - real :: akc !q10 for kc25 - real :: ko25 !o2 michaelis-menten constant at 25c (pa) - real :: ako !q10 for ko25 - real :: vcmx25 !maximum rate of carboxylation at 25c (umol co2/m**2/s) - real :: avcmx !q10 for vcmx25 - real :: bp !minimum leaf conductance (umol/m**2/s) - real :: mp !slope of conductance-to-photosynthesis relationship - real :: qe25 !quantum efficiency at 25c (umol co2 / umol photon) - real :: aqe !q10 for qe25 - real :: rmf25 !leaf maintenance respiration at 25c (umol co2/m**2/s) - real :: rms25 !stem maintenance respiration at 25c (umol co2/kg bio/s) - real :: rmr25 !root maintenance respiration at 25c (umol co2/kg bio/s) - real :: arm !q10 for maintenance respiration - real :: folnmx !foliage nitrogen concentration when f(n)=1 (%) - real :: tmin !minimum temperature for photosynthesis (k) + real (kind=kind_phys) :: ch2op !maximum intercepted h2o per unit lai+sai (mm) + real (kind=kind_phys) :: dleaf !characteristic leaf dimension (m) + real (kind=kind_phys) :: z0mvt !momentum roughness length (m) + real (kind=kind_phys) :: hvt !top of canopy (m) + real (kind=kind_phys) :: hvb !bottom of canopy (m) + real (kind=kind_phys) :: den !tree density (no. of trunks per m2) + real (kind=kind_phys) :: rc !tree crown radius (m) + real (kind=kind_phys) :: mfsno !snowmelt m parameter () + real (kind=kind_phys) :: scffac !snow cover factor (m) + real (kind=kind_phys) :: saim(12) !monthly stem area index, one-sided + real (kind=kind_phys) :: laim(12) !monthly leaf area index, one-sided + real (kind=kind_phys) :: sla !single-side leaf area per kg [m2/kg] + real (kind=kind_phys) :: dilefc !coeficient for leaf stress death [1/s] + real (kind=kind_phys) :: dilefw !coeficient for leaf stress death [1/s] + real (kind=kind_phys) :: fragr !fraction of growth respiration !original was 0.3 + real (kind=kind_phys) :: ltovrc !leaf turnover [1/s] + + real (kind=kind_phys) :: c3psn !photosynthetic pathway: 0. = c4, 1. = c3 + real (kind=kind_phys) :: kc25 !co2 michaelis-menten constant at 25c (pa) + real (kind=kind_phys) :: akc !q10 for kc25 + real (kind=kind_phys) :: ko25 !o2 michaelis-menten constant at 25c (pa) + real (kind=kind_phys) :: ako !q10 for ko25 + real (kind=kind_phys) :: vcmx25 !maximum rate of carboxylation at 25c (umol co2/m**2/s) + real (kind=kind_phys) :: avcmx !q10 for vcmx25 + real (kind=kind_phys) :: bp !minimum leaf conductance (umol/m**2/s) + real (kind=kind_phys) :: mp !slope of conductance-to-photosynthesis relationship + real (kind=kind_phys) :: qe25 !quantum efficiency at 25c (umol co2 / umol photon) + real (kind=kind_phys) :: aqe !q10 for qe25 + real (kind=kind_phys) :: rmf25 !leaf maintenance respiration at 25c (umol co2/m**2/s) + real (kind=kind_phys) :: rms25 !stem maintenance respiration at 25c (umol co2/kg bio/s) + real (kind=kind_phys) :: rmr25 !root maintenance respiration at 25c (umol co2/kg bio/s) + real (kind=kind_phys) :: arm !q10 for maintenance respiration + real (kind=kind_phys) :: folnmx !foliage nitrogen concentration when f(n)=1 (%) + real (kind=kind_phys) :: tmin !minimum temperature for photosynthesis (k) - real :: xl !leaf/stem orientation index - real :: rhol(mband) !leaf reflectance: 1=vis, 2=nir - real :: rhos(mband) !stem reflectance: 1=vis, 2=nir - real :: taul(mband) !leaf transmittance: 1=vis, 2=nir - real :: taus(mband) !stem transmittance: 1=vis, 2=nir + real (kind=kind_phys) :: xl !leaf/stem orientation index + real (kind=kind_phys) :: rhol(mband) !leaf reflectance: 1=vis, 2=nir + real (kind=kind_phys) :: rhos(mband) !stem reflectance: 1=vis, 2=nir + real (kind=kind_phys) :: taul(mband) !leaf transmittance: 1=vis, 2=nir + real (kind=kind_phys) :: taus(mband) !stem transmittance: 1=vis, 2=nir - real :: mrp !microbial respiration parameter (umol co2 /kg c/ s) - real :: cwpvt !empirical canopy wind parameter + real (kind=kind_phys) :: mrp !microbial respiration parameter (umol co2 /kg c/ s) + real (kind=kind_phys) :: cwpvt !empirical canopy wind parameter - real :: wrrat !wood to non-wood ratio - real :: wdpool !wood pool (switch 1 or 0) depending on woody or not [-] - real :: tdlef !characteristic t for leaf freezing [k] + real (kind=kind_phys) :: wrrat !wood to non-wood ratio + real (kind=kind_phys) :: wdpool !wood pool (switch 1 or 0) depending on woody or not [-] + real (kind=kind_phys) :: tdlef !characteristic t for leaf freezing [k] integer :: nroot !number of soil layers with root present - real :: rgl !parameter used in radiation stress function - real :: rsmin !minimum stomatal resistance [s m-1] - real :: hs !parameter used in vapor pressure deficit function - real :: topt !optimum transpiration air temperature [k] - real :: rsmax !maximal stomatal resistance [s m-1] + real (kind=kind_phys) :: rgl !parameter used in radiation stress function + real (kind=kind_phys) :: rsmin !minimum stomatal resistance [s m-1] + real (kind=kind_phys) :: hs !parameter used in vapor pressure deficit function + real (kind=kind_phys) :: topt !optimum transpiration air temperature [k] + real (kind=kind_phys) :: rsmax !maximal stomatal resistance [s m-1] - real :: slarea - real :: eps(5) + real (kind=kind_phys) :: slarea + real (kind=kind_phys) :: eps(5) !------------------------------------------------------------------------------------------! ! from the rad section of mptable.tbl !------------------------------------------------------------------------------------------! - real :: albsat(mband) !saturated soil albedos: 1=vis, 2=nir - real :: albdry(mband) !dry soil albedos: 1=vis, 2=nir - real :: albice(mband) !albedo land ice: 1=vis, 2=nir - real :: alblak(mband) !albedo frozen lakes: 1=vis, 2=nir - real :: omegas(mband) !two-stream parameter omega for snow - real :: betads !two-stream parameter betad for snow - real :: betais !two-stream parameter betad for snow - real :: eg(2) !emissivity + real (kind=kind_phys) :: albsat(mband) !saturated soil albedos: 1=vis, 2=nir + real (kind=kind_phys) :: albdry(mband) !dry soil albedos: 1=vis, 2=nir + real (kind=kind_phys) :: albice(mband) !albedo land ice: 1=vis, 2=nir + real (kind=kind_phys) :: alblak(mband) !albedo frozen lakes: 1=vis, 2=nir + real (kind=kind_phys) :: omegas(mband) !two-stream parameter omega for snow + real (kind=kind_phys) :: betads !two-stream parameter betad for snow + real (kind=kind_phys) :: betais !two-stream parameter betad for snow + real (kind=kind_phys) :: eg(2) !emissivity !------------------------------------------------------------------------------------------! ! from the globals section of mptable.tbl !------------------------------------------------------------------------------------------! - real :: co2 !co2 partial pressure - real :: o2 !o2 partial pressure - real :: timean !gridcell mean topgraphic index (global mean) - real :: fsatmx !maximum surface saturated fraction (global mean) - real :: z0sno !snow surface roughness length (m) (0.002) - real :: ssi !liquid water holding capacity for snowpack (m3/m3) - real :: swemx !new snow mass to fully cover old snow (mm) + real (kind=kind_phys) :: co2 !co2 partial pressure + real (kind=kind_phys) :: o2 !o2 partial pressure + real (kind=kind_phys) :: timean !gridcell mean topgraphic index (global mean) + real (kind=kind_phys) :: fsatmx !maximum surface saturated fraction (global mean) + real (kind=kind_phys) :: z0sno !snow surface roughness length (m) (0.002) + real (kind=kind_phys) :: ssi !liquid water holding capacity for snowpack (m3/m3) + real (kind=kind_phys) :: snow_ret_fac !snowpack water release timescale factor (1/s) + real (kind=kind_phys) :: swemx !new snow mass to fully cover old snow (mm) + real (kind=kind_phys) :: snow_emis !snow emissivity + real (kind=kind_phys) :: tau0 !tau0 from yang97 eqn. 10a + real (kind=kind_phys) :: grain_growth !growth from vapor diffusion yang97 eqn. 10b + real (kind=kind_phys) :: extra_growth !extra growth near freezing yang97 eqn. 10c + real (kind=kind_phys) :: dirt_soot !dirt and soot term yang97 eqn. 10d + real (kind=kind_phys) :: bats_cosz !zenith angle snow albedo adjustment; b in yang97 eqn. 15 + real (kind=kind_phys) :: bats_vis_new !new snow visible albedo + real (kind=kind_phys) :: bats_nir_new !new snow nir albedo + real (kind=kind_phys) :: bats_vis_age !age factor for diffuse visible snow albedo yang97 eqn. 17 + real (kind=kind_phys) :: bats_nir_age !age factor for diffuse nir snow albedo yang97 eqn. 18 + real (kind=kind_phys) :: bats_vis_dir !cosz factor for direct visible snow albedo yang97 eqn. 15 + real (kind=kind_phys) :: bats_nir_dir !cosz factor for direct nir snow albedo yang97 eqn. 16 + real (kind=kind_phys) :: rsurf_snow !surface resistance for snow(s/m) + real (kind=kind_phys) :: rsurf_exp !exponent in the shape parameter for soil resistance option 1 + +!------------------------------------------------------------------------------------------! +! from the crop section of mptable.tbl +!------------------------------------------------------------------------------------------! + + integer :: pltday ! planting date + integer :: hsday ! harvest date + real (kind=kind_phys) :: plantpop ! plant density [per ha] - used? + real (kind=kind_phys) :: irri ! irrigation strategy 0= non-irrigation 1=irrigation (no water-stress) + real (kind=kind_phys) :: gddtbase ! base temperature for gdd accumulation [c] + real (kind=kind_phys) :: gddtcut ! upper temperature for gdd accumulation [c] + real (kind=kind_phys) :: gdds1 ! gdd from seeding to emergence + real (kind=kind_phys) :: gdds2 ! gdd from seeding to initial vegetative + real (kind=kind_phys) :: gdds3 ! gdd from seeding to post vegetative + real (kind=kind_phys) :: gdds4 ! gdd from seeding to intial reproductive + real (kind=kind_phys) :: gdds5 ! gdd from seeding to pysical maturity + integer :: c3c4 ! photosynthetic pathway: 1 = c3 2 = c4 + real (kind=kind_phys) :: aref ! reference maximum co2 assimulation rate + real (kind=kind_phys) :: psnrf ! co2 assimulation reduction factor(0-1) (caused by non-modeling part,e.g.pest,weeds) + real (kind=kind_phys) :: i2par ! fraction of incoming solar radiation to photosynthetically active radiation + real (kind=kind_phys) :: tassim0 ! minimum temperature for co2 assimulation [c] + real (kind=kind_phys) :: tassim1 ! co2 assimulation linearly increasing until temperature reaches t1 [c] + real (kind=kind_phys) :: tassim2 ! co2 assmilation rate remain at aref until temperature reaches t2 [c] + real (kind=kind_phys) :: k ! light extinction coefficient + real (kind=kind_phys) :: epsi ! initial light use efficiency + real (kind=kind_phys) :: q10mr ! q10 for maintainance respiration + real (kind=kind_phys) :: foln_mx ! foliage nitrogen concentration when f(n)=1 (%) + real (kind=kind_phys) :: lefreez ! characteristic t for leaf freezing [k] + real (kind=kind_phys) :: dile_fc(nstage) ! coeficient for temperature leaf stress death [1/s] + real (kind=kind_phys) :: dile_fw(nstage) ! coeficient for water leaf stress death [1/s] + real (kind=kind_phys) :: fra_gr ! fraction of growth respiration + real (kind=kind_phys) :: lf_ovrc(nstage) ! fraction of leaf turnover [1/s] + real (kind=kind_phys) :: st_ovrc(nstage) ! fraction of stem turnover [1/s] + real (kind=kind_phys) :: rt_ovrc(nstage) ! fraction of root tunrover [1/s] + real (kind=kind_phys) :: lfmr25 ! leaf maintenance respiration at 25c [umol co2/m**2 /s] + real (kind=kind_phys) :: stmr25 ! stem maintenance respiration at 25c [umol co2/kg bio/s] + real (kind=kind_phys) :: rtmr25 ! root maintenance respiration at 25c [umol co2/kg bio/s] + real (kind=kind_phys) :: grainmr25 ! grain maintenance respiration at 25c [umol co2/kg bio/s] + real (kind=kind_phys) :: lfpt(nstage) ! fraction of carbohydrate flux to leaf + real (kind=kind_phys) :: stpt(nstage) ! fraction of carbohydrate flux to stem + real (kind=kind_phys) :: rtpt(nstage) ! fraction of carbohydrate flux to root + real (kind=kind_phys) :: grainpt(nstage) ! fraction of carbohydrate flux to grain + real (kind=kind_phys) :: bio2lai ! leaf are per living leaf biomass [m^2/kg] !------------------------------------------------------------------------------------------! ! from the soilparm.tbl tables, as functions of soil category. !------------------------------------------------------------------------------------------! - real :: bexp !b parameter - real :: smcdry !dry soil moisture threshold where direct evap from top + real (kind=kind_phys) :: bexp(nsoil) !b parameter + real (kind=kind_phys) :: smcdry(nsoil) !dry soil moisture threshold where direct evap from top !layer ends (volumetric) (not used mb: 20140718) - real :: smcwlt !wilting point soil moisture (volumetric) - real :: smcref !reference soil moisture (field capacity) (volumetric) - real :: smcmax !porosity, saturated value of soil moisture (volumetric) - real :: f1 !soil thermal diffusivity/conductivity coef (not used mb: 20140718) - real :: psisat !saturated soil matric potential - real :: dksat !saturated soil hydraulic conductivity - real :: dwsat !saturated soil hydraulic diffusivity - real :: quartz !soil quartz content + real (kind=kind_phys) :: smcwlt(nsoil) !wilting point soil moisture (volumetric) + real (kind=kind_phys) :: smcref(nsoil) !reference soil moisture (field capacity) (volumetric) + real (kind=kind_phys) :: smcmax (nsoil) !porosity, saturated value of soil moisture (volumetric) + real (kind=kind_phys) :: psisat(nsoil) !saturated soil matric potential + real (kind=kind_phys) :: dksat(nsoil) !saturated soil hydraulic conductivity + real (kind=kind_phys) :: dwsat(nsoil) !saturated soil hydraulic diffusivity + real (kind=kind_phys) :: quartz(nsoil) !soil quartz content + real (kind=kind_phys) :: f1 !soil thermal diffusivity/conductivity coef (not used mb: 20140718) !------------------------------------------------------------------------------------------! ! from the genparm.tbl file !------------------------------------------------------------------------------------------! - real :: slope !slope index (0 - 1) - real :: csoil !vol. soil heat capacity [j/m3/k] - real :: zbot !depth (m) of lower boundary soil temperature - real :: czil !calculate roughness length of heat + real (kind=kind_phys) :: slope !slope index (0 - 1) + real (kind=kind_phys) :: csoil !vol. soil heat capacity [j/m3/k] + real (kind=kind_phys) :: zbot !depth (m) of lower boundary soil temperature + real (kind=kind_phys) :: czil !calculate roughness length of heat + real (kind=kind_phys) :: refdk + real (kind=kind_phys) :: refkdt - real :: kdt !used in compute maximum infiltration rate (in infil) - real :: frzx !used in compute maximum infiltration rate (in infil) + real (kind=kind_phys) :: kdt !used in compute maximum infiltration rate (in infil) + real (kind=kind_phys) :: frzx !used in compute maximum infiltration rate (in infil) end type noahmp_parameters @@ -286,7 +375,7 @@ module module_sf_noahmplsm subroutine noahmp_sflx (parameters, & iloc , jloc , lat , yearlen , julian , cosz , & ! in : time/space-related dt , dx , dz8w , nsoil , zsoil , nsnow , & ! in : model configuration - shdfac , shdmax , vegtyp , ice , ist , & ! in : vegetation/soil characteristics + shdfac , shdmax , vegtyp , ice , ist , croptype, & ! in : vegetation/soil characteristics smceq , & ! in : vegetation/soil characteristics sfctmp , sfcprs , psfc , uu , vv , q2 , & ! in : forcing qc , soldn , lwdn , & ! in : forcing @@ -294,12 +383,13 @@ subroutine noahmp_sflx (parameters, & tbot , co2air , o2air , foln , ficeold , zlvl , & ! in : forcing albold , sneqvo , & ! in/out : stc , sh2o , smc , tah , eah , fwet , & ! in/out : - canliq , canice , tv , tg , qsfc , qsnow , & ! in/out : + canliq , canice , tv , tg , qsfc, qsnow, qrain, & ! in/out : isnow , zsnso , snowh , sneqv , snice , snliq , & ! in/out : zwt , wa , wt , wslake , lfmass , rtmass , & ! in/out : stmass , wood , stblcp , fastcp , lai , sai , & ! in/out : cm , ch , tauss , & ! in/out : - smcwtd ,deeprech , rech , & ! in/out : + grain , gdd , pgs , & ! in/out + smcwtd ,deeprech , rech , & ! in/out : z0wrf , & fsa , fsr , fira , fsh , ssoil , fcev , & ! out : fgev , fctr , ecan , etran , edir , trad , & ! out : @@ -307,19 +397,22 @@ subroutine noahmp_sflx (parameters, & runsrf , runsub , apar , psn , sav , sag , & ! out : fsno , nee , gpp , npp , fveg , albedo , & ! out : qsnbot , ponding , ponding1, ponding2, rssun , rssha , & ! out : + albd , albi , albsnd , albsni , & ! out : bgap , wgap , chv , chb , emissi , & ! out : shg , shc , shb , evg , evb , ghv , & ! out : ghb , irg , irc , irb , tr , evc , & ! out : chleaf , chuc , chv2 , chb2 , fpice , pahv , & + pahg , pahb , pah , esnow , laisun , laisha , rb & #ifdef CCPP - pahg , pahb , pah , esnow, errmsg, errflg) + ,errmsg, errflg) #else - pahg , pahb , pah , esnow) + ) #endif ! -------------------------------------------------------------------------------------------------- ! initial code: guo-yue niu, oct. 2007 ! -------------------------------------------------------------------------------------------------- + implicit none ! -------------------------------------------------------------------------------------------------- ! input @@ -328,121 +421,130 @@ subroutine noahmp_sflx (parameters, & integer , intent(in) :: ice !ice (ice = 1) integer , intent(in) :: ist !surface type 1->soil; 2->lake integer , intent(in) :: vegtyp !vegetation type + INTEGER , INTENT(IN) :: CROPTYPE !crop type integer , intent(in) :: nsnow !maximum no. of snow layers integer , intent(in) :: nsoil !no. of soil layers integer , intent(in) :: iloc !grid index integer , intent(in) :: jloc !grid index - real , intent(in) :: dt !time step [sec] - real, dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf (m) - real , intent(in) :: q2 !mixing ratio (kg/kg) lowest model layer - real , intent(in) :: sfctmp !surface air temperature [k] - real , intent(in) :: uu !wind speed in eastward dir (m/s) - real , intent(in) :: vv !wind speed in northward dir (m/s) - real , intent(in) :: soldn !downward shortwave radiation (w/m2) - real , intent(in) :: lwdn !downward longwave radiation (w/m2) - real , intent(in) :: sfcprs !pressure (pa) - real , intent(inout) :: zlvl !reference height (m) - real , intent(in) :: cosz !cosine solar zenith angle [0-1] - real , intent(in) :: tbot !bottom condition for soil temp. [k] - real , intent(in) :: foln !foliage nitrogen (%) [1-saturated] - real , intent(in) :: shdfac !green vegetation fraction [0.0-1.0] + real (kind=kind_phys) , intent(in) :: dt !time step [sec] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf (m) + real (kind=kind_phys) , intent(in) :: q2 !mixing ratio (kg/kg) lowest model layer + real (kind=kind_phys) , intent(in) :: sfctmp !surface air temperature [k] + real (kind=kind_phys) , intent(in) :: uu !wind speed in eastward dir (m/s) + real (kind=kind_phys) , intent(in) :: vv !wind speed in northward dir (m/s) + real (kind=kind_phys) , intent(in) :: soldn !downward shortwave radiation (w/m2) + real (kind=kind_phys) , intent(in) :: lwdn !downward longwave radiation (w/m2) + real (kind=kind_phys) , intent(in) :: sfcprs !pressure (pa) + real (kind=kind_phys) , intent(inout) :: zlvl !reference height (m) + real (kind=kind_phys) , intent(in) :: cosz !cosine solar zenith angle [0-1] + real (kind=kind_phys) , intent(in) :: tbot !bottom condition for soil temp. [k] + real (kind=kind_phys) , intent(in) :: foln !foliage nitrogen (%) [1-saturated] + real (kind=kind_phys) , intent(in) :: shdfac !green vegetation fraction [0.0-1.0] integer , intent(in) :: yearlen!number of days in the particular year. - real , intent(in) :: julian !julian day of year (floating point) - real , intent(in) :: lat !latitude (radians) - real, dimension(-nsnow+1: 0), intent(in) :: ficeold!ice fraction at last timestep - real, dimension( 1:nsoil), intent(in) :: smceq !equilibrium soil water content [m3/m3] - real , intent(in) :: prcpconv ! convective precipitation entering [mm/s] ! mb/an : v3.7 - real , intent(in) :: prcpnonc ! non-convective precipitation entering [mm/s] ! mb/an : v3.7 - real , intent(in) :: prcpshcv ! shallow convective precip entering [mm/s] ! mb/an : v3.7 - real , intent(in) :: prcpsnow ! snow entering land model [mm/s] ! mb/an : v3.7 - real , intent(in) :: prcpgrpl ! graupel entering land model [mm/s] ! mb/an : v3.7 - real , intent(in) :: prcphail ! hail entering land model [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: julian !julian day of year (floating point) + real (kind=kind_phys) , intent(in) :: lat !latitude (radians) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: ficeold!ice fraction at last timestep + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: smceq !equilibrium soil water content [m3/m3] + real (kind=kind_phys) , intent(in) :: prcpconv ! convective precipitation entering [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: prcpnonc ! non-convective precipitation entering [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: prcpshcv ! shallow convective precip entering [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: prcpsnow ! snow entering land model [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: prcpgrpl ! graupel entering land model [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: prcphail ! hail entering land model [mm/s] ! mb/an : v3.7 !jref:start; in - real , intent(in) :: qc !cloud water mixing ratio - real , intent(inout) :: qsfc !mixing ratio at lowest model layer - real , intent(in) :: psfc !pressure at lowest model layer - real , intent(in) :: dz8w !thickness of lowest layer - real , intent(in) :: dx - real , intent(in) :: shdmax !yearly max vegetation fraction + real (kind=kind_phys) , intent(in) :: qc !cloud water mixing ratio + real (kind=kind_phys) , intent(inout) :: qsfc !mixing ratio at lowest model layer + real (kind=kind_phys) , intent(in) :: psfc !pressure at lowest model layer + real (kind=kind_phys) , intent(in) :: dz8w !thickness of lowest layer + real (kind=kind_phys) , intent(in) :: dx + real (kind=kind_phys) , intent(in) :: shdmax !yearly max vegetation fraction !jref:end ! input/output : need arbitary intial values - real , intent(inout) :: qsnow !snowfall [mm/s] - real , intent(inout) :: fwet !wetted or snowed fraction of canopy (-) - real , intent(inout) :: sneqvo !snow mass at last time step (mm) - real , intent(inout) :: eah !canopy air vapor pressure (pa) - real , intent(inout) :: tah !canopy air tmeperature (k) - real , intent(inout) :: albold !snow albedo at last time step (class type) - real , intent(inout) :: cm !momentum drag coefficient - real , intent(inout) :: ch !sensible heat exchange coefficient - real , intent(inout) :: tauss !non-dimensional snow age + real (kind=kind_phys) , intent(inout) :: qsnow !snowfall [mm/s] + REAL (kind=kind_phys) , INTENT(INOUT) :: QRAIN !rainfall [mm/s] + real (kind=kind_phys) , intent(inout) :: fwet !wetted or snowed fraction of canopy (-) + real (kind=kind_phys) , intent(inout) :: sneqvo !snow mass at last time step (mm) + real (kind=kind_phys) , intent(inout) :: eah !canopy air vapor pressure (pa) + real (kind=kind_phys) , intent(inout) :: tah !canopy air tmeperature (k) + real (kind=kind_phys) , intent(inout) :: albold !snow albedo at last time step (class type) + real (kind=kind_phys) , intent(inout) :: cm !momentum drag coefficient + real (kind=kind_phys) , intent(inout) :: ch !sensible heat exchange coefficient + real (kind=kind_phys) , intent(inout) :: tauss !non-dimensional snow age ! prognostic variables integer , intent(inout) :: isnow !actual no. of snow layers [-] - real , intent(inout) :: canliq !intercepted liquid water (mm) - real , intent(inout) :: canice !intercepted ice mass (mm) - real , intent(inout) :: sneqv !snow water eqv. [mm] - real, dimension( 1:nsoil), intent(inout) :: smc !soil moisture (ice + liq.) [m3/m3] - real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !layer-bottom depth from snow surf [m] - real , intent(inout) :: snowh !snow height [m] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] - real , intent(inout) :: tv !vegetation temperature (k) - real , intent(inout) :: tg !ground temperature (k) - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] - real, dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil moisture [m3/m3] - real , intent(inout) :: zwt !depth to water table [m] - real , intent(inout) :: wa !water storage in aquifer [mm] - real , intent(inout) :: wt !water in aquifer&saturated soil [mm] - real , intent(inout) :: wslake !lake water storage (can be neg.) (mm) - real, intent(inout) :: smcwtd !soil water content between bottom of the soil and water table [m3/m3] - real, intent(inout) :: deeprech !recharge to or from the water table when deep [m] - real, intent(inout) :: rech !recharge to or from the water table when shallow [m] (diagnostic) + real (kind=kind_phys) , intent(inout) :: canliq !intercepted liquid water (mm) + real (kind=kind_phys) , intent(inout) :: canice !intercepted ice mass (mm) + real (kind=kind_phys) , intent(inout) :: sneqv !snow water eqv. [mm] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: smc !soil moisture (ice + liq.) [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !layer-bottom depth from snow surf [m] + real (kind=kind_phys) , intent(inout) :: snowh !snow height [m] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys) , intent(inout) :: tv !vegetation temperature (k) + real (kind=kind_phys) , intent(inout) :: tg !ground temperature (k) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil moisture [m3/m3] + real (kind=kind_phys) , intent(inout) :: zwt !depth to water table [m] + real (kind=kind_phys) , intent(inout) :: wa !water storage in aquifer [mm] + real (kind=kind_phys) , intent(inout) :: wt !water in aquifer&saturated soil [mm] + real (kind=kind_phys) , intent(inout) :: wslake !lake water storage (can be neg.) (mm) + real (kind=kind_phys), intent(inout) :: smcwtd !soil water content between bottom of the soil and water table [m3/m3] + real (kind=kind_phys), intent(inout) :: deeprech !recharge to or from the water table when deep [m] + real (kind=kind_phys), intent(inout) :: rech !recharge to or from the water table when shallow [m] (diagnostic) ! output - real , intent(out) :: z0wrf !combined z0 sent to coupled model - real , intent(out) :: fsa !total absorbed solar radiation (w/m2) - real , intent(out) :: fsr !total reflected solar radiation (w/m2) - real , intent(out) :: fira !total net lw rad (w/m2) [+ to atm] - real , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] - real , intent(out) :: fcev !canopy evap heat (w/m2) [+ to atm] - real , intent(out) :: fgev !ground evap heat (w/m2) [+ to atm] - real , intent(out) :: fctr !transpiration heat (w/m2) [+ to atm] - real , intent(out) :: ssoil !ground heat flux (w/m2) [+ to soil] - real , intent(out) :: trad !surface radiative temperature (k) - real :: ts !surface temperature (k) - real , intent(out) :: ecan !evaporation of intercepted water (mm/s) - real , intent(out) :: etran !transpiration rate (mm/s) - real , intent(out) :: edir !soil surface evaporation rate (mm/s] - real , intent(out) :: runsrf !surface runoff [mm/s] - real , intent(out) :: runsub !baseflow (saturation excess) [mm/s] - real , intent(out) :: psn !total photosynthesis (umol co2/m2/s) [+] - real , intent(out) :: apar !photosyn active energy by canopy (w/m2) - real , intent(out) :: sav !solar rad absorbed by veg. (w/m2) - real , intent(out) :: sag !solar rad absorbed by ground (w/m2) - real , intent(out) :: fsno !snow cover fraction on the ground (-) - real , intent(out) :: fveg !green vegetation fraction [0.0-1.0] - real , intent(out) :: albedo !surface albedo [-] - real :: errwat !water error [kg m{-2}] - real , intent(out) :: qsnbot !snowmelt out bottom of pack [mm/s] - real , intent(out) :: ponding!surface ponding [mm] - real , intent(out) :: ponding1!surface ponding [mm] - real , intent(out) :: ponding2!surface ponding [mm] - real , intent(out) :: esnow + real (kind=kind_phys) , intent(out) :: z0wrf !combined z0 sent to coupled model + real (kind=kind_phys) , intent(out) :: fsa !total absorbed solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: fsr !total reflected solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: fira !total net lw rad (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fcev !canopy evap heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fgev !ground evap heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fctr !transpiration heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: ssoil !ground heat flux (w/m2) [+ to soil] + real (kind=kind_phys) , intent(out) :: trad !surface radiative temperature (k) + real (kind=kind_phys) :: ts !surface temperature (k) + real (kind=kind_phys) , intent(out) :: ecan !evaporation of intercepted water (mm/s) + real (kind=kind_phys) , intent(out) :: etran !transpiration rate (mm/s) + real (kind=kind_phys) , intent(out) :: edir !soil surface evaporation rate (mm/s] + real (kind=kind_phys) , intent(out) :: runsrf !surface runoff [mm/s] + real (kind=kind_phys) , intent(out) :: runsub !baseflow (saturation excess) [mm/s] + real (kind=kind_phys) , intent(out) :: psn !total photosynthesis (umol co2/m2/s) [+] + real (kind=kind_phys) , intent(out) :: apar !photosyn active energy by canopy (w/m2) + real (kind=kind_phys) , intent(out) :: sav !solar rad absorbed by veg. (w/m2) + real (kind=kind_phys) , intent(out) :: sag !solar rad absorbed by ground (w/m2) + real (kind=kind_phys) , intent(out) :: fsno !snow cover fraction on the ground (-) + real (kind=kind_phys) , intent(out) :: fveg !green vegetation fraction [0.0-1.0] + real (kind=kind_phys) , intent(out) :: albedo !surface albedo [-] + real (kind=kind_phys) :: errwat !water error [kg m{-2}] + real (kind=kind_phys) , intent(out) :: qsnbot !snowmelt out bottom of pack [mm/s] + real (kind=kind_phys) , intent(out) :: ponding!surface ponding [mm] + real (kind=kind_phys) , intent(out) :: ponding1!surface ponding [mm] + real (kind=kind_phys) , intent(out) :: ponding2!surface ponding [mm] + real (kind=kind_phys) , intent(out) :: esnow + real (kind=kind_phys) , intent(out) :: rb ! leaf boundary layer resistance (s/m) + real (kind=kind_phys) , intent(out) :: laisun ! sunlit leaf area index (m2/m2) + real (kind=kind_phys) , intent(out) :: laisha ! shaded leaf area index (m2/m2) !jref:start; output - real , intent(out) :: t2mv !2-m air temperature over vegetated part [k] - real , intent(out) :: t2mb !2-m air temperature over bare ground part [k] - real, intent(out) :: rssun !sunlit leaf stomatal resistance (s/m) - real, intent(out) :: rssha !shaded leaf stomatal resistance (s/m) - real, intent(out) :: bgap - real, intent(out) :: wgap - real, intent(out) :: tgv - real, intent(out) :: tgb - real :: q1 - real, intent(out) :: emissi + real (kind=kind_phys) , intent(out) :: t2mv !2-m air temperature over vegetated part [k] + real (kind=kind_phys) , intent(out) :: t2mb !2-m air temperature over bare ground part [k] + real (kind=kind_phys), intent(out) :: rssun !sunlit leaf stomatal resistance (s/m) + real (kind=kind_phys), intent(out) :: rssha !shaded leaf stomatal resistance (s/m) + real (kind=kind_phys), intent(out) :: bgap + real (kind=kind_phys), intent(out) :: wgap + real (kind=kind_phys), dimension(1:2) , intent(out) :: albd ! albedo (direct) + real (kind=kind_phys), dimension(1:2) , intent(out) :: albi ! albedo (diffuse) + real (kind=kind_phys), dimension(1:2) , intent(out) :: albsnd !snow albedo (direct) + real (kind=kind_phys), dimension(1:2) , intent(out) :: albsni !snow albedo (diffuse) + real (kind=kind_phys), intent(out) :: tgv + real (kind=kind_phys), intent(out) :: tgb + real (kind=kind_phys) :: q1 + real (kind=kind_phys), intent(out) :: emissi !jref:end #ifdef CCPP character(len=*), intent(inout) :: errmsg @@ -452,113 +554,117 @@ subroutine noahmp_sflx (parameters, & ! local integer :: iz !do-loop index integer, dimension(-nsnow+1:nsoil) :: imelt !phase change index [1-melt; 2-freeze] - real :: cmc !intercepted water (canice+canliq) (mm) - real :: taux !wind stress: e-w (n/m2) - real :: tauy !wind stress: n-s (n/m2) - real :: rhoair !density air (kg/m3) -! real, dimension( 1: 5) :: vocflx !voc fluxes [ug c m-2 h-1] - real, dimension(-nsnow+1:nsoil) :: dzsnso !snow/soil layer thickness [m] - real :: thair !potential temperature (k) - real :: qair !specific humidity (kg/kg) (q2/(1+q2)) - real :: eair !vapor pressure air (pa) - real, dimension( 1: 2) :: solad !incoming direct solar rad (w/m2) - real, dimension( 1: 2) :: solai !incoming diffuse solar rad (w/m2) - real :: qprecc !convective precipitation (mm/s) - real :: qprecl !large-scale precipitation (mm/s) - real :: igs !growing season index (0=off, 1=on) - real :: elai !leaf area index, after burying by snow - real :: esai !stem area index, after burying by snow - real :: bevap !soil water evaporation factor (0 - 1) - real, dimension( 1:nsoil) :: btrani !soil water transpiration factor (0 - 1) - real :: btran !soil water transpiration factor (0 - 1) - real :: qin !groundwater recharge [mm/s] - real :: qdis !groundwater discharge [mm/s] - real, dimension( 1:nsoil) :: sice !soil ice content (m3/m3) - real, dimension(-nsnow+1: 0) :: snicev !partial volume ice of snow [m3/m3] - real, dimension(-nsnow+1: 0) :: snliqv !partial volume liq of snow [m3/m3] - real, dimension(-nsnow+1: 0) :: epore !effective porosity [m3/m3] - real :: totsc !total soil carbon (g/m2) - real :: totlb !total living carbon (g/m2) - real :: t2m !2-meter air temperature (k) - real :: qdew !ground surface dew rate [mm/s] - real :: qvap !ground surface evap. rate [mm/s] - real :: lathea !latent heat [j/kg] - real :: swdown !downward solar [w/m2] - real :: qmelt !snowmelt [mm/s] - real :: beg_wb !water storage at begin of a step [mm] - real,intent(out) :: irc !canopy net lw rad. [w/m2] [+ to atm] - real,intent(out) :: irg !ground net lw rad. [w/m2] [+ to atm] - real,intent(out) :: shc !canopy sen. heat [w/m2] [+ to atm] - real,intent(out) :: shg !ground sen. heat [w/m2] [+ to atm] - real,intent(out) :: evg !ground evap. heat [w/m2] [+ to atm] - real,intent(out) :: ghv !ground heat flux [w/m2] [+ to soil] - real,intent(out) :: irb !net longwave rad. [w/m2] [+ to atm] - real,intent(out) :: shb !sensible heat [w/m2] [+ to atm] - real,intent(out) :: evb !evaporation heat [w/m2] [+ to atm] - real,intent(out) :: ghb !ground heat flux [w/m2] [+ to soil] - real,intent(out) :: evc !canopy evap. heat [w/m2] [+ to atm] - real,intent(out) :: tr !transpiration heat [w/m2] [+ to atm] - real, intent(out) :: fpice !snow fraction in precipitation - real, intent(out) :: pahv !precipitation advected heat - vegetation net (w/m2) - real, intent(out) :: pahg !precipitation advected heat - under canopy net (w/m2) - real, intent(out) :: pahb !precipitation advected heat - bare ground net (w/m2) - real, intent(out) :: pah !precipitation advected heat - total (w/m2) + real (kind=kind_phys) :: cmc !intercepted water (canice+canliq) (mm) + real (kind=kind_phys) :: taux !wind stress: e-w (n/m2) + real (kind=kind_phys) :: tauy !wind stress: n-s (n/m2) + real (kind=kind_phys) :: rhoair !density air (kg/m3) +! real (kind=kind_phys), dimension( 1: 5) :: vocflx !voc fluxes [ug c m-2 h-1] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys) :: thair !potential temperature (k) + real (kind=kind_phys) :: qair !specific humidity (kg/kg) (q2/(1+q2)) + real (kind=kind_phys) :: eair !vapor pressure air (pa) + real (kind=kind_phys), dimension( 1: 2) :: solad !incoming direct solar rad (w/m2) + real (kind=kind_phys), dimension( 1: 2) :: solai !incoming diffuse solar rad (w/m2) + real (kind=kind_phys) :: qprecc !convective precipitation (mm/s) + real (kind=kind_phys) :: qprecl !large-scale precipitation (mm/s) + real (kind=kind_phys) :: igs !growing season index (0=off, 1=on) + real (kind=kind_phys) :: elai !leaf area index, after burying by snow + real (kind=kind_phys) :: esai !stem area index, after burying by snow + real (kind=kind_phys) :: bevap !soil water evaporation factor (0 - 1) + real (kind=kind_phys), dimension( 1:nsoil) :: btrani !soil water transpiration factor (0 - 1) + real (kind=kind_phys) :: btran !soil water transpiration factor (0 - 1) + real (kind=kind_phys) :: qin !groundwater recharge [mm/s] + real (kind=kind_phys) :: qdis !groundwater discharge [mm/s] + real (kind=kind_phys), dimension( 1:nsoil) :: sice !soil ice content (m3/m3) + real (kind=kind_phys), dimension(-nsnow+1: 0) :: snicev !partial volume ice of snow [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0) :: snliqv !partial volume liq of snow [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0) :: epore !effective porosity [m3/m3] + real (kind=kind_phys) :: totsc !total soil carbon (g/m2) + real (kind=kind_phys) :: totlb !total living carbon (g/m2) + real (kind=kind_phys) :: t2m !2-meter air temperature (k) + real (kind=kind_phys) :: qdew !ground surface dew rate [mm/s] + real (kind=kind_phys) :: qvap !ground surface evap. rate [mm/s] + real (kind=kind_phys) :: lathea !latent heat [j/kg] + real (kind=kind_phys) :: swdown !downward solar [w/m2] + real (kind=kind_phys) :: qmelt !snowmelt [mm/s] + real (kind=kind_phys) :: beg_wb !water storage at begin of a step [mm] + real (kind=kind_phys),intent(out) :: irc !canopy net lw rad. [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: irg !ground net lw rad. [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: shc !canopy sen. heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: shg !ground sen. heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: evg !ground evap. heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: ghv !ground heat flux [w/m2] [+ to soil] + real (kind=kind_phys),intent(out) :: irb !net longwave rad. [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: shb !sensible heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: evb !evaporation heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: ghb !ground heat flux [w/m2] [+ to soil] + real (kind=kind_phys),intent(out) :: evc !canopy evap. heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: tr !transpiration heat [w/m2] [+ to atm] + real (kind=kind_phys), intent(out) :: fpice !snow fraction in precipitation + real (kind=kind_phys), intent(out) :: pahv !precipitation advected heat - vegetation net (w/m2) + real (kind=kind_phys), intent(out) :: pahg !precipitation advected heat - under canopy net (w/m2) + real (kind=kind_phys), intent(out) :: pahb !precipitation advected heat - bare ground net (w/m2) + real (kind=kind_phys), intent(out) :: pah !precipitation advected heat - total (w/m2) !jref:start - real :: fsrv - real :: fsrg - real,intent(out) :: q2v - real,intent(out) :: q2b - real :: q2e - real :: qfx - real,intent(out) :: chv !sensible heat exchange coefficient over vegetated fraction - real,intent(out) :: chb !sensible heat exchange coefficient over bare-ground - real,intent(out) :: chleaf !leaf exchange coefficient - real,intent(out) :: chuc !under canopy exchange coefficient - real,intent(out) :: chv2 !sensible heat exchange coefficient over vegetated fraction - real,intent(out) :: chb2 !sensible heat exchange coefficient over bare-ground + real (kind=kind_phys) :: fsrv + real (kind=kind_phys) :: fsrg + real (kind=kind_phys),intent(out) :: q2v + real (kind=kind_phys),intent(out) :: q2b + real (kind=kind_phys) :: q2e + real (kind=kind_phys) :: qfx + real (kind=kind_phys),intent(out) :: chv !sensible heat exchange coefficient over vegetated fraction + real (kind=kind_phys),intent(out) :: chb !sensible heat exchange coefficient over bare-ground + real (kind=kind_phys),intent(out) :: chleaf !leaf exchange coefficient + real (kind=kind_phys),intent(out) :: chuc !under canopy exchange coefficient + real (kind=kind_phys),intent(out) :: chv2 !sensible heat exchange coefficient over vegetated fraction + real (kind=kind_phys),intent(out) :: chb2 !sensible heat exchange coefficient over bare-ground !jref:end ! carbon ! inputs - real , intent(in) :: co2air !atmospheric co2 concentration (pa) - real , intent(in) :: o2air !atmospheric o2 concentration (pa) + real (kind=kind_phys) , intent(in) :: co2air !atmospheric co2 concentration (pa) + real (kind=kind_phys) , intent(in) :: o2air !atmospheric o2 concentration (pa) ! inputs and outputs : prognostic variables - real , intent(inout) :: lfmass !leaf mass [g/m2] - real , intent(inout) :: rtmass !mass of fine roots [g/m2] - real , intent(inout) :: stmass !stem mass [g/m2] - real , intent(inout) :: wood !mass of wood (incl. woody roots) [g/m2] - real , intent(inout) :: stblcp !stable carbon in deep soil [g/m2] - real , intent(inout) :: fastcp !short-lived carbon, shallow soil [g/m2] - real , intent(inout) :: lai !leaf area index [-] - real , intent(inout) :: sai !stem area index [-] + real (kind=kind_phys) , intent(inout) :: lfmass !leaf mass [g/m2] + real (kind=kind_phys) , intent(inout) :: rtmass !mass of fine roots [g/m2] + real (kind=kind_phys) , intent(inout) :: stmass !stem mass [g/m2] + real (kind=kind_phys) , intent(inout) :: wood !mass of wood (incl. woody roots) [g/m2] + real (kind=kind_phys) , intent(inout) :: stblcp !stable carbon in deep soil [g/m2] + real (kind=kind_phys) , intent(inout) :: fastcp !short-lived carbon, shallow soil [g/m2] + real (kind=kind_phys) , intent(inout) :: lai !leaf area index [-] + real (kind=kind_phys) , intent(inout) :: sai !stem area index [-] + real (kind=kind_phys) , intent(inout) :: grain !grain mass [g/m2] + real (kind=kind_phys) , intent(inout) :: gdd !growing degree days + integer , intent(inout) :: pgs !plant growing stage [-] ! outputs - real , intent(out) :: nee !net ecosys exchange (g/m2/s co2) - real , intent(out) :: gpp !net instantaneous assimilation [g/m2/s c] - real , intent(out) :: npp !net primary productivity [g/m2/s c] - real :: autors !net ecosystem respiration (g/m2/s c) - real :: heters !organic respiration (g/m2/s c) - real :: troot !root-zone averaged temperature (k) - real :: bdfall !bulk density of new snow (kg/m3) ! mb/an: v3.7 - real :: rain !rain rate (mm/s) ! mb/an: v3.7 - real :: snow !liquid equivalent snow rate (mm/s) ! mb/an: v3.7 - real :: fp ! mb/an: v3.7 - real :: prcp ! mb/an: v3.7 + real (kind=kind_phys) , intent(out) :: nee !net ecosys exchange (g/m2/s co2) + real (kind=kind_phys) , intent(out) :: gpp !net instantaneous assimilation [g/m2/s c] + real (kind=kind_phys) , intent(out) :: npp !net primary productivity [g/m2/s c] + real (kind=kind_phys) :: autors !net ecosystem respiration (g/m2/s c) + real (kind=kind_phys) :: heters !organic respiration (g/m2/s c) + real (kind=kind_phys) :: troot !root-zone averaged temperature (k) + real (kind=kind_phys) :: bdfall !bulk density of new snow (kg/m3) ! mb/an: v3.7 + real (kind=kind_phys) :: rain !rain rate (mm/s) ! mb/an: v3.7 + real (kind=kind_phys) :: snow !liquid equivalent snow rate (mm/s) ! mb/an: v3.7 + real (kind=kind_phys) :: fp ! mb/an: v3.7 + real (kind=kind_phys) :: prcp ! mb/an: v3.7 !more local variables for precip heat mb - real :: qintr !interception rate for rain (mm/s) - real :: qdripr !drip rate for rain (mm/s) - real :: qthror !throughfall for rain (mm/s) - real :: qints !interception (loading) rate for snowfall (mm/s) - real :: qdrips !drip (unloading) rate for intercepted snow (mm/s) - real :: qthros !throughfall of snowfall (mm/s) - real :: qrain !rain at ground srf (mm/s) [+] - real :: snowhin !snow depth increasing rate (m/s) - real :: latheav !latent heat vap./sublimation (j/kg) - real :: latheag !latent heat vap./sublimation (j/kg) + real (kind=kind_phys) :: qintr !interception rate for rain (mm/s) + real (kind=kind_phys) :: qdripr !drip rate for rain (mm/s) + real (kind=kind_phys) :: qthror !throughfall for rain (mm/s) + real (kind=kind_phys) :: qints !interception (loading) rate for snowfall (mm/s) + real (kind=kind_phys) :: qdrips !drip (unloading) rate for intercepted snow (mm/s) + real (kind=kind_phys) :: qthros !throughfall of snowfall (mm/s) + real (kind=kind_phys) :: snowhin !snow depth increasing rate (m/s) + real (kind=kind_phys) :: latheav !latent heat vap./sublimation (j/kg) + real (kind=kind_phys) :: latheag !latent heat vap./sublimation (j/kg) logical :: frozen_ground ! used to define latent heat pathway logical :: frozen_canopy ! used to define latent heat pathway + LOGICAL :: dveg_active ! flag to run dynamic vegetation + LOGICAL :: crop_active ! flag to run crop model ! intent (out) variables need to be assigned a value. these normally get assigned values ! only if dveg == 2. @@ -607,17 +713,17 @@ subroutine noahmp_sflx (parameters, & ! vegetation phenology - call phenology (parameters,vegtyp , snowh , tv , lat , yearlen , julian , & !in - lai , sai , troot , elai , esai ,igs) + call phenology (parameters,vegtyp ,croptype, snowh , tv , lat , yearlen , julian , & !in + lai , sai , troot , elai , esai ,igs, pgs) !input gvf should be consistent with lai - if(dveg == 1) then + if(dveg == 1 .or. dveg == 6 .or. dveg == 7) then fveg = shdfac if(fveg <= 0.05) fveg = 0.05 - else if (dveg == 2 .or. dveg == 3) then + else if (dveg == 2 .or. dveg == 3 .or. dveg == 8) then fveg = 1.-exp(-0.52*(lai+sai)) if(fveg <= 0.05) fveg = 0.05 - else if (dveg == 4 .or. dveg == 5) then + else if (dveg == 4 .or. dveg == 5 .or. dveg == 9) then fveg = shdmax if(fveg <= 0.05) fveg = 0.05 else @@ -630,6 +736,10 @@ subroutine noahmp_sflx (parameters, & call wrf_error_fatal("namelist parameter dveg unknown") #endif endif + if(opt_crop > 0 .and. croptype > 0) then + fveg = shdmax + if(fveg <= 0.05) fveg = 0.05 + endif if(parameters%urban_flag .or. vegtyp == parameters%isbarren) fveg = 0.0 if(elai+esai == 0.0) fveg = 0.0 @@ -651,7 +761,7 @@ subroutine noahmp_sflx (parameters, & elai ,esai ,fwet ,foln , & !in fveg ,pahv ,pahg ,pahb , & !in qsnow ,dzsnso ,lat ,canliq ,canice ,iloc, jloc , & !in - z0wrf , & + z0wrf , & imelt ,snicev ,snliqv ,epore ,t2m ,fsno , & !out sav ,sag ,qmelt ,fsa ,fsr ,taux , & !out tauy ,fira ,fsh ,fcev ,fgev ,fctr , & !out @@ -661,17 +771,17 @@ subroutine noahmp_sflx (parameters, & sneqvo ,sneqv ,sh2o ,smc ,snice ,snliq , & !inout albold ,cm ,ch ,dx ,dz8w ,q2 , & !inout #ifdef CCPP - tauss ,errmsg ,errflg , & !inout + tauss ,laisun ,laisha ,rb , errmsg ,errflg , & !inout #else - tauss , & !inout + tauss ,laisun ,laisha ,rb , & !inout #endif !jref:start qc ,qsfc ,psfc , & !in t2mv ,t2mb ,fsrv , & - fsrg ,rssun ,rssha ,bgap ,wgap, tgv,tgb,& + fsrg ,rssun ,rssha ,albd ,albi ,albsnd,albsni, bgap ,wgap, tgv,tgb,& q1 ,q2v ,q2b ,q2e ,chv ,chb , & !out emissi ,pah , & - shg,shc,shb,evg,evb,ghv,ghb,irg,irc,irb,tr,evc,chleaf,chuc,chv2,chb2 ) !out + shg,shc,shb,evg,evb,ghv,ghb,irg,irc,irb,tr,evc,chleaf,chuc,chv2,chb2 ) !out !jref:end #ifdef CCPP if (errflg /= 0) return @@ -703,8 +813,16 @@ subroutine noahmp_sflx (parameters, & ! compute carbon budgets (carbon storages and co2 & bvoc fluxes) - if (dveg == 2 .or. dveg == 5) then - call carbon (parameters,nsnow ,nsoil ,vegtyp ,dt ,zsoil , & !in + crop_active = .false. + dveg_active = .false. + if (dveg == 2 .or. dveg == 5 .or. dveg == 6) dveg_active = .true. + if (opt_crop > 0 .and. croptype > 0) then + crop_active = .true. + dveg_active = .false. + endif + + IF (dveg_active) THEN + call carbon (parameters,nsnow ,nsoil ,vegtyp ,dt ,zsoil , & !in dzsnso ,stc ,smc ,tv ,tg ,psn , & !in foln ,btran ,apar ,fveg ,igs , & !in troot ,ist ,lat ,iloc ,jloc , & !in @@ -713,9 +831,18 @@ subroutine noahmp_sflx (parameters, & totlb ,lai ,sai ) !out end if + if (opt_crop == 1 .and. crop_active) then + call carbon_crop (parameters,nsnow ,nsoil ,vegtyp ,dt ,zsoil ,julian , & !in + dzsnso ,stc ,smc ,tv ,psn ,foln ,btran , & !in + soldn ,t2m , & !in + lfmass ,rtmass ,stmass ,wood ,stblcp ,fastcp ,grain , & !inout + lai ,sai ,gdd , & !inout + gpp ,npp ,nee ,autors ,heters ,totsc ,totlb, pgs ) !out + end if + ! water and energy balance check - call error (parameters,swdown ,fsa ,fsr ,fira ,fsh ,fcev , & !in + call error (parameters,swdown ,fsa ,fsr ,fira ,fsh ,fcev , & !in fgev ,fctr ,ssoil ,beg_wb ,canliq ,canice , & !in sneqv ,wa ,smc ,dzsnso ,prcp ,ecan , & !in etran ,edir ,runsrf ,runsub ,dt ,nsoil , & !in @@ -734,7 +861,7 @@ subroutine noahmp_sflx (parameters, & ! urban - jref qfx = etran + ecan + edir if ( parameters%urban_flag ) then - qsfc = (qfx/rhoair*ch) + qair + qsfc = qfx/(rhoair*ch) + qair q2b = qsfc end if @@ -768,42 +895,42 @@ subroutine atm (parameters,sfcprs ,sfctmp ,q2 , ! inputs type (noahmp_parameters), intent(in) :: parameters - real , intent(in) :: sfcprs !pressure (pa) - real , intent(in) :: sfctmp !surface air temperature [k] - real , intent(in) :: q2 !mixing ratio (kg/kg) - real , intent(in) :: prcpconv ! convective precipitation entering [mm/s] ! mb/an : v3.7 - real , intent(in) :: prcpnonc ! non-convective precipitation entering [mm/s] ! mb/an : v3.7 - real , intent(in) :: prcpshcv ! shallow convective precip entering [mm/s] ! mb/an : v3.7 - real , intent(in) :: prcpsnow ! snow entering land model [mm/s] ! mb/an : v3.7 - real , intent(in) :: prcpgrpl ! graupel entering land model [mm/s] ! mb/an : v3.7 - real , intent(in) :: prcphail ! hail entering land model [mm/s] ! mb/an : v3.7 - real , intent(in) :: soldn !downward shortwave radiation (w/m2) - real , intent(in) :: cosz !cosine solar zenith angle [0-1] + real (kind=kind_phys) , intent(in) :: sfcprs !pressure (pa) + real (kind=kind_phys) , intent(in) :: sfctmp !surface air temperature [k] + real (kind=kind_phys) , intent(in) :: q2 !mixing ratio (kg/kg) + real (kind=kind_phys) , intent(in) :: prcpconv ! convective precipitation entering [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: prcpnonc ! non-convective precipitation entering [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: prcpshcv ! shallow convective precip entering [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: prcpsnow ! snow entering land model [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: prcpgrpl ! graupel entering land model [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: prcphail ! hail entering land model [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: soldn !downward shortwave radiation (w/m2) + real (kind=kind_phys) , intent(in) :: cosz !cosine solar zenith angle [0-1] ! outputs - real , intent(out) :: thair !potential temperature (k) - real , intent(out) :: qair !specific humidity (kg/kg) (q2/(1+q2)) - real , intent(out) :: eair !vapor pressure air (pa) - real , intent(out) :: rhoair !density air (kg/m3) - real , intent(out) :: qprecc !convective precipitation (mm/s) - real , intent(out) :: qprecl !large-scale precipitation (mm/s) - real, dimension( 1: 2), intent(out) :: solad !incoming direct solar radiation (w/m2) - real, dimension( 1: 2), intent(out) :: solai !incoming diffuse solar radiation (w/m2) - real , intent(out) :: swdown !downward solar filtered by sun angle [w/m2] - real , intent(out) :: bdfall !!bulk density of snowfall (kg/m3) ajn - real , intent(out) :: rain !rainfall (mm/s) ajn - real , intent(out) :: snow !liquid equivalent snowfall (mm/s) ajn - real , intent(out) :: fp !fraction of area receiving precipitation ajn - real , intent(out) :: fpice !fraction of ice ajn - real , intent(out) :: prcp !total precipitation [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(out) :: thair !potential temperature (k) + real (kind=kind_phys) , intent(out) :: qair !specific humidity (kg/kg) (q2/(1+q2)) + real (kind=kind_phys) , intent(out) :: eair !vapor pressure air (pa) + real (kind=kind_phys) , intent(out) :: rhoair !density air (kg/m3) + real (kind=kind_phys) , intent(out) :: qprecc !convective precipitation (mm/s) + real (kind=kind_phys) , intent(out) :: qprecl !large-scale precipitation (mm/s) + real (kind=kind_phys), dimension( 1: 2), intent(out) :: solad !incoming direct solar radiation (w/m2) + real (kind=kind_phys), dimension( 1: 2), intent(out) :: solai !incoming diffuse solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: swdown !downward solar filtered by sun angle [w/m2] + real (kind=kind_phys) , intent(out) :: bdfall !!bulk density of snowfall (kg/m3) ajn + real (kind=kind_phys) , intent(out) :: rain !rainfall (mm/s) ajn + real (kind=kind_phys) , intent(out) :: snow !liquid equivalent snowfall (mm/s) ajn + real (kind=kind_phys) , intent(out) :: fp !fraction of area receiving precipitation ajn + real (kind=kind_phys) , intent(out) :: fpice !fraction of ice ajn + real (kind=kind_phys) , intent(out) :: prcp !total precipitation [mm/s] ! mb/an : v3.7 !locals - real :: pair !atm bottom level pressure (pa) - real :: prcp_frozen !total frozen precipitation [mm/s] ! mb/an : v3.7 - real, parameter :: rho_grpl = 500.0 ! graupel bulk density [kg/m3] ! mb/an : v3.7 - real, parameter :: rho_hail = 917.0 ! hail bulk density [kg/m3] ! mb/an : v3.7 + real (kind=kind_phys) :: pair !atm bottom level pressure (pa) + real (kind=kind_phys) :: prcp_frozen !total frozen precipitation [mm/s] ! mb/an : v3.7 + real (kind=kind_phys), parameter :: rho_grpl = 500.0 ! graupel bulk density [kg/m3] ! mb/an : v3.7 + real (kind=kind_phys), parameter :: rho_hail = 917.0 ! hail bulk density [kg/m3] ! mb/an : v3.7 ! -------------------------------------------------------------------------------------------------- !jref: seems like pair should be p1000mb?? @@ -828,13 +955,13 @@ subroutine atm (parameters,sfcprs ,sfctmp ,q2 , prcp = prcpconv + prcpnonc + prcpshcv -! if(opt_snf == 4) then + if(opt_snf == 4) then qprecc = prcpconv + prcpshcv qprecl = prcpnonc -! else -! qprecc = 0.10 * prcp ! should be from the atmospheric model -! qprecl = 0.90 * prcp ! should be from the atmospheric model -! end if + else + qprecc = 0.10 * prcp ! should be from the atmospheric model + qprecl = 0.90 * prcp ! should be from the atmospheric model + end if ! fractional area that receives precipitation (see, niu et al. 2005) @@ -883,7 +1010,7 @@ subroutine atm (parameters,sfcprs ,sfctmp ,q2 , if(opt_snf == 4) then prcp_frozen = prcpsnow + prcpgrpl + prcphail if(prcpnonc > 0. .and. prcp_frozen > 0.) then - fpice = min(1.0,prcp_frozen/prcp) + fpice = min(1.0,prcp_frozen/prcpnonc) fpice = max(0.0,fpice) bdfall = bdfall*(prcpsnow/prcp_frozen) + rho_grpl*(prcpgrpl/prcp_frozen) + & rho_hail*(prcphail/prcp_frozen) @@ -902,8 +1029,8 @@ end subroutine atm !== begin phenology ================================================================================ !>\ingroup NoahMP_LSM - subroutine phenology (parameters,vegtyp , snowh , tv , lat , yearlen , julian , & !in - lai , sai , troot , elai , esai , igs) + subroutine phenology (parameters,vegtyp ,croptype, snowh , tv , lat , yearlen , julian , & !in + lai , sai , troot , elai , esai , igs, pgs) ! -------------------------------------------------------------------------------------------------- ! vegetation phenology considering vegeation canopy being buries by snow and evolution in time @@ -913,34 +1040,38 @@ subroutine phenology (parameters,vegtyp , snowh , tv , lat , yearlen , ju ! inputs type (noahmp_parameters), intent(in) :: parameters integer , intent(in ) :: vegtyp !vegetation type - real , intent(in ) :: snowh !snow height [m] - real , intent(in ) :: tv !vegetation temperature (k) - real , intent(in ) :: lat !latitude (radians) + integer , intent(in ) :: croptype !vegetation type + real (kind=kind_phys) , intent(in ) :: snowh !snow height [m] + real (kind=kind_phys) , intent(in ) :: tv !vegetation temperature (k) + real (kind=kind_phys) , intent(in ) :: lat !latitude (radians) integer , intent(in ) :: yearlen!number of days in the particular year - real , intent(in ) :: julian !julian day of year (fractional) ( 0 <= julian < yearlen ) - real , intent(in ) :: troot !root-zone averaged temperature (k) - real , intent(inout) :: lai !lai, unadjusted for burying by snow - real , intent(inout) :: sai !sai, unadjusted for burying by snow + real (kind=kind_phys) , intent(in ) :: julian !julian day of year (fractional) ( 0 <= julian < yearlen ) + real (kind=kind_phys) , intent(in ) :: troot !root-zone averaged temperature (k) + real (kind=kind_phys) , intent(inout) :: lai !lai, unadjusted for burying by snow + real (kind=kind_phys) , intent(inout) :: sai !sai, unadjusted for burying by snow ! outputs - real , intent(out ) :: elai !leaf area index, after burying by snow - real , intent(out ) :: esai !stem area index, after burying by snow - real , intent(out ) :: igs !growing season index (0=off, 1=on) + real (kind=kind_phys) , intent(out ) :: elai !leaf area index, after burying by snow + real (kind=kind_phys) , intent(out ) :: esai !stem area index, after burying by snow + real (kind=kind_phys) , intent(out ) :: igs !growing season index (0=off, 1=on) + integer , intent(in ) :: pgs !plant growing stage ! locals - real :: db !thickness of canopy buried by snow (m) - real :: fb !fraction of canopy buried by snow - real :: snowhc !critical snow depth at which short vege + real (kind=kind_phys) :: db !thickness of canopy buried by snow (m) + real (kind=kind_phys) :: fb !fraction of canopy buried by snow + real (kind=kind_phys) :: snowhc !critical snow depth at which short vege !is fully covered by snow integer :: k !index integer :: it1,it2 !interpolation months - real :: day !current day of year ( 0 <= day < yearlen ) - real :: wt1,wt2 !interpolation weights - real :: t !current month (1.00, ..., 12.00) + real (kind=kind_phys) :: day !current day of year ( 0 <= day < yearlen ) + real (kind=kind_phys) :: wt1,wt2 !interpolation weights + real (kind=kind_phys) :: t !current month (1.00, ..., 12.00) ! -------------------------------------------------------------------------------------------------- +if (croptype == 0) then + if ( dveg == 1 .or. dveg == 3 .or. dveg == 4 ) then if (lat >= 0.) then @@ -962,7 +1093,13 @@ subroutine phenology (parameters,vegtyp , snowh , tv , lat , yearlen , ju lai = wt1*parameters%laim(it1) + wt2*parameters%laim(it2) sai = wt1*parameters%saim(it1) + wt2*parameters%saim(it2) endif - if (sai < 0.05) sai = 0.0 ! mb: sai check, change to 0.05 v3.6 + + if(dveg == 7 .or. dveg == 8 .or. dveg == 9) then + sai = max(0.05,0.1 * lai) ! when reading lai, set sai to 10% lai, but not below 0.05 mb: v3.8 + if (lai < 0.05) sai = 0.0 ! if lai below minimum, make sure sai = 0 + endif + + if (sai < 0.05) sai = 0.0 ! mb: sai check, change to 0.05 v3.6 if (lai < 0.05 .or. sai == 0.0) lai = 0.0 ! mb: lai check if ( ( vegtyp == parameters%iswater ) .or. ( vegtyp == parameters%isbarren ) .or. & @@ -971,6 +1108,8 @@ subroutine phenology (parameters,vegtyp , snowh , tv , lat , yearlen , ju sai = 0. endif +endif ! croptype == 0 + !buried by snow db = min( max(snowh - parameters%hvb,0.), parameters%hvt-parameters%hvb ) @@ -978,15 +1117,22 @@ subroutine phenology (parameters,vegtyp , snowh , tv , lat , yearlen , ju if(parameters%hvt> 0. .and. parameters%hvt <= 1.0) then !mb: change to 1.0 and 0.2 to reflect snowhc = parameters%hvt*exp(-snowh/0.2) ! changes to hvt in mptable - fb = min(snowh,snowhc)/snowhc +! fb = min(snowh,snowhc)/snowhc + if (snowh < snowhc) then + fb = snowh/snowhc + else + fb = 1.0 + endif endif elai = lai*(1.-fb) esai = sai*(1.-fb) - if (esai < 0.05) esai = 0.0 ! mb: esai check, change to 0.05 v3.6 - if (elai < 0.05 .or. esai == 0.0) elai = 0.0 ! mb: lai check + if (esai < 0.05 .and. croptype == 0) esai = 0.0 ! mb: esai check, change to 0.05 v3.6 + if ((elai < 0.05 .or. esai == 0.0) .and. croptype == 0) elai = 0.0 ! mb: lai check - if (tv .gt. parameters%tmin) then +! set growing season flag + + if ((tv .gt. parameters%tmin .and. croptype == 0).or.(pgs > 2 .and. pgs < 7 .and. croptype > 0)) then igs = 1. else igs = 0. @@ -1017,50 +1163,50 @@ subroutine precip_heat (parameters,iloc ,jloc ,vegtyp ,dt ,uu ,vv integer,intent(in) :: jloc !grid index integer,intent(in) :: vegtyp !vegetation type integer,intent(in) :: ist !surface type 1-soil; 2-lake - real, intent(in) :: dt !main time step (s) - real, intent(in) :: uu !u-direction wind speed [m/s] - real, intent(in) :: vv !v-direction wind speed [m/s] - real, intent(in) :: elai !leaf area index, after burying by snow - real, intent(in) :: esai !stem area index, after burying by snow - real, intent(in) :: fveg !greeness vegetation fraction (-) - real, intent(in) :: bdfall !bulk density of snowfall (kg/m3) - real, intent(in) :: rain !rainfall (mm/s) - real, intent(in) :: snow !snowfall (mm/s) - real, intent(in) :: fp !fraction of the gridcell that receives precipitation - real, intent(in) :: tv !vegetation temperature (k) - real, intent(in) :: sfctmp !model-level temperature (k) - real, intent(in) :: tg !ground temperature (k) + real (kind=kind_phys), intent(in) :: dt !main time step (s) + real (kind=kind_phys), intent(in) :: uu !u-direction wind speed [m/s] + real (kind=kind_phys), intent(in) :: vv !v-direction wind speed [m/s] + real (kind=kind_phys), intent(in) :: elai !leaf area index, after burying by snow + real (kind=kind_phys), intent(in) :: esai !stem area index, after burying by snow + real (kind=kind_phys), intent(in) :: fveg !greeness vegetation fraction (-) + real (kind=kind_phys), intent(in) :: bdfall !bulk density of snowfall (kg/m3) + real (kind=kind_phys), intent(in) :: rain !rainfall (mm/s) + real (kind=kind_phys), intent(in) :: snow !snowfall (mm/s) + real (kind=kind_phys), intent(in) :: fp !fraction of the gridcell that receives precipitation + real (kind=kind_phys), intent(in) :: tv !vegetation temperature (k) + real (kind=kind_phys), intent(in) :: sfctmp !model-level temperature (k) + real (kind=kind_phys), intent(in) :: tg !ground temperature (k) ! input & output - real, intent(inout) :: canliq !intercepted liquid water (mm) - real, intent(inout) :: canice !intercepted ice mass (mm) + real (kind=kind_phys), intent(inout) :: canliq !intercepted liquid water (mm) + real (kind=kind_phys), intent(inout) :: canice !intercepted ice mass (mm) ! output - real, intent(out) :: qintr !interception rate for rain (mm/s) - real, intent(out) :: qdripr !drip rate for rain (mm/s) - real, intent(out) :: qthror !throughfall for rain (mm/s) - real, intent(out) :: qints !interception (loading) rate for snowfall (mm/s) - real, intent(out) :: qdrips !drip (unloading) rate for intercepted snow (mm/s) - real, intent(out) :: qthros !throughfall of snowfall (mm/s) - real, intent(out) :: pahv !precipitation advected heat - vegetation net (w/m2) - real, intent(out) :: pahg !precipitation advected heat - under canopy net (w/m2) - real, intent(out) :: pahb !precipitation advected heat - bare ground net (w/m2) - real, intent(out) :: qrain !rain at ground srf (mm/s) [+] - real, intent(out) :: qsnow !snow at ground srf (mm/s) [+] - real, intent(out) :: snowhin !snow depth increasing rate (m/s) - real, intent(out) :: fwet !wetted or snowed fraction of the canopy (-) - real, intent(out) :: cmc !intercepted water (mm) + real (kind=kind_phys), intent(out) :: qintr !interception rate for rain (mm/s) + real (kind=kind_phys), intent(out) :: qdripr !drip rate for rain (mm/s) + real (kind=kind_phys), intent(out) :: qthror !throughfall for rain (mm/s) + real (kind=kind_phys), intent(out) :: qints !interception (loading) rate for snowfall (mm/s) + real (kind=kind_phys), intent(out) :: qdrips !drip (unloading) rate for intercepted snow (mm/s) + real (kind=kind_phys), intent(out) :: qthros !throughfall of snowfall (mm/s) + real (kind=kind_phys), intent(out) :: pahv !precipitation advected heat - vegetation net (w/m2) + real (kind=kind_phys), intent(out) :: pahg !precipitation advected heat - under canopy net (w/m2) + real (kind=kind_phys), intent(out) :: pahb !precipitation advected heat - bare ground net (w/m2) + real (kind=kind_phys), intent(out) :: qrain !rain at ground srf (mm/s) [+] + real (kind=kind_phys), intent(out) :: qsnow !snow at ground srf (mm/s) [+] + real (kind=kind_phys), intent(out) :: snowhin !snow depth increasing rate (m/s) + real (kind=kind_phys), intent(out) :: fwet !wetted or snowed fraction of the canopy (-) + real (kind=kind_phys), intent(out) :: cmc !intercepted water (mm) ! -------------------------------------------------------------------- ! ------------------------ local variables --------------------------- - real :: maxsno !canopy capacity for snow interception (mm) - real :: maxliq !canopy capacity for rain interception (mm) - real :: ft !temperature factor for unloading rate - real :: fv !wind factor for unloading rate - real :: pah_ac !precipitation advected heat - air to canopy (w/m2) - real :: pah_cg !precipitation advected heat - canopy to ground (w/m2) - real :: pah_ag !precipitation advected heat - air to ground (w/m2) - real :: icedrip !canice unloading + real (kind=kind_phys) :: maxsno !canopy capacity for snow interception (mm) + real (kind=kind_phys) :: maxliq !canopy capacity for rain interception (mm) + real (kind=kind_phys) :: ft !temperature factor for unloading rate + real (kind=kind_phys) :: fv !wind factor for unloading rate + real (kind=kind_phys) :: pah_ac !precipitation advected heat - air to canopy (w/m2) + real (kind=kind_phys) :: pah_cg !precipitation advected heat - canopy to ground (w/m2) + real (kind=kind_phys) :: pah_ag !precipitation advected heat - air to ground (w/m2) + real (kind=kind_phys) :: icedrip !canice unloading ! -------------------------------------------------------------------- ! initialization @@ -1250,41 +1396,41 @@ subroutine error (parameters,swdown ,fsa ,fsr ,fira ,fsh ,fcev , & integer , intent(in) :: ist !surface type 1->soil; 2->lake integer , intent(in) :: iloc !grid index integer , intent(in) :: jloc !grid index - real , intent(in) :: swdown !downward solar filtered by sun angle [w/m2] - real , intent(in) :: fsa !total absorbed solar radiation (w/m2) - real , intent(in) :: fsr !total reflected solar radiation (w/m2) - real , intent(in) :: fira !total net longwave rad (w/m2) [+ to atm] - real , intent(in) :: fsh !total sensible heat (w/m2) [+ to atm] - real , intent(in) :: fcev !canopy evaporation heat (w/m2) [+ to atm] - real , intent(in) :: fgev !ground evaporation heat (w/m2) [+ to atm] - real , intent(in) :: fctr !transpiration heat flux (w/m2) [+ to atm] - real , intent(in) :: ssoil !ground heat flux (w/m2) [+ to soil] - real , intent(in) :: fveg - real , intent(in) :: sav - real , intent(in) :: sag - real , intent(in) :: fsrv - real , intent(in) :: fsrg - real , intent(in) :: zwt - - real , intent(in) :: prcp !precipitation rate (kg m-2 s-1) - real , intent(in) :: ecan !evaporation of intercepted water (mm/s) - real , intent(in) :: etran !transpiration rate (mm/s) - real , intent(in) :: edir !soil surface evaporation rate[mm/s] - real , intent(in) :: runsrf !surface runoff [mm/s] - real , intent(in) :: runsub !baseflow (saturation excess) [mm/s] - real , intent(in) :: canliq !intercepted liquid water (mm) - real , intent(in) :: canice !intercepted ice mass (mm) - real , intent(in) :: sneqv !snow water eqv. [mm] - real, dimension( 1:nsoil), intent(in) :: smc !soil moisture (ice + liq.) [m3/m3] - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] - real , intent(in) :: wa !water storage in aquifer [mm] - real , intent(in) :: dt !time step [sec] - real , intent(in) :: beg_wb !water storage at begin of a timesetp [mm] - real , intent(out) :: errwat !error in water balance [mm/timestep] - real, intent(in) :: pah !precipitation advected heat - total (w/m2) - real, intent(in) :: pahv !precipitation advected heat - total (w/m2) - real, intent(in) :: pahg !precipitation advected heat - total (w/m2) - real, intent(in) :: pahb !precipitation advected heat - total (w/m2) + real (kind=kind_phys) , intent(in) :: swdown !downward solar filtered by sun angle [w/m2] + real (kind=kind_phys) , intent(in) :: fsa !total absorbed solar radiation (w/m2) + real (kind=kind_phys) , intent(in) :: fsr !total reflected solar radiation (w/m2) + real (kind=kind_phys) , intent(in) :: fira !total net longwave rad (w/m2) [+ to atm] + real (kind=kind_phys) , intent(in) :: fsh !total sensible heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(in) :: fcev !canopy evaporation heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(in) :: fgev !ground evaporation heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(in) :: fctr !transpiration heat flux (w/m2) [+ to atm] + real (kind=kind_phys) , intent(in) :: ssoil !ground heat flux (w/m2) [+ to soil] + real (kind=kind_phys) , intent(in) :: fveg + real (kind=kind_phys) , intent(in) :: sav + real (kind=kind_phys) , intent(in) :: sag + real (kind=kind_phys) , intent(in) :: fsrv + real (kind=kind_phys) , intent(in) :: fsrg + real (kind=kind_phys) , intent(in) :: zwt + + real (kind=kind_phys) , intent(in) :: prcp !precipitation rate (kg m-2 s-1) + real (kind=kind_phys) , intent(in) :: ecan !evaporation of intercepted water (mm/s) + real (kind=kind_phys) , intent(in) :: etran !transpiration rate (mm/s) + real (kind=kind_phys) , intent(in) :: edir !soil surface evaporation rate[mm/s] + real (kind=kind_phys) , intent(in) :: runsrf !surface runoff [mm/s] + real (kind=kind_phys) , intent(in) :: runsub !baseflow (saturation excess) [mm/s] + real (kind=kind_phys) , intent(in) :: canliq !intercepted liquid water (mm) + real (kind=kind_phys) , intent(in) :: canice !intercepted ice mass (mm) + real (kind=kind_phys) , intent(in) :: sneqv !snow water eqv. [mm] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: smc !soil moisture (ice + liq.) [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys) , intent(in) :: wa !water storage in aquifer [mm] + real (kind=kind_phys) , intent(in) :: dt !time step [sec] + real (kind=kind_phys) , intent(in) :: beg_wb !water storage at begin of a timesetp [mm] + real (kind=kind_phys) , intent(out) :: errwat !error in water balance [mm/timestep] + real (kind=kind_phys), intent(in) :: pah !precipitation advected heat - total (w/m2) + real (kind=kind_phys), intent(in) :: pahv !precipitation advected heat - total (w/m2) + real (kind=kind_phys), intent(in) :: pahg !precipitation advected heat - total (w/m2) + real (kind=kind_phys), intent(in) :: pahb !precipitation advected heat - total (w/m2) #ifdef CCPP character(len=*) , intent(inout) :: errmsg @@ -1292,11 +1438,11 @@ subroutine error (parameters,swdown ,fsa ,fsr ,fira ,fsh ,fcev , & #endif integer :: iz !do-loop index - real :: end_wb !water storage at end of a timestep [mm] - !kwm real :: errwat !error in water balance [mm/timestep] - real :: erreng !error in surface energy balance [w/m2] - real :: errsw !error in shortwave radiation balance [w/m2] - real :: fsrvg + real (kind=kind_phys) :: end_wb !water storage at end of a timestep [mm] + !kwm real (kind=kind_phys) :: errwat !error in water balance [mm/timestep] + real (kind=kind_phys) :: erreng !error in surface energy balance [w/m2] + real (kind=kind_phys) :: errsw !error in shortwave radiation balance [w/m2] + real (kind=kind_phys) :: fsrvg character(len=256) :: message ! -------------------------------------------------------------------------------------------------- !jref:start @@ -1439,14 +1585,14 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in sneqvo ,sneqv ,sh2o ,smc ,snice ,snliq , & !inout albold ,cm ,ch ,dx ,dz8w ,q2 , & !inout #ifdef CCPP - tauss ,errmsg ,errflg, & !inout + tauss ,laisun ,laisha ,rb ,errmsg ,errflg, & !inout #else - tauss , & !inout + tauss ,laisun ,laisha ,rb , & !inout #endif !jref:start qc ,qsfc ,psfc , & !in t2mv ,t2mb ,fsrv , & - fsrg ,rssun ,rssha ,bgap ,wgap,tgv,tgb,& + fsrg ,rssun ,rssha ,albd ,albi,albsnd ,albsni,bgap ,wgap,tgv,tgb,& q1 ,q2v ,q2b ,q2e ,chv ,chb, emissi,pah ,& shg,shc,shb,evg,evb,ghv,ghb,irg,irc,irb,tr,evc,chleaf,chuc,chv2,chb2 ) !out !jref:end @@ -1496,214 +1642,218 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in integer , intent(in) :: nsnow !maximum no. of snow layers integer , intent(in) :: nsoil !number of soil layers integer , intent(in) :: isnow !actual no. of snow layers - real , intent(in) :: dt !time step [sec] - real , intent(in) :: qsnow !snowfall on the ground (mm/s) - real , intent(in) :: rhoair !density air (kg/m3) - real , intent(in) :: eair !vapor pressure air (pa) - real , intent(in) :: sfcprs !pressure (pa) - real , intent(in) :: qair !specific humidity (kg/kg) - real , intent(in) :: sfctmp !air temperature (k) - real , intent(in) :: thair !potential temperature (k) - real , intent(in) :: lwdn !downward longwave radiation (w/m2) - real , intent(in) :: uu !wind speed in e-w dir (m/s) - real , intent(in) :: vv !wind speed in n-s dir (m/s) - real , dimension( 1: 2), intent(in) :: solad !incoming direct solar rad. (w/m2) - real , dimension( 1: 2), intent(in) :: solai !incoming diffuse solar rad. (w/m2) - real , intent(in) :: cosz !cosine solar zenith angle (0-1) - real , intent(in) :: elai !lai adjusted for burying by snow - real , intent(in) :: esai !lai adjusted for burying by snow - real , intent(in) :: fwet !fraction of canopy that is wet [-] - real , intent(in) :: fveg !greeness vegetation fraction (-) - real , intent(in) :: lat !latitude (radians) - real , intent(in) :: canliq !canopy-intercepted liquid water (mm) - real , intent(in) :: canice !canopy-intercepted ice mass (mm) - real , intent(in) :: foln !foliage nitrogen (%) - real , intent(in) :: co2air !atmospheric co2 concentration (pa) - real , intent(in) :: o2air !atmospheric o2 concentration (pa) - real , intent(in) :: igs !growing season index (0=off, 1=on) - - real , intent(in) :: zref !reference height (m) - real , intent(in) :: tbot !bottom condition for soil temp. (k) - real , dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bottom depth from snow surf [m] - real , dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf [m] - real , dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !depth of snow & soil layer-bottom [m] - real, intent(in) :: pahv !precipitation advected heat - vegetation net (w/m2) - real, intent(in) :: pahg !precipitation advected heat - under canopy net (w/m2) - real, intent(in) :: pahb !precipitation advected heat - bare ground net (w/m2) + real (kind=kind_phys) , intent(in) :: dt !time step [sec] + real (kind=kind_phys) , intent(in) :: qsnow !snowfall on the ground (mm/s) + real (kind=kind_phys) , intent(in) :: rhoair !density air (kg/m3) + real (kind=kind_phys) , intent(in) :: eair !vapor pressure air (pa) + real (kind=kind_phys) , intent(in) :: sfcprs !pressure (pa) + real (kind=kind_phys) , intent(in) :: qair !specific humidity (kg/kg) + real (kind=kind_phys) , intent(in) :: sfctmp !air temperature (k) + real (kind=kind_phys) , intent(in) :: thair !potential temperature (k) + real (kind=kind_phys) , intent(in) :: lwdn !downward longwave radiation (w/m2) + real (kind=kind_phys) , intent(in) :: uu !wind speed in e-w dir (m/s) + real (kind=kind_phys) , intent(in) :: vv !wind speed in n-s dir (m/s) + real (kind=kind_phys) , dimension( 1: 2), intent(in) :: solad !incoming direct solar rad. (w/m2) + real (kind=kind_phys) , dimension( 1: 2), intent(in) :: solai !incoming diffuse solar rad. (w/m2) + real (kind=kind_phys) , intent(in) :: cosz !cosine solar zenith angle (0-1) + real (kind=kind_phys) , intent(in) :: elai !lai adjusted for burying by snow + real (kind=kind_phys) , intent(in) :: esai !lai adjusted for burying by snow + real (kind=kind_phys) , intent(in) :: fwet !fraction of canopy that is wet [-] + real (kind=kind_phys) , intent(in) :: fveg !greeness vegetation fraction (-) + real (kind=kind_phys) , intent(in) :: lat !latitude (radians) + real (kind=kind_phys) , intent(in) :: canliq !canopy-intercepted liquid water (mm) + real (kind=kind_phys) , intent(in) :: canice !canopy-intercepted ice mass (mm) + real (kind=kind_phys) , intent(in) :: foln !foliage nitrogen (%) + real (kind=kind_phys) , intent(in) :: co2air !atmospheric co2 concentration (pa) + real (kind=kind_phys) , intent(in) :: o2air !atmospheric o2 concentration (pa) + real (kind=kind_phys) , intent(in) :: igs !growing season index (0=off, 1=on) + + real (kind=kind_phys) , intent(in) :: zref !reference height (m) + real (kind=kind_phys) , intent(in) :: tbot !bottom condition for soil temp. (k) + real (kind=kind_phys) , dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bottom depth from snow surf [m] + real (kind=kind_phys) , dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf [m] + real (kind=kind_phys) , dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !depth of snow & soil layer-bottom [m] + real (kind=kind_phys), intent(in) :: pahv !precipitation advected heat - vegetation net (w/m2) + real (kind=kind_phys), intent(in) :: pahg !precipitation advected heat - under canopy net (w/m2) + real (kind=kind_phys), intent(in) :: pahb !precipitation advected heat - bare ground net (w/m2) !jref:start; in - real , intent(in) :: qc !cloud water mixing ratio - real , intent(inout) :: qsfc !mixing ratio at lowest model layer - real , intent(in) :: psfc !pressure at lowest model layer - real , intent(in) :: dx !horisontal resolution - real , intent(in) :: dz8w !thickness of lowest layer - real , intent(in) :: q2 !mixing ratio (kg/kg) + real (kind=kind_phys) , intent(in) :: qc !cloud water mixing ratio + real (kind=kind_phys) , intent(inout) :: qsfc !mixing ratio at lowest model layer + real (kind=kind_phys) , intent(in) :: psfc !pressure at lowest model layer + real (kind=kind_phys) , intent(in) :: dx !horisontal resolution + real (kind=kind_phys) , intent(in) :: dz8w !thickness of lowest layer + real (kind=kind_phys) , intent(in) :: q2 !mixing ratio (kg/kg) !jref:end ! outputs - real , intent(out) :: z0wrf !combined z0 sent to coupled model + real (kind=kind_phys) , intent(out) :: z0wrf !combined z0 sent to coupled model integer, dimension(-nsnow+1:nsoil), intent(out) :: imelt !phase change index [1-melt; 2-freeze] - real , dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume ice [m3/m3] - real , dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume liq. water [m3/m3] - real , dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] - real , intent(out) :: fsno !snow cover fraction (-) - real , intent(out) :: qmelt !snowmelt [mm/s] - real , intent(out) :: ponding!pounding at ground [mm] - real , intent(out) :: sav !solar rad. absorbed by veg. (w/m2) - real , intent(out) :: sag !solar rad. absorbed by ground (w/m2) - real , intent(out) :: fsa !tot. absorbed solar radiation (w/m2) - real , intent(out) :: fsr !tot. reflected solar radiation (w/m2) - real , intent(out) :: taux !wind stress: e-w (n/m2) - real , intent(out) :: tauy !wind stress: n-s (n/m2) - real , intent(out) :: fira !total net lw. rad (w/m2) [+ to atm] - real , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] - real , intent(out) :: fcev !canopy evaporation (w/m2) [+ to atm] - real , intent(out) :: fgev !ground evaporation (w/m2) [+ to atm] - real , intent(out) :: fctr !transpiration (w/m2) [+ to atm] - real , intent(out) :: trad !radiative temperature (k) - real , intent(out) :: t2m !2 m height air temperature (k) - real , intent(out) :: psn !total photosyn. (umolco2/m2/s) [+] - real , intent(out) :: apar !total photosyn. active energy (w/m2) - real , intent(out) :: ssoil !ground heat flux (w/m2) [+ to soil] - real , dimension( 1:nsoil), intent(out) :: btrani !soil water transpiration factor (0-1) - real , intent(out) :: btran !soil water transpiration factor (0-1) -! real , intent(out) :: lathea !latent heat vap./sublimation (j/kg) - real , intent(out) :: latheav !latent heat vap./sublimation (j/kg) - real , intent(out) :: latheag !latent heat vap./sublimation (j/kg) + real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume ice [m3/m3] + real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume liq. water [m3/m3] + real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] + real (kind=kind_phys) , intent(out) :: fsno !snow cover fraction (-) + real (kind=kind_phys) , intent(out) :: qmelt !snowmelt [mm/s] + real (kind=kind_phys) , intent(out) :: ponding!pounding at ground [mm] + real (kind=kind_phys) , intent(out) :: sav !solar rad. absorbed by veg. (w/m2) + real (kind=kind_phys) , intent(out) :: sag !solar rad. absorbed by ground (w/m2) + real (kind=kind_phys) , intent(out) :: fsa !tot. absorbed solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: fsr !tot. reflected solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: taux !wind stress: e-w (n/m2) + real (kind=kind_phys) , intent(out) :: tauy !wind stress: n-s (n/m2) + real (kind=kind_phys) , intent(out) :: fira !total net lw. rad (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fcev !canopy evaporation (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fgev !ground evaporation (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fctr !transpiration (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: trad !radiative temperature (k) + real (kind=kind_phys) , intent(out) :: t2m !2 m height air temperature (k) + real (kind=kind_phys) , intent(out) :: psn !total photosyn. (umolco2/m2/s) [+] + real (kind=kind_phys) , intent(out) :: apar !total photosyn. active energy (w/m2) + real (kind=kind_phys) , intent(out) :: ssoil !ground heat flux (w/m2) [+ to soil] + real (kind=kind_phys) , dimension( 1:nsoil), intent(out) :: btrani !soil water transpiration factor (0-1) + real (kind=kind_phys) , intent(out) :: btran !soil water transpiration factor (0-1) +! real (kind=kind_phys) , intent(out) :: lathea !latent heat vap./sublimation (j/kg) + real (kind=kind_phys) , intent(out) :: latheav !latent heat vap./sublimation (j/kg) + real (kind=kind_phys) , intent(out) :: latheag !latent heat vap./sublimation (j/kg) logical , intent(out) :: frozen_ground ! used to define latent heat pathway logical , intent(out) :: frozen_canopy ! used to define latent heat pathway !jref:start - real , intent(out) :: fsrv !veg. reflected solar radiation (w/m2) - real , intent(out) :: fsrg !ground reflected solar radiation (w/m2) - real, intent(out) :: rssun !sunlit leaf stomatal resistance (s/m) - real, intent(out) :: rssha !shaded leaf stomatal resistance (s/m) + real (kind=kind_phys) , intent(out) :: fsrv !veg. reflected solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: fsrg !ground reflected solar radiation (w/m2) + real (kind=kind_phys), intent(out) :: rssun !sunlit leaf stomatal resistance (s/m) + real (kind=kind_phys), intent(out) :: rssha !shaded leaf stomatal resistance (s/m) !jref:end - out for debug !jref:start; output - real , intent(out) :: t2mv !2-m air temperature over vegetated part [k] - real , intent(out) :: t2mb !2-m air temperature over bare ground part [k] - real , intent(out) :: bgap - real , intent(out) :: wgap + real (kind=kind_phys) , intent(out) :: t2mv !2-m air temperature over vegetated part [k] + real (kind=kind_phys) , intent(out) :: t2mb !2-m air temperature over bare ground part [k] + real (kind=kind_phys) , intent(out) :: bgap + real (kind=kind_phys) , intent(out) :: wgap + real (kind=kind_phys), dimension(1:2) , intent(out) :: albd !albedo (direct) + real (kind=kind_phys), dimension(1:2) , intent(out) :: albi !albedo (diffuse) + real (kind=kind_phys), dimension(1:2) , intent(out) :: albsnd !snow albedo (direct) + real (kind=kind_phys), dimension(1:2) , intent(out) :: albsni !snow albedo (diffuse) !jref:end ! input & output - real , intent(inout) :: ts !surface temperature (k) - real , intent(inout) :: tv !vegetation temperature (k) - real , intent(inout) :: tg !ground temperature (k) - real , dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] - real , intent(inout) :: snowh !snow height [m] - real , intent(inout) :: sneqv !snow mass (mm) - real , intent(inout) :: sneqvo !snow mass at last time step (mm) - real , dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil moisture [m3/m3] - real , dimension( 1:nsoil), intent(inout) :: smc !soil moisture (ice + liq.) [m3/m3] - real , dimension(-nsnow+1: 0), intent(inout) :: snice !snow ice mass (kg/m2) - real , dimension(-nsnow+1: 0), intent(inout) :: snliq !snow liq mass (kg/m2) - real , intent(inout) :: eah !canopy air vapor pressure (pa) - real , intent(inout) :: tah !canopy air temperature (k) - real , intent(inout) :: albold !snow albedo at last time step(class type) - real , intent(inout) :: tauss !non-dimensional snow age - real , intent(inout) :: cm !momentum drag coefficient - real , intent(inout) :: ch !sensible heat exchange coefficient - real , intent(inout) :: q1 + real (kind=kind_phys) , intent(inout) :: ts !surface temperature (k) + real (kind=kind_phys) , intent(inout) :: tv !vegetation temperature (k) + real (kind=kind_phys) , intent(inout) :: tg !ground temperature (k) + real (kind=kind_phys) , dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] + real (kind=kind_phys) , intent(inout) :: snowh !snow height [m] + real (kind=kind_phys) , intent(inout) :: sneqv !snow mass (mm) + real (kind=kind_phys) , intent(inout) :: sneqvo !snow mass at last time step (mm) + real (kind=kind_phys) , dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil moisture [m3/m3] + real (kind=kind_phys) , dimension( 1:nsoil), intent(inout) :: smc !soil moisture (ice + liq.) [m3/m3] + real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(inout) :: snice !snow ice mass (kg/m2) + real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(inout) :: snliq !snow liq mass (kg/m2) + real (kind=kind_phys) , intent(inout) :: eah !canopy air vapor pressure (pa) + real (kind=kind_phys) , intent(inout) :: tah !canopy air temperature (k) + real (kind=kind_phys) , intent(inout) :: albold !snow albedo at last time step(class type) + real (kind=kind_phys) , intent(inout) :: tauss !non-dimensional snow age + real (kind=kind_phys) , intent(inout) :: cm !momentum drag coefficient + real (kind=kind_phys) , intent(inout) :: ch !sensible heat exchange coefficient + real (kind=kind_phys) , intent(inout) :: q1 + real , intent(inout) :: rb !leaf boundary layer resistance (s/m) + real , intent(inout) :: laisun !sunlit leaf area index (m2/m2) + real , intent(inout) :: laisha !shaded leaf area index (m2/m2) #ifdef CCPP character(len=*) , intent(inout) :: errmsg integer , intent(inout) :: errflg #endif -! real :: q2e - real, intent(out) :: emissi - real, intent(out) :: pah !precipitation advected heat - total (w/m2) +! real (kind=kind_phys) :: q2e + real (kind=kind_phys), intent(out) :: emissi + real (kind=kind_phys), intent(out) :: pah !precipitation advected heat - total (w/m2) ! local integer :: iz !do-loop index logical :: veg !true if vegetated surface - real :: ur !wind speed at height zlvl (m/s) - real :: zlvl !reference height (m) - real :: fsun !sunlit fraction of canopy [-] - real :: rb !leaf boundary layer resistance (s/m) - real :: rsurf !ground surface resistance (s/m) - real :: l_rsurf!dry-layer thickness for computing rsurf (sakaguchi and zeng, 2009) - real :: d_rsurf!reduced vapor diffusivity in soil for computing rsurf (sz09) - real :: bevap !soil water evaporation factor (0- 1) - real :: mol !monin-obukhov length (m) - real :: vai !sum of lai + stem area index [m2/m2] - real :: cwp !canopy wind extinction parameter - real :: zpd !zero plane displacement (m) - real :: z0m !z0 momentum (m) - real :: zpdg !zero plane displacement (m) - real :: z0mg !z0 momentum, ground (m) - real :: emv !vegetation emissivity - real :: emg !ground emissivity - real :: fire !emitted ir (w/m2) - - real :: laisun !sunlit leaf area index (m2/m2) - real :: laisha !shaded leaf area index (m2/m2) - real :: psnsun !sunlit photosynthesis (umolco2/m2/s) - real :: psnsha !shaded photosynthesis (umolco2/m2/s) + real (kind=kind_phys) :: ur !wind speed at height zlvl (m/s) + real (kind=kind_phys) :: zlvl !reference height (m) + real (kind=kind_phys) :: fsun !sunlit fraction of canopy [-] + real (kind=kind_phys) :: rsurf !ground surface resistance (s/m) + real (kind=kind_phys) :: l_rsurf!dry-layer thickness for computing rsurf (sakaguchi and zeng, 2009) + real (kind=kind_phys) :: d_rsurf!reduced vapor diffusivity in soil for computing rsurf (sz09) + real (kind=kind_phys) :: bevap !soil water evaporation factor (0- 1) + real (kind=kind_phys) :: mol !monin-obukhov length (m) + real (kind=kind_phys) :: vai !sum of lai + stem area index [m2/m2] + real (kind=kind_phys) :: cwp !canopy wind extinction parameter + real (kind=kind_phys) :: zpd !zero plane displacement (m) + real (kind=kind_phys) :: z0m !z0 momentum (m) + real (kind=kind_phys) :: zpdg !zero plane displacement (m) + real (kind=kind_phys) :: z0mg !z0 momentum, ground (m) + real (kind=kind_phys) :: emv !vegetation emissivity + real (kind=kind_phys) :: emg !ground emissivity + real (kind=kind_phys) :: fire !emitted ir (w/m2) + + real (kind=kind_phys) :: psnsun !sunlit photosynthesis (umolco2/m2/s) + real (kind=kind_phys) :: psnsha !shaded photosynthesis (umolco2/m2/s) !jref:start - for debug -! real :: rssun !sunlit stomatal resistance (s/m) -! real :: rssha !shaded stomatal resistance (s/m) +! real (kind=kind_phys) :: rssun !sunlit stomatal resistance (s/m) +! real (kind=kind_phys) :: rssha !shaded stomatal resistance (s/m) !jref:end - for debug - real :: parsun !par absorbed per sunlit lai (w/m2) - real :: parsha !par absorbed per shaded lai (w/m2) - - real, dimension(-nsnow+1:nsoil) :: fact !temporary used in phase change - real, dimension(-nsnow+1:nsoil) :: df !thermal conductivity [w/m/k] - real, dimension(-nsnow+1:nsoil) :: hcpct !heat capacity [j/m3/k] - real :: bdsno !bulk density of snow (kg/m3) - real :: fmelt !melting factor for snow cover frac - real :: gx !temporary variable - real, dimension(-nsnow+1:nsoil) :: phi !light through water (w/m2) -! real :: gamma !psychrometric constant (pa/k) - real :: gammav !psychrometric constant (pa/k) - real :: gammag !psychrometric constant (pa/k) - real :: psi !surface layer soil matrix potential (m) - real :: rhsur !raltive humidity in surface soil/snow air space (-) + real (kind=kind_phys) :: parsun !par absorbed per sunlit lai (w/m2) + real (kind=kind_phys) :: parsha !par absorbed per shaded lai (w/m2) + + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: fact !temporary used in phase change + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: df !thermal conductivity [w/m/k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: hcpct !heat capacity [j/m3/k] + real (kind=kind_phys) :: bdsno !bulk density of snow (kg/m3) + real (kind=kind_phys) :: fmelt !melting factor for snow cover frac + real (kind=kind_phys) :: gx !temporary variable + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: phi !light through water (w/m2) +! real (kind=kind_phys) :: gamma !psychrometric constant (pa/k) + real (kind=kind_phys) :: gammav !psychrometric constant (pa/k) + real (kind=kind_phys) :: gammag !psychrometric constant (pa/k) + real (kind=kind_phys) :: psi !surface layer soil matrix potential (m) + real (kind=kind_phys) :: rhsur !raltive humidity in surface soil/snow air space (-) ! temperature and fluxes over vegetated fraction - real :: tauxv !wind stress: e-w dir [n/m2] - real :: tauyv !wind stress: n-s dir [n/m2] - real,intent(out) :: irc !canopy net lw rad. [w/m2] [+ to atm] - real,intent(out) :: irg !ground net lw rad. [w/m2] [+ to atm] - real,intent(out) :: shc !canopy sen. heat [w/m2] [+ to atm] - real,intent(out) :: shg !ground sen. heat [w/m2] [+ to atm] + real (kind=kind_phys) :: tauxv !wind stress: e-w dir [n/m2] + real (kind=kind_phys) :: tauyv !wind stress: n-s dir [n/m2] + real (kind=kind_phys),intent(out) :: irc !canopy net lw rad. [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: irg !ground net lw rad. [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: shc !canopy sen. heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: shg !ground sen. heat [w/m2] [+ to atm] !jref:start - real,intent(out) :: q2v - real,intent(out) :: q2b - real,intent(out) :: q2e + real (kind=kind_phys),intent(out) :: q2v + real (kind=kind_phys),intent(out) :: q2b + real (kind=kind_phys),intent(out) :: q2e !jref:end - real,intent(out) :: evc !canopy evap. heat [w/m2] [+ to atm] - real,intent(out) :: evg !ground evap. heat [w/m2] [+ to atm] - real,intent(out) :: tr !transpiration heat [w/m2] [+ to atm] - real,intent(out) :: ghv !ground heat flux [w/m2] [+ to soil] - real,intent(out) :: tgv !ground surface temp. [k] - real :: cmv !momentum drag coefficient - real,intent(out) :: chv !sensible heat exchange coefficient + real (kind=kind_phys),intent(out) :: evc !canopy evap. heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: evg !ground evap. heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: tr !transpiration heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: ghv !ground heat flux [w/m2] [+ to soil] + real (kind=kind_phys),intent(out) :: tgv !ground surface temp. [k] + real (kind=kind_phys) :: cmv !momentum drag coefficient + real (kind=kind_phys),intent(out) :: chv !sensible heat exchange coefficient ! temperature and fluxes over bare soil fraction - real :: tauxb !wind stress: e-w dir [n/m2] - real :: tauyb !wind stress: n-s dir [n/m2] - real,intent(out) :: irb !net longwave rad. [w/m2] [+ to atm] - real,intent(out) :: shb !sensible heat [w/m2] [+ to atm] - real,intent(out) :: evb !evaporation heat [w/m2] [+ to atm] - real,intent(out) :: ghb !ground heat flux [w/m2] [+ to soil] - real,intent(out) :: tgb !ground surface temp. [k] - real :: cmb !momentum drag coefficient - real,intent(out) :: chb !sensible heat exchange coefficient - real,intent(out) :: chleaf !leaf exchange coefficient - real,intent(out) :: chuc !under canopy exchange coefficient + real (kind=kind_phys) :: tauxb !wind stress: e-w dir [n/m2] + real (kind=kind_phys) :: tauyb !wind stress: n-s dir [n/m2] + real (kind=kind_phys),intent(out) :: irb !net longwave rad. [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: shb !sensible heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: evb !evaporation heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: ghb !ground heat flux [w/m2] [+ to soil] + real (kind=kind_phys),intent(out) :: tgb !ground surface temp. [k] + real (kind=kind_phys) :: cmb !momentum drag coefficient + real (kind=kind_phys),intent(out) :: chb !sensible heat exchange coefficient + real (kind=kind_phys),intent(out) :: chleaf !leaf exchange coefficient + real (kind=kind_phys),intent(out) :: chuc !under canopy exchange coefficient !jref:start - real,intent(out) :: chv2 !sensible heat conductance, canopy air to zlvl air (m/s) - real,intent(out) :: chb2 !sensible heat conductance, canopy air to zlvl air (m/s) - real :: noahmpres + real (kind=kind_phys),intent(out) :: chv2 !sensible heat conductance, canopy air to zlvl air (m/s) + real (kind=kind_phys),intent(out) :: chb2 !sensible heat conductance, canopy air to zlvl air (m/s) + real (kind=kind_phys) :: noahmpres !jref:end - real, parameter :: mpe = 1.e-6 - real, parameter :: psiwlt = -150. !metric potential for wilting point (m) - real, parameter :: z0 = 0.01 ! bare-soil roughness length (m) (i.e., under the canopy) + real (kind=kind_phys), parameter :: mpe = 1.e-6 + real (kind=kind_phys), parameter :: psiwlt = -150. !metric potential for wilting point (m) + real (kind=kind_phys), parameter :: z0 = 0.002 ! bare-soil roughness length (m) (i.e., under the canopy) ! --------------------------------------------------------------------------------------------------- ! initialize fluxes from veg. fraction @@ -1726,6 +1876,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in chleaf = 0. chuc = 0. chv2 = 0. + rb = 0. ! wind speed at reference height: ur >= 1 @@ -1743,7 +1894,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in if(snowh.gt.0.) then bdsno = sneqv / snowh fmelt = (bdsno/100.)**parameters%mfsno - fsno = tanh( snowh /(2.5* z0 * fmelt)) + fsno = tanh( snowh /(parameters%scffac * fmelt)) endif ! ground roughness length @@ -1770,6 +1921,15 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in zpd = zpdg end if +! special case for urban + + IF (parameters%urban_flag) THEN + Z0MG = parameters%Z0MVT + ZPDG = 0.65 * parameters%HVT + Z0M = Z0MG + ZPD = ZPDG + END IF + zlvl = max(zpd,parameters%hvt) + zref if(zpdg >= zlvl) zlvl = zpdg + zref ! ur = ur*log(zlvl/z0m)/log(10./z0m) !input ur is at 10m @@ -1797,15 +1957,15 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in albold ,tauss , & !inout fsun ,laisun ,laisha ,parsun ,parsha , & !out sav ,sag ,fsr ,fsa ,fsrv , & - fsrg ,bgap ,wgap ) !out + fsrg ,albd ,albi ,albsnd ,albsni ,bgap ,wgap ) ! out ! vegetation and ground emissivity emv = 1. - exp(-(elai+esai)/1.0) if (ice == 1) then - emg = 0.98*(1.-fsno) + 1.0*fsno + emg = 0.98*(1.-fsno) + parameters%snow_emis*fsno else - emg = parameters%eg(ist)*(1.-fsno) + 1.0*fsno + emg = parameters%eg(ist)*(1.-fsno) + parameters%snow_emis*fsno end if ! soil moisture factor controlling stomatal resistance @@ -1815,14 +1975,14 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in if(ist ==1 ) then do iz = 1, parameters%nroot if(opt_btr == 1) then ! noah - gx = (sh2o(iz)-parameters%smcwlt) / (parameters%smcref-parameters%smcwlt) + gx = (sh2o(iz)-parameters%smcwlt(iz)) / (parameters%smcref(iz)-parameters%smcwlt(iz)) end if if(opt_btr == 2) then ! clm - psi = max(psiwlt,-parameters%psisat*(max(0.01,sh2o(iz))/parameters%smcmax)**(-parameters%bexp) ) - gx = (1.-psi/psiwlt)/(1.+parameters%psisat/psiwlt) + psi = max(psiwlt,-parameters%psisat(iz)*(max(0.01,sh2o(iz))/parameters%smcmax(iz))**(-parameters%bexp(iz)) ) + gx = (1.-psi/psiwlt)/(1.+parameters%psisat(iz)/psiwlt) end if if(opt_btr == 3) then ! ssib - psi = max(psiwlt,-parameters%psisat*(max(0.01,sh2o(iz))/parameters%smcmax)**(-parameters%bexp) ) + psi = max(psiwlt,-parameters%psisat(iz)*(max(0.01,sh2o(iz))/parameters%smcmax(iz))**(-parameters%bexp(iz)) ) gx = 1.-exp(-5.8*(log(psiwlt/psi))) end if @@ -1837,25 +1997,31 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in ! soil surface resistance for ground evap. - bevap = max(0.0,sh2o(1)/parameters%smcmax) + bevap = max(0.0,sh2o(1)/parameters%smcmax(1)) if(ist == 2) then rsurf = 1. ! avoid being divided by 0 rhsur = 1.0 else - ! rsurf based on sakaguchi and zeng, 2009 - ! taking the "residual water content" to be the wilting point, - ! and correcting the exponent on the d term (typo in sz09 ?) - l_rsurf = (-zsoil(1)) * ( exp ( (1.0 - min(1.0,sh2o(1)/parameters%smcmax)) ** 5 ) - 1.0 ) / ( 2.71828 - 1.0 ) - d_rsurf = 2.2e-5 * parameters%smcmax * parameters%smcmax * ( 1.0 - parameters%smcwlt / parameters%smcmax ) ** (2.0+3.0/parameters%bexp) - rsurf = l_rsurf / d_rsurf + if(opt_rsf == 1 .or. opt_rsf == 4) then + ! rsurf based on sakaguchi and zeng, 2009 + ! taking the "residual water content" to be the wilting point, + ! and correcting the exponent on the d term (typo in sz09 ?) + l_rsurf = (-zsoil(1)) * ( exp ( (1.0 - min(1.0,sh2o(1)/parameters%smcmax(1))) ** parameters%rsurf_exp ) - 1.0 ) / ( 2.71828 - 1.0 ) + d_rsurf = 2.2e-5 * parameters%smcmax(1) * parameters%smcmax(1) * ( 1.0 - parameters%smcwlt(1) / parameters%smcmax(1) ) ** (2.0+3.0/parameters%bexp(1)) + rsurf = l_rsurf / d_rsurf + elseif(opt_rsf == 2) then + rsurf = fsno * 1. + (1.-fsno)* exp(8.25-4.225*bevap) !sellers (1992) ! older rsurf computations + elseif(opt_rsf == 3) then + rsurf = fsno * 1. + (1.-fsno)* exp(8.25-6.0 *bevap) !adjusted to decrease rsurf for wet soil + endif - ! older rsurf computations: - ! rsurf = fsno * 1. + (1.-fsno)* exp(8.25-4.225*bevap) !sellers (1992) - ! rsurf = fsno * 1. + (1.-fsno)* exp(8.25-6.0 *bevap) !adjusted to decrease rsurf for wet soil + if(opt_rsf == 4) then ! ad: fsno weighted; snow rsurf set in mptable v3.8 + rsurf = 1. / (fsno * (1./parameters%rsurf_snow) + (1.-fsno) * (1./max(rsurf, 0.001))) + endif if(sh2o(1) < 0.01 .and. snowh == 0.) rsurf = 1.e6 - psi = -parameters%psisat*(max(0.01,sh2o(1))/parameters%smcmax)**(-parameters%bexp) + psi = -parameters%psisat(1)*(max(0.01,sh2o(1))/parameters%smcmax(1))**(-parameters%bexp(1)) rhsur = fsno + (1.-fsno) * exp(psi*grav/(rw*tg)) end if @@ -1897,14 +2063,12 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in tgv = tg cmv = cm chv = ch -! YRQ -! write(*,*) 'cm,ch,tv,tgv, YRQ', cm,ch,tv,tgv call vege_flux (parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & !in dt ,sav ,sag ,lwdn ,ur , & !in uu ,vv ,sfctmp ,thair ,qair , & !in - eair ,rhoair ,snowh ,vai ,gammav ,gammag , & !in + eair ,rhoair ,snowh ,vai ,gammav ,gammag , & !in fwet ,laisun ,laisha ,cwp ,dzsnso , & !in - zlvl ,zpd ,z0m ,fveg , & !in + zlvl ,zpd ,z0m ,fveg , & !in z0mg ,emv ,emg ,canliq ,fsno, & !in canice ,stc ,df ,rssun ,rssha , & !in rsurf ,latheav ,latheag ,parsun ,parsha ,igs , & !in @@ -1934,7 +2098,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in call bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & !in lwdn ,ur ,uu ,vv ,sfctmp , & !in thair ,qair ,eair ,rhoair ,snowh , & !in - dzsnso ,zlvl ,zpdg ,z0mg ,fsno, & !in + dzsnso ,zlvl ,zpdg ,z0mg ,fsno, & !in emg ,stc ,df ,rsurf ,latheag , & !in gammag ,rhsur ,iloc ,jloc ,q2 ,pahb , & !in #ifdef CCPP @@ -2096,35 +2260,35 @@ subroutine thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , integer , intent(in) :: nsnow !maximum no. of snow layers integer , intent(in) :: isnow !actual no. of snow layers integer , intent(in) :: ist !surface type - real , intent(in) :: dt !time step [s] - real, dimension(-nsnow+1: 0), intent(in) :: snice !snow ice mass (kg/m2) - real, dimension(-nsnow+1: 0), intent(in) :: snliq !snow liq mass (kg/m2) - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thickness of snow/soil layers [m] - real, dimension( 1:nsoil), intent(in) :: smc !soil moisture (ice + liq.) [m3/m3] - real, dimension( 1:nsoil), intent(in) :: sh2o !liquid soil moisture [m3/m3] - real , intent(in) :: snowh !snow height [m] - real, intent(in) :: tg !surface temperature (k) - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil/lake temp. (k) - real, intent(in) :: ur !wind speed at zlvl (m/s) - real, intent(in) :: lat !latitude (radians) - real, intent(in) :: z0m !roughness length (m) - real, intent(in) :: zlvl !reference height (m) + real (kind=kind_phys) , intent(in) :: dt !time step [s] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snice !snow ice mass (kg/m2) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snliq !snow liq mass (kg/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thickness of snow/soil layers [m] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: smc !soil moisture (ice + liq.) [m3/m3] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: sh2o !liquid soil moisture [m3/m3] + real (kind=kind_phys) , intent(in) :: snowh !snow height [m] + real (kind=kind_phys), intent(in) :: tg !surface temperature (k) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil/lake temp. (k) + real (kind=kind_phys), intent(in) :: ur !wind speed at zlvl (m/s) + real (kind=kind_phys), intent(in) :: lat !latitude (radians) + real (kind=kind_phys), intent(in) :: z0m !roughness length (m) + real (kind=kind_phys), intent(in) :: zlvl !reference height (m) integer , intent(in) :: vegtyp !vegtyp type ! outputs - real, dimension(-nsnow+1:nsoil), intent(out) :: df !thermal conductivity [w/m/k] - real, dimension(-nsnow+1:nsoil), intent(out) :: hcpct !heat capacity [j/m3/k] - real, dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume of ice [m3/m3] - real, dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume of liquid water [m3/m3] - real, dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] - real, dimension(-nsnow+1:nsoil), intent(out) :: fact !computing energy for phase change + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: df !thermal conductivity [w/m/k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: hcpct !heat capacity [j/m3/k] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume of ice [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume of liquid water [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: fact !computing energy for phase change ! -------------------------------------------------------------------------------------------------- ! locals integer :: iz - real, dimension(-nsnow+1: 0) :: cvsno !volumetric specific heat (j/m3/k) - real, dimension(-nsnow+1: 0) :: tksno !snow thermal conductivity (j/m3/k) - real, dimension( 1:nsoil) :: sice !soil ice content + real (kind=kind_phys), dimension(-nsnow+1: 0) :: cvsno !volumetric specific heat (j/m3/k) + real (kind=kind_phys), dimension(-nsnow+1: 0) :: tksno !snow thermal conductivity (j/m3/k) + real (kind=kind_phys), dimension( 1:nsoil) :: sice !soil ice content ! -------------------------------------------------------------------------------------------------- ! compute snow thermal conductivity and heat capacity @@ -2141,9 +2305,9 @@ subroutine thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , do iz = 1, nsoil sice(iz) = smc(iz) - sh2o(iz) - hcpct(iz) = sh2o(iz)*cwat + (1.0-parameters%smcmax)*parameters%csoil & - + (parameters%smcmax-smc(iz))*cpair + sice(iz)*cice - call tdfcnd (parameters,df(iz), smc(iz), sh2o(iz)) + hcpct(iz) = sh2o(iz)*cwat + (1.0-parameters%smcmax(iz))*parameters%csoil & + + (parameters%smcmax(iz)-smc(iz))*cpair + sice(iz)*cice + call tdfcnd (parameters,iz,df(iz), smc(iz), sh2o(iz)) end do if ( parameters%urban_flag ) then @@ -2206,22 +2370,22 @@ subroutine csnow (parameters,isnow ,nsnow ,nsoil ,snice ,snliq ,dzsnso integer, intent(in) :: isnow !number of snow layers (-) integer , intent(in) :: nsnow !maximum no. of snow layers integer , intent(in) :: nsoil !number of soil layers - real, dimension(-nsnow+1: 0), intent(in) :: snice !snow ice mass (kg/m2) - real, dimension(-nsnow+1: 0), intent(in) :: snliq !snow liq mass (kg/m2) - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snice !snow ice mass (kg/m2) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snliq !snow liq mass (kg/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] ! outputs - real, dimension(-nsnow+1: 0), intent(out) :: cvsno !volumetric specific heat (j/m3/k) - real, dimension(-nsnow+1: 0), intent(out) :: tksno !thermal conductivity (w/m/k) - real, dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume of ice [m3/m3] - real, dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume of liquid water [m3/m3] - real, dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: cvsno !volumetric specific heat (j/m3/k) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: tksno !thermal conductivity (w/m/k) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume of ice [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume of liquid water [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] ! locals integer :: iz - real, dimension(-nsnow+1: 0) :: bdsnoi !bulk density of snow(kg/m3) + real (kind=kind_phys), dimension(-nsnow+1: 0) :: bdsnoi !bulk density of snow(kg/m3) !--------------------------------------------------------------------------------------------------- ! thermal capacity of snow @@ -2253,7 +2417,7 @@ end subroutine csnow !== begin tdfcnd =================================================================================== !>\ingroup NoahMP_LSM - subroutine tdfcnd (parameters, df, smc, sh2o) + subroutine tdfcnd (parameters, isoil, df, smc, sh2o) ! -------------------------------------------------------------------------------------------------- ! calculate thermal diffusivity and conductivity of the soil. ! peters-lidard approach (peters-lidard et al., 1998) @@ -2263,22 +2427,23 @@ subroutine tdfcnd (parameters, df, smc, sh2o) ! -------------------------------------------------------------------------------------------------- implicit none type (noahmp_parameters), intent(in) :: parameters - real, intent(in) :: smc ! total soil water - real, intent(in) :: sh2o ! liq. soil water - real, intent(out) :: df ! thermal diffusivity + integer, intent(in) :: isoil ! soil layer + real (kind=kind_phys), intent(in) :: smc ! total soil water + real (kind=kind_phys), intent(in) :: sh2o ! liq. soil water + real (kind=kind_phys), intent(out) :: df ! thermal diffusivity ! local variables - real :: ake - real :: gammd - real :: thkdry - real :: thko ! thermal conductivity for other soil components - real :: thkqtz ! thermal conductivity for quartz - real :: thksat ! - real :: thks ! thermal conductivity for the solids - real :: thkw ! water thermal conductivity - real :: satratio - real :: xu - real :: xunfroz + real (kind=kind_phys) :: ake + real (kind=kind_phys) :: gammd + real (kind=kind_phys) :: thkdry + real (kind=kind_phys) :: thko ! thermal conductivity for other soil components + real (kind=kind_phys) :: thkqtz ! thermal conductivity for quartz + real (kind=kind_phys) :: thksat ! + real (kind=kind_phys) :: thks ! thermal conductivity for the solids + real (kind=kind_phys) :: thkw ! water thermal conductivity + real (kind=kind_phys) :: satratio + real (kind=kind_phys) :: xu + real (kind=kind_phys) :: xunfroz ! -------------------------------------------------------------------------------------------------- ! we now get quartz as an input argument (set in routine redprm): ! data quartz /0.82, 0.10, 0.25, 0.60, 0.52, @@ -2307,7 +2472,7 @@ subroutine tdfcnd (parameters, df, smc, sh2o) ! poros = smcmax ! saturation ratio: ! parameters w/(m.k) - satratio = smc / parameters%smcmax + satratio = smc / parameters%smcmax(isoil) thkw = 0.57 ! if (quartz .le. 0.2) thko = 3.0 thko = 2.0 @@ -2316,19 +2481,20 @@ subroutine tdfcnd (parameters, df, smc, sh2o) thkqtz = 7.7 ! unfrozen fraction (from 1., i.e., 100%liquid, to 0. (100% frozen)) - thks = (thkqtz ** parameters%quartz)* (thko ** (1. - parameters%quartz)) + thks = (thkqtz ** parameters%quartz(isoil))* (thko ** (1. - parameters%quartz(isoil))) ! unfrozen volume for saturation (porosity*xunfroz) - xunfroz = sh2o / smc + xunfroz = 1.0 ! prevent divide by zero (suggested by d. mocko) + if(smc > 0.) xunfroz = sh2o / smc ! saturated thermal conductivity - xu = xunfroz * parameters%smcmax + xu = xunfroz * parameters%smcmax(isoil) ! dry density in kg/m3 - thksat = thks ** (1. - parameters%smcmax)* tkice ** (parameters%smcmax - xu)* thkw ** & + thksat = thks ** (1. - parameters%smcmax(isoil))* tkice ** (parameters%smcmax(isoil) - xu)* thkw ** & (xu) ! dry thermal conductivity in w.m-1.k-1 - gammd = (1. - parameters%smcmax)*2700. + gammd = (1. - parameters%smcmax(isoil))*2700. thkdry = (0.135* gammd+ 64.7)/ (2700. - 0.947* gammd) ! frozen @@ -2371,7 +2537,7 @@ subroutine radiation (parameters,vegtyp ,ist ,ice ,nsoil , & !in albold ,tauss , & !inout fsun ,laisun ,laisha ,parsun ,parsha , & !out sav ,sag ,fsr ,fsa ,fsrv , & - fsrg ,bgap ,wgap) !out + fsrg ,albd ,albi ,albsnd ,albsni ,bgap ,wgap) !out ! -------------------------------------------------------------------------------------------------- implicit none ! -------------------------------------------------------------------------------------------------- @@ -2384,67 +2550,69 @@ subroutine radiation (parameters,vegtyp ,ist ,ice ,nsoil , & !in integer, intent(in) :: ice !ice (ice = 1) integer, intent(in) :: nsoil !number of soil layers - real, intent(in) :: dt !time step [s] - real, intent(in) :: qsnow !snowfall (mm/s) - real, intent(in) :: sneqvo !snow mass at last time step(mm) - real, intent(in) :: sneqv !snow mass (mm) - real, intent(in) :: snowh !snow height (mm) - real, intent(in) :: cosz !cosine solar zenith angle (0-1) - real, intent(in) :: tg !ground temperature (k) - real, intent(in) :: tv !vegetation temperature (k) - real, intent(in) :: elai !lai, one-sided, adjusted for burying by snow - real, intent(in) :: esai !sai, one-sided, adjusted for burying by snow - real, intent(in) :: fwet !fraction of canopy that is wet - real, dimension(1:nsoil), intent(in) :: smc !volumetric soil water [m3/m3] - real, dimension(1:2) , intent(in) :: solad !incoming direct solar radiation (w/m2) - real, dimension(1:2) , intent(in) :: solai !incoming diffuse solar radiation (w/m2) - real, intent(in) :: fsno !snow cover fraction (-) - real, intent(in) :: fveg !green vegetation fraction [0.0-1.0] + real (kind=kind_phys), intent(in) :: dt !time step [s] + real (kind=kind_phys), intent(in) :: qsnow !snowfall (mm/s) + real (kind=kind_phys), intent(in) :: sneqvo !snow mass at last time step(mm) + real (kind=kind_phys), intent(in) :: sneqv !snow mass (mm) + real (kind=kind_phys), intent(in) :: snowh !snow height (mm) + real (kind=kind_phys), intent(in) :: cosz !cosine solar zenith angle (0-1) + real (kind=kind_phys), intent(in) :: tg !ground temperature (k) + real (kind=kind_phys), intent(in) :: tv !vegetation temperature (k) + real (kind=kind_phys), intent(in) :: elai !lai, one-sided, adjusted for burying by snow + real (kind=kind_phys), intent(in) :: esai !sai, one-sided, adjusted for burying by snow + real (kind=kind_phys), intent(in) :: fwet !fraction of canopy that is wet + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: smc !volumetric soil water [m3/m3] + real (kind=kind_phys), dimension(1:2) , intent(in) :: solad !incoming direct solar radiation (w/m2) + real (kind=kind_phys), dimension(1:2) , intent(in) :: solai !incoming diffuse solar radiation (w/m2) + real (kind=kind_phys), intent(in) :: fsno !snow cover fraction (-) + real (kind=kind_phys), intent(in) :: fveg !green vegetation fraction [0.0-1.0] ! inout - real, intent(inout) :: albold !snow albedo at last time step (class type) - real, intent(inout) :: tauss !non-dimensional snow age. + real (kind=kind_phys), intent(inout) :: albold !snow albedo at last time step (class type) + real (kind=kind_phys), intent(inout) :: tauss !non-dimensional snow age. ! output - real, intent(out) :: fsun !sunlit fraction of canopy (-) - real, intent(out) :: laisun !sunlit leaf area (-) - real, intent(out) :: laisha !shaded leaf area (-) - real, intent(out) :: parsun !average absorbed par for sunlit leaves (w/m2) - real, intent(out) :: parsha !average absorbed par for shaded leaves (w/m2) - real, intent(out) :: sav !solar radiation absorbed by vegetation (w/m2) - real, intent(out) :: sag !solar radiation absorbed by ground (w/m2) - real, intent(out) :: fsa !total absorbed solar radiation (w/m2) - real, intent(out) :: fsr !total reflected solar radiation (w/m2) + real (kind=kind_phys), intent(out) :: fsun !sunlit fraction of canopy (-) + real (kind=kind_phys), intent(out) :: laisun !sunlit leaf area (-) + real (kind=kind_phys), intent(out) :: laisha !shaded leaf area (-) + real (kind=kind_phys), intent(out) :: parsun !average absorbed par for sunlit leaves (w/m2) + real (kind=kind_phys), intent(out) :: parsha !average absorbed par for shaded leaves (w/m2) + real (kind=kind_phys), intent(out) :: sav !solar radiation absorbed by vegetation (w/m2) + real (kind=kind_phys), intent(out) :: sag !solar radiation absorbed by ground (w/m2) + real (kind=kind_phys), intent(out) :: fsa !total absorbed solar radiation (w/m2) + real (kind=kind_phys), intent(out) :: fsr !total reflected solar radiation (w/m2) !jref:start - real, intent(out) :: fsrv !veg. reflected solar radiation (w/m2) - real, intent(out) :: fsrg !ground reflected solar radiation (w/m2) - real, intent(out) :: bgap - real, intent(out) :: wgap + real (kind=kind_phys), intent(out) :: fsrv !veg. reflected solar radiation (w/m2) + real (kind=kind_phys), intent(out) :: fsrg !ground reflected solar radiation (w/m2) + real (kind=kind_phys), intent(out) :: bgap + real (kind=kind_phys), intent(out) :: wgap + real (kind=kind_phys), dimension(1:2), intent(out) :: albsnd !snow albedo (direct) + real (kind=kind_phys), dimension(1:2), intent(out) :: albsni !snow albedo (diffuse) !jref:end ! local - real :: fage !snow age function (0 - new snow) - real, dimension(1:2) :: albgrd !ground albedo (direct) - real, dimension(1:2) :: albgri !ground albedo (diffuse) - real, dimension(1:2) :: albd !surface albedo (direct) - real, dimension(1:2) :: albi !surface albedo (diffuse) - real, dimension(1:2) :: fabd !flux abs by veg (per unit direct flux) - real, dimension(1:2) :: fabi !flux abs by veg (per unit diffuse flux) - real, dimension(1:2) :: ftdd !down direct flux below veg (per unit dir flux) - real, dimension(1:2) :: ftid !down diffuse flux below veg (per unit dir flux) - real, dimension(1:2) :: ftii !down diffuse flux below veg (per unit dif flux) + real (kind=kind_phys) :: fage !snow age function (0 - new snow) + real (kind=kind_phys), dimension(1:2) :: albgrd !ground albedo (direct) + real (kind=kind_phys), dimension(1:2) :: albgri !ground albedo (diffuse) + real (kind=kind_phys), dimension(1:2) :: albd !surface albedo (direct) + real (kind=kind_phys), dimension(1:2) :: albi !surface albedo (diffuse) + real (kind=kind_phys), dimension(1:2) :: fabd !flux abs by veg (per unit direct flux) + real (kind=kind_phys), dimension(1:2) :: fabi !flux abs by veg (per unit diffuse flux) + real (kind=kind_phys), dimension(1:2) :: ftdd !down direct flux below veg (per unit dir flux) + real (kind=kind_phys), dimension(1:2) :: ftid !down diffuse flux below veg (per unit dir flux) + real (kind=kind_phys), dimension(1:2) :: ftii !down diffuse flux below veg (per unit dif flux) !jref:start - real, dimension(1:2) :: frevi - real, dimension(1:2) :: frevd - real, dimension(1:2) :: fregi - real, dimension(1:2) :: fregd + real (kind=kind_phys), dimension(1:2) :: frevi + real (kind=kind_phys), dimension(1:2) :: frevd + real (kind=kind_phys), dimension(1:2) :: fregi + real (kind=kind_phys), dimension(1:2) :: fregd !jref:end - real :: fsha !shaded fraction of canopy - real :: vai !total lai + stem area index, one sided + real (kind=kind_phys) :: fsha !shaded fraction of canopy + real (kind=kind_phys) :: vai !total lai + stem area index, one sided - real,parameter :: mpe = 1.e-6 + real (kind=kind_phys),parameter :: mpe = 1.e-6 logical veg !true: vegetated for surface temperature calculation ! -------------------------------------------------------------------------------------------------- @@ -2460,7 +2628,7 @@ subroutine radiation (parameters,vegtyp ,ist ,ice ,nsoil , & !in albgrd ,albgri ,albd ,albi ,fabd , & !out fabi ,ftdd ,ftid ,ftii ,fsun , & !) !out frevi ,frevd ,fregd ,fregi ,bgap , & !inout - wgap) + wgap ,albsnd ,albsni ) ! surface radiation @@ -2497,7 +2665,7 @@ subroutine albedo (parameters,vegtyp ,ist ,ice ,nsoil , & !in albgrd ,albgri ,albd ,albi ,fabd , & !out fabi ,ftdd ,ftid ,ftii ,fsun , & !out frevi ,frevd ,fregd ,fregi ,bgap , & !out - wgap) + wgap ,albsnd ,albsni ) ! -------------------------------------------------------------------------------------------------- ! surface albedos. also fluxes (per unit incoming direct and diffuse @@ -2515,67 +2683,67 @@ subroutine albedo (parameters,vegtyp ,ist ,ice ,nsoil , & !in integer, intent(in) :: ist !surface type integer, intent(in) :: ice !ice (ice = 1) - real, intent(in) :: dt !time step [sec] - real, intent(in) :: qsnow !snowfall - real, intent(in) :: cosz !cosine solar zenith angle for next time step - real, intent(in) :: snowh !snow height (mm) - real, intent(in) :: tg !ground temperature (k) - real, intent(in) :: tv !vegetation temperature (k) - real, intent(in) :: elai !lai, one-sided, adjusted for burying by snow - real, intent(in) :: esai !sai, one-sided, adjusted for burying by snow - real, intent(in) :: fsno !fraction of grid covered by snow - real, intent(in) :: fwet !fraction of canopy that is wet - real, intent(in) :: sneqvo !snow mass at last time step(mm) - real, intent(in) :: sneqv !snow mass (mm) - real, intent(in) :: fveg !green vegetation fraction [0.0-1.0] - real, dimension(1:nsoil), intent(in) :: smc !volumetric soil water (m3/m3) + real (kind=kind_phys), intent(in) :: dt !time step [sec] + real (kind=kind_phys), intent(in) :: qsnow !snowfall + real (kind=kind_phys), intent(in) :: cosz !cosine solar zenith angle for next time step + real (kind=kind_phys), intent(in) :: snowh !snow height (mm) + real (kind=kind_phys), intent(in) :: tg !ground temperature (k) + real (kind=kind_phys), intent(in) :: tv !vegetation temperature (k) + real (kind=kind_phys), intent(in) :: elai !lai, one-sided, adjusted for burying by snow + real (kind=kind_phys), intent(in) :: esai !sai, one-sided, adjusted for burying by snow + real (kind=kind_phys), intent(in) :: fsno !fraction of grid covered by snow + real (kind=kind_phys), intent(in) :: fwet !fraction of canopy that is wet + real (kind=kind_phys), intent(in) :: sneqvo !snow mass at last time step(mm) + real (kind=kind_phys), intent(in) :: sneqv !snow mass (mm) + real (kind=kind_phys), intent(in) :: fveg !green vegetation fraction [0.0-1.0] + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: smc !volumetric soil water (m3/m3) ! inout - real, intent(inout) :: albold !snow albedo at last time step (class type) - real, intent(inout) :: tauss !non-dimensional snow age + real (kind=kind_phys), intent(inout) :: albold !snow albedo at last time step (class type) + real (kind=kind_phys), intent(inout) :: tauss !non-dimensional snow age ! output - real, dimension(1: 2), intent(out) :: albgrd !ground albedo (direct) - real, dimension(1: 2), intent(out) :: albgri !ground albedo (diffuse) - real, dimension(1: 2), intent(out) :: albd !surface albedo (direct) - real, dimension(1: 2), intent(out) :: albi !surface albedo (diffuse) - real, dimension(1: 2), intent(out) :: fabd !flux abs by veg (per unit direct flux) - real, dimension(1: 2), intent(out) :: fabi !flux abs by veg (per unit diffuse flux) - real, dimension(1: 2), intent(out) :: ftdd !down direct flux below veg (per unit dir flux) - real, dimension(1: 2), intent(out) :: ftid !down diffuse flux below veg (per unit dir flux) - real, dimension(1: 2), intent(out) :: ftii !down diffuse flux below veg (per unit dif flux) - real, intent(out) :: fsun !sunlit fraction of canopy (-) + real (kind=kind_phys), dimension(1: 2), intent(out) :: albgrd !ground albedo (direct) + real (kind=kind_phys), dimension(1: 2), intent(out) :: albgri !ground albedo (diffuse) + real (kind=kind_phys), dimension(1: 2), intent(out) :: albd !surface albedo (direct) + real (kind=kind_phys), dimension(1: 2), intent(out) :: albi !surface albedo (diffuse) + real (kind=kind_phys), dimension(1: 2), intent(out) :: fabd !flux abs by veg (per unit direct flux) + real (kind=kind_phys), dimension(1: 2), intent(out) :: fabi !flux abs by veg (per unit diffuse flux) + real (kind=kind_phys), dimension(1: 2), intent(out) :: ftdd !down direct flux below veg (per unit dir flux) + real (kind=kind_phys), dimension(1: 2), intent(out) :: ftid !down diffuse flux below veg (per unit dir flux) + real (kind=kind_phys), dimension(1: 2), intent(out) :: ftii !down diffuse flux below veg (per unit dif flux) + real (kind=kind_phys), intent(out) :: fsun !sunlit fraction of canopy (-) !jref:start - real, dimension(1: 2), intent(out) :: frevd - real, dimension(1: 2), intent(out) :: frevi - real, dimension(1: 2), intent(out) :: fregd - real, dimension(1: 2), intent(out) :: fregi - real, intent(out) :: bgap - real, intent(out) :: wgap + real (kind=kind_phys), dimension(1: 2), intent(out) :: frevd + real (kind=kind_phys), dimension(1: 2), intent(out) :: frevi + real (kind=kind_phys), dimension(1: 2), intent(out) :: fregd + real (kind=kind_phys), dimension(1: 2), intent(out) :: fregi + real (kind=kind_phys), intent(out) :: bgap + real (kind=kind_phys), intent(out) :: wgap !jref:end ! ------------------------------------------------------------------------ ! ------------------------ local variables ------------------------------- ! local - real :: fage !snow age function - real :: alb + real (kind=kind_phys) :: fage !snow age function + real (kind=kind_phys) :: alb integer :: ib !indices integer :: nband !number of solar radiation wave bands integer :: ic !direct beam: ic=0; diffuse: ic=1 - real :: wl !fraction of lai+sai that is lai - real :: ws !fraction of lai+sai that is sai - real :: mpe !prevents overflow for division by zero + real (kind=kind_phys) :: wl !fraction of lai+sai that is lai + real (kind=kind_phys) :: ws !fraction of lai+sai that is sai + real (kind=kind_phys) :: mpe !prevents overflow for division by zero - real, dimension(1:2) :: rho !leaf/stem reflectance weighted by fraction lai and sai - real, dimension(1:2) :: tau !leaf/stem transmittance weighted by fraction lai and sai - real, dimension(1:2) :: ftdi !down direct flux below veg per unit dif flux = 0 - real, dimension(1:2) :: albsnd !snow albedo (direct) - real, dimension(1:2) :: albsni !snow albedo (diffuse) + real (kind=kind_phys), dimension(1:2) :: rho !leaf/stem reflectance weighted by fraction lai and sai + real (kind=kind_phys), dimension(1:2) :: tau !leaf/stem transmittance weighted by fraction lai and sai + real (kind=kind_phys), dimension(1:2) :: ftdi !down direct flux below veg per unit dif flux = 0 + real (kind=kind_phys), dimension(1:2) :: albsnd !snow albedo (direct) + real (kind=kind_phys), dimension(1:2) :: albsni !snow albedo (diffuse) - real :: vai !elai+esai - real :: gdir !average projected leaf/stem area in solar direction - real :: ext !optical depth direct beam per unit leaf + stem area + real (kind=kind_phys) :: vai !elai+esai + real (kind=kind_phys) :: gdir !average projected leaf/stem area in solar direction + real (kind=kind_phys) :: ext !optical depth direct beam per unit leaf + stem area ! -------------------------------------------------------------------------------------------------- @@ -2591,6 +2759,8 @@ subroutine albedo (parameters,vegtyp ,ist ,ice ,nsoil , & !in albi(ib) = 0. albgrd(ib) = 0. albgri(ib) = 0. + albsnd(ib) = 0. + albsni(ib) = 0. fabd(ib) = 0. fabi(ib) = 0. ftdd(ib) = 0. @@ -2688,55 +2858,55 @@ subroutine surrad (parameters,mpe ,fsun ,fsha ,elai ,vai , & !i type (noahmp_parameters), intent(in) :: parameters integer, intent(in) :: iloc integer, intent(in) :: jloc - real, intent(in) :: mpe !prevents underflow errors if division by zero - - real, intent(in) :: fsun !sunlit fraction of canopy - real, intent(in) :: fsha !shaded fraction of canopy - real, intent(in) :: elai !leaf area, one-sided - real, intent(in) :: vai !leaf + stem area, one-sided - real, intent(in) :: laisun !sunlit leaf area index, one-sided - real, intent(in) :: laisha !shaded leaf area index, one-sided - - real, dimension(1:2), intent(in) :: solad !incoming direct solar radiation (w/m2) - real, dimension(1:2), intent(in) :: solai !incoming diffuse solar radiation (w/m2) - real, dimension(1:2), intent(in) :: fabd !flux abs by veg (per unit incoming direct flux) - real, dimension(1:2), intent(in) :: fabi !flux abs by veg (per unit incoming diffuse flux) - real, dimension(1:2), intent(in) :: ftdd !down dir flux below veg (per incoming dir flux) - real, dimension(1:2), intent(in) :: ftid !down dif flux below veg (per incoming dir flux) - real, dimension(1:2), intent(in) :: ftii !down dif flux below veg (per incoming dif flux) - real, dimension(1:2), intent(in) :: albgrd !ground albedo (direct) - real, dimension(1:2), intent(in) :: albgri !ground albedo (diffuse) - real, dimension(1:2), intent(in) :: albd !overall surface albedo (direct) - real, dimension(1:2), intent(in) :: albi !overall surface albedo (diffuse) - - real, dimension(1:2), intent(in) :: frevd !overall surface albedo veg (direct) - real, dimension(1:2), intent(in) :: frevi !overall surface albedo veg (diffuse) - real, dimension(1:2), intent(in) :: fregd !overall surface albedo grd (direct) - real, dimension(1:2), intent(in) :: fregi !overall surface albedo grd (diffuse) + real (kind=kind_phys), intent(in) :: mpe !prevents underflow errors if division by zero + + real (kind=kind_phys), intent(in) :: fsun !sunlit fraction of canopy + real (kind=kind_phys), intent(in) :: fsha !shaded fraction of canopy + real (kind=kind_phys), intent(in) :: elai !leaf area, one-sided + real (kind=kind_phys), intent(in) :: vai !leaf + stem area, one-sided + real (kind=kind_phys), intent(in) :: laisun !sunlit leaf area index, one-sided + real (kind=kind_phys), intent(in) :: laisha !shaded leaf area index, one-sided + + real (kind=kind_phys), dimension(1:2), intent(in) :: solad !incoming direct solar radiation (w/m2) + real (kind=kind_phys), dimension(1:2), intent(in) :: solai !incoming diffuse solar radiation (w/m2) + real (kind=kind_phys), dimension(1:2), intent(in) :: fabd !flux abs by veg (per unit incoming direct flux) + real (kind=kind_phys), dimension(1:2), intent(in) :: fabi !flux abs by veg (per unit incoming diffuse flux) + real (kind=kind_phys), dimension(1:2), intent(in) :: ftdd !down dir flux below veg (per incoming dir flux) + real (kind=kind_phys), dimension(1:2), intent(in) :: ftid !down dif flux below veg (per incoming dir flux) + real (kind=kind_phys), dimension(1:2), intent(in) :: ftii !down dif flux below veg (per incoming dif flux) + real (kind=kind_phys), dimension(1:2), intent(in) :: albgrd !ground albedo (direct) + real (kind=kind_phys), dimension(1:2), intent(in) :: albgri !ground albedo (diffuse) + real (kind=kind_phys), dimension(1:2), intent(in) :: albd !overall surface albedo (direct) + real (kind=kind_phys), dimension(1:2), intent(in) :: albi !overall surface albedo (diffuse) + + real (kind=kind_phys), dimension(1:2), intent(in) :: frevd !overall surface albedo veg (direct) + real (kind=kind_phys), dimension(1:2), intent(in) :: frevi !overall surface albedo veg (diffuse) + real (kind=kind_phys), dimension(1:2), intent(in) :: fregd !overall surface albedo grd (direct) + real (kind=kind_phys), dimension(1:2), intent(in) :: fregi !overall surface albedo grd (diffuse) ! output - real, intent(out) :: parsun !average absorbed par for sunlit leaves (w/m2) - real, intent(out) :: parsha !average absorbed par for shaded leaves (w/m2) - real, intent(out) :: sav !solar radiation absorbed by vegetation (w/m2) - real, intent(out) :: sag !solar radiation absorbed by ground (w/m2) - real, intent(out) :: fsa !total absorbed solar radiation (w/m2) - real, intent(out) :: fsr !total reflected solar radiation (w/m2) - real, intent(out) :: fsrv !reflected solar radiation by vegetation - real, intent(out) :: fsrg !reflected solar radiation by ground + real (kind=kind_phys), intent(out) :: parsun !average absorbed par for sunlit leaves (w/m2) + real (kind=kind_phys), intent(out) :: parsha !average absorbed par for shaded leaves (w/m2) + real (kind=kind_phys), intent(out) :: sav !solar radiation absorbed by vegetation (w/m2) + real (kind=kind_phys), intent(out) :: sag !solar radiation absorbed by ground (w/m2) + real (kind=kind_phys), intent(out) :: fsa !total absorbed solar radiation (w/m2) + real (kind=kind_phys), intent(out) :: fsr !total reflected solar radiation (w/m2) + real (kind=kind_phys), intent(out) :: fsrv !reflected solar radiation by vegetation + real (kind=kind_phys), intent(out) :: fsrg !reflected solar radiation by ground ! ------------------------ local variables ---------------------------------------------------- integer :: ib !waveband number (1=vis, 2=nir) integer :: nband !number of solar radiation waveband classes - real :: abs !absorbed solar radiation (w/m2) - real :: rnir !reflected solar radiation [nir] (w/m2) - real :: rvis !reflected solar radiation [vis] (w/m2) - real :: laifra !leaf area fraction of canopy - real :: trd !transmitted solar radiation: direct (w/m2) - real :: tri !transmitted solar radiation: diffuse (w/m2) - real, dimension(1:2) :: cad !direct beam absorbed by canopy (w/m2) - real, dimension(1:2) :: cai !diffuse radiation absorbed by canopy (w/m2) + real (kind=kind_phys) :: abs !absorbed solar radiation (w/m2) + real (kind=kind_phys) :: rnir !reflected solar radiation [nir] (w/m2) + real (kind=kind_phys) :: rvis !reflected solar radiation [vis] (w/m2) + real (kind=kind_phys) :: laifra !leaf area fraction of canopy + real (kind=kind_phys) :: trd !transmitted solar radiation: direct (w/m2) + real (kind=kind_phys) :: tri !transmitted solar radiation: diffuse (w/m2) + real (kind=kind_phys), dimension(1:2) :: cad !direct beam absorbed by canopy (w/m2) + real (kind=kind_phys), dimension(1:2) :: cai !diffuse radiation absorbed by canopy (w/m2) ! --------------------------------------------------------------------------------------------- nband = 2 @@ -2805,39 +2975,37 @@ subroutine snow_age (parameters,dt,tg,sneqvo,sneqv,tauss,fage) ! ------------------------ input/output variables -------------------------------------------------- !input type (noahmp_parameters), intent(in) :: parameters - real, intent(in) :: dt !main time step (s) - real, intent(in) :: tg !ground temperature (k) - real, intent(in) :: sneqvo !snow mass at last time step(mm) - real, intent(in) :: sneqv !snow water per unit ground area (mm) + real (kind=kind_phys), intent(in) :: dt !main time step (s) + real (kind=kind_phys), intent(in) :: tg !ground temperature (k) + real (kind=kind_phys), intent(in) :: sneqvo !snow mass at last time step(mm) + real (kind=kind_phys), intent(in) :: sneqv !snow water per unit ground area (mm) !output - real, intent(out) :: fage !snow age + real (kind=kind_phys), intent(out) :: fage !snow age !input/output - real, intent(inout) :: tauss !non-dimensional snow age + real (kind=kind_phys), intent(inout) :: tauss !non-dimensional snow age !local - real :: tage !total aging effects - real :: age1 !effects of grain growth due to vapor diffusion - real :: age2 !effects of grain growth at freezing of melt water - real :: age3 !effects of soot - real :: dela !temporary variable - real :: sge !temporary variable - real :: dels !temporary variable - real :: dela0 !temporary variable - real :: arg !temporary variable + real (kind=kind_phys) :: tage !total aging effects + real (kind=kind_phys) :: age1 !effects of grain growth due to vapor diffusion + real (kind=kind_phys) :: age2 !effects of grain growth at freezing of melt water + real (kind=kind_phys) :: age3 !effects of soot + real (kind=kind_phys) :: dela !temporary variable + real (kind=kind_phys) :: sge !temporary variable + real (kind=kind_phys) :: dels !temporary variable + real (kind=kind_phys) :: dela0 !temporary variable + real (kind=kind_phys) :: arg !temporary variable ! see yang et al. (1997) j.of climate for detail. !--------------------------------------------------------------------------------------------------- if(sneqv.le.0.0) then tauss = 0. - else if (sneqv.gt.800.) then - tauss = 0. else - dela0 = 1.e-6*dt - arg = 5.e3*(1./tfrz-1./tg) + dela0 = dt/parameters%tau0 + arg = parameters%grain_growth*(1./tfrz-1./tg) age1 = exp(arg) - age2 = exp(amin1(0.,10.*arg)) - age3 = 0.3 + age2 = exp(amin1(0.,parameters%extra_growth*arg)) + age3 = parameters%dirt_soot tage = age1+age2+age3 dela = dela0*tage dels = amax1(0.0,sneqv-sneqvo) / parameters%swemx @@ -2861,28 +3029,28 @@ subroutine snowalb_bats (parameters,nband,fsno,cosz,fage,albsnd,albsni) type (noahmp_parameters), intent(in) :: parameters integer,intent(in) :: nband !number of waveband classes - real,intent(in) :: cosz !cosine solar zenith angle - real,intent(in) :: fsno !snow cover fraction (-) - real,intent(in) :: fage !snow age correction + real (kind=kind_phys),intent(in) :: cosz !cosine solar zenith angle + real (kind=kind_phys),intent(in) :: fsno !snow cover fraction (-) + real (kind=kind_phys),intent(in) :: fage !snow age correction ! output - real, dimension(1:2),intent(out) :: albsnd !snow albedo for direct(1=vis, 2=nir) - real, dimension(1:2),intent(out) :: albsni !snow albedo for diffuse + real (kind=kind_phys), dimension(1:2),intent(out) :: albsnd !snow albedo for direct(1=vis, 2=nir) + real (kind=kind_phys), dimension(1:2),intent(out) :: albsni !snow albedo for diffuse ! --------------------------------------------------------------------------------------------- ! ------------------------ local variables ---------------------------------------------------- integer :: ib !waveband class - real :: fzen !zenith angle correction - real :: cf1 !temperary variable - real :: sl2 !2.*sl - real :: sl1 !1/sl - real :: sl !adjustable parameter - real, parameter :: c1 = 0.2 !default in bats - real, parameter :: c2 = 0.5 !default in bats -! real, parameter :: c1 = 0.2 * 2. ! double the default to match sleepers river's -! real, parameter :: c2 = 0.5 * 2. ! snow surface albedo (double aging effects) + real (kind=kind_phys) :: fzen !zenith angle correction + real (kind=kind_phys) :: cf1 !temperary variable + real (kind=kind_phys) :: sl2 !2.*sl + real (kind=kind_phys) :: sl1 !1/sl + real (kind=kind_phys) :: sl !adjustable parameter +! real (kind=kind_phys), parameter :: c1 = 0.2 !default in bats +! real (kind=kind_phys), parameter :: c2 = 0.5 !default in bats +! real (kind=kind_phys), parameter :: c1 = 0.2 * 2. ! double the default to match sleepers river's +! real (kind=kind_phys), parameter :: c2 = 0.5 * 2. ! snow surface albedo (double aging effects) ! --------------------------------------------------------------------------------------------- ! zero albedos for all points @@ -2891,17 +3059,17 @@ subroutine snowalb_bats (parameters,nband,fsno,cosz,fage,albsnd,albsni) ! when cosz > 0 - sl=2.0 + sl=parameters%bats_cosz sl1=1./sl sl2=2.*sl cf1=((1.+sl1)/(1.+sl2*cosz)-sl1) fzen=amax1(cf1,0.) - albsni(1)=0.95*(1.-c1*fage) - albsni(2)=0.65*(1.-c2*fage) + albsni(1)=parameters%bats_vis_new*(1.-parameters%bats_vis_age*fage) + albsni(2)=parameters%bats_nir_new*(1.-parameters%bats_nir_age*fage) - albsnd(1)=albsni(1)+0.4*fzen*(1.-albsni(1)) ! vis direct - albsnd(2)=albsni(2)+0.4*fzen*(1.-albsni(2)) ! nir direct + albsnd(1)=albsni(1)+parameters%bats_vis_dir*fzen*(1.-albsni(1)) ! vis direct + albsnd(2)=albsni(2)+parameters%bats_vis_dir*fzen*(1.-albsni(2)) ! nir direct end subroutine snowalb_bats @@ -2919,17 +3087,17 @@ subroutine snowalb_class (parameters,nband,qsnow,dt,alb,albold,albsnd,albsni,ilo integer,intent(in) :: jloc !grid index integer,intent(in) :: nband !number of waveband classes - real,intent(in) :: qsnow !snowfall (mm/s) - real,intent(in) :: dt !time step (sec) - real,intent(in) :: albold !snow albedo at last time step + real (kind=kind_phys),intent(in) :: qsnow !snowfall (mm/s) + real (kind=kind_phys),intent(in) :: dt !time step (sec) + real (kind=kind_phys),intent(in) :: albold !snow albedo at last time step ! in & out - real, intent(inout) :: alb ! + real (kind=kind_phys), intent(inout) :: alb ! ! output - real, dimension(1:2),intent(out) :: albsnd !snow albedo for direct(1=vis, 2=nir) - real, dimension(1:2),intent(out) :: albsni !snow albedo for diffuse + real (kind=kind_phys), dimension(1:2),intent(out) :: albsnd !snow albedo for direct(1=vis, 2=nir) + real (kind=kind_phys), dimension(1:2),intent(out) :: albsni !snow albedo for diffuse ! --------------------------------------------------------------------------------------------- ! ------------------------ local variables ---------------------------------------------------- @@ -2978,24 +3146,24 @@ subroutine groundalb (parameters,nsoil ,nband ,ice ,ist , & !in integer, intent(in) :: nband !number of solar radiation waveband classes integer, intent(in) :: ice !value of ist for land ice integer, intent(in) :: ist !surface type - real, intent(in) :: fsno !fraction of surface covered with snow (-) - real, intent(in) :: tg !ground temperature (k) - real, intent(in) :: cosz !cosine solar zenith angle (0-1) - real, dimension(1:nsoil), intent(in) :: smc !volumetric soil water content (m3/m3) - real, dimension(1: 2), intent(in) :: albsnd !direct beam snow albedo (vis, nir) - real, dimension(1: 2), intent(in) :: albsni !diffuse snow albedo (vis, nir) + real (kind=kind_phys), intent(in) :: fsno !fraction of surface covered with snow (-) + real (kind=kind_phys), intent(in) :: tg !ground temperature (k) + real (kind=kind_phys), intent(in) :: cosz !cosine solar zenith angle (0-1) + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: smc !volumetric soil water content (m3/m3) + real (kind=kind_phys), dimension(1: 2), intent(in) :: albsnd !direct beam snow albedo (vis, nir) + real (kind=kind_phys), dimension(1: 2), intent(in) :: albsni !diffuse snow albedo (vis, nir) !output - real, dimension(1: 2), intent(out) :: albgrd !ground albedo (direct beam: vis, nir) - real, dimension(1: 2), intent(out) :: albgri !ground albedo (diffuse: vis, nir) + real (kind=kind_phys), dimension(1: 2), intent(out) :: albgrd !ground albedo (direct beam: vis, nir) + real (kind=kind_phys), dimension(1: 2), intent(out) :: albgri !ground albedo (diffuse: vis, nir) !local integer :: ib !waveband number (1=vis, 2=nir) - real :: inc !soil water correction factor for soil albedo - real :: albsod !soil albedo (direct) - real :: albsoi !soil albedo (diffuse) + real (kind=kind_phys) :: inc !soil water correction factor for soil albedo + real (kind=kind_phys) :: albsod !soil albedo (direct) + real (kind=kind_phys) :: albsoi !soil albedo (diffuse) ! -------------------------------------------------------------------------------------------------- do ib = 1, nband @@ -3052,68 +3220,68 @@ subroutine twostream (parameters,ib ,ic ,vegtyp ,cosz ,vai , & ! integer, intent(in) :: ic !0=unit incoming direct; 1=unit incoming diffuse integer, intent(in) :: vegtyp !vegetation type - real, intent(in) :: cosz !cosine of direct zenith angle (0-1) - real, intent(in) :: vai !one-sided leaf+stem area index (m2/m2) - real, intent(in) :: fwet !fraction of lai, sai that is wetted (-) - real, intent(in) :: t !surface temperature (k) + real (kind=kind_phys), intent(in) :: cosz !cosine of direct zenith angle (0-1) + real (kind=kind_phys), intent(in) :: vai !one-sided leaf+stem area index (m2/m2) + real (kind=kind_phys), intent(in) :: fwet !fraction of lai, sai that is wetted (-) + real (kind=kind_phys), intent(in) :: t !surface temperature (k) - real, dimension(1:2), intent(in) :: albgrd !direct albedo of underlying surface (-) - real, dimension(1:2), intent(in) :: albgri !diffuse albedo of underlying surface (-) - real, dimension(1:2), intent(in) :: rho !leaf+stem reflectance - real, dimension(1:2), intent(in) :: tau !leaf+stem transmittance - real, intent(in) :: fveg !green vegetation fraction [0.0-1.0] + real (kind=kind_phys), dimension(1:2), intent(in) :: albgrd !direct albedo of underlying surface (-) + real (kind=kind_phys), dimension(1:2), intent(in) :: albgri !diffuse albedo of underlying surface (-) + real (kind=kind_phys), dimension(1:2), intent(in) :: rho !leaf+stem reflectance + real (kind=kind_phys), dimension(1:2), intent(in) :: tau !leaf+stem transmittance + real (kind=kind_phys), intent(in) :: fveg !green vegetation fraction [0.0-1.0] ! output - real, dimension(1:2), intent(out) :: fab !flux abs by veg layer (per unit incoming flux) - real, dimension(1:2), intent(out) :: fre !flux refl above veg layer (per unit incoming flux) - real, dimension(1:2), intent(out) :: ftd !down dir flux below veg layer (per unit in flux) - real, dimension(1:2), intent(out) :: fti !down dif flux below veg layer (per unit in flux) - real, intent(out) :: gdir !projected leaf+stem area in solar direction - real, dimension(1:2), intent(out) :: frev !flux reflected by veg layer (per unit incoming flux) - real, dimension(1:2), intent(out) :: freg !flux reflected by ground (per unit incoming flux) + real (kind=kind_phys), dimension(1:2), intent(out) :: fab !flux abs by veg layer (per unit incoming flux) + real (kind=kind_phys), dimension(1:2), intent(out) :: fre !flux refl above veg layer (per unit incoming flux) + real (kind=kind_phys), dimension(1:2), intent(out) :: ftd !down dir flux below veg layer (per unit in flux) + real (kind=kind_phys), dimension(1:2), intent(out) :: fti !down dif flux below veg layer (per unit in flux) + real (kind=kind_phys), intent(out) :: gdir !projected leaf+stem area in solar direction + real (kind=kind_phys), dimension(1:2), intent(out) :: frev !flux reflected by veg layer (per unit incoming flux) + real (kind=kind_phys), dimension(1:2), intent(out) :: freg !flux reflected by ground (per unit incoming flux) ! local - real :: omega !fraction of intercepted radiation that is scattered - real :: omegal !omega for leaves - real :: betai !upscatter parameter for diffuse radiation - real :: betail !betai for leaves - real :: betad !upscatter parameter for direct beam radiation - real :: betadl !betad for leaves - real :: ext !optical depth of direct beam per unit leaf area - real :: avmu !average diffuse optical depth - - real :: coszi !0.001 <= cosz <= 1.000 - real :: asu !single scattering albedo - real :: chil ! -0.4 <= xl <= 0.6 - - real :: tmp0,tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,tmp7,tmp8,tmp9 - real :: p1,p2,p3,p4,s1,s2,u1,u2,u3 - real :: b,c,d,d1,d2,f,h,h1,h2,h3,h4,h5,h6,h7,h8,h9,h10 - real :: phi1,phi2,sigma - real :: ftds,ftis,fres - real :: denfveg - real :: vai_spread + real (kind=kind_phys) :: omega !fraction of intercepted radiation that is scattered + real (kind=kind_phys) :: omegal !omega for leaves + real (kind=kind_phys) :: betai !upscatter parameter for diffuse radiation + real (kind=kind_phys) :: betail !betai for leaves + real (kind=kind_phys) :: betad !upscatter parameter for direct beam radiation + real (kind=kind_phys) :: betadl !betad for leaves + real (kind=kind_phys) :: ext !optical depth of direct beam per unit leaf area + real (kind=kind_phys) :: avmu !average diffuse optical depth + + real (kind=kind_phys) :: coszi !0.001 <= cosz <= 1.000 + real (kind=kind_phys) :: asu !single scattering albedo + real (kind=kind_phys) :: chil ! -0.4 <= xl <= 0.6 + + real (kind=kind_phys) :: tmp0,tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,tmp7,tmp8,tmp9 + real (kind=kind_phys) :: p1,p2,p3,p4,s1,s2,u1,u2,u3 + real (kind=kind_phys) :: b,c,d,d1,d2,f,h,h1,h2,h3,h4,h5,h6,h7,h8,h9,h10 + real (kind=kind_phys) :: phi1,phi2,sigma + real (kind=kind_phys) :: ftds,ftis,fres + real (kind=kind_phys) :: denfveg + real (kind=kind_phys) :: vai_spread !jref:start - real :: freveg,frebar,ftdveg,ftiveg,ftdbar,ftibar - real :: thetaz + real (kind=kind_phys) :: freveg,frebar,ftdveg,ftiveg,ftdbar,ftibar + real (kind=kind_phys) :: thetaz !jref:end ! variables for the modified two-stream scheme ! niu and yang (2004), jgr - real, parameter :: pai = 3.14159265 - real :: hd !crown depth (m) - real :: bb !vertical crown radius (m) - real :: thetap !angle conversion from sza - real :: fa !foliage volume density (m-1) - real :: newvai !effective lsai (-) + real (kind=kind_phys), parameter :: pai = 3.14159265 + real (kind=kind_phys) :: hd !crown depth (m) + real (kind=kind_phys) :: bb !vertical crown radius (m) + real (kind=kind_phys) :: thetap !angle conversion from sza + real (kind=kind_phys) :: fa !foliage volume density (m-1) + real (kind=kind_phys) :: newvai !effective lsai (-) - real,intent(inout) :: bgap !between canopy gap fraction for beam (-) - real,intent(inout) :: wgap !within canopy gap fraction for beam (-) + real (kind=kind_phys),intent(inout) :: bgap !between canopy gap fraction for beam (-) + real (kind=kind_phys),intent(inout) :: wgap !within canopy gap fraction for beam (-) - real :: kopen !gap fraction for diffue light (-) - real :: gap !total gap fraction for beam ( <=1-shafac ) + real (kind=kind_phys) :: kopen !gap fraction for diffue light (-) + real (kind=kind_phys) :: gap !total gap fraction for beam ( <=1-shafac ) ! ----------------------------------------------------------------- ! compute within and between gaps @@ -3283,7 +3451,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & uu ,vv ,sfctmp ,thair ,qair , & !in eair ,rhoair ,snowh ,vai ,gammav ,gammag, & !in fwet ,laisun ,laisha ,cwp ,dzsnso , & !in - zlvl ,zpd ,z0m ,fveg , & !in + zlvl ,zpd ,z0m ,fveg , & !in z0mg ,emv ,emg ,canliq ,fsno, & !in canice ,stc ,df ,rssun ,rssha , & !in rsurf ,latheav ,latheag ,parsun ,parsha ,igs , & !in @@ -3320,74 +3488,73 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & integer, intent(in) :: nsoil !number of soil layers integer, intent(in) :: isnow !actual no. of snow layers integer, intent(in) :: vegtyp !vegetation physiology type - real, intent(in) :: fveg !greeness vegetation fraction (-) - real, intent(in) :: sav !solar rad absorbed by veg (w/m2) - real, intent(in) :: sag !solar rad absorbed by ground (w/m2) - real, intent(in) :: lwdn !atmospheric longwave radiation (w/m2) - real, intent(in) :: ur !wind speed at height zlvl (m/s) - real, intent(in) :: uu !wind speed in eastward dir (m/s) - real, intent(in) :: vv !wind speed in northward dir (m/s) - real, intent(in) :: sfctmp !air temperature at reference height (k) - real, intent(in) :: thair !potential temp at reference height (k) - real, intent(in) :: eair !vapor pressure air at zlvl (pa) - real, intent(in) :: qair !specific humidity at zlvl (kg/kg) - real, intent(in) :: rhoair !density air (kg/m**3) - real, intent(in) :: dt !time step (s) - real, intent(in) :: fsno !snow fraction - - real, intent(in) :: snowh !actual snow depth [m] - real, intent(in) :: fwet !wetted fraction of canopy - real, intent(in) :: cwp !canopy wind parameter - - real, intent(in) :: vai !total leaf area index + stem area index - real, intent(in) :: laisun !sunlit leaf area index, one-sided (m2/m2) - real, intent(in) :: laisha !shaded leaf area index, one-sided (m2/m2) - real, intent(in) :: zlvl !reference height (m) - - real, intent(in) :: zpd !zero plane displacement (m) - real, intent(in) :: z0m !roughness length, momentum (m) - real, intent(in) :: z0mg !roughness length, momentum, ground (m) - real, intent(in) :: emv !vegetation emissivity - real, intent(in) :: emg !ground emissivity - - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !soil/snow temperature (k) - real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity of snow/soil (w/m/k) - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thinkness of snow/soil layers (m) - real, intent(in) :: canliq !intercepted liquid water (mm) - real, intent(in) :: canice !intercepted ice mass (mm) - real, intent(in) :: rsurf !ground surface resistance (s/m) -! real, intent(in) :: gamma !psychrometric constant (pa/k) -! real, intent(in) :: lathea !latent heat of vaporization/subli (j/kg) - real, intent(in) :: gammav !psychrometric constant (pa/k) - real, intent(in) :: latheav !latent heat of vaporization/subli (j/kg) - real, intent(in) :: gammag !psychrometric constant (pa/k) - real, intent(in) :: latheag !latent heat of vaporization/subli (j/kg) - real, intent(in) :: parsun !par absorbed per unit sunlit lai (w/m2) - real, intent(in) :: parsha !par absorbed per unit shaded lai (w/m2) - real, intent(in) :: foln !foliage nitrogen (%) - real, intent(in) :: co2air !atmospheric co2 concentration (pa) - real, intent(in) :: o2air !atmospheric o2 concentration (pa) - real, intent(in) :: igs !growing season index (0=off, 1=on) - real, intent(in) :: sfcprs !pressure (pa) - real, intent(in) :: btran !soil water transpiration factor (0 to 1) - real, intent(in) :: rhsur !raltive humidity in surface soil/snow air space (-) - - real , intent(in) :: qc !cloud water mixing ratio - real , intent(in) :: psfc !pressure at lowest model layer - real , intent(in) :: dx !grid spacing - real , intent(in) :: q2 !mixing ratio (kg/kg) - real , intent(in) :: dz8w !thickness of lowest layer - real , intent(inout) :: qsfc !mixing ratio at lowest model layer - real, intent(in) :: pahv !precipitation advected heat - canopy net in (w/m2) - real, intent(in) :: pahg !precipitation advected heat - ground net in (w/m2) + real (kind=kind_phys), intent(in) :: fveg !greeness vegetation fraction (-) + real (kind=kind_phys), intent(in) :: sav !solar rad absorbed by veg (w/m2) + real (kind=kind_phys), intent(in) :: sag !solar rad absorbed by ground (w/m2) + real (kind=kind_phys), intent(in) :: lwdn !atmospheric longwave radiation (w/m2) + real (kind=kind_phys), intent(in) :: ur !wind speed at height zlvl (m/s) + real (kind=kind_phys), intent(in) :: uu !wind speed in eastward dir (m/s) + real (kind=kind_phys), intent(in) :: vv !wind speed in northward dir (m/s) + real (kind=kind_phys), intent(in) :: sfctmp !air temperature at reference height (k) + real (kind=kind_phys), intent(in) :: thair !potential temp at reference height (k) + real (kind=kind_phys), intent(in) :: eair !vapor pressure air at zlvl (pa) + real (kind=kind_phys), intent(in) :: qair !specific humidity at zlvl (kg/kg) + real (kind=kind_phys), intent(in) :: rhoair !density air (kg/m**3) + real (kind=kind_phys), intent(in) :: dt !time step (s) + real (kind=kind_phys), intent(in) :: fsno !snow fraction + + real (kind=kind_phys), intent(in) :: snowh !actual snow depth [m] + real (kind=kind_phys), intent(in) :: fwet !wetted fraction of canopy + real (kind=kind_phys), intent(in) :: cwp !canopy wind parameter + + real (kind=kind_phys), intent(in) :: vai !total leaf area index + stem area index + real (kind=kind_phys), intent(in) :: laisun !sunlit leaf area index, one-sided (m2/m2) + real (kind=kind_phys), intent(in) :: laisha !shaded leaf area index, one-sided (m2/m2) + real (kind=kind_phys), intent(in) :: zlvl !reference height (m) + real (kind=kind_phys), intent(in) :: zpd !zero plane displacement (m) + real (kind=kind_phys), intent(in) :: z0m !roughness length, momentum (m) + real (kind=kind_phys), intent(in) :: z0mg !roughness length, momentum, ground (m) + real (kind=kind_phys), intent(in) :: emv !vegetation emissivity + real (kind=kind_phys), intent(in) :: emg !ground emissivity + + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !soil/snow temperature (k) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity of snow/soil (w/m/k) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thinkness of snow/soil layers (m) + real (kind=kind_phys), intent(in) :: canliq !intercepted liquid water (mm) + real (kind=kind_phys), intent(in) :: canice !intercepted ice mass (mm) + real (kind=kind_phys), intent(in) :: rsurf !ground surface resistance (s/m) +! real (kind=kind_phys), intent(in) :: gamma !psychrometric constant (pa/k) +! real (kind=kind_phys), intent(in) :: lathea !latent heat of vaporization/subli (j/kg) + real (kind=kind_phys), intent(in) :: gammav !psychrometric constant (pa/k) + real (kind=kind_phys), intent(in) :: latheav !latent heat of vaporization/subli (j/kg) + real (kind=kind_phys), intent(in) :: gammag !psychrometric constant (pa/k) + real (kind=kind_phys), intent(in) :: latheag !latent heat of vaporization/subli (j/kg) + real (kind=kind_phys), intent(in) :: parsun !par absorbed per unit sunlit lai (w/m2) + real (kind=kind_phys), intent(in) :: parsha !par absorbed per unit shaded lai (w/m2) + real (kind=kind_phys), intent(in) :: foln !foliage nitrogen (%) + real (kind=kind_phys), intent(in) :: co2air !atmospheric co2 concentration (pa) + real (kind=kind_phys), intent(in) :: o2air !atmospheric o2 concentration (pa) + real (kind=kind_phys), intent(in) :: igs !growing season index (0=off, 1=on) + real (kind=kind_phys), intent(in) :: sfcprs !pressure (pa) + real (kind=kind_phys), intent(in) :: btran !soil water transpiration factor (0 to 1) + real (kind=kind_phys), intent(in) :: rhsur !raltive humidity in surface soil/snow air space (-) + + real (kind=kind_phys) , intent(in) :: qc !cloud water mixing ratio + real (kind=kind_phys) , intent(in) :: psfc !pressure at lowest model layer + real (kind=kind_phys) , intent(in) :: dx !grid spacing + real (kind=kind_phys) , intent(in) :: q2 !mixing ratio (kg/kg) + real (kind=kind_phys) , intent(in) :: dz8w !thickness of lowest layer + real (kind=kind_phys) , intent(inout) :: qsfc !mixing ratio at lowest model layer + real (kind=kind_phys), intent(in) :: pahv !precipitation advected heat - canopy net in (w/m2) + real (kind=kind_phys), intent(in) :: pahg !precipitation advected heat - ground net in (w/m2) ! input/output - real, intent(inout) :: eah !canopy air vapor pressure (pa) - real, intent(inout) :: tah !canopy air temperature (k) - real, intent(inout) :: tv !vegetation temperature (k) - real, intent(inout) :: tg !ground temperature (k) - real, intent(inout) :: cm !momentum drag coefficient - real, intent(inout) :: ch !sensible heat exchange coefficient + real (kind=kind_phys), intent(inout) :: eah !canopy air vapor pressure (pa) + real (kind=kind_phys), intent(inout) :: tah !canopy air temperature (k) + real (kind=kind_phys), intent(inout) :: tv !vegetation temperature (k) + real (kind=kind_phys), intent(inout) :: tg !ground temperature (k) + real (kind=kind_phys), intent(inout) :: cm !momentum drag coefficient + real (kind=kind_phys), intent(inout) :: ch !sensible heat exchange coefficient #ifdef CCPP character(len=*), intent(inout) :: errmsg @@ -3396,107 +3563,106 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & ! output ! -fsa + fira + fsh + (fcev + fctr + fgev) + fcst + ssoil = 0 - real, intent(out) :: tauxv !wind stress: e-w (n/m2) - real, intent(out) :: tauyv !wind stress: n-s (n/m2) - real, intent(out) :: irc !net longwave radiation (w/m2) [+= to atm] - real, intent(out) :: shc !sensible heat flux (w/m2) [+= to atm] - real, intent(out) :: evc !evaporation heat flux (w/m2) [+= to atm] - real, intent(out) :: irg !net longwave radiation (w/m2) [+= to atm] - real, intent(out) :: shg !sensible heat flux (w/m2) [+= to atm] - real, intent(out) :: evg !evaporation heat flux (w/m2) [+= to atm] - real, intent(out) :: tr !transpiration heat flux (w/m2)[+= to atm] - real, intent(out) :: gh !ground heat (w/m2) [+ = to soil] - real, intent(out) :: t2mv !2 m height air temperature (k) - real, intent(out) :: psnsun !sunlit leaf photosynthesis (umolco2/m2/s) - real, intent(out) :: psnsha !shaded leaf photosynthesis (umolco2/m2/s) - real, intent(out) :: chleaf !leaf exchange coefficient - real, intent(out) :: chuc !under canopy exchange coefficient - - real, intent(out) :: q2v - real :: cah !sensible heat conductance, canopy air to zlvl air (m/s) - real :: u10v !10 m wind speed in eastward dir (m/s) - real :: v10v !10 m wind speed in eastward dir (m/s) - real :: wspd + real (kind=kind_phys), intent(out) :: tauxv !wind stress: e-w (n/m2) + real (kind=kind_phys), intent(out) :: tauyv !wind stress: n-s (n/m2) + real (kind=kind_phys), intent(out) :: irc !net longwave radiation (w/m2) [+= to atm] + real (kind=kind_phys), intent(out) :: shc !sensible heat flux (w/m2) [+= to atm] + real (kind=kind_phys), intent(out) :: evc !evaporation heat flux (w/m2) [+= to atm] + real (kind=kind_phys), intent(out) :: irg !net longwave radiation (w/m2) [+= to atm] + real (kind=kind_phys), intent(out) :: shg !sensible heat flux (w/m2) [+= to atm] + real (kind=kind_phys), intent(out) :: evg !evaporation heat flux (w/m2) [+= to atm] + real (kind=kind_phys), intent(out) :: tr !transpiration heat flux (w/m2)[+= to atm] + real (kind=kind_phys), intent(out) :: gh !ground heat (w/m2) [+ = to soil] + real (kind=kind_phys), intent(out) :: t2mv !2 m height air temperature (k) + real (kind=kind_phys), intent(out) :: psnsun !sunlit leaf photosynthesis (umolco2/m2/s) + real (kind=kind_phys), intent(out) :: psnsha !shaded leaf photosynthesis (umolco2/m2/s) + real (kind=kind_phys), intent(out) :: chleaf !leaf exchange coefficient + real (kind=kind_phys), intent(out) :: chuc !under canopy exchange coefficient + + real (kind=kind_phys), intent(out) :: q2v + real (kind=kind_phys) :: cah !sensible heat conductance, canopy air to zlvl air (m/s) + real (kind=kind_phys) :: u10v !10 m wind speed in eastward dir (m/s) + real (kind=kind_phys) :: v10v !10 m wind speed in eastward dir (m/s) + real (kind=kind_phys) :: wspd ! ------------------------ local variables ---------------------------------------------------- - real :: cw !water vapor exchange coefficient - real :: fv !friction velocity (m/s) - real :: wstar !friction velocity n vertical direction (m/s) (only for sfcdif2) - real :: z0h !roughness length, sensible heat (m) - real :: z0hg !roughness length, sensible heat (m) - real :: rb !bulk leaf boundary layer resistance (s/m) - real :: ramc !aerodynamic resistance for momentum (s/m) - real :: rahc !aerodynamic resistance for sensible heat (s/m) - real :: rawc !aerodynamic resistance for water vapor (s/m) - real :: ramg !aerodynamic resistance for momentum (s/m) - real :: rahg !aerodynamic resistance for sensible heat (s/m) - real :: rawg !aerodynamic resistance for water vapor (s/m) - - real, intent(out) :: rssun !sunlit leaf stomatal resistance (s/m) - real, intent(out) :: rssha !shaded leaf stomatal resistance (s/m) - - real :: mol !monin-obukhov length (m) - real :: dtv !change in tv, last iteration (k) - real :: dtg !change in tg, last iteration (k) - - real :: air,cir !coefficients for ir as function of ts**4 - real :: csh !coefficients for sh as function of ts - real :: cev !coefficients for ev as function of esat[ts] - real :: cgh !coefficients for st as function of ts - real :: atr,ctr !coefficients for tr as function of esat[ts] - real :: ata,bta !coefficients for tah as function of ts - real :: aea,bea !coefficients for eah as function of esat[ts] - - real :: estv !saturation vapor pressure at tv (pa) - real :: estg !saturation vapor pressure at tg (pa) - real :: destv !d(es)/dt at ts (pa/k) - real :: destg !d(es)/dt at tg (pa/k) - real :: esatw !es for water - real :: esati !es for ice - real :: dsatw !d(es)/dt at tg (pa/k) for water - real :: dsati !d(es)/dt at tg (pa/k) for ice - - real :: fm !momentum stability correction, weighted by prior iters - real :: fh !sen heat stability correction, weighted by prior iters - real :: fhg !sen heat stability correction, ground - real :: hcan !canopy height (m) [note: hcan >= z0mg] - - real :: a !temporary calculation - real :: b !temporary calculation - real :: cvh !sensible heat conductance, leaf surface to canopy air (m/s) - real :: caw !latent heat conductance, canopy air zlvl air (m/s) - real :: ctw !transpiration conductance, leaf to canopy air (m/s) - real :: cew !evaporation conductance, leaf to canopy air (m/s) - real :: cgw !latent heat conductance, ground to canopy air (m/s) - real :: cond !sum of conductances (s/m) - real :: uc !wind speed at top of canopy (m/s) - real :: kh !turbulent transfer coefficient, sensible heat, (m2/s) - real :: h !temporary sensible heat flux (w/m2) - real :: hg !temporary sensible heat flux (w/m2) - - real :: moz !monin-obukhov stability parameter - real :: mozg !monin-obukhov stability parameter - real :: mozold !monin-obukhov stability parameter from prior iteration - real :: fm2 !monin-obukhov momentum adjustment at 2m - real :: fh2 !monin-obukhov heat adjustment at 2m - real :: ch2 !surface exchange at 2m - real :: thstar !surface exchange at 2m - - real :: thvair - real :: thah - real :: rahc2 !aerodynamic resistance for sensible heat (s/m) - real :: rawc2 !aerodynamic resistance for water vapor (s/m) - real, intent(out):: cah2 !sensible heat conductance for diagnostics - real :: ch2v !exchange coefficient for 2m over vegetation. - real :: cq2v !exchange coefficient for 2m over vegetation. - real :: eah2 !2m vapor pressure over canopy - real :: qfx !moisture flux - real :: e1 - - - real :: vaie !total leaf area index + stem area index,effective - real :: laisune !sunlit leaf area index, one-sided (m2/m2),effective - real :: laishae !shaded leaf area index, one-sided (m2/m2),effective + real (kind=kind_phys) :: cw !water vapor exchange coefficient + real (kind=kind_phys) :: fv !friction velocity (m/s) + real (kind=kind_phys) :: wstar !friction velocity n vertical direction (m/s) (only for sfcdif2) + real (kind=kind_phys) :: z0h !roughness length, sensible heat (m) + real (kind=kind_phys) :: z0hg !roughness length, sensible heat (m) + real (kind=kind_phys) :: rb !bulk leaf boundary layer resistance (s/m) + real (kind=kind_phys) :: ramc !aerodynamic resistance for momentum (s/m) + real (kind=kind_phys) :: rahc !aerodynamic resistance for sensible heat (s/m) + real (kind=kind_phys) :: rawc !aerodynamic resistance for water vapor (s/m) + real (kind=kind_phys) :: ramg !aerodynamic resistance for momentum (s/m) + real (kind=kind_phys) :: rahg !aerodynamic resistance for sensible heat (s/m) + real (kind=kind_phys) :: rawg !aerodynamic resistance for water vapor (s/m) + + real (kind=kind_phys), intent(out) :: rssun !sunlit leaf stomatal resistance (s/m) + real (kind=kind_phys), intent(out) :: rssha !shaded leaf stomatal resistance (s/m) + + real (kind=kind_phys) :: mol !monin-obukhov length (m) + real (kind=kind_phys) :: dtv !change in tv, last iteration (k) + real (kind=kind_phys) :: dtg !change in tg, last iteration (k) + + real (kind=kind_phys) :: air,cir !coefficients for ir as function of ts**4 + real (kind=kind_phys) :: csh !coefficients for sh as function of ts + real (kind=kind_phys) :: cev !coefficients for ev as function of esat[ts] + real (kind=kind_phys) :: cgh !coefficients for st as function of ts + real (kind=kind_phys) :: atr,ctr !coefficients for tr as function of esat[ts] + real (kind=kind_phys) :: ata,bta !coefficients for tah as function of ts + real (kind=kind_phys) :: aea,bea !coefficients for eah as function of esat[ts] + + real (kind=kind_phys) :: estv !saturation vapor pressure at tv (pa) + real (kind=kind_phys) :: estg !saturation vapor pressure at tg (pa) + real (kind=kind_phys) :: destv !d(es)/dt at ts (pa/k) + real (kind=kind_phys) :: destg !d(es)/dt at tg (pa/k) + real (kind=kind_phys) :: esatw !es for water + real (kind=kind_phys) :: esati !es for ice + real (kind=kind_phys) :: dsatw !d(es)/dt at tg (pa/k) for water + real (kind=kind_phys) :: dsati !d(es)/dt at tg (pa/k) for ice + + real (kind=kind_phys) :: fm !momentum stability correction, weighted by prior iters + real (kind=kind_phys) :: fh !sen heat stability correction, weighted by prior iters + real (kind=kind_phys) :: fhg !sen heat stability correction, ground + real (kind=kind_phys) :: hcan !canopy height (m) [note: hcan >= z0mg] + + real (kind=kind_phys) :: a !temporary calculation + real (kind=kind_phys) :: b !temporary calculation + real (kind=kind_phys) :: cvh !sensible heat conductance, leaf surface to canopy air (m/s) + real (kind=kind_phys) :: caw !latent heat conductance, canopy air zlvl air (m/s) + real (kind=kind_phys) :: ctw !transpiration conductance, leaf to canopy air (m/s) + real (kind=kind_phys) :: cew !evaporation conductance, leaf to canopy air (m/s) + real (kind=kind_phys) :: cgw !latent heat conductance, ground to canopy air (m/s) + real (kind=kind_phys) :: cond !sum of conductances (s/m) + real (kind=kind_phys) :: uc !wind speed at top of canopy (m/s) + real (kind=kind_phys) :: kh !turbulent transfer coefficient, sensible heat, (m2/s) + real (kind=kind_phys) :: h !temporary sensible heat flux (w/m2) + real (kind=kind_phys) :: hg !temporary sensible heat flux (w/m2) + real (kind=kind_phys) :: moz !monin-obukhov stability parameter + real (kind=kind_phys) :: mozg !monin-obukhov stability parameter + real (kind=kind_phys) :: mozold !monin-obukhov stability parameter from prior iteration + real (kind=kind_phys) :: fm2 !monin-obukhov momentum adjustment at 2m + real (kind=kind_phys) :: fh2 !monin-obukhov heat adjustment at 2m + real (kind=kind_phys) :: ch2 !surface exchange at 2m + real (kind=kind_phys) :: thstar !surface exchange at 2m + + real (kind=kind_phys) :: thvair + real (kind=kind_phys) :: thah + real (kind=kind_phys) :: rahc2 !aerodynamic resistance for sensible heat (s/m) + real (kind=kind_phys) :: rawc2 !aerodynamic resistance for water vapor (s/m) + real (kind=kind_phys), intent(out):: cah2 !sensible heat conductance for diagnostics + real (kind=kind_phys) :: ch2v !exchange coefficient for 2m over vegetation. + real (kind=kind_phys) :: cq2v !exchange coefficient for 2m over vegetation. + real (kind=kind_phys) :: eah2 !2m vapor pressure over canopy + real (kind=kind_phys) :: qfx !moisture flux + real (kind=kind_phys) :: e1 + + + real (kind=kind_phys) :: vaie !total leaf area index + stem area index,effective + real (kind=kind_phys) :: laisune !sunlit leaf area index, one-sided (m2/m2),effective + real (kind=kind_phys) :: laishae !shaded leaf area index, one-sided (m2/m2),effective integer :: k !index integer :: iter !iteration index @@ -3506,12 +3672,12 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & !jref - niterg test from 3-5 integer, parameter :: niterg = 5 !number of iterations for ground temperature integer :: mozsgn !number of times moz changes sign - real :: mpe !prevents overflow error if division by zero + real (kind=kind_phys) :: mpe !prevents overflow error if division by zero integer :: liter !last iteration - real :: t, tdc !kelvin to degree celsius with limit -50 to +50 + real (kind=kind_phys) :: t, tdc !kelvin to degree celsius with limit -50 to +50 character(len=80) :: message @@ -3530,18 +3696,16 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & moz = 0. mozsgn = 0 mozold = 0. + fh2 = 0. hg = 0. h = 0. qfx = 0. -! YRQ -! write(*,*) 'tv,tg,stc in input:YRQ', tv,tg,stc +! limit lai -! convert grid-cell lai to the fractional vegetated area (fveg) - - vaie = min(6.,vai / fveg) - laisune = min(6.,laisun / fveg) - laishae = min(6.,laisha / fveg) + vaie = min(6.,vai ) + laisune = min(6.,laisun) + laishae = min(6.,laisha) ! saturation vapor pressure at ground temperature @@ -3603,7 +3767,6 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & air = -emv*(1.+(1.-emv)*(1.-emg))*lwdn - emv*emg*sb*tg**4 cir = (2.-emv*(1.-emg))*emv*sb - ! --------------------------------------------------------------------------------------------- loop1: do iter = 1, niterc ! begin stability iteration @@ -3624,7 +3787,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & #ifdef CCPP moz ,mozsgn ,fm ,fh ,fm2 ,fh2 ,errmsg ,errflg ,& !inout #else - moz ,mozsgn ,fm ,fh ,fm2 ,fh2 , & !inout + moz ,mozsgn ,fm ,fh ,fm2,fh2, & !inout #endif cm ,ch ,fv ,ch2 ) !out #ifdef CCPP @@ -3765,7 +3928,6 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & csh = rhoair*cpair/rahg cev = rhoair*cpair / (gammag*(rawg+rsurf)) ! barlage: change to ground v3.6 cgh = 2.*df(isnow+1)/dzsnso(isnow+1) -! write(*,*)'inside tg=',tg,'stc(1)=',stc(1) loop2: do iter = 1, niterg @@ -3802,7 +3964,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & if(opt_stc == 1 .or. opt_stc == 3) then if (snowh > 0.05 .and. tg > tfrz) then - tg = tfrz + if(opt_stc == 1) tg = tfrz if(opt_stc == 3) tg = (1.-fsno)*tg + fsno*tfrz ! mb: allow tg>0c during melt v3.7 irg = cir*tg**4 - emg*(1.-emv)*lwdn - emg*emv*sb*tv**4 shg = csh * (tg - tah) @@ -3882,47 +4044,47 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & integer, intent(in) :: nsnow !maximum no. of snow layers integer, intent(in) :: nsoil !number of soil layers integer, intent(in) :: isnow !actual no. of snow layers - real, intent(in) :: dt !time step (s) - real, intent(in) :: sag !solar radiation absorbed by ground (w/m2) - real, intent(in) :: lwdn !atmospheric longwave radiation (w/m2) - real, intent(in) :: ur !wind speed at height zlvl (m/s) - real, intent(in) :: uu !wind speed in eastward dir (m/s) - real, intent(in) :: vv !wind speed in northward dir (m/s) - real, intent(in) :: sfctmp !air temperature at reference height (k) - real, intent(in) :: thair !potential temperature at height zlvl (k) - real, intent(in) :: qair !specific humidity at height zlvl (kg/kg) - real, intent(in) :: eair !vapor pressure air at height (pa) - real, intent(in) :: rhoair !density air (kg/m3) - real, intent(in) :: snowh !actual snow depth [m] - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thickness of snow/soil layers (m) - real, intent(in) :: zlvl !reference height (m) - real, intent(in) :: zpd !zero plane displacement (m) - real, intent(in) :: z0m !roughness length, momentum, ground (m) - real, intent(in) :: emg !ground emissivity - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !soil/snow temperature (k) - real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity of snow/soil (w/m/k) - real, intent(in) :: rsurf !ground surface resistance (s/m) - real, intent(in) :: lathea !latent heat of vaporization/subli (j/kg) - real, intent(in) :: gamma !psychrometric constant (pa/k) - real, intent(in) :: rhsur !raltive humidity in surface soil/snow air space (-) - real, intent(in) :: fsno !snow fraction + real (kind=kind_phys), intent(in) :: dt !time step (s) + real (kind=kind_phys), intent(in) :: sag !solar radiation absorbed by ground (w/m2) + real (kind=kind_phys), intent(in) :: lwdn !atmospheric longwave radiation (w/m2) + real (kind=kind_phys), intent(in) :: ur !wind speed at height zlvl (m/s) + real (kind=kind_phys), intent(in) :: uu !wind speed in eastward dir (m/s) + real (kind=kind_phys), intent(in) :: vv !wind speed in northward dir (m/s) + real (kind=kind_phys), intent(in) :: sfctmp !air temperature at reference height (k) + real (kind=kind_phys), intent(in) :: thair !potential temperature at height zlvl (k) + real (kind=kind_phys), intent(in) :: qair !specific humidity at height zlvl (kg/kg) + real (kind=kind_phys), intent(in) :: eair !vapor pressure air at height (pa) + real (kind=kind_phys), intent(in) :: rhoair !density air (kg/m3) + real (kind=kind_phys), intent(in) :: snowh !actual snow depth [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thickness of snow/soil layers (m) + real (kind=kind_phys), intent(in) :: zlvl !reference height (m) + real (kind=kind_phys), intent(in) :: zpd !zero plane displacement (m) + real (kind=kind_phys), intent(in) :: z0m !roughness length, momentum, ground (m) + real (kind=kind_phys), intent(in) :: emg !ground emissivity + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !soil/snow temperature (k) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity of snow/soil (w/m/k) + real (kind=kind_phys), intent(in) :: rsurf !ground surface resistance (s/m) + real (kind=kind_phys), intent(in) :: lathea !latent heat of vaporization/subli (j/kg) + real (kind=kind_phys), intent(in) :: gamma !psychrometric constant (pa/k) + real (kind=kind_phys), intent(in) :: rhsur !raltive humidity in surface soil/snow air space (-) + real (kind=kind_phys), intent(in) :: fsno !snow fraction !jref:start; in integer , intent(in) :: ivgtyp - real , intent(in) :: qc !cloud water mixing ratio - real , intent(inout) :: qsfc !mixing ratio at lowest model layer - real , intent(in) :: psfc !pressure at lowest model layer - real , intent(in) :: sfcprs !pressure at lowest model layer - real , intent(in) :: dx !horisontal grid spacing - real , intent(in) :: q2 !mixing ratio (kg/kg) - real , intent(in) :: dz8w !thickness of lowest layer + real (kind=kind_phys) , intent(in) :: qc !cloud water mixing ratio + real (kind=kind_phys) , intent(inout) :: qsfc !mixing ratio at lowest model layer + real (kind=kind_phys) , intent(in) :: psfc !pressure at lowest model layer + real (kind=kind_phys) , intent(in) :: sfcprs !pressure at lowest model layer + real (kind=kind_phys) , intent(in) :: dx !horisontal grid spacing + real (kind=kind_phys) , intent(in) :: q2 !mixing ratio (kg/kg) + real (kind=kind_phys) , intent(in) :: dz8w !thickness of lowest layer !jref:end - real, intent(in) :: pahb !precipitation advected heat - ground net in (w/m2) + real (kind=kind_phys), intent(in) :: pahb !precipitation advected heat - ground net in (w/m2) ! input/output - real, intent(inout) :: tgb !ground temperature (k) - real, intent(inout) :: cm !momentum drag coefficient - real, intent(inout) :: ch !sensible heat exchange coefficient + real (kind=kind_phys), intent(inout) :: tgb !ground temperature (k) + real (kind=kind_phys), intent(inout) :: cm !momentum drag coefficient + real (kind=kind_phys), intent(inout) :: ch !sensible heat exchange coefficient #ifdef CCPP character(len=*), intent(inout) :: errmsg integer, intent(inout) :: errflg @@ -3931,91 +4093,91 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & ! output ! -sab + irb[tg] + shb[tg] + evb[tg] + ghb[tg] = 0 - real, intent(out) :: tauxb !wind stress: e-w (n/m2) - real, intent(out) :: tauyb !wind stress: n-s (n/m2) - real, intent(out) :: irb !net longwave rad (w/m2) [+ to atm] - real, intent(out) :: shb !sensible heat flux (w/m2) [+ to atm] - real, intent(out) :: evb !latent heat flux (w/m2) [+ to atm] - real, intent(out) :: ghb !ground heat flux (w/m2) [+ to soil] - real, intent(out) :: t2mb !2 m height air temperature (k) + real (kind=kind_phys), intent(out) :: tauxb !wind stress: e-w (n/m2) + real (kind=kind_phys), intent(out) :: tauyb !wind stress: n-s (n/m2) + real (kind=kind_phys), intent(out) :: irb !net longwave rad (w/m2) [+ to atm] + real (kind=kind_phys), intent(out) :: shb !sensible heat flux (w/m2) [+ to atm] + real (kind=kind_phys), intent(out) :: evb !latent heat flux (w/m2) [+ to atm] + real (kind=kind_phys), intent(out) :: ghb !ground heat flux (w/m2) [+ to soil] + real (kind=kind_phys), intent(out) :: t2mb !2 m height air temperature (k) !jref:start - real, intent(out) :: q2b !bare ground heat conductance - real :: ehb !bare ground heat conductance - real :: u10b !10 m wind speed in eastward dir (m/s) - real :: v10b !10 m wind speed in eastward dir (m/s) - real :: wspd + real (kind=kind_phys), intent(out) :: q2b !bare ground heat conductance + real (kind=kind_phys) :: ehb !bare ground heat conductance + real (kind=kind_phys) :: u10b !10 m wind speed in eastward dir (m/s) + real (kind=kind_phys) :: v10b !10 m wind speed in eastward dir (m/s) + real (kind=kind_phys) :: wspd !jref:end ! local variables - real :: taux !wind stress: e-w (n/m2) - real :: tauy !wind stress: n-s (n/m2) - real :: fira !total net longwave rad (w/m2) [+ to atm] - real :: fsh !total sensible heat flux (w/m2) [+ to atm] - real :: fgev !ground evaporation heat flux (w/m2)[+ to atm] - real :: ssoil !soil heat flux (w/m2) [+ to soil] - real :: fire !emitted ir (w/m2) - real :: trad !radiative temperature (k) - real :: tah !"surface" temperature at height z0h+zpd (k) - - real :: cw !water vapor exchange coefficient - real :: fv !friction velocity (m/s) - real :: wstar !friction velocity n vertical direction (m/s) (only for sfcdif2) - real :: z0h !roughness length, sensible heat, ground (m) - real :: rb !bulk leaf boundary layer resistance (s/m) - real :: ramb !aerodynamic resistance for momentum (s/m) - real :: rahb !aerodynamic resistance for sensible heat (s/m) - real :: rawb !aerodynamic resistance for water vapor (s/m) - real :: mol !monin-obukhov length (m) - real :: dtg !change in tg, last iteration (k) - - real :: cir !coefficients for ir as function of ts**4 - real :: csh !coefficients for sh as function of ts - real :: cev !coefficients for ev as function of esat[ts] - real :: cgh !coefficients for st as function of ts + real (kind=kind_phys) :: taux !wind stress: e-w (n/m2) + real (kind=kind_phys) :: tauy !wind stress: n-s (n/m2) + real (kind=kind_phys) :: fira !total net longwave rad (w/m2) [+ to atm] + real (kind=kind_phys) :: fsh !total sensible heat flux (w/m2) [+ to atm] + real (kind=kind_phys) :: fgev !ground evaporation heat flux (w/m2)[+ to atm] + real (kind=kind_phys) :: ssoil !soil heat flux (w/m2) [+ to soil] + real (kind=kind_phys) :: fire !emitted ir (w/m2) + real (kind=kind_phys) :: trad !radiative temperature (k) + real (kind=kind_phys) :: tah !"surface" temperature at height z0h+zpd (k) + + real (kind=kind_phys) :: cw !water vapor exchange coefficient + real (kind=kind_phys) :: fv !friction velocity (m/s) + real (kind=kind_phys) :: wstar !friction velocity n vertical direction (m/s) (only for sfcdif2) + real (kind=kind_phys) :: z0h !roughness length, sensible heat, ground (m) + real (kind=kind_phys) :: rb !bulk leaf boundary layer resistance (s/m) + real (kind=kind_phys) :: ramb !aerodynamic resistance for momentum (s/m) + real (kind=kind_phys) :: rahb !aerodynamic resistance for sensible heat (s/m) + real (kind=kind_phys) :: rawb !aerodynamic resistance for water vapor (s/m) + real (kind=kind_phys) :: mol !monin-obukhov length (m) + real (kind=kind_phys) :: dtg !change in tg, last iteration (k) + + real (kind=kind_phys) :: cir !coefficients for ir as function of ts**4 + real (kind=kind_phys) :: csh !coefficients for sh as function of ts + real (kind=kind_phys) :: cev !coefficients for ev as function of esat[ts] + real (kind=kind_phys) :: cgh !coefficients for st as function of ts !jref:start - real :: rahb2 !aerodynamic resistance for sensible heat 2m (s/m) - real :: rawb2 !aerodynamic resistance for water vapor 2m (s/m) - real,intent(out) :: ehb2 !sensible heat conductance for diagnostics - real :: ch2b !exchange coefficient for 2m temp. - real :: cq2b !exchange coefficient for 2m temp. - real :: thvair !virtual potential air temp - real :: thgh !potential ground temp - real :: emb !momentum conductance - real :: qfx !moisture flux - real :: estg2 !saturation vapor pressure at 2m (pa) + real (kind=kind_phys) :: rahb2 !aerodynamic resistance for sensible heat 2m (s/m) + real (kind=kind_phys) :: rawb2 !aerodynamic resistance for water vapor 2m (s/m) + real (kind=kind_phys),intent(out) :: ehb2 !sensible heat conductance for diagnostics + real (kind=kind_phys) :: ch2b !exchange coefficient for 2m temp. + real (kind=kind_phys) :: cq2b !exchange coefficient for 2m temp. + real (kind=kind_phys) :: thvair !virtual potential air temp + real (kind=kind_phys) :: thgh !potential ground temp + real (kind=kind_phys) :: emb !momentum conductance + real (kind=kind_phys) :: qfx !moisture flux + real (kind=kind_phys) :: estg2 !saturation vapor pressure at 2m (pa) integer :: vegtyp !vegetation type set to isbarren - real :: e1 + real (kind=kind_phys) :: e1 !jref:end - real :: estg !saturation vapor pressure at tg (pa) - real :: destg !d(es)/dt at tg (pa/k) - real :: esatw !es for water - real :: esati !es for ice - real :: dsatw !d(es)/dt at tg (pa/k) for water - real :: dsati !d(es)/dt at tg (pa/k) for ice - - real :: a !temporary calculation - real :: b !temporary calculation - real :: h !temporary sensible heat flux (w/m2) - real :: moz !monin-obukhov stability parameter - real :: mozold !monin-obukhov stability parameter from prior iteration - real :: fm !momentum stability correction, weighted by prior iters - real :: fh !sen heat stability correction, weighted by prior iters + real (kind=kind_phys) :: estg !saturation vapor pressure at tg (pa) + real (kind=kind_phys) :: destg !d(es)/dt at tg (pa/k) + real (kind=kind_phys) :: esatw !es for water + real (kind=kind_phys) :: esati !es for ice + real (kind=kind_phys) :: dsatw !d(es)/dt at tg (pa/k) for water + real (kind=kind_phys) :: dsati !d(es)/dt at tg (pa/k) for ice + + real (kind=kind_phys) :: a !temporary calculation + real (kind=kind_phys) :: b !temporary calculation + real (kind=kind_phys) :: h !temporary sensible heat flux (w/m2) + real (kind=kind_phys) :: moz !monin-obukhov stability parameter + real (kind=kind_phys) :: mozold !monin-obukhov stability parameter from prior iteration + real (kind=kind_phys) :: fm !momentum stability correction, weighted by prior iters + real (kind=kind_phys) :: fh !sen heat stability correction, weighted by prior iters integer :: mozsgn !number of times moz changes sign - real :: fm2 !monin-obukhov momentum adjustment at 2m - real :: fh2 !monin-obukhov heat adjustment at 2m - real :: ch2 !surface exchange at 2m + real (kind=kind_phys) :: fm2 !monin-obukhov momentum adjustment at 2m + real (kind=kind_phys) :: fh2 !monin-obukhov heat adjustment at 2m + real (kind=kind_phys) :: ch2 !surface exchange at 2m integer :: iter !iteration index integer :: niterb !number of iterations for surface temperature - real :: mpe !prevents overflow error if division by zero + real (kind=kind_phys) :: mpe !prevents overflow error if division by zero !jref:start ! data niterb /3/ data niterb /5/ save niterb - real :: t, tdc !kelvin to degree celsius with limit -50 to +50 + real (kind=kind_phys) :: t, tdc !kelvin to degree celsius with limit -50 to +50 tdc(t) = min( 50., max(-50.,(t-tfrz)) ) ! ----------------------------------------------------------------- @@ -4026,6 +4188,7 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & moz = 0. mozsgn = 0 mozold = 0. + fh2 = 0. h = 0. qfx = 0. fv = 0.1 @@ -4136,7 +4299,7 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & if(opt_stc == 1 .or. opt_stc == 3) then if (snowh > 0.05 .and. tgb > tfrz) then - tgb = tfrz + if(opt_stc == 1) tgb = tfrz if(opt_stc == 3) tgb = (1.-fsno)*tgb + fsno*tfrz ! mb: allow tg>0c during melt v3.7 irb = cir * tgb**4 - emg*lwdn shb = csh * (tgb - sfctmp) @@ -4192,39 +4355,39 @@ subroutine ragrb(parameters,iter ,vai ,rhoair ,hg ,tah , & !in integer, intent(in) :: jloc !grid index integer, intent(in) :: iter !iteration index integer, intent(in) :: vegtyp !vegetation physiology type - real, intent(in) :: vai !total lai + stem area index, one sided - real, intent(in) :: rhoair !density air (kg/m3) - real, intent(in) :: hg !ground sensible heat flux (w/m2) - real, intent(in) :: tv !vegetation temperature (k) - real, intent(in) :: tah !air temperature at height z0h+zpd (k) - real, intent(in) :: zpd !zero plane displacement (m) - real, intent(in) :: z0mg !roughness length, momentum, ground (m) - real, intent(in) :: hcan !canopy height (m) [note: hcan >= z0mg] - real, intent(in) :: uc !wind speed at top of canopy (m/s) - real, intent(in) :: z0h !roughness length, sensible heat (m) - real, intent(in) :: z0hg !roughness length, sensible heat, ground (m) - real, intent(in) :: fv !friction velocity (m/s) - real, intent(in) :: cwp !canopy wind parameter - real, intent(in) :: mpe !prevents overflow error if division by zero + real (kind=kind_phys), intent(in) :: vai !total lai + stem area index, one sided + real (kind=kind_phys), intent(in) :: rhoair !density air (kg/m3) + real (kind=kind_phys), intent(in) :: hg !ground sensible heat flux (w/m2) + real (kind=kind_phys), intent(in) :: tv !vegetation temperature (k) + real (kind=kind_phys), intent(in) :: tah !air temperature at height z0h+zpd (k) + real (kind=kind_phys), intent(in) :: zpd !zero plane displacement (m) + real (kind=kind_phys), intent(in) :: z0mg !roughness length, momentum, ground (m) + real (kind=kind_phys), intent(in) :: hcan !canopy height (m) [note: hcan >= z0mg] + real (kind=kind_phys), intent(in) :: uc !wind speed at top of canopy (m/s) + real (kind=kind_phys), intent(in) :: z0h !roughness length, sensible heat (m) + real (kind=kind_phys), intent(in) :: z0hg !roughness length, sensible heat, ground (m) + real (kind=kind_phys), intent(in) :: fv !friction velocity (m/s) + real (kind=kind_phys), intent(in) :: cwp !canopy wind parameter + real (kind=kind_phys), intent(in) :: mpe !prevents overflow error if division by zero ! in & out - real, intent(inout) :: mozg !monin-obukhov stability parameter - real, intent(inout) :: fhg !stability correction + real (kind=kind_phys), intent(inout) :: mozg !monin-obukhov stability parameter + real (kind=kind_phys), intent(inout) :: fhg !stability correction ! outputs - real :: ramg !aerodynamic resistance for momentum (s/m) - real :: rahg !aerodynamic resistance for sensible heat (s/m) - real :: rawg !aerodynamic resistance for water vapor (s/m) - real :: rb !bulk leaf boundary layer resistance (s/m) - - - real :: kh !turbulent transfer coefficient, sensible heat, (m2/s) - real :: tmp1 !temporary calculation - real :: tmp2 !temporary calculation - real :: tmprah2 !temporary calculation for aerodynamic resistances - real :: tmprb !temporary calculation for rb - real :: molg,fhgnew,cwpc + real (kind=kind_phys) :: ramg !aerodynamic resistance for momentum (s/m) + real (kind=kind_phys) :: rahg !aerodynamic resistance for sensible heat (s/m) + real (kind=kind_phys) :: rawg !aerodynamic resistance for water vapor (s/m) + real (kind=kind_phys) :: rb !bulk leaf boundary layer resistance (s/m) + + + real (kind=kind_phys) :: kh !turbulent transfer coefficient, sensible heat, (m2/s) + real (kind=kind_phys) :: tmp1 !temporary calculation + real (kind=kind_phys) :: tmp2 !temporary calculation + real (kind=kind_phys) :: tmprah2 !temporary calculation for aerodynamic resistances + real (kind=kind_phys) :: tmprb !temporary calculation for rb + real (kind=kind_phys) :: molg,fhgnew,cwpc ! -------------------------------------------------------------------------------------------------- ! stability correction to below canopy resistance @@ -4268,6 +4431,7 @@ subroutine ragrb(parameters,iter ,vai ,rhoair ,hg ,tah , & !in tmprb = cwpc*50. / (1. - exp(-cwpc/2.)) rb = tmprb * sqrt(parameters%dleaf/uc) + rb = max(rb,20.0) ! rb = 200 end subroutine ragrb @@ -4295,24 +4459,24 @@ subroutine sfcdif1(parameters,iter ,sfctmp ,rhoair ,h ,qair , & !in integer, intent(in) :: iloc !grid index integer, intent(in) :: jloc !grid index integer, intent(in) :: iter !iteration index - real, intent(in) :: sfctmp !temperature at reference height (k) - real, intent(in) :: rhoair !density air (kg/m**3) - real, intent(in) :: h !sensible heat flux (w/m2) [+ to atm] - real, intent(in) :: qair !specific humidity at reference height (kg/kg) - real, intent(in) :: zlvl !reference height (m) - real, intent(in) :: zpd !zero plane displacement (m) - real, intent(in) :: z0h !roughness length, sensible heat, ground (m) - real, intent(in) :: z0m !roughness length, momentum, ground (m) - real, intent(in) :: ur !wind speed (m/s) - real, intent(in) :: mpe !prevents overflow error if division by zero + real (kind=kind_phys), intent(in) :: sfctmp !temperature at reference height (k) + real (kind=kind_phys), intent(in) :: rhoair !density air (kg/m**3) + real (kind=kind_phys), intent(in) :: h !sensible heat flux (w/m2) [+ to atm] + real (kind=kind_phys), intent(in) :: qair !specific humidity at reference height (kg/kg) + real (kind=kind_phys), intent(in) :: zlvl !reference height (m) + real (kind=kind_phys), intent(in) :: zpd !zero plane displacement (m) + real (kind=kind_phys), intent(in) :: z0h !roughness length, sensible heat, ground (m) + real (kind=kind_phys), intent(in) :: z0m !roughness length, momentum, ground (m) + real (kind=kind_phys), intent(in) :: ur !wind speed (m/s) + real (kind=kind_phys), intent(in) :: mpe !prevents overflow error if division by zero ! in & out integer, intent(inout) :: mozsgn !number of times moz changes sign - real, intent(inout) :: moz !monin-obukhov stability (z/l) - real, intent(inout) :: fm !momentum stability correction, weighted by prior iters - real, intent(inout) :: fh !sen heat stability correction, weighted by prior iters - real, intent(inout) :: fm2 !sen heat stability correction, weighted by prior iters - real, intent(inout) :: fh2 !sen heat stability correction, weighted by prior iters + real (kind=kind_phys), intent(inout) :: moz !monin-obukhov stability (z/l) + real (kind=kind_phys), intent(inout) :: fm !momentum stability correction, weighted by prior iters + real (kind=kind_phys), intent(inout) :: fh !sen heat stability correction, weighted by prior iters + real (kind=kind_phys), intent(inout) :: fm2 !sen heat stability correction, weighted by prior iters + real (kind=kind_phys), intent(inout) :: fh2 !sen heat stability correction, weighted by prior iters #ifdef CCPP character(len=*), intent(inout) :: errmsg integer, intent(inout) :: errflg @@ -4320,28 +4484,28 @@ subroutine sfcdif1(parameters,iter ,sfctmp ,rhoair ,h ,qair , & !in ! outputs - real, intent(out) :: cm !drag coefficient for momentum - real, intent(out) :: ch !drag coefficient for heat - real, intent(out) :: fv !friction velocity (m/s) - real, intent(out) :: ch2 !drag coefficient for heat + real (kind=kind_phys), intent(out) :: cm !drag coefficient for momentum + real (kind=kind_phys), intent(out) :: ch !drag coefficient for heat + real (kind=kind_phys), intent(out) :: fv !friction velocity (m/s) + real (kind=kind_phys), intent(out) :: ch2 !drag coefficient for heat ! locals - real :: mol !monin-obukhov length (m) - real :: tmpcm !temporary calculation for cm - real :: tmpch !temporary calculation for ch - real :: fmnew !stability correction factor, momentum, for current moz - real :: fhnew !stability correction factor, sen heat, for current moz - real :: mozold !monin-obukhov stability parameter from prior iteration - real :: tmp1,tmp2,tmp3,tmp4,tmp5 !temporary calculation - real :: tvir !temporary virtual temperature (k) - real :: moz2 !2/l - real :: tmpcm2 !temporary calculation for cm2 - real :: tmpch2 !temporary calculation for ch2 - real :: fm2new !stability correction factor, momentum, for current moz - real :: fh2new !stability correction factor, sen heat, for current moz - real :: tmp12,tmp22,tmp32 !temporary calculation - - real :: cmfm, chfh, cm2fm2, ch2fh2 + real (kind=kind_phys) :: mol !monin-obukhov length (m) + real (kind=kind_phys) :: tmpcm !temporary calculation for cm + real (kind=kind_phys) :: tmpch !temporary calculation for ch + real (kind=kind_phys) :: fmnew !stability correction factor, momentum, for current moz + real (kind=kind_phys) :: fhnew !stability correction factor, sen heat, for current moz + real (kind=kind_phys) :: mozold !monin-obukhov stability parameter from prior iteration + real (kind=kind_phys) :: tmp1,tmp2,tmp3,tmp4,tmp5 !temporary calculation + real (kind=kind_phys) :: tvir !temporary virtual temperature (k) + real (kind=kind_phys) :: moz2 !2/l + real (kind=kind_phys) :: tmpcm2 !temporary calculation for cm2 + real (kind=kind_phys) :: tmpch2 !temporary calculation for ch2 + real (kind=kind_phys) :: fm2new !stability correction factor, momentum, for current moz + real (kind=kind_phys) :: fh2new !stability correction factor, sen heat, for current moz + real (kind=kind_phys) :: tmp12,tmp22,tmp32 !temporary calculation + + real (kind=kind_phys) :: cmfm, chfh, cm2fm2, ch2fh2 ! ------------------------------------------------------------------------------------------------- ! monin-obukhov stability parameter moz for next iteration @@ -4364,7 +4528,7 @@ subroutine sfcdif1(parameters,iter ,sfctmp ,rhoair ,h ,qair , & !in tmpch2 = log((2.0 + z0h) / z0h) if(iter == 1) then - fv = 0.0 + fv = 0.1 moz = 0.0 mol = 0.0 moz2 = 0.0 @@ -4470,48 +4634,48 @@ subroutine sfcdif2(parameters,iter ,z0 ,thz0 ,thlm ,sfcspd , & !in integer, intent(in) :: iloc integer, intent(in) :: jloc integer, intent(in) :: iter - real, intent(in) :: zlm, z0, thz0, thlm, sfcspd - real, intent(inout) :: akms - real, intent(inout) :: akhs - real, intent(inout) :: rlmo - real, intent(inout) :: wstar2 - real, intent(out) :: ustar - - real zz, pslmu, pslms, pslhu, pslhs - real xx, pspmu, yy, pspms, psphu, psphs - real zilfc, zu, zt, rdz, cxch - real dthv, du2, btgh, zslu, zslt, rlogu, rlogt - real zetalt, zetalu, zetau, zetat, xlu4, xlt4, xu4, xt4 - - real xlu, xlt, xu, xt, psmz, simm, pshz, simh, ustark, rlmn, & + real (kind=kind_phys), intent(in) :: zlm, z0, thz0, thlm, sfcspd + real (kind=kind_phys), intent(inout) :: akms + real (kind=kind_phys), intent(inout) :: akhs + real (kind=kind_phys), intent(inout) :: rlmo + real (kind=kind_phys), intent(inout) :: wstar2 + real (kind=kind_phys), intent(out) :: ustar + + real (kind=kind_phys) zz, pslmu, pslms, pslhu, pslhs + real (kind=kind_phys) xx, pspmu, yy, pspms, psphu, psphs + real (kind=kind_phys) zilfc, zu, zt, rdz, cxch + real (kind=kind_phys) dthv, du2, btgh, zslu, zslt, rlogu, rlogt + real (kind=kind_phys) zetalt, zetalu, zetau, zetat, xlu4, xlt4, xu4, xt4 + + real (kind=kind_phys) xlu, xlt, xu, xt, psmz, simm, pshz, simh, ustark, rlmn, & & rlma integer ilech, itr integer, parameter :: itrmx = 5 - real, parameter :: wwst = 1.2 - real, parameter :: wwst2 = wwst * wwst - real, parameter :: vkrm = 0.40 - real, parameter :: excm = 0.001 - real, parameter :: beta = 1.0 / 270.0 - real, parameter :: btg = beta * grav - real, parameter :: elfc = vkrm * btg - real, parameter :: wold = 0.15 - real, parameter :: wnew = 1.0 - wold - real, parameter :: pihf = 3.14159265 / 2. - real, parameter :: epsu2 = 1.e-4 - real, parameter :: epsust = 0.07 - real, parameter :: epsit = 1.e-4 - real, parameter :: epsa = 1.e-8 - real, parameter :: ztmin = -5.0 - real, parameter :: ztmax = 1.0 - real, parameter :: hpbl = 1000.0 - real, parameter :: sqvisc = 258.2 - real, parameter :: ric = 0.183 - real, parameter :: rric = 1.0 / ric - real, parameter :: fhneu = 0.8 - real, parameter :: rfc = 0.191 - real, parameter :: rfac = ric / ( fhneu * rfc * rfc ) + 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 * grav + 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. + real (kind=kind_phys), parameter :: epsu2 = 1.e-4 + real (kind=kind_phys), parameter :: epsust = 0.07 + real (kind=kind_phys), parameter :: epsit = 1.e-4 + real (kind=kind_phys), parameter :: epsa = 1.e-8 + 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 ) ! ---------------------------------------------------------------------- ! note: the two code blocks below define functions @@ -4593,6 +4757,8 @@ subroutine sfcdif2(parameters,iter ,z0 ,thz0 ,thlm ,sfcspd , & !in else zetalu = min (zetalu,ztmax) zetalt = min (zetalt,ztmax) + zetau = min (zetau,ztmax/(zslu/zu)) ! barlage: add limit on zetau/zetat + zetat = min (zetat,ztmax/(zslt/zt)) ! barlage: prevent simm/simh < 0 psmz = pspms (zetau) simm = pspms (zetalu) - psmz + rlogu pshz = psphs (zetat) @@ -4629,10 +4795,12 @@ subroutine sfcdif2(parameters,iter ,z0 ,thz0 ,thlm ,sfcspd , & !in !----------------------------------------------------------------------- rlogt = log (zslt / zt) ustark = ustar * vkrm + if(simm < 1.e-6) simm = 1.e-6 ! limit stability function akms = max (ustark / simm,cxch) !----------------------------------------------------------------------- ! if statements to avoid tangent linear problems near zero !----------------------------------------------------------------------- + if(simh < 1.e-6) simh = 1.e-6 ! limit stability function akhs = max (ustark / simh,cxch) if (btgh * akhs * dthv .ne. 0.0) then @@ -4665,21 +4833,21 @@ subroutine esat(t, esw, esi, desw, desi) !--------------------------------------------------------------------------------------------------- ! in - real, intent(in) :: t !temperature + real (kind=kind_phys), intent(in) :: t !temperature !out - real, intent(out) :: esw !saturation vapor pressure over water (pa) - real, intent(out) :: esi !saturation vapor pressure over ice (pa) - real, intent(out) :: desw !d(esat)/dt over water (pa/k) - real, intent(out) :: desi !d(esat)/dt over ice (pa/k) + real (kind=kind_phys), intent(out) :: esw !saturation vapor pressure over water (pa) + real (kind=kind_phys), intent(out) :: esi !saturation vapor pressure over ice (pa) + real (kind=kind_phys), intent(out) :: desw !d(esat)/dt over water (pa/k) + real (kind=kind_phys), intent(out) :: desi !d(esat)/dt over ice (pa/k) ! local - real :: a0,a1,a2,a3,a4,a5,a6 !coefficients for esat over water - real :: b0,b1,b2,b3,b4,b5,b6 !coefficients for esat over ice - real :: c0,c1,c2,c3,c4,c5,c6 !coefficients for dsat over water - real :: d0,d1,d2,d3,d4,d5,d6 !coefficients for dsat over ice + real (kind=kind_phys) :: a0,a1,a2,a3,a4,a5,a6 !coefficients for esat over water + real (kind=kind_phys) :: b0,b1,b2,b3,b4,b5,b6 !coefficients for esat over ice + real (kind=kind_phys) :: c0,c1,c2,c3,c4,c5,c6 !coefficients for dsat over water + real (kind=kind_phys) :: d0,d1,d2,d3,d4,d5,d6 !coefficients for dsat over ice parameter (a0=6.107799961 , a1=4.436518521e-01, & a2=1.428945805e-02, a3=2.650648471e-04, & @@ -4724,27 +4892,27 @@ subroutine stomata (parameters,vegtyp ,mpe ,apar ,foln ,iloc , jlo integer,intent(in) :: jloc !grid index integer,intent(in) :: vegtyp !vegetation physiology type - real, intent(in) :: igs !growing season index (0=off, 1=on) - real, intent(in) :: mpe !prevents division by zero errors - - real, intent(in) :: tv !foliage temperature (k) - real, intent(in) :: ei !vapor pressure inside leaf (sat vapor press at tv) (pa) - real, intent(in) :: ea !vapor pressure of canopy air (pa) - real, intent(in) :: apar !par absorbed per unit lai (w/m2) - real, intent(in) :: o2 !atmospheric o2 concentration (pa) - real, intent(in) :: co2 !atmospheric co2 concentration (pa) - real, intent(in) :: sfcprs !air pressure at reference height (pa) - real, intent(in) :: sfctmp !air temperature at reference height (k) - real, intent(in) :: btran !soil water transpiration factor (0 to 1) - real, intent(in) :: foln !foliage nitrogen concentration (%) - real, intent(in) :: rb !boundary layer resistance (s/m) + real (kind=kind_phys), intent(in) :: igs !growing season index (0=off, 1=on) + real (kind=kind_phys), intent(in) :: mpe !prevents division by zero errors + + real (kind=kind_phys), intent(in) :: tv !foliage temperature (k) + real (kind=kind_phys), intent(in) :: ei !vapor pressure inside leaf (sat vapor press at tv) (pa) + real (kind=kind_phys), intent(in) :: ea !vapor pressure of canopy air (pa) + real (kind=kind_phys), intent(in) :: apar !par absorbed per unit lai (w/m2) + real (kind=kind_phys), intent(in) :: o2 !atmospheric o2 concentration (pa) + real (kind=kind_phys), intent(in) :: co2 !atmospheric co2 concentration (pa) + real (kind=kind_phys), intent(in) :: sfcprs !air pressure at reference height (pa) + real (kind=kind_phys), intent(in) :: sfctmp !air temperature at reference height (k) + real (kind=kind_phys), intent(in) :: btran !soil water transpiration factor (0 to 1) + real (kind=kind_phys), intent(in) :: foln !foliage nitrogen concentration (%) + real (kind=kind_phys), intent(in) :: rb !boundary layer resistance (s/m) ! output - real, intent(out) :: rs !leaf stomatal resistance (s/m) - real, intent(out) :: psn !foliage photosynthesis (umol co2 /m2/ s) [always +] + real (kind=kind_phys), intent(out) :: rs !leaf stomatal resistance (s/m) + real (kind=kind_phys), intent(out) :: psn !foliage photosynthesis (umol co2 /m2/ s) [always +] ! in&out - real :: rlb !boundary layer resistance (s m2 / umol) + real (kind=kind_phys) :: rlb !boundary layer resistance (s m2 / umol) ! --------------------------------------------------------------------------------------------- ! ------------------------ local variables ---------------------------------------------------- @@ -4754,32 +4922,32 @@ subroutine stomata (parameters,vegtyp ,mpe ,apar ,foln ,iloc , jlo data niter /3/ save niter - real :: ab !used in statement functions - real :: bc !used in statement functions - real :: f1 !generic temperature response (statement function) - real :: f2 !generic temperature inhibition (statement function) - real :: tc !foliage temperature (degree celsius) - real :: cs !co2 concentration at leaf surface (pa) - real :: kc !co2 michaelis-menten constant (pa) - real :: ko !o2 michaelis-menten constant (pa) - real :: a,b,c,q !intermediate calculations for rs - real :: r1,r2 !roots for rs - real :: fnf !foliage nitrogen adjustment factor (0 to 1) - real :: ppf !absorb photosynthetic photon flux (umol photons/m2/s) - real :: wc !rubisco limited photosynthesis (umol co2/m2/s) - real :: wj !light limited photosynthesis (umol co2/m2/s) - real :: we !export limited photosynthesis (umol co2/m2/s) - real :: cp !co2 compensation point (pa) - real :: ci !internal co2 (pa) - real :: awc !intermediate calculation for wc - real :: vcmx !maximum rate of carbonylation (umol co2/m2/s) - real :: j !electron transport (umol co2/m2/s) - real :: cea !constrain ea or else model blows up - real :: cf !s m2/umol -> s/m + real (kind=kind_phys) :: ab !used in statement functions + real (kind=kind_phys) :: bc !used in statement functions + real (kind=kind_phys) :: f1 !generic temperature response (statement function) + real (kind=kind_phys) :: f2 !generic temperature inhibition (statement function) + real (kind=kind_phys) :: tc !foliage temperature (degree celsius) + real (kind=kind_phys) :: cs !co2 concentration at leaf surface (pa) + real (kind=kind_phys) :: kc !co2 michaelis-menten constant (pa) + real (kind=kind_phys) :: ko !o2 michaelis-menten constant (pa) + real (kind=kind_phys) :: a,b,c,q !intermediate calculations for rs + real (kind=kind_phys) :: r1,r2 !roots for rs + real (kind=kind_phys) :: fnf !foliage nitrogen adjustment factor (0 to 1) + real (kind=kind_phys) :: ppf !absorb photosynthetic photon flux (umol photons/m2/s) + real (kind=kind_phys) :: wc !rubisco limited photosynthesis (umol co2/m2/s) + real (kind=kind_phys) :: wj !light limited photosynthesis (umol co2/m2/s) + real (kind=kind_phys) :: we !export limited photosynthesis (umol co2/m2/s) + real (kind=kind_phys) :: cp !co2 compensation point (pa) + real (kind=kind_phys) :: ci !internal co2 (pa) + real (kind=kind_phys) :: awc !intermediate calculation for wc + real (kind=kind_phys) :: vcmx !maximum rate of carbonylation (umol co2/m2/s) + real (kind=kind_phys) :: j !electron transport (umol co2/m2/s) + real (kind=kind_phys) :: cea !constrain ea or else model blows up + real (kind=kind_phys) :: cf !s m2/umol -> s/m f1(ab,bc) = ab**((bc-25.)/10.) f2(ab) = 1. + exp((-2.2e05+710.*(ab+273.16))/(8.314*(ab+273.16))) - real :: t + real (kind=kind_phys) :: t ! --------------------------------------------------------------------------------------------- ! initialize rs=rsmax and psn=0 because will only do calculations @@ -4867,26 +5035,26 @@ subroutine canres (parameters,par ,sfctmp,rcsoil ,eah ,sfcprs , & !in type (noahmp_parameters), intent(in) :: parameters integer, intent(in) :: iloc !grid index integer, intent(in) :: jloc !grid index - real, intent(in) :: par !par absorbed per unit sunlit lai (w/m2) - real, intent(in) :: sfctmp !canopy air temperature - real, intent(in) :: sfcprs !surface pressure (pa) - real, intent(in) :: eah !water vapor pressure (pa) - real, intent(in) :: rcsoil !soil moisture stress factor + real (kind=kind_phys), intent(in) :: par !par absorbed per unit sunlit lai (w/m2) + real (kind=kind_phys), intent(in) :: sfctmp !canopy air temperature + real (kind=kind_phys), intent(in) :: sfcprs !surface pressure (pa) + real (kind=kind_phys), intent(in) :: eah !water vapor pressure (pa) + real (kind=kind_phys), intent(in) :: rcsoil !soil moisture stress factor !outputs - real, intent(out) :: rc !canopy resistance per unit lai - real, intent(out) :: psn !foliage photosynthesis (umolco2/m2/s) + real (kind=kind_phys), intent(out) :: rc !canopy resistance per unit lai + real (kind=kind_phys), intent(out) :: psn !foliage photosynthesis (umolco2/m2/s) !local - real :: rcq - real :: rcs - real :: rct - real :: ff - real :: q2 !water vapor mixing ratio (kg/kg) - real :: q2sat !saturation q2 - real :: dqsdt2 !d(q2sat)/d(t) + real (kind=kind_phys) :: rcq + real (kind=kind_phys) :: rcs + real (kind=kind_phys) :: rct + real (kind=kind_phys) :: ff + real (kind=kind_phys) :: q2 !water vapor mixing ratio (kg/kg) + real (kind=kind_phys) :: q2sat !saturation q2 + real (kind=kind_phys) :: dqsdt2 !d(q2sat)/d(t) ! rsmin, rsmax, topt, rgl, hs are canopy stress parameters set in redprm ! ---------------------------------------------------------------------- @@ -4935,12 +5103,12 @@ subroutine calhum(parameters,sfctmp, sfcprs, q2sat, dqsdt2) implicit none type (noahmp_parameters), intent(in) :: parameters - real, intent(in) :: sfctmp, sfcprs - real, intent(out) :: q2sat, dqsdt2 - real, parameter :: a2=17.67,a3=273.15,a4=29.65, elwv=2.501e6, & + real (kind=kind_phys), intent(in) :: sfctmp, sfcprs + real (kind=kind_phys), intent(out) :: q2sat, dqsdt2 + real (kind=kind_phys), parameter :: a2=17.67,a3=273.15,a4=29.65, elwv=2.501e6, & a23m4=a2*(a3-a4), e0=0.611, rv=461.0, & epsilon=0.622 - real :: es, sfcprsx + real (kind=kind_phys) :: es, sfcprsx ! q2sat: saturated mixing ratio es = e0 * exp ( elwv/rv*(1./a3 - 1./sfctmp) ) @@ -4989,20 +5157,20 @@ subroutine tsnosoi (parameters,ice ,nsoil ,nsnow ,isnow ,ist , & ! integer, intent(in) :: isnow !actual no of snow layers integer, intent(in) :: ist !surface type - real, intent(in) :: dt !time step (s) - real, intent(in) :: tbot ! - real, intent(in) :: ssoil !ground heat flux (w/m2) - real, intent(in) :: sag !solar rad. absorbed by ground (w/m2) - real, intent(in) :: snowh !snow depth (m) - real, intent(in) :: tg !ground temperature (k) - real, dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bot. depth from snow surf.(m) - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness (m) - real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity - real, dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity (j/m3/k) + real (kind=kind_phys), intent(in) :: dt !time step (s) + real (kind=kind_phys), intent(in) :: tbot ! + real (kind=kind_phys), intent(in) :: ssoil !ground heat flux (w/m2) + real (kind=kind_phys), intent(in) :: sag !solar rad. absorbed by ground (w/m2) + real (kind=kind_phys), intent(in) :: snowh !snow depth (m) + real (kind=kind_phys), intent(in) :: tg !ground temperature (k) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bot. depth from snow surf.(m) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness (m) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity (j/m3/k) !input and output - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc #ifdef CCPP character(len=*) , intent(inout) :: errmsg integer , intent(inout) :: errflg @@ -5011,15 +5179,15 @@ subroutine tsnosoi (parameters,ice ,nsoil ,nsnow ,isnow ,ist , & ! !local integer :: iz - real :: zbotsno !zbot from snow surface - real, dimension(-nsnow+1:nsoil) :: ai, bi, ci, rhsts - real :: eflxb !energy influx from soil bottom (w/m2) - real, dimension(-nsnow+1:nsoil) :: phi !light through water (w/m2) - - real, dimension(-nsnow+1:nsoil) :: tbeg - real :: err_est !heat storage error (w/m2) - real :: ssoil2 !ground heat flux (w/m2) (for energy check) - real :: eflxb2 !heat flux from the bottom (w/m2) (for energy check) + real (kind=kind_phys) :: zbotsno !zbot from snow surface + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: ai, bi, ci, rhsts + real (kind=kind_phys) :: eflxb !energy influx from soil bottom (w/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: phi !light through water (w/m2) + + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: tbeg + real (kind=kind_phys) :: err_est !heat storage error (w/m2) + real (kind=kind_phys) :: ssoil2 !ground heat flux (w/m2) (for energy check) + real (kind=kind_phys) :: eflxb2 !heat flux from the bottom (w/m2) (for energy check) character(len=256) :: message ! ---------------------------------------------------------------------- ! compute solar penetration through water, needs more work @@ -5069,7 +5237,7 @@ subroutine tsnosoi (parameters,ice ,nsoil ,nsnow ,isnow ,ist , & ! err_est = err_est + (stc(iz)-tbeg(iz)) * dzsnso(iz) * hcpct(iz) / dt enddo - if (opt_stc == 1) then ! semi-implicit + if (opt_stc == 1 .or. opt_stc == 3) then ! semi-implicit err_est = err_est - (ssoil +eflxb) else ! full-implicit ssoil2 = df(isnow+1)*(tg-stc(isnow+1))/(0.5*dzsnso(isnow+1)) !m. barlage @@ -5117,34 +5285,34 @@ subroutine hrt (parameters,nsnow ,nsoil ,isnow ,zsnso , & integer, intent(in) :: nsoil !no of soil layers (4) integer, intent(in) :: nsnow !maximum no of snow layers (3) integer, intent(in) :: isnow !actual no of snow layers - real, intent(in) :: tbot !bottom soil temp. at zbot (k) - real, intent(in) :: zbot !depth of lower boundary condition (m) + real (kind=kind_phys), intent(in) :: tbot !bottom soil temp. at zbot (k) + real (kind=kind_phys), intent(in) :: zbot !depth of lower boundary condition (m) !from soil surface not snow surface - real, intent(in) :: dt !time step (s) - real, intent(in) :: ssoil !ground heat flux (w/m2) - real, dimension(-nsnow+1:nsoil), intent(in) :: zsnso !depth of layer-bottom of snow/soil (m) - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature (k) - real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity [w/m/k] - real, dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity [j/m3/k] - real, dimension(-nsnow+1:nsoil), intent(in) :: phi !light through water (w/m2) + real (kind=kind_phys), intent(in) :: dt !time step (s) + real (kind=kind_phys), intent(in) :: ssoil !ground heat flux (w/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: zsnso !depth of layer-bottom of snow/soil (m) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature (k) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity [w/m/k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity [j/m3/k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: phi !light through water (w/m2) ! output - real, dimension(-nsnow+1:nsoil), intent(out) :: rhsts !right-hand side of the matrix - real, dimension(-nsnow+1:nsoil), intent(out) :: ai !left-hand side coefficient - real, dimension(-nsnow+1:nsoil), intent(out) :: bi !left-hand side coefficient - real, dimension(-nsnow+1:nsoil), intent(out) :: ci !left-hand side coefficient - real, intent(out) :: botflx !energy influx from soil bottom (w/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: rhsts !right-hand side of the matrix + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: ai !left-hand side coefficient + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: bi !left-hand side coefficient + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: ci !left-hand side coefficient + real (kind=kind_phys), intent(out) :: botflx !energy influx from soil bottom (w/m2) ! local integer :: k - real, dimension(-nsnow+1:nsoil) :: ddz - real, dimension(-nsnow+1:nsoil) :: dz - real, dimension(-nsnow+1:nsoil) :: denom - real, dimension(-nsnow+1:nsoil) :: dtsdz - real, dimension(-nsnow+1:nsoil) :: eflux - real :: temp1 + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: ddz + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: dz + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: denom + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: dtsdz + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: eflux + real (kind=kind_phys) :: temp1 ! ---------------------------------------------------------------------- do k = isnow+1, nsoil @@ -5178,7 +5346,7 @@ subroutine hrt (parameters,nsnow ,nsoil ,isnow ,zsnso , & if (k == isnow+1) then ai(k) = 0.0 ci(k) = - df(k) * ddz(k) / denom(k) - if (opt_stc == 1) then + if (opt_stc == 1 .or. opt_stc == 3 ) then bi(k) = - ci(k) end if if (opt_stc == 2) then @@ -5215,19 +5383,19 @@ subroutine hstep (parameters,nsnow ,nsoil ,isnow ,dt , & integer, intent(in) :: nsoil integer, intent(in) :: nsnow integer, intent(in) :: isnow - real, intent(in) :: dt + real (kind=kind_phys), intent(in) :: dt ! output & input - real, dimension(-nsnow+1:nsoil), intent(inout) :: rhsts - real, dimension(-nsnow+1:nsoil), intent(inout) :: ai - real, dimension(-nsnow+1:nsoil), intent(inout) :: bi - real, dimension(-nsnow+1:nsoil), intent(inout) :: ci - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: rhsts + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: ai + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: bi + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: ci + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc ! local integer :: k - real, dimension(-nsnow+1:nsoil) :: rhstsin - real, dimension(-nsnow+1:nsoil) :: ciin + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: rhstsin + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: ciin ! ---------------------------------------------------------------------- do k = isnow+1,nsoil @@ -5237,7 +5405,6 @@ subroutine hstep (parameters,nsnow ,nsoil ,isnow ,dt , & ci(k) = ci(k) * dt end do - ! copy values for input variables before call to rosr12 do k = isnow+1,nsoil @@ -5247,7 +5414,6 @@ subroutine hstep (parameters,nsnow ,nsoil ,isnow ,dt , & ! solve the tri-diagonal matrix equation - call rosr12 (ci,ai,bi,ciin,rhstsin,rhsts,isnow+1,nsoil,nsnow) ! update snow & soil temperature @@ -5286,8 +5452,8 @@ subroutine rosr12 (p,a,b,c,d,delta,ntop,nsoil,nsnow) integer, intent(in) :: nsoil,nsnow integer :: k, kk - real, dimension(-nsnow+1:nsoil),intent(in):: a, b, d - real, dimension(-nsnow+1:nsoil),intent(inout):: c,p,delta + real (kind=kind_phys), dimension(-nsnow+1:nsoil),intent(in):: a, b, d + real (kind=kind_phys), dimension(-nsnow+1:nsoil),intent(inout):: c,p,delta ! ---------------------------------------------------------------------- ! initialize eqn coef c for the lowest soil layer @@ -5346,25 +5512,25 @@ subroutine phasechange (parameters,nsnow ,nsoil ,isnow ,dt ,fact , integer, intent(in) :: nsoil !no. of soil layers [=4] integer, intent(in) :: isnow !actual no. of snow layers [<=3] integer, intent(in) :: ist !surface type: 1->soil; 2->lake - real, intent(in) :: dt !land model time step (sec) - real, dimension(-nsnow+1:nsoil), intent(in) :: fact !temporary - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] - real, dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity (j/m3/k) + real (kind=kind_phys), intent(in) :: dt !land model time step (sec) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: fact !temporary + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity (j/m3/k) ! outputs integer, dimension(-nsnow+1:nsoil), intent(out) :: imelt !phase change index - real, intent(out) :: qmelt !snowmelt rate [mm/s] - real, intent(out) :: ponding!snowmelt when snow has no layer [mm] + real (kind=kind_phys), intent(out) :: qmelt !snowmelt rate [mm/s] + real (kind=kind_phys), intent(out) :: ponding!snowmelt when snow has no layer [mm] ! inputs and outputs - real, intent(inout) :: sneqv - real, intent(inout) :: snowh - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil layer temperature [k] - real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid water [m3/m3] - real, dimension( 1:nsoil), intent(inout) :: smc !total soil water [m3/m3] - real, dimension(-nsnow+1:0) , intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1:0) , intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), intent(inout) :: sneqv + real (kind=kind_phys), intent(inout) :: snowh + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil layer temperature [k] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid water [m3/m3] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: smc !total soil water [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1:0) , intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1:0) , intent(inout) :: snliq !snow layer liquid water [mm] #ifdef CCPP character(len=*) , intent(inout) :: errmsg integer , intent(inout) :: errflg @@ -5373,19 +5539,19 @@ subroutine phasechange (parameters,nsnow ,nsoil ,isnow ,dt ,fact , ! local integer :: j !do loop index - real, dimension(-nsnow+1:nsoil) :: hm !energy residual [w/m2] - real, dimension(-nsnow+1:nsoil) :: xm !melting or freezing water [kg/m2] - real, dimension(-nsnow+1:nsoil) :: wmass0 - real, dimension(-nsnow+1:nsoil) :: wice0 - real, dimension(-nsnow+1:nsoil) :: wliq0 - real, dimension(-nsnow+1:nsoil) :: mice !soil/snow ice mass [mm] - real, dimension(-nsnow+1:nsoil) :: mliq !soil/snow liquid water mass [mm] - real, dimension(-nsnow+1:nsoil) :: supercool !supercooled water in soil (kg/m2) - real :: heatr !energy residual or loss after melting/freezing - real :: temp1 !temporary variables [kg/m2] - real :: propor - real :: smp !frozen water potential (mm) - real :: xmf !total latent heat of phase change + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: hm !energy residual [w/m2] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: xm !melting or freezing water [kg/m2] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: wmass0 + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: wice0 + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: wliq0 + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: mice !soil/snow ice mass [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: mliq !soil/snow liquid water mass [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: supercool !supercooled water in soil (kg/m2) + real (kind=kind_phys) :: heatr !energy residual or loss after melting/freezing + real (kind=kind_phys) :: temp1 !temporary variables [kg/m2] + real (kind=kind_phys) :: propor + real (kind=kind_phys) :: smp !frozen water potential (mm) + real (kind=kind_phys) :: xmf !total latent heat of phase change ! ---------------------------------------------------------------------- ! initialization @@ -5422,16 +5588,16 @@ subroutine phasechange (parameters,nsnow ,nsoil ,isnow ,dt ,fact , if (opt_frz == 1) then if(stc(j) < tfrz) then smp = hfus*(tfrz-stc(j))/(grav*stc(j)) !(m) - supercool(j) = parameters%smcmax*(smp/parameters%psisat)**(-1./parameters%bexp) + supercool(j) = parameters%smcmax(j)*(smp/parameters%psisat(j))**(-1./parameters%bexp(j)) supercool(j) = supercool(j)*dzsnso(j)*1000. !(mm) end if end if if (opt_frz == 2) then #ifdef CCPP - call frh2o (parameters,supercool(j),stc(j),smc(j),sh2o(j),errmsg,errflg) + call frh2o (parameters,j,supercool(j),stc(j),smc(j),sh2o(j),errmsg,errflg) if (errflg /=0) return #else - call frh2o (parameters,supercool(j),stc(j),smc(j),sh2o(j)) + call frh2o (parameters,j,supercool(j),stc(j),smc(j),sh2o(j)) #endif supercool(j) = supercool(j)*dzsnso(j)*1000. !(mm) end if @@ -5480,6 +5646,7 @@ subroutine phasechange (parameters,nsnow ,nsoil ,isnow ,dt ,fact , sneqv = max(0.,temp1-xm(1)) propor = sneqv/temp1 snowh = max(0.,propor * snowh) + snowh = min(max(snowh,sneqv/500.0),sneqv/50.0) ! limit adjustment to a reasonable density heatr = hm(1) - hfus*(temp1-sneqv)/dt if (heatr > 0.) then xm(1) = heatr*dt/hfus @@ -5522,6 +5689,11 @@ subroutine phasechange (parameters,nsnow ,nsoil ,isnow ,dt ,fact , stc(j) = stc(j) + fact(j)*heatr if (j <= 0) then ! snow if (mliq(j)*mice(j)>0.) stc(j) = tfrz + if (mice(j) == 0.) then ! barlage + stc(j) = tfrz ! barlage + hm(j+1) = hm(j+1) + heatr ! barlage + xm(j+1) = hm(j+1)*dt/hfus ! barlage + endif end if endif @@ -5548,7 +5720,7 @@ end subroutine phasechange !== begin frh2o ==================================================================================== !>\ingroup NoahMP_LSM - subroutine frh2o (parameters,free,tkelv,smc,sh2o,& + subroutine frh2o (parameters,isoil,free,tkelv,smc,sh2o,& #ifdef CCPP errmsg,errflg) #else @@ -5584,16 +5756,17 @@ subroutine frh2o (parameters,free,tkelv,smc,sh2o,& ! ---------------------------------------------------------------------- implicit none type (noahmp_parameters), intent(in) :: parameters - real, intent(in) :: sh2o,smc,tkelv - real, intent(out) :: free + integer,intent(in) :: isoil + real (kind=kind_phys), intent(in) :: sh2o,smc,tkelv + real (kind=kind_phys), intent(out) :: free #ifdef CCPP character(len=*), intent(inout) :: errmsg integer, intent(inout) :: errflg #endif - real :: bx,denom,df,dswl,fk,swl,swlk + real (kind=kind_phys) :: bx,denom,df,dswl,fk,swl,swlk integer :: nlog,kcount ! parameter(ck = 0.0) - real, parameter :: ck = 8.0, blim = 5.5, error = 0.005, & + real (kind=kind_phys), parameter :: ck = 8.0, blim = 5.5, error = 0.005, & dice = 920.0 character(len=80) :: message @@ -5602,12 +5775,12 @@ subroutine frh2o (parameters,free,tkelv,smc,sh2o,& ! simulations showed if b > 5.5 unfrozen water content is ! non-realistically high at very low temperatures. ! ---------------------------------------------------------------------- - bx = parameters%bexp + bx = parameters%bexp(isoil) ! ---------------------------------------------------------------------- ! initializing iterations counter and iterative solution flag. ! ---------------------------------------------------------------------- - if (parameters%bexp > blim) bx = blim + if (parameters%bexp(isoil) > blim) bx = blim nlog = 0 ! ---------------------------------------------------------------------- @@ -5636,8 +5809,8 @@ subroutine frh2o (parameters,free,tkelv,smc,sh2o,& 1001 continue if (.not.( (nlog < 10) .and. (kcount == 0))) goto 1002 nlog = nlog +1 - df = alog ( ( parameters%psisat * grav / hfus ) * ( ( 1. + ck * swl )**2.) * & - ( parameters%smcmax / (smc - swl) )** bx) - alog ( - ( & + df = alog ( ( parameters%psisat(isoil) * grav / hfus ) * ( ( 1. + ck * swl )**2.) * & + ( parameters%smcmax(isoil) / (smc - swl) )** bx) - alog ( - ( & tkelv - tfrz)/ tkelv) denom = 2. * ck / ( 1. + ck * swl ) + bx / ( smc - swl ) swlk = swl - df / denom @@ -5682,8 +5855,8 @@ subroutine frh2o (parameters,free,tkelv,smc,sh2o,& #else call wrf_message(trim(message)) #endif - fk = ( ( (hfus / (grav * ( - parameters%psisat)))* & - ( (tkelv - tfrz)/ tkelv))** ( -1/ bx))* parameters%smcmax + fk = ( ( (hfus / (grav * ( - parameters%psisat(isoil))))* & + ( (tkelv - tfrz)/ tkelv))** ( -1/ bx))* parameters%smcmax(isoil) if (fk < 0.02) fk = 0.02 free = min (fk, smc) ! ---------------------------------------------------------------------- @@ -5729,91 +5902,91 @@ subroutine water (parameters,vegtyp ,nsnow ,nsoil ,imelt ,dt ,uu , & integer , intent(in) :: ist !surface type 1-soil; 2-lake integer, intent(in) :: nsoil !no. of soil layers integer, dimension(-nsnow+1:0) , intent(in) :: imelt !melting state index [1-melt; 2-freeze] - real, intent(in) :: dt !main time step (s) - real, intent(in) :: uu !u-direction wind speed [m/s] - real, intent(in) :: vv !v-direction wind speed [m/s] - real, intent(in) :: fcev !canopy evaporation (w/m2) [+ to atm ] - real, intent(in) :: fctr !transpiration (w/m2) [+ to atm] - real, intent(in) :: qprecc !convective precipitation (mm/s) - real, intent(in) :: qprecl !large-scale precipitation (mm/s) - real, intent(in) :: elai !leaf area index, after burying by snow - real, intent(in) :: esai !stem area index, after burying by snow - real, intent(in) :: sfctmp !surface air temperature [k] - real, intent(in) :: qvap !soil surface evaporation rate[mm/s] - real, intent(in) :: qdew !soil surface dew rate[mm/s] - real, dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottom from soil surface - real, dimension( 1:nsoil), intent(in) :: btrani !soil water stress factor (0 to 1) - real, dimension(-nsnow+1: 0), intent(in) :: ficeold !ice fraction at last timestep -! real , intent(in) :: ponding ![mm] - real , intent(in) :: tg !ground temperature (k) - real , intent(in) :: fveg !greeness vegetation fraction (-) - real , intent(in) :: bdfall !bulk density of snowfall (kg/m3) ! mb/an: v3.7 - real , intent(in) :: fp !fraction of the gridcell that receives precipitation ! mb/an: v3.7 - real , intent(in) :: rain !rainfall (mm/s) ! mb/an: v3.7 - real , intent(in) :: snow !snowfall (mm/s) ! mb/an: v3.7 - real, dimension( 1:nsoil), intent(in) :: smceq !equilibrium soil water content [m3/m3] (used in m-m&f groundwater dynamics) - real , intent(in) :: qsnow !snow at ground srf (mm/s) [+] - real , intent(in) :: qrain !rain at ground srf (mm) [+] - real , intent(in) :: snowhin !snow depth increasing rate (m/s) + real (kind=kind_phys), intent(in) :: dt !main time step (s) + real (kind=kind_phys), intent(in) :: uu !u-direction wind speed [m/s] + real (kind=kind_phys), intent(in) :: vv !v-direction wind speed [m/s] + real (kind=kind_phys), intent(in) :: fcev !canopy evaporation (w/m2) [+ to atm ] + real (kind=kind_phys), intent(in) :: fctr !transpiration (w/m2) [+ to atm] + real (kind=kind_phys), intent(in) :: qprecc !convective precipitation (mm/s) + real (kind=kind_phys), intent(in) :: qprecl !large-scale precipitation (mm/s) + real (kind=kind_phys), intent(in) :: elai !leaf area index, after burying by snow + real (kind=kind_phys), intent(in) :: esai !stem area index, after burying by snow + real (kind=kind_phys), intent(in) :: sfctmp !surface air temperature [k] + real (kind=kind_phys), intent(in) :: qvap !soil surface evaporation rate[mm/s] + real (kind=kind_phys), intent(in) :: qdew !soil surface dew rate[mm/s] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottom from soil surface + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: btrani !soil water stress factor (0 to 1) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: ficeold !ice fraction at last timestep +! real (kind=kind_phys) , intent(in) :: ponding ![mm] + real (kind=kind_phys) , intent(in) :: tg !ground temperature (k) + real (kind=kind_phys) , intent(in) :: fveg !greeness vegetation fraction (-) + real (kind=kind_phys) , intent(in) :: bdfall !bulk density of snowfall (kg/m3) ! mb/an: v3.7 + real (kind=kind_phys) , intent(in) :: fp !fraction of the gridcell that receives precipitation ! mb/an: v3.7 + real (kind=kind_phys) , intent(in) :: rain !rainfall (mm/s) ! mb/an: v3.7 + real (kind=kind_phys) , intent(in) :: snow !snowfall (mm/s) ! mb/an: v3.7 + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: smceq !equilibrium soil water content [m3/m3] (used in m-m&f groundwater dynamics) + real (kind=kind_phys) , intent(in) :: qsnow !snow at ground srf (mm/s) [+] + real (kind=kind_phys) , intent(in) :: qrain !rain at ground srf (mm) [+] + real (kind=kind_phys) , intent(in) :: snowhin !snow depth increasing rate (m/s) ! input/output integer, intent(inout) :: isnow !actual no. of snow layers - real, intent(inout) :: canliq !intercepted liquid water (mm) - real, intent(inout) :: canice !intercepted ice mass (mm) - real, intent(inout) :: tv !vegetation temperature (k) - real, intent(inout) :: snowh !snow height [m] - real, intent(inout) :: sneqv !snow water eqv. [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil layer temperature [k] - real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !depth of snow/soil layer-bottom - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !snow/soil layer thickness [m] - real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid water content [m3/m3] - real, dimension( 1:nsoil), intent(inout) :: sice !soil ice content [m3/m3] - real, dimension( 1:nsoil), intent(inout) :: smc !total soil water content [m3/m3] - real, intent(inout) :: zwt !the depth to water table [m] - real, intent(inout) :: wa !water storage in aquifer [mm] - real, intent(inout) :: wt !water storage in aquifer + real (kind=kind_phys), intent(inout) :: canliq !intercepted liquid water (mm) + real (kind=kind_phys), intent(inout) :: canice !intercepted ice mass (mm) + real (kind=kind_phys), intent(inout) :: tv !vegetation temperature (k) + real (kind=kind_phys), intent(inout) :: snowh !snow height [m] + real (kind=kind_phys), intent(inout) :: sneqv !snow water eqv. [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !depth of snow/soil layer-bottom + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid water content [m3/m3] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sice !soil ice content [m3/m3] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: smc !total soil water content [m3/m3] + real (kind=kind_phys), intent(inout) :: zwt !the depth to water table [m] + real (kind=kind_phys), intent(inout) :: wa !water storage in aquifer [mm] + real (kind=kind_phys), intent(inout) :: wt !water storage in aquifer !+ stuarated soil [mm] - real, intent(inout) :: wslake !water storage in lake (can be -) (mm) - real , intent(inout) :: ponding ![mm] - real, intent(inout) :: smcwtd !soil water content between bottom of the soil and water table [m3/m3] - real, intent(inout) :: deeprech !recharge to or from the water table when deep [m] - real, intent(inout) :: rech !recharge to or from the water table when shallow [m] (diagnostic) + real (kind=kind_phys), intent(inout) :: wslake !water storage in lake (can be -) (mm) + real (kind=kind_phys) , intent(inout) :: ponding ![mm] + real (kind=kind_phys), intent(inout) :: smcwtd !soil water content between bottom of the soil and water table [m3/m3] + real (kind=kind_phys), intent(inout) :: deeprech !recharge to or from the water table when deep [m] + real (kind=kind_phys), intent(inout) :: rech !recharge to or from the water table when shallow [m] (diagnostic) ! output - real, intent(out) :: cmc !intercepted water per ground area (mm) - real, intent(out) :: ecan !evap of intercepted water (mm/s) [+] - real, intent(out) :: etran !transpiration rate (mm/s) [+] - real, intent(out) :: fwet !wetted/snowed fraction of canopy (-) - real, intent(out) :: runsrf !surface runoff [mm/s] - real, intent(out) :: runsub !baseflow (sturation excess) [mm/s] - real, intent(out) :: qin !groundwater recharge [mm/s] - real, intent(out) :: qdis !groundwater discharge [mm/s] - real, intent(out) :: ponding1 - real, intent(out) :: ponding2 - real, intent(out) :: esnow - real, intent(out) :: qsnbot !melting water out of snow bottom [mm/s] - real , intent(in) :: latheav !latent heat vap./sublimation (j/kg) - real , intent(in) :: latheag !latent heat vap./sublimation (j/kg) + real (kind=kind_phys), intent(out) :: cmc !intercepted water per ground area (mm) + real (kind=kind_phys), intent(out) :: ecan !evap of intercepted water (mm/s) [+] + real (kind=kind_phys), intent(out) :: etran !transpiration rate (mm/s) [+] + real (kind=kind_phys), intent(out) :: fwet !wetted/snowed fraction of canopy (-) + real (kind=kind_phys), intent(out) :: runsrf !surface runoff [mm/s] + real (kind=kind_phys), intent(out) :: runsub !baseflow (sturation excess) [mm/s] + real (kind=kind_phys), intent(out) :: qin !groundwater recharge [mm/s] + real (kind=kind_phys), intent(out) :: qdis !groundwater discharge [mm/s] + real (kind=kind_phys), intent(out) :: ponding1 + real (kind=kind_phys), intent(out) :: ponding2 + real (kind=kind_phys), intent(out) :: esnow + real (kind=kind_phys), intent(out) :: qsnbot !melting water out of snow bottom [mm/s] + real (kind=kind_phys) , intent(in) :: latheav !latent heat vap./sublimation (j/kg) + real (kind=kind_phys) , intent(in) :: latheag !latent heat vap./sublimation (j/kg) logical , intent(in) :: frozen_ground ! used to define latent heat pathway logical , intent(in) :: frozen_canopy ! used to define latent heat pathway ! local integer :: iz - real :: qinsur !water input on soil surface [m/s] - real :: qseva !soil surface evap rate [mm/s] - real :: qsdew !soil surface dew rate [mm/s] - real :: qsnfro !snow surface frost rate[mm/s] - real :: qsnsub !snow surface sublimation rate [mm/s] - real, dimension( 1:nsoil) :: etrani !transpiration rate (mm/s) [+] - real, dimension( 1:nsoil) :: wcnd !hydraulic conductivity (m/s) - real :: qdrain !soil-bottom free drainage [mm/s] - real :: snoflow !glacier flow [mm/s] - real :: fcrmax !maximum of fcr (-) + real (kind=kind_phys) :: qinsur !water input on soil surface [m/s] + real (kind=kind_phys) :: qseva !soil surface evap rate [mm/s] + real (kind=kind_phys) :: qsdew !soil surface dew rate [mm/s] + real (kind=kind_phys) :: qsnfro !snow surface frost rate[mm/s] + real (kind=kind_phys) :: qsnsub !snow surface sublimation rate [mm/s] + real (kind=kind_phys), dimension( 1:nsoil) :: etrani !transpiration rate (mm/s) [+] + real (kind=kind_phys), dimension( 1:nsoil) :: wcnd !hydraulic conductivity (m/s) + real (kind=kind_phys) :: qdrain !soil-bottom free drainage [mm/s] + real (kind=kind_phys) :: snoflow !glacier flow [mm/s] + real (kind=kind_phys) :: fcrmax !maximum of fcr (-) - real, parameter :: wslmax = 5000. !maximum lake water storage (mm) + real (kind=kind_phys), parameter :: wslmax = 5000. !maximum lake water storage (mm) ! ---------------------------------------------------------------------- @@ -5841,7 +6014,7 @@ subroutine water (parameters,vegtyp ,nsnow ,nsoil ,imelt ,dt ,uu , & qsnsub = min(qvap, sneqv/dt) endif qseva = qvap-qsnsub - esnow = qsnsub*2.83e+6 + esnow = qsnsub*hsub qsnfro = 0. if (sneqv > 0.) then @@ -5951,38 +6124,38 @@ subroutine canwater (parameters,vegtyp ,dt , & !in integer,intent(in) :: iloc !grid index integer,intent(in) :: jloc !grid index integer,intent(in) :: vegtyp !vegetation type - real, intent(in) :: dt !main time step (s) - real, intent(in) :: fcev !canopy evaporation (w/m2) [+ = to atm] - real, intent(in) :: fctr !transpiration (w/m2) [+ = to atm] - real, intent(in) :: elai !leaf area index, after burying by snow - real, intent(in) :: esai !stem area index, after burying by snow - real, intent(in) :: tg !ground temperature (k) - real, intent(in) :: fveg !greeness vegetation fraction (-) + real (kind=kind_phys), intent(in) :: dt !main time step (s) + real (kind=kind_phys), intent(in) :: fcev !canopy evaporation (w/m2) [+ = to atm] + real (kind=kind_phys), intent(in) :: fctr !transpiration (w/m2) [+ = to atm] + real (kind=kind_phys), intent(in) :: elai !leaf area index, after burying by snow + real (kind=kind_phys), intent(in) :: esai !stem area index, after burying by snow + real (kind=kind_phys), intent(in) :: tg !ground temperature (k) + real (kind=kind_phys), intent(in) :: fveg !greeness vegetation fraction (-) logical , intent(in) :: frozen_canopy ! used to define latent heat pathway - real , intent(in) :: bdfall !bulk density of snowfall (kg/m3) ! mb/an: v3.7 + real (kind=kind_phys) , intent(in) :: bdfall !bulk density of snowfall (kg/m3) ! mb/an: v3.7 ! input & output - real, intent(inout) :: canliq !intercepted liquid water (mm) - real, intent(inout) :: canice !intercepted ice mass (mm) - real, intent(inout) :: tv !vegetation temperature (k) + real (kind=kind_phys), intent(inout) :: canliq !intercepted liquid water (mm) + real (kind=kind_phys), intent(inout) :: canice !intercepted ice mass (mm) + real (kind=kind_phys), intent(inout) :: tv !vegetation temperature (k) ! output - real, intent(out) :: cmc !intercepted water (mm) - real, intent(out) :: ecan !evaporation of intercepted water (mm/s) [+] - real, intent(out) :: etran !transpiration rate (mm/s) [+] - real, intent(out) :: fwet !wetted or snowed fraction of the canopy (-) + real (kind=kind_phys), intent(out) :: cmc !intercepted water (mm) + real (kind=kind_phys), intent(out) :: ecan !evaporation of intercepted water (mm/s) [+] + real (kind=kind_phys), intent(out) :: etran !transpiration rate (mm/s) [+] + real (kind=kind_phys), intent(out) :: fwet !wetted or snowed fraction of the canopy (-) ! -------------------------------------------------------------------- ! ------------------------ local variables --------------------------- - real :: maxsno !canopy capacity for snow interception (mm) - real :: maxliq !canopy capacity for rain interception (mm) - real :: qevac !evaporation rate (mm/s) - real :: qdewc !dew rate (mm/s) - real :: qfroc !frost rate (mm/s) - real :: qsubc !sublimation rate (mm/s) - real :: qmeltc !melting rate of canopy snow (mm/s) - real :: qfrzc !refreezing rate of canopy liquid water (mm/s) - real :: canmas !total canopy mass (kg/m2) + real (kind=kind_phys) :: maxsno !canopy capacity for snow interception (mm) + real (kind=kind_phys) :: maxliq !canopy capacity for rain interception (mm) + real (kind=kind_phys) :: qevac !evaporation rate (mm/s) + real (kind=kind_phys) :: qdewc !dew rate (mm/s) + real (kind=kind_phys) :: qfroc !frost rate (mm/s) + real (kind=kind_phys) :: qsubc !sublimation rate (mm/s) + real (kind=kind_phys) :: qmeltc !melting rate of canopy snow (mm/s) + real (kind=kind_phys) :: qfrzc !refreezing rate of canopy liquid water (mm/s) + real (kind=kind_phys) :: canmas !total canopy mass (kg/m2) ! -------------------------------------------------------------------- ! initialization @@ -6082,37 +6255,37 @@ subroutine snowwater (parameters,nsnow ,nsoil ,imelt ,dt ,zsoil , & !in integer, intent(in) :: nsnow !maximum no. of snow layers integer, intent(in) :: nsoil !no. of soil layers integer, dimension(-nsnow+1:0) , intent(in) :: imelt !melting state index [0-no melt;1-melt] - real, intent(in) :: dt !time step (s) - real, dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottom from soil surface - real, intent(in) :: sfctmp !surface air temperature [k] - real, intent(in) :: snowhin!snow depth increasing rate (m/s) - real, intent(in) :: qsnow !snow at ground srf (mm/s) [+] - real, intent(in) :: qsnfro !snow surface frost rate[mm/s] - real, intent(in) :: qsnsub !snow surface sublimation rate[mm/s] - real, intent(in) :: qrain !snow surface rain rate[mm/s] - real, dimension(-nsnow+1:0) , intent(in) :: ficeold!ice fraction at last timestep + real (kind=kind_phys), intent(in) :: dt !time step (s) + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottom from soil surface + real (kind=kind_phys), intent(in) :: sfctmp !surface air temperature [k] + real (kind=kind_phys), intent(in) :: snowhin!snow depth increasing rate (m/s) + real (kind=kind_phys), intent(in) :: qsnow !snow at ground srf (mm/s) [+] + real (kind=kind_phys), intent(in) :: qsnfro !snow surface frost rate[mm/s] + real (kind=kind_phys), intent(in) :: qsnsub !snow surface sublimation rate[mm/s] + real (kind=kind_phys), intent(in) :: qrain !snow surface rain rate[mm/s] + real (kind=kind_phys), dimension(-nsnow+1:0) , intent(in) :: ficeold!ice fraction at last timestep ! input & output integer, intent(inout) :: isnow !actual no. of snow layers - real, intent(inout) :: snowh !snow height [m] - real, intent(inout) :: sneqv !snow water eqv. [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] - real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) - real, dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] - real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !depth of snow/soil layer-bottom - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys), intent(inout) :: snowh !snow height [m] + real (kind=kind_phys), intent(inout) :: sneqv !snow water eqv. [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !depth of snow/soil layer-bottom + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !snow/soil layer thickness [m] ! output - real, intent(out) :: qsnbot !melting water out of snow bottom [mm/s] - real, intent(out) :: snoflow!glacier flow [mm] - real, intent(out) :: ponding1 - real, intent(out) :: ponding2 + real (kind=kind_phys), intent(out) :: qsnbot !melting water out of snow bottom [mm/s] + real (kind=kind_phys), intent(out) :: snoflow!glacier flow [mm] + real (kind=kind_phys), intent(out) :: ponding1 + real (kind=kind_phys), intent(out) :: ponding2 ! local integer :: iz,i - real :: bdsnow !bulk density of snow (kg/m3) + real (kind=kind_phys) :: bdsnow !bulk density of snow (kg/m3) ! ---------------------------------------------------------------------- snoflow = 0.0 ponding1 = 0.0 @@ -6158,9 +6331,9 @@ subroutine snowwater (parameters,nsnow ,nsoil ,imelt ,dt ,zsoil , & !in !to obtain equilibrium state of snow in glacier region - if(sneqv > 2000.) then ! 2000 mm -> maximum water depth + if(sneqv > 5000.) then ! 5000 mm -> maximum water depth bdsnow = snice(0) / dzsnso(0) - snoflow = (sneqv - 2000.) + snoflow = (sneqv - 5000.) snice(0) = snice(0) - snoflow dzsnso(0) = dzsnso(0) - snoflow/bdsnow snoflow = snoflow / dt @@ -6217,20 +6390,20 @@ subroutine snowfall (parameters,nsoil ,nsnow ,dt ,qsnow ,snowhin , & !in integer, intent(in) :: jloc !grid index integer, intent(in) :: nsoil !no. of soil layers integer, intent(in) :: nsnow !maximum no. of snow layers - real, intent(in) :: dt !main time step (s) - real, intent(in) :: qsnow !snow at ground srf (mm/s) [+] - real, intent(in) :: snowhin!snow depth increasing rate (m/s) - real, intent(in) :: sfctmp !surface air temperature [k] + real (kind=kind_phys), intent(in) :: dt !main time step (s) + real (kind=kind_phys), intent(in) :: qsnow !snow at ground srf (mm/s) [+] + real (kind=kind_phys), intent(in) :: snowhin!snow depth increasing rate (m/s) + real (kind=kind_phys), intent(in) :: sfctmp !surface air temperature [k] ! input and output integer, intent(inout) :: isnow !actual no. of snow layers - real, intent(inout) :: snowh !snow depth [m] - real, intent(inout) :: sneqv !swow water equivalent [m] - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !thickness of snow/soil layers (m) - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), intent(inout) :: snowh !snow depth [m] + real (kind=kind_phys), intent(inout) :: sneqv !swow water equivalent [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !thickness of snow/soil layers (m) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] ! local @@ -6289,16 +6462,16 @@ subroutine combine (parameters,nsnow ,nsoil ,iloc ,jloc , & !in ! input and output integer, intent(inout) :: isnow !actual no. of snow layers - real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) - real, dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso!snow layer depth [m] - real, intent(inout) :: sneqv !snow water equivalent [m] - real, intent(inout) :: snowh !snow depth [m] - real, intent(out) :: ponding1 - real, intent(out) :: ponding2 + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso!snow layer depth [m] + real (kind=kind_phys), intent(inout) :: sneqv !snow water equivalent [m] + real (kind=kind_phys), intent(inout) :: snowh !snow depth [m] + real (kind=kind_phys), intent(out) :: ponding1 + real (kind=kind_phys), intent(out) :: ponding2 ! local variables: @@ -6306,10 +6479,10 @@ subroutine combine (parameters,nsnow ,nsoil ,iloc ,jloc , & !in integer :: isnow_old ! number of top snow layer integer :: mssi ! node index integer :: neibor ! adjacent node selected for combination - real :: zwice ! total ice mass in snow - real :: zwliq ! total liquid water in snow + real (kind=kind_phys) :: zwice ! total ice mass in snow + real (kind=kind_phys) :: zwliq ! total liquid water in snow - real :: dzmin(3) ! minimum of top snow layer + real (kind=kind_phys) :: dzmin(3) ! minimum of top snow layer ! data dzmin /0.045, 0.05, 0.2/ data dzmin /0.025, 0.025, 0.1/ ! mb: change limit !----------------------------------------------------------------------- @@ -6321,10 +6494,12 @@ subroutine combine (parameters,nsnow ,nsoil ,iloc ,jloc , & !in if(j /= 0) then snliq(j+1) = snliq(j+1) + snliq(j) snice(j+1) = snice(j+1) + snice(j) + dzsnso(j+1) = dzsnso(j+1) + dzsnso(j) else if (isnow_old < -1) then ! mb/km: change to isnow snliq(j-1) = snliq(j-1) + snliq(j) snice(j-1) = snice(j-1) + snice(j) + dzsnso(j-1) = dzsnso(j-1) + dzsnso(j) else if(snice(j) >= 0.) then ponding1 = snliq(j) ! isnow will get set to zero below; ponding1 will get @@ -6472,24 +6647,24 @@ subroutine divide (parameters,nsnow ,nsoil , & !in ! input and output integer , intent(inout) :: isnow !actual no. of snow layers - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso!snow layer depth [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso!snow layer depth [m] ! local variables: integer :: j !indices integer :: msno !number of layer (top) to msno (bot) - real :: drr !thickness of the combined [m] - real, dimension( 1:nsnow) :: dz !snow layer thickness [m] - real, dimension( 1:nsnow) :: swice !partial volume of ice [m3/m3] - real, dimension( 1:nsnow) :: swliq !partial volume of liquid water [m3/m3] - real, dimension( 1:nsnow) :: tsno !node temperature [k] - real :: zwice !temporary - real :: zwliq !temporary - real :: propor!temporary - real :: dtdz !temporary + real (kind=kind_phys) :: drr !thickness of the combined [m] + real (kind=kind_phys), dimension( 1:nsnow) :: dz !snow layer thickness [m] + real (kind=kind_phys), dimension( 1:nsnow) :: swice !partial volume of ice [m3/m3] + real (kind=kind_phys), dimension( 1:nsnow) :: swliq !partial volume of liquid water [m3/m3] + real (kind=kind_phys), dimension( 1:nsnow) :: tsno !node temperature [k] + real (kind=kind_phys) :: zwice !temporary + real (kind=kind_phys) :: zwliq !temporary + real (kind=kind_phys) :: propor!temporary + real (kind=kind_phys) :: dtdz !temporary ! ---------------------------------------------------------------------- do j = 1,nsnow @@ -6596,24 +6771,24 @@ subroutine combo(parameters,dz, wliq, wice, t, dz2, wliq2, wice2, t2) ! input type (noahmp_parameters), intent(in) :: parameters - real, intent(in) :: dz2 !nodal thickness of 2 elements being combined [m] - real, intent(in) :: wliq2 !liquid water of element 2 [kg/m2] - real, intent(in) :: wice2 !ice of element 2 [kg/m2] - real, intent(in) :: t2 !nodal temperature of element 2 [k] - real, intent(inout) :: dz !nodal thickness of 1 elements being combined [m] - real, intent(inout) :: wliq !liquid water of element 1 - real, intent(inout) :: wice !ice of element 1 [kg/m2] - real, intent(inout) :: t !node temperature of element 1 [k] + real (kind=kind_phys), intent(in) :: dz2 !nodal thickness of 2 elements being combined [m] + real (kind=kind_phys), intent(in) :: wliq2 !liquid water of element 2 [kg/m2] + real (kind=kind_phys), intent(in) :: wice2 !ice of element 2 [kg/m2] + real (kind=kind_phys), intent(in) :: t2 !nodal temperature of element 2 [k] + real (kind=kind_phys), intent(inout) :: dz !nodal thickness of 1 elements being combined [m] + real (kind=kind_phys), intent(inout) :: wliq !liquid water of element 1 + real (kind=kind_phys), intent(inout) :: wice !ice of element 1 [kg/m2] + real (kind=kind_phys), intent(inout) :: t !node temperature of element 1 [k] ! local - real :: dzc !total thickness of nodes 1 and 2 (dzc=dz+dz2). - real :: wliqc !combined liquid water [kg/m2] - real :: wicec !combined ice [kg/m2] - real :: tc !combined node temperature [k] - real :: h !enthalpy of element 1 [j/m2] - real :: h2 !enthalpy of element 2 [j/m2] - real :: hc !temporary + real (kind=kind_phys) :: dzc !total thickness of nodes 1 and 2 (dzc=dz+dz2). + real (kind=kind_phys) :: wliqc !combined liquid water [kg/m2] + real (kind=kind_phys) :: wicec !combined ice [kg/m2] + real (kind=kind_phys) :: tc !combined node temperature [k] + real (kind=kind_phys) :: h !enthalpy of element 1 [j/m2] + real (kind=kind_phys) :: h2 !enthalpy of element 2 [j/m2] + real (kind=kind_phys) :: hc !temporary !----------------------------------------------------------------------- @@ -6655,37 +6830,37 @@ subroutine compact (parameters,nsnow ,nsoil ,dt ,stc ,snice , & !in integer, intent(in) :: nsoil !no. of soil layers [ =4] integer, intent(in) :: nsnow !maximum no. of snow layers [ =3] integer, dimension(-nsnow+1:0) , intent(in) :: imelt !melting state index [0-no melt;1-melt] - real, intent(in) :: dt !time step (sec) - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow layer temperature [k] - real, dimension(-nsnow+1: 0), intent(in) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(in) :: snliq !snow layer liquid water [mm] - real, dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottom from soil srf - real, dimension(-nsnow+1: 0), intent(in) :: ficeold!ice fraction at last timestep + real (kind=kind_phys), intent(in) :: dt !time step (sec) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottom from soil srf + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: ficeold!ice fraction at last timestep ! input and output integer, intent(inout) :: isnow ! actual no. of snow layers - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso ! snow layer thickness [m] - real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso ! depth of snow/soil layer-bottom + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso ! snow layer thickness [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: zsnso ! depth of snow/soil layer-bottom ! local - real, parameter :: c2 = 21.e-3 ![m3/kg] ! default 21.e-3 - real, parameter :: c3 = 2.5e-6 ![1/s] - real, parameter :: c4 = 0.04 ![1/k] - real, parameter :: c5 = 2.0 ! - real, parameter :: dm = 100.0 !upper limit on destructive metamorphism compaction [kg/m3] - real, parameter :: eta0 = 0.8e+6 !viscosity coefficient [kg-s/m2] + real (kind=kind_phys), parameter :: c2 = 21.e-3 ![m3/kg] ! default 21.e-3 + real (kind=kind_phys), parameter :: c3 = 2.5e-6 ![1/s] + real (kind=kind_phys), parameter :: c4 = 0.04 ![1/k] + real (kind=kind_phys), parameter :: c5 = 2.0 ! + real (kind=kind_phys), parameter :: dm = 100.0 !upper limit on destructive metamorphism compaction [kg/m3] + real (kind=kind_phys), parameter :: eta0 = 0.8e+6 !viscosity coefficient [kg-s/m2] !according to anderson, it is between 0.52e6~1.38e6 - real :: burden !pressure of overlying snow [kg/m2] - real :: ddz1 !rate of settling of snow pack due to destructive metamorphism. - real :: ddz2 !rate of compaction of snow pack due to overburden. - real :: ddz3 !rate of compaction of snow pack due to melt [1/s] - real :: dexpf !expf=exp(-c4*(273.15-stc)). - real :: td !stc - tfrz [k] - real :: pdzdtc !nodal rate of change in fractional-thickness due to compaction [fraction/s] - real :: void !void (1 - snice - snliq) - real :: wx !water mass (ice + liquid) [kg/m2] - real :: bi !partial density of ice [kg/m3] - real, dimension(-nsnow+1:0) :: fice !fraction of ice at current time step + real (kind=kind_phys) :: burden !pressure of overlying snow [kg/m2] + real (kind=kind_phys) :: ddz1 !rate of settling of snow pack due to destructive metamorphism. + real (kind=kind_phys) :: ddz2 !rate of compaction of snow pack due to overburden. + real (kind=kind_phys) :: ddz3 !rate of compaction of snow pack due to melt [1/s] + real (kind=kind_phys) :: dexpf !expf=exp(-c4*(273.15-stc)). + real (kind=kind_phys) :: td !stc - tfrz [k] + real (kind=kind_phys) :: pdzdtc !nodal rate of change in fractional-thickness due to compaction [fraction/s] + real (kind=kind_phys) :: void !void (1 - snice - snliq) + real (kind=kind_phys) :: wx !water mass (ice + liquid) [kg/m2] + real (kind=kind_phys) :: bi !partial density of ice [kg/m3] + real (kind=kind_phys), dimension(-nsnow+1:0) :: fice !fraction of ice at current time step integer :: j @@ -6735,6 +6910,7 @@ subroutine compact (parameters,nsnow ,nsoil ,dt ,stc ,snice , & !in ! the change in dz due to compaction dzsnso(j) = dzsnso(j)*(1.+pdzdtc) + dzsnso(j) = max(dzsnso(j),snice(j)/denice + snliq(j)/denh2o) end if ! pressure of overlying snow @@ -6766,38 +6942,39 @@ subroutine snowh2o (parameters,nsnow ,nsoil ,dt ,qsnfro ,qsnsub , & !in integer, intent(in) :: jloc !grid index integer, intent(in) :: nsnow !maximum no. of snow layers[=3] integer, intent(in) :: nsoil !no. of soil layers[=4] - real, intent(in) :: dt !time step - real, intent(in) :: qsnfro !snow surface frost rate[mm/s] - real, intent(in) :: qsnsub !snow surface sublimation rate[mm/s] - real, intent(in) :: qrain !snow surface rain rate[mm/s] + real (kind=kind_phys), intent(in) :: dt !time step + real (kind=kind_phys), intent(in) :: qsnfro !snow surface frost rate[mm/s] + real (kind=kind_phys), intent(in) :: qsnsub !snow surface sublimation rate[mm/s] + real (kind=kind_phys), intent(in) :: qrain !snow surface rain rate[mm/s] ! output - real, intent(out) :: qsnbot !melting water out of snow bottom [mm/s] + real (kind=kind_phys), intent(out) :: qsnbot !melting water out of snow bottom [mm/s] ! input and output integer, intent(inout) :: isnow !actual no. of snow layers - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso ! snow layer depth [m] - real, intent(inout) :: snowh !snow height [m] - real, intent(inout) :: sneqv !snow water eqv. [mm] - real, dimension(-nsnow+1:0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1:0), intent(inout) :: snliq !snow layer liquid water [mm] - real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) - real, dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso ! snow layer depth [m] + real (kind=kind_phys), intent(inout) :: snowh !snow height [m] + real (kind=kind_phys), intent(inout) :: sneqv !snow water eqv. [mm] + real (kind=kind_phys), dimension(-nsnow+1:0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1:0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] ! local variables: integer :: j !do loop/array indices - real :: qin !water flow into the element (mm/s) - real :: qout !water flow out of the element (mm/s) - real :: wgdif !ice mass after minus sublimation - real, dimension(-nsnow+1:0) :: vol_liq !partial volume of liquid water in layer - real, dimension(-nsnow+1:0) :: vol_ice !partial volume of ice lens in layer - real, dimension(-nsnow+1:0) :: epore !effective porosity = porosity - vol_ice - real :: propor, temp - real :: ponding1, ponding2 + real (kind=kind_phys) :: qin !water flow into the element (mm/s) + real (kind=kind_phys) :: qout !water flow out of the element (mm/s) + real (kind=kind_phys) :: wgdif !ice mass after minus sublimation + real (kind=kind_phys), dimension(-nsnow+1:0) :: vol_liq !partial volume of liquid water in layer + real (kind=kind_phys), dimension(-nsnow+1:0) :: vol_ice !partial volume of ice lens in layer + real (kind=kind_phys), dimension(-nsnow+1:0) :: epore !effective porosity = porosity - vol_ice + real (kind=kind_phys) :: propor, temp + real (kind=kind_phys) :: ponding1, ponding2 + REAL, PARAMETER :: max_liq_mass_fraction = 0.4 ! ---------------------------------------------------------------------- !for the case when sneqv becomes '0' after 'combine' @@ -6820,6 +6997,7 @@ subroutine snowh2o (parameters,nsnow ,nsoil ,dt ,qsnfro ,qsnsub , & !in sneqv = sneqv - qsnsub*dt + qsnfro*dt propor = sneqv/temp snowh = max(0.,propor * snowh) + snowh = min(max(snowh,sneqv/500.0),sneqv/50.0) ! limit adjustment to a reasonable density if(sneqv < 0.) then sice(1) = sice(1) + sneqv/(dzsnso(1)*1000.) @@ -6859,38 +7037,32 @@ subroutine snowh2o (parameters,nsnow ,nsoil ,dt ,qsnfro ,qsnsub , & !in ! porosity and partial volume - !kwm looks to me like loop index / if test can be simplified. - - do j = -nsnow+1, 0 - if (j >= isnow+1) then - vol_ice(j) = min(1., snice(j)/(dzsnso(j)*denice)) - epore(j) = 1. - vol_ice(j) - vol_liq(j) = min(epore(j),snliq(j)/(dzsnso(j)*denh2o)) - end if + do j = isnow+1, 0 + vol_ice(j) = min(1., snice(j)/(dzsnso(j)*denice)) + epore(j) = 1. - vol_ice(j) end do qin = 0. qout = 0. - !kwm looks to me like loop index / if test can be simplified. + do j = isnow+1, 0 + snliq(j) = snliq(j) + qin + vol_liq(j) = snliq(j)/(dzsnso(j)*denh2o) + qout = max(0.,(vol_liq(j)-parameters%ssi*epore(j))*dzsnso(j)) + if(j == 0) then + qout = max((vol_liq(j)- epore(j))*dzsnso(j) , parameters%snow_ret_fac*dt*qout) + end if + qout = qout*denh2o + snliq(j) = snliq(j) - qout + if((snliq(j)/(snice(j)+snliq(j))) > max_liq_mass_fraction) then + qout = qout + (snliq(j) - max_liq_mass_fraction/(1.0 - max_liq_mass_fraction)*snice(j)) + snliq(j) = max_liq_mass_fraction/(1.0 - max_liq_mass_fraction)*snice(j) + endif + qin = qout + end do - do j = -nsnow+1, 0 - if (j >= isnow+1) then - snliq(j) = snliq(j) + qin - if (j <= -1) then - if (epore(j) < 0.05 .or. epore(j+1) < 0.05) then - qout = 0. - else - qout = max(0.,(vol_liq(j)-parameters%ssi*epore(j))*dzsnso(j)) - qout = min(qout,(1.-vol_ice(j+1)-vol_liq(j+1))*dzsnso(j+1)) - end if - else - qout = max(0.,(vol_liq(j) - parameters%ssi*epore(j))*dzsnso(j)) - end if - qout = qout*1000. - snliq(j) = snliq(j) - qout - qin = qout - end if + do j = isnow+1, 0 + dzsnso(j) = max(dzsnso(j),snliq(j)/denh2o + snice(j)/denice) end do ! liquid water from snow bottom to soil @@ -6920,60 +7092,61 @@ subroutine soilwater (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in integer, intent(in) :: jloc !grid index integer, intent(in) :: nsoil !no. of soil layers integer, intent(in) :: nsnow !maximum no. of snow layers - real, intent(in) :: dt !time step (sec) - real, intent(in) :: qinsur !water input on soil surface [mm/s] - real, intent(in) :: qseva !evap from soil surface [mm/s] - real, dimension(1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] - real, dimension(1:nsoil), intent(in) :: etrani !evapotranspiration from soil layers [mm/s] - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer depth [m] - real, dimension(1:nsoil), intent(in) :: sice !soil ice content [m3/m3] + real (kind=kind_phys), intent(in) :: dt !time step (sec) + real (kind=kind_phys), intent(in) :: qinsur !water input on soil surface [mm/s] + real (kind=kind_phys), intent(in) :: qseva !evap from soil surface [mm/s] + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: etrani !evapotranspiration from soil layers [mm/s] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer depth [m] + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: sice !soil ice content [m3/m3] integer, intent(in) :: vegtyp ! input & output - real, dimension(1:nsoil), intent(inout) :: sh2o !soil liquid water content [m3/m3] - real, dimension(1:nsoil), intent(inout) :: smc !total soil water content [m3/m3] - real, intent(inout) :: zwt !water table depth [m] - real, intent(inout) :: smcwtd !soil moisture between bottom of the soil and the water table [m3/m3] - real , intent(inout) :: deeprech + real (kind=kind_phys), dimension(1:nsoil), intent(inout) :: sh2o !soil liquid water content [m3/m3] + real (kind=kind_phys), dimension(1:nsoil), intent(inout) :: smc !total soil water content [m3/m3] + real (kind=kind_phys), intent(inout) :: zwt !water table depth [m] + real (kind=kind_phys), intent(inout) :: smcwtd !soil moisture between bottom of the soil and the water table [m3/m3] + real (kind=kind_phys) , intent(inout) :: deeprech ! output - real, intent(out) :: qdrain !soil-bottom free drainage [mm/s] - real, intent(out) :: runsrf !surface runoff [mm/s] - real, intent(out) :: runsub !subsurface runoff [mm/s] - real, intent(out) :: fcrmax !maximum of fcr (-) - real, dimension(1:nsoil), intent(out) :: wcnd !hydraulic conductivity (m/s) + real (kind=kind_phys), intent(out) :: qdrain !soil-bottom free drainage [mm/s] + real (kind=kind_phys), intent(out) :: runsrf !surface runoff [mm/s] + real (kind=kind_phys), intent(out) :: runsub !subsurface runoff [mm/s] + real (kind=kind_phys), intent(out) :: fcrmax !maximum of fcr (-) + real (kind=kind_phys), dimension(1:nsoil), intent(out) :: wcnd !hydraulic conductivity (m/s) ! local integer :: k,iz !do-loop index integer :: iter !iteration index - real :: dtfine !fine time step (s) - real, dimension(1:nsoil) :: rhstt !right-hand side term of the matrix - real, dimension(1:nsoil) :: ai !left-hand side term - real, dimension(1:nsoil) :: bi !left-hand side term - real, dimension(1:nsoil) :: ci !left-hand side term - - real :: fff !runoff decay factor (m-1) - real :: rsbmx !baseflow coefficient [mm/s] - real :: pddum !infiltration rate at surface (m/s) - real :: fice !ice fraction in frozen soil - real :: wplus !saturation excess of the total soil [m] - real :: rsat !accumulation of wplus (saturation excess) [m] - real :: sicemax!maximum soil ice content (m3/m3) - real :: sh2omin!minimum soil liquid water content (m3/m3) - real :: wtsub !sum of wcnd(k)*dzsnso(k) - real :: mh2o !water mass removal (mm) - real :: fsat !fractional saturated area (-) - real, dimension(1:nsoil) :: mliq ! - real :: xs ! - real :: watmin ! - real :: qdrain_save ! - real :: epore !effective porosity [m3/m3] - real, dimension(1:nsoil) :: fcr !impermeable fraction due to frozen soil + real (kind=kind_phys) :: dtfine !fine time step (s) + real (kind=kind_phys), dimension(1:nsoil) :: rhstt !right-hand side term of the matrix + real (kind=kind_phys), dimension(1:nsoil) :: ai !left-hand side term + real (kind=kind_phys), dimension(1:nsoil) :: bi !left-hand side term + real (kind=kind_phys), dimension(1:nsoil) :: ci !left-hand side term + + real (kind=kind_phys) :: fff !runoff decay factor (m-1) + real (kind=kind_phys) :: rsbmx !baseflow coefficient [mm/s] + real (kind=kind_phys) :: pddum !infiltration rate at surface (m/s) + real (kind=kind_phys) :: fice !ice fraction in frozen soil + real (kind=kind_phys) :: wplus !saturation excess of the total soil [m] + real (kind=kind_phys) :: rsat !accumulation of wplus (saturation excess) [m] + real (kind=kind_phys) :: sicemax!maximum soil ice content (m3/m3) + real (kind=kind_phys) :: sh2omin!minimum soil liquid water content (m3/m3) + real (kind=kind_phys) :: wtsub !sum of wcnd(k)*dzsnso(k) + real (kind=kind_phys) :: mh2o !water mass removal (mm) + real (kind=kind_phys) :: fsat !fractional saturated area (-) + real (kind=kind_phys), dimension(1:nsoil) :: mliq ! + real (kind=kind_phys) :: xs ! + real (kind=kind_phys) :: watmin ! + real (kind=kind_phys) :: qdrain_save ! + real (kind=kind_phys) :: runsrf_save ! + real (kind=kind_phys) :: epore !effective porosity [m3/m3] + real (kind=kind_phys), dimension(1:nsoil) :: fcr !impermeable fraction due to frozen soil integer :: niter !iteration times soil moisture (-) - real :: smctot !2-m averaged soil moisture (m3/m3) - real :: dztot !2-m soil depth (m) - real, parameter :: a = 4.0 + real (kind=kind_phys) :: smctot !2-m averaged soil moisture (m3/m3) + real (kind=kind_phys) :: dztot !2-m soil depth (m) + real (kind=kind_phys), parameter :: a = 4.0 ! ---------------------------------------------------------------------- runsrf = 0.0 pddum = 0.0 @@ -6982,7 +7155,7 @@ subroutine soilwater (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in ! for the case when snowmelt water is too large do k = 1,nsoil - epore = max ( 1.e-4 , ( parameters%smcmax - sice(k) ) ) + epore = max ( 1.e-4 , ( parameters%smcmax(k) - sice(k) ) ) rsat = rsat + max(0.,sh2o(k)-epore)*dzsnso(k) sh2o(k) = min(epore,sh2o(k)) end do @@ -6990,7 +7163,7 @@ subroutine soilwater (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in !impermeable fraction due to frozen soil do k = 1,nsoil - fice = min(1.0,sice(k)/parameters%smcmax) + fice = min(1.0,sice(k)/parameters%smcmax(k)) fcr(k) = max(0.0,exp(-a*(1.-fice))- exp(-a)) / & (1.0 - exp(-a)) end do @@ -6999,7 +7172,7 @@ subroutine soilwater (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in sicemax = 0.0 fcrmax = 0.0 - sh2omin = parameters%smcmax + sh2omin = parameters%smcmax(1) do k = 1,nsoil if (sice(k) > sicemax) sicemax = sice(k) if (fcr(k) > fcrmax) fcrmax = fcr(k) @@ -7058,11 +7231,11 @@ subroutine soilwater (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in dztot = 0. do k = 1,nsoil dztot = dztot + dzsnso(k) - smctot = smctot + smc(k)*dzsnso(k) + smctot = smctot + smc(k)/parameters%smcmax(k)*dzsnso(k) if(dztot >= 2.0) exit end do smctot = smctot/dztot - fsat = max(0.01,smctot/parameters%smcmax) ** 4. !bats + fsat = max(0.01,smctot) ** 4. !bats if(qinsur > 0.) then runsrf = qinsur * ((1.0-fcr(1))*fsat+fcr(1)) @@ -7074,19 +7247,26 @@ subroutine soilwater (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in niter = 1 - if(opt_inf == 1) then !opt_inf =2 may cause water imbalance +! if(opt_inf == 1) then !opt_inf =2 may cause water imbalance niter = 3 - if (pddum*dt>dzsnso(1)*parameters%smcmax ) then + if (pddum*dt>dzsnso(1)*parameters%smcmax(1) ) then niter = niter*2 end if - end if +! end if dtfine = dt / niter ! solve soil moisture qdrain_save = 0.0 + runsrf_save = 0.0 do iter = 1, niter + if(qinsur > 0. .and. opt_run == 3) then + call infil (parameters,nsoil ,dtfine ,zsoil ,sh2o ,sice , & !in + sicemax,qinsur , & !in + pddum ,runsrf ) !out + end if + call srt (parameters,nsoil ,zsoil ,dtfine ,pddum ,etrani , & !in qseva ,sh2o ,smc ,zwt ,fcr , & !in sicemax,fcrmax ,iloc ,jloc ,smcwtd , & !in @@ -7100,9 +7280,11 @@ subroutine soilwater (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in wplus) !out rsat = rsat + wplus qdrain_save = qdrain_save + qdrain + runsrf_save = runsrf_save + runsrf end do qdrain = qdrain_save/niter + runsrf = runsrf_save/niter runsrf = runsrf * 1000. + rsat * 1000./dt ! m/s -> mm/s qdrain = qdrain * 1000. @@ -7174,28 +7356,28 @@ subroutine zwteq (parameters,nsoil ,nsnow ,zsoil ,dzsnso ,sh2o ,zwt) type (noahmp_parameters), intent(in) :: parameters integer, intent(in) :: nsoil !no. of soil layers integer, intent(in) :: nsnow !maximum no. of snow layers - real, dimension(1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer depth [m] - real, dimension(1:nsoil), intent(in) :: sh2o !soil liquid water content [m3/m3] + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer depth [m] + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: sh2o !soil liquid water content [m3/m3] ! output - real, intent(out) :: zwt !water table depth [m] + real (kind=kind_phys), intent(out) :: zwt !water table depth [m] ! locals integer :: k !do-loop index integer, parameter :: nfine = 100 !no. of fine soil layers of 6m soil - real :: wd1 !water deficit from coarse (4-l) soil moisture profile - real :: wd2 !water deficit from fine (100-l) soil moisture profile - real :: dzfine !layer thickness of the 100-l soil layers to 6.0 m - real :: temp !temporary variable - real, dimension(1:nfine) :: zfine !layer-bottom depth of the 100-l soil layers to 6.0 m + real (kind=kind_phys) :: wd1 !water deficit from coarse (4-l) soil moisture profile + real (kind=kind_phys) :: wd2 !water deficit from fine (100-l) soil moisture profile + real (kind=kind_phys) :: dzfine !layer thickness of the 100-l soil layers to 6.0 m + real (kind=kind_phys) :: temp !temporary variable + real (kind=kind_phys), dimension(1:nfine) :: zfine !layer-bottom depth of the 100-l soil layers to 6.0 m ! ---------------------------------------------------------------------- wd1 = 0. do k = 1,nsoil - wd1 = wd1 + (parameters%smcmax-sh2o(k)) * dzsnso(k) ! [m] + wd1 = wd1 + (parameters%smcmax(1)-sh2o(k)) * dzsnso(k) ! [m] enddo dzfine = 3.0 * (-zsoil(nsoil)) / nfine @@ -7207,8 +7389,8 @@ subroutine zwteq (parameters,nsoil ,nsnow ,zsoil ,dzsnso ,sh2o ,zwt) wd2 = 0. do k = 1,nfine - temp = 1. + (zwt-zfine(k))/parameters%psisat - wd2 = wd2 + parameters%smcmax*(1.-temp**(-1./parameters%bexp))*dzfine + temp = 1. + (zwt-zfine(k))/parameters%psisat(1) + wd2 = wd2 + parameters%smcmax(1)*(1.-temp**(-1./parameters%bexp(1)))*dzfine if(abs(wd2-wd1).le.0.01) then zwt = zfine(k) exit @@ -7231,50 +7413,50 @@ subroutine infil (parameters,nsoil ,dt ,zsoil ,sh2o ,sice , & !in ! inputs type (noahmp_parameters), intent(in) :: parameters integer, intent(in) :: nsoil !no. of soil layers - real, intent(in) :: dt !time step (sec) - real, dimension(1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] - real, dimension(1:nsoil), intent(in) :: sh2o !soil liquid water content [m3/m3] - real, dimension(1:nsoil), intent(in) :: sice !soil ice content [m3/m3] - real, intent(in) :: qinsur !water input on soil surface [mm/s] - real, intent(in) :: sicemax!maximum soil ice content (m3/m3) + real (kind=kind_phys), intent(in) :: dt !time step (sec) + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: sh2o !soil liquid water content [m3/m3] + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: sice !soil ice content [m3/m3] + real (kind=kind_phys), intent(in) :: qinsur !water input on soil surface [mm/s] + real (kind=kind_phys), intent(in) :: sicemax!maximum soil ice content (m3/m3) ! outputs - real, intent(out) :: runsrf !surface runoff [mm/s] - real, intent(out) :: pddum !infiltration rate at surface + real (kind=kind_phys), intent(out) :: runsrf !surface runoff [mm/s] + real (kind=kind_phys), intent(out) :: pddum !infiltration rate at surface ! locals integer :: ialp1, j, jj, k - real :: val - real :: ddt - real :: px - real :: dt1, dd, dice - real :: fcr - real :: sum - real :: acrt - real :: wdf - real :: wcnd - real :: smcav - real :: infmax - real, dimension(1:nsoil) :: dmax + real (kind=kind_phys) :: val + real (kind=kind_phys) :: ddt + real (kind=kind_phys) :: px + real (kind=kind_phys) :: dt1, dd, dice + real (kind=kind_phys) :: fcr + real (kind=kind_phys) :: sum + real (kind=kind_phys) :: acrt + real (kind=kind_phys) :: wdf + real (kind=kind_phys) :: wcnd + real (kind=kind_phys) :: smcav + real (kind=kind_phys) :: infmax + real (kind=kind_phys), dimension(1:nsoil) :: dmax integer, parameter :: cvfrz = 3 ! -------------------------------------------------------------------------------- if (qinsur > 0.0) then dt1 = dt /86400. - smcav = parameters%smcmax - parameters%smcwlt + smcav = parameters%smcmax(1) - parameters%smcwlt(1) ! maximum infiltration rate dmax(1)= -zsoil(1) * smcav dice = -zsoil(1) * sice(1) - dmax(1)= dmax(1)* (1.0-(sh2o(1) + sice(1) - parameters%smcwlt)/smcav) + dmax(1)= dmax(1)* (1.0-(sh2o(1) + sice(1) - parameters%smcwlt(1))/smcav) dd = dmax(1) do k = 2,nsoil dice = dice + (zsoil(k-1) - zsoil(k) ) * sice(k) dmax(k) = (zsoil(k-1) - zsoil(k)) * smcav - dmax(k) = dmax(k) * (1.0-(sh2o(k) + sice(k) - parameters%smcwlt)/smcav) + dmax(k) = dmax(k) * (1.0-(sh2o(k) + sice(k) - parameters%smcwlt(k))/smcav) dd = dd + dmax(k) end do @@ -7307,7 +7489,7 @@ subroutine infil (parameters,nsoil ,dt ,zsoil ,sh2o ,sice , & !in ! jref for urban areas ! if ( parameters%urban_flag ) infmax == infmax * 0.05 - call wdfcnd2 (parameters,wdf,wcnd,sh2o(1),sicemax) + call wdfcnd2 (parameters,wdf,wcnd,sh2o(1),sicemax,1) infmax = max (infmax,wcnd) infmax = min (infmax,px) @@ -7339,46 +7521,46 @@ subroutine srt (parameters,nsoil ,zsoil ,dt ,pddum ,etrani , & !in integer, intent(in) :: iloc !grid index integer, intent(in) :: jloc !grid index integer, intent(in) :: nsoil - real, dimension(1:nsoil), intent(in) :: zsoil - real, intent(in) :: dt - real, intent(in) :: pddum - real, intent(in) :: qseva - real, dimension(1:nsoil), intent(in) :: etrani - real, dimension(1:nsoil), intent(in) :: sh2o - real, dimension(1:nsoil), intent(in) :: smc - real, intent(in) :: zwt ! water table depth [m] - real, dimension(1:nsoil), intent(in) :: fcr - real, intent(in) :: fcrmax !maximum of fcr (-) - real, intent(in) :: sicemax!maximum soil ice content (m3/m3) - real, intent(in) :: smcwtd !soil moisture between bottom of the soil and the water table + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: zsoil + real (kind=kind_phys), intent(in) :: dt + real (kind=kind_phys), intent(in) :: pddum + real (kind=kind_phys), intent(in) :: qseva + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: etrani + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: sh2o + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: smc + real (kind=kind_phys), intent(in) :: zwt ! water table depth [m] + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: fcr + real (kind=kind_phys), intent(in) :: fcrmax !maximum of fcr (-) + real (kind=kind_phys), intent(in) :: sicemax!maximum soil ice content (m3/m3) + real (kind=kind_phys), intent(in) :: smcwtd !soil moisture between bottom of the soil and the water table ! output - real, dimension(1:nsoil), intent(out) :: rhstt - real, dimension(1:nsoil), intent(out) :: ai - real, dimension(1:nsoil), intent(out) :: bi - real, dimension(1:nsoil), intent(out) :: ci - real, dimension(1:nsoil), intent(out) :: wcnd !hydraulic conductivity (m/s) - real, intent(out) :: qdrain !bottom drainage (m/s) + real (kind=kind_phys), dimension(1:nsoil), intent(out) :: rhstt + real (kind=kind_phys), dimension(1:nsoil), intent(out) :: ai + real (kind=kind_phys), dimension(1:nsoil), intent(out) :: bi + real (kind=kind_phys), dimension(1:nsoil), intent(out) :: ci + real (kind=kind_phys), dimension(1:nsoil), intent(out) :: wcnd !hydraulic conductivity (m/s) + real (kind=kind_phys), intent(out) :: qdrain !bottom drainage (m/s) ! local integer :: k - real, dimension(1:nsoil) :: ddz - real, dimension(1:nsoil) :: denom - real, dimension(1:nsoil) :: dsmdz - real, dimension(1:nsoil) :: wflux - real, dimension(1:nsoil) :: wdf - real, dimension(1:nsoil) :: smx - real :: temp1 - real :: smxwtd !soil moisture between bottom of the soil and water table - real :: smxbot !soil moisture below bottom to calculate flux + real (kind=kind_phys), dimension(1:nsoil) :: ddz + real (kind=kind_phys), dimension(1:nsoil) :: denom + real (kind=kind_phys), dimension(1:nsoil) :: dsmdz + real (kind=kind_phys), dimension(1:nsoil) :: wflux + real (kind=kind_phys), dimension(1:nsoil) :: wdf + real (kind=kind_phys), dimension(1:nsoil) :: smx + real (kind=kind_phys) :: temp1 + real (kind=kind_phys) :: smxwtd !soil moisture between bottom of the soil and water table + real (kind=kind_phys) :: smxbot !soil moisture below bottom to calculate flux ! niu and yang (2006), j. of hydrometeorology ! ---------------------------------------------------------------------- if(opt_inf == 1) then do k = 1, nsoil - call wdfcnd1 (parameters,wdf(k),wcnd(k),smc(k),fcr(k)) + call wdfcnd1 (parameters,wdf(k),wcnd(k),smc(k),fcr(k),k) smx(k) = smc(k) end do if(opt_run == 5)smxwtd=smcwtd @@ -7386,7 +7568,7 @@ subroutine srt (parameters,nsoil ,zsoil ,dt ,pddum ,etrani , & !in if(opt_inf == 2) then do k = 1, nsoil - call wdfcnd2 (parameters,wdf(k),wcnd(k),sh2o(k),sicemax) + call wdfcnd2 (parameters,wdf(k),wcnd(k),sh2o(k),sicemax,k) smx(k) = sh2o(k) end do if(opt_run == 5)smxwtd=smcwtd*sh2o(nsoil)/smc(nsoil) !same liquid fraction as in the bottom layer @@ -7473,33 +7655,33 @@ subroutine sstep (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in integer, intent(in) :: jloc !grid index integer, intent(in) :: nsoil ! integer, intent(in) :: nsnow ! - real, intent(in) :: dt - real, intent(in) :: zwt - real, dimension( 1:nsoil), intent(in) :: zsoil - real, dimension( 1:nsoil), intent(in) :: sice - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso ! snow/soil layer thickness [m] + real (kind=kind_phys), intent(in) :: dt + real (kind=kind_phys), intent(in) :: zwt + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: sice + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso ! snow/soil layer thickness [m] !input and output - real, dimension(1:nsoil), intent(inout) :: sh2o - real, dimension(1:nsoil), intent(inout) :: smc - real, dimension(1:nsoil), intent(inout) :: ai - real, dimension(1:nsoil), intent(inout) :: bi - real, dimension(1:nsoil), intent(inout) :: ci - real, dimension(1:nsoil), intent(inout) :: rhstt - real , intent(inout) :: smcwtd - real , intent(inout) :: qdrain - real , intent(inout) :: deeprech + real (kind=kind_phys), dimension(1:nsoil), intent(inout) :: sh2o + real (kind=kind_phys), dimension(1:nsoil), intent(inout) :: smc + real (kind=kind_phys), dimension(1:nsoil), intent(inout) :: ai + real (kind=kind_phys), dimension(1:nsoil), intent(inout) :: bi + real (kind=kind_phys), dimension(1:nsoil), intent(inout) :: ci + real (kind=kind_phys), dimension(1:nsoil), intent(inout) :: rhstt + real (kind=kind_phys) , intent(inout) :: smcwtd + real (kind=kind_phys) , intent(inout) :: qdrain + real (kind=kind_phys) , intent(inout) :: deeprech !output - real, intent(out) :: wplus !saturation excess water (m) + real (kind=kind_phys), intent(out) :: wplus !saturation excess water (m) !local integer :: k - real, dimension(1:nsoil) :: rhsttin - real, dimension(1:nsoil) :: ciin - real :: stot - real :: epore - real :: wminus + real (kind=kind_phys), dimension(1:nsoil) :: rhsttin + real (kind=kind_phys), dimension(1:nsoil) :: ciin + real (kind=kind_phys) :: stot + real (kind=kind_phys) :: epore + real (kind=kind_phys) :: wminus ! ---------------------------------------------------------------------- wplus = 0.0 @@ -7538,10 +7720,10 @@ subroutine sstep (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in deeprech = deeprech + dt * qdrain else smcwtd = smcwtd + dt * qdrain / dzsnso(nsoil) - wplus = max((smcwtd-parameters%smcmax), 0.0) * dzsnso(nsoil) + wplus = max((smcwtd-parameters%smcmax(nsoil)), 0.0) * dzsnso(nsoil) wminus = max((1.e-4-smcwtd), 0.0) * dzsnso(nsoil) - smcwtd = max( min(smcwtd,parameters%smcmax) , 1.e-4) + smcwtd = max( min(smcwtd,parameters%smcmax(nsoil)) , 1.e-4) sh2o(nsoil) = sh2o(nsoil) + wplus/dzsnso(nsoil) !reduce fluxes at the bottom boundaries accordingly @@ -7552,22 +7734,38 @@ subroutine sstep (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in endif do k = nsoil,2,-1 - epore = max ( 1.e-4 , ( parameters%smcmax - sice(k) ) ) + epore = max ( 1.e-4 , ( parameters%smcmax(k) - sice(k) ) ) wplus = max((sh2o(k)-epore), 0.0) * dzsnso(k) sh2o(k) = min(epore,sh2o(k)) sh2o(k-1) = sh2o(k-1) + wplus/dzsnso(k-1) end do - epore = max ( 1.e-4 , ( parameters%smcmax - sice(1) ) ) + epore = max ( 1.e-4 , ( parameters%smcmax(1) - sice(1) ) ) wplus = max((sh2o(1)-epore), 0.0) * dzsnso(1) sh2o(1) = min(epore,sh2o(1)) + if(wplus > 0.0) then + sh2o(2) = sh2o(2) + wplus/dzsnso(2) + do k = 2,nsoil-1 + epore = max ( 1.e-4 , ( parameters%smcmax(k) - sice(k) ) ) + wplus = max((sh2o(k)-epore), 0.0) * dzsnso(k) + sh2o(k) = min(epore,sh2o(k)) + sh2o(k+1) = sh2o(k+1) + wplus/dzsnso(k+1) + end do + + epore = max ( 1.e-4 , ( parameters%smcmax(nsoil) - sice(nsoil) ) ) + wplus = max((sh2o(nsoil)-epore), 0.0) * dzsnso(nsoil) + sh2o(nsoil) = min(epore,sh2o(nsoil)) + end if + + smc = sh2o + sice + end subroutine sstep !== begin wdfcnd1 ================================================================================== !>\ingroup NoahMP_LSM - subroutine wdfcnd1 (parameters,wdf,wcnd,smc,fcr) + subroutine wdfcnd1 (parameters,wdf,wcnd,smc,fcr,isoil) ! ---------------------------------------------------------------------- ! calculate soil water diffusivity and soil hydraulic conductivity. ! ---------------------------------------------------------------------- @@ -7575,30 +7773,31 @@ subroutine wdfcnd1 (parameters,wdf,wcnd,smc,fcr) ! ---------------------------------------------------------------------- ! input type (noahmp_parameters), intent(in) :: parameters - real,intent(in) :: smc - real,intent(in) :: fcr + real (kind=kind_phys),intent(in) :: smc + real (kind=kind_phys),intent(in) :: fcr + integer,intent(in) :: isoil ! output - real,intent(out) :: wcnd - real,intent(out) :: wdf + real (kind=kind_phys),intent(out) :: wcnd + real (kind=kind_phys),intent(out) :: wdf ! local - real :: expon - real :: factr - real :: vkwgt + real (kind=kind_phys) :: expon + real (kind=kind_phys) :: factr + real (kind=kind_phys) :: vkwgt ! ---------------------------------------------------------------------- ! soil water diffusivity - factr = max(0.01, smc/parameters%smcmax) - expon = parameters%bexp + 2.0 - wdf = parameters%dwsat * factr ** expon + factr = max(0.01, smc/parameters%smcmax(isoil)) + expon = parameters%bexp(isoil) + 2.0 + wdf = parameters%dwsat(isoil) * factr ** expon wdf = wdf * (1.0 - fcr) ! hydraulic conductivity - expon = 2.0*parameters%bexp + 3.0 - wcnd = parameters%dksat * factr ** expon + expon = 2.0*parameters%bexp(isoil) + 3.0 + wcnd = parameters%dksat(isoil) * factr ** expon wcnd = wcnd * (1.0 - fcr) end subroutine wdfcnd1 @@ -7606,7 +7805,7 @@ end subroutine wdfcnd1 !== begin wdfcnd2 ================================================================================== !>\ingroup NoahMP_LSM - subroutine wdfcnd2 (parameters,wdf,wcnd,smc,sice) + subroutine wdfcnd2 (parameters,wdf,wcnd,smc,sice,isoil) ! ---------------------------------------------------------------------- ! calculate soil water diffusivity and soil hydraulic conductivity. ! ---------------------------------------------------------------------- @@ -7614,34 +7813,37 @@ subroutine wdfcnd2 (parameters,wdf,wcnd,smc,sice) ! ---------------------------------------------------------------------- ! input type (noahmp_parameters), intent(in) :: parameters - real,intent(in) :: smc - real,intent(in) :: sice + real (kind=kind_phys),intent(in) :: smc + real (kind=kind_phys),intent(in) :: sice + integer,intent(in) :: isoil ! output - real,intent(out) :: wcnd - real,intent(out) :: wdf + real (kind=kind_phys),intent(out) :: wcnd + real (kind=kind_phys),intent(out) :: wdf ! local - real :: expon - real :: factr - real :: vkwgt + real (kind=kind_phys) :: expon + real (kind=kind_phys) :: factr1,factr2 + real (kind=kind_phys) :: vkwgt ! ---------------------------------------------------------------------- ! soil water diffusivity - factr = max(0.01, smc/parameters%smcmax) - expon = parameters%bexp + 2.0 - wdf = parameters%dwsat * factr ** expon + factr1 = 0.05/parameters%smcmax(isoil) + factr2 = max(0.01, smc/parameters%smcmax(isoil)) + factr1 = min(factr1,factr2) + expon = parameters%bexp(isoil) + 2.0 + wdf = parameters%dwsat(isoil) * factr2 ** expon if (sice > 0.0) then vkwgt = 1./ (1. + (500.* sice)**3.) - wdf = vkwgt * wdf + (1.-vkwgt)*parameters%dwsat*(0.2/parameters%smcmax)**expon + wdf = vkwgt * wdf + (1.-vkwgt)*parameters%dwsat(isoil)*(factr1)**expon end if ! hydraulic conductivity - expon = 2.0*parameters%bexp + 3.0 - wcnd = parameters%dksat * factr ** expon + expon = 2.0*parameters%bexp(isoil) + 3.0 + wcnd = parameters%dksat(isoil) * factr2 ** expon end subroutine wdfcnd2 @@ -7661,46 +7863,46 @@ subroutine groundwater(parameters,nsnow ,nsoil ,dt ,sice ,zsoil , & !in integer, intent(in) :: jloc !grid index integer, intent(in) :: nsnow !maximum no. of snow layers integer, intent(in) :: nsoil !no. of soil layers - real, intent(in) :: dt !timestep [sec] - real, intent(in) :: fcrmax!maximum fcr (-) - real, dimension( 1:nsoil), intent(in) :: sice !soil ice content [m3/m3] - real, dimension( 1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] - real, dimension( 1:nsoil), intent(in) :: wcnd !hydraulic conductivity (m/s) - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature (k) + real (kind=kind_phys), intent(in) :: dt !timestep [sec] + real (kind=kind_phys), intent(in) :: fcrmax!maximum fcr (-) + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: sice !soil ice content [m3/m3] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: wcnd !hydraulic conductivity (m/s) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature (k) ! input and output - real, dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil water [m3/m3] - real, intent(inout) :: zwt !the depth to water table [m] - real, intent(inout) :: wa !water storage in aquifer [mm] - real, intent(inout) :: wt !water storage in aquifer + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil water [m3/m3] + real (kind=kind_phys), intent(inout) :: zwt !the depth to water table [m] + real (kind=kind_phys), intent(inout) :: wa !water storage in aquifer [mm] + real (kind=kind_phys), intent(inout) :: wt !water storage in aquifer !+ saturated soil [mm] ! output - real, intent(out) :: qin !groundwater recharge [mm/s] - real, intent(out) :: qdis !groundwater discharge [mm/s] + real (kind=kind_phys), intent(out) :: qin !groundwater recharge [mm/s] + real (kind=kind_phys), intent(out) :: qdis !groundwater discharge [mm/s] ! local - real :: fff !runoff decay factor (m-1) - real :: rsbmx !baseflow coefficient [mm/s] + real (kind=kind_phys) :: fff !runoff decay factor (m-1) + real (kind=kind_phys) :: rsbmx !baseflow coefficient [mm/s] integer :: iz !do-loop index integer :: iwt !layer index above water table layer - real, dimension( 1:nsoil) :: dzmm !layer thickness [mm] - real, dimension( 1:nsoil) :: znode !node depth [m] - real, dimension( 1:nsoil) :: mliq !liquid water mass [kg/m2 or mm] - real, dimension( 1:nsoil) :: epore !effective porosity [-] - real, dimension( 1:nsoil) :: hk !hydraulic conductivity [mm/s] - real, dimension( 1:nsoil) :: smc !total soil water content [m3/m3] - real(kind=8) :: s_node!degree of saturation of iwt layer - real :: dzsum !cumulative depth above water table [m] - real :: smpfz !matric potential (frozen effects) [mm] - real :: ka !aquifer hydraulic conductivity [mm/s] - real :: wh_zwt!water head at water table [mm] - real :: wh !water head at layer above zwt [mm] - real :: ws !water used to fill air pore [mm] - real :: wtsub !sum of hk*dzmm - real :: watmin!minimum soil vol soil moisture [m3/m3] - real :: xs !excessive water above saturation [mm] - real, parameter :: rous = 0.2 !specific yield [-] - real, parameter :: cmic = 0.20 !microprore content (0.0-1.0) + real (kind=kind_phys), dimension( 1:nsoil) :: dzmm !layer thickness [mm] + real (kind=kind_phys), dimension( 1:nsoil) :: znode !node depth [m] + real (kind=kind_phys), dimension( 1:nsoil) :: mliq !liquid water mass [kg/m2 or mm] + real (kind=kind_phys), dimension( 1:nsoil) :: epore !effective porosity [-] + real (kind=kind_phys), dimension( 1:nsoil) :: hk !hydraulic conductivity [mm/s] + real (kind=kind_phys), dimension( 1:nsoil) :: smc !total soil water content [m3/m3] + real (kind=kind_phys) :: s_node!degree of saturation of iwt layer + real (kind=kind_phys) :: dzsum !cumulative depth above water table [m] + real (kind=kind_phys) :: smpfz !matric potential (frozen effects) [mm] + real (kind=kind_phys) :: ka !aquifer hydraulic conductivity [mm/s] + real (kind=kind_phys) :: wh_zwt!water head at water table [mm] + real (kind=kind_phys) :: wh !water head at layer above zwt [mm] + real (kind=kind_phys) :: ws !water used to fill air pore [mm] + real (kind=kind_phys) :: wtsub !sum of hk*dzmm + real (kind=kind_phys) :: watmin!minimum soil vol soil moisture [m3/m3] + real (kind=kind_phys) :: xs !excessive water above saturation [mm] + real (kind=kind_phys), parameter :: rous = 0.2 !specific yield [-] + real (kind=kind_phys), parameter :: cmic = 0.20 !microprore content (0.0-1.0) !0.0-close to free drainage ! ------------------------------------------------------------- qdis = 0.0 @@ -7726,7 +7928,7 @@ subroutine groundwater(parameters,nsnow ,nsoil ,dt ,sice ,zsoil , & !in do iz = 1, nsoil smc(iz) = sh2o(iz) + sice(iz) mliq(iz) = sh2o(iz) * dzmm(iz) - epore(iz) = max(0.01,parameters%smcmax - sice(iz)) + epore(iz) = max(0.01,parameters%smcmax(iz) - sice(iz)) hk(iz) = 1.e3*wcnd(iz) enddo @@ -7750,9 +7952,9 @@ subroutine groundwater(parameters,nsnow ,nsoil ,dt ,sice ,zsoil , & !in ! matric potential at the layer above the water table - s_node = min(1.0,smc(iwt)/parameters%smcmax ) + s_node = min(1.0,smc(iwt)/parameters%smcmax(iwt) ) s_node = max(s_node,real(0.01,kind=8)) - smpfz = -parameters%psisat*1000.*s_node**(-parameters%bexp) ! m --> mm + smpfz = -parameters%psisat(iwt)*1000.*s_node**(-parameters%bexp(iwt)) ! m --> mm smpfz = max(-120000.0,cmic*smpfz) ! recharge rate qin to groundwater @@ -7850,26 +8052,26 @@ subroutine shallowwatertable (parameters,nsnow ,nsoil ,zsoil, dt , & !in integer, intent(in) :: nsnow !maximum no. of snow layers integer, intent(in) :: nsoil !no. of soil layers integer, intent(in) :: iloc,jloc - real, intent(in) :: dt - real, dimension( 1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso ! snow/soil layer thickness [m] - real, dimension( 1:nsoil), intent(in) :: smceq !equilibrium soil water content [m3/m3] + real (kind=kind_phys), intent(in) :: dt + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso ! snow/soil layer thickness [m] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: smceq !equilibrium soil water content [m3/m3] ! input and output - real, dimension( 1:nsoil), intent(inout) :: smc !total soil water content [m3/m3] - real, intent(inout) :: wtd !the depth to water table [m] - real, intent(inout) :: smcwtd !soil moisture between bottom of the soil and the water table [m3/m3] - real, intent(out) :: rech ! groundwater recharge (net vertical flux across the water table), positive up - real, intent(inout) :: qdrain + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: smc !total soil water content [m3/m3] + real (kind=kind_phys), intent(inout) :: wtd !the depth to water table [m] + real (kind=kind_phys), intent(inout) :: smcwtd !soil moisture between bottom of the soil and the water table [m3/m3] + real (kind=kind_phys), intent(out) :: rech ! groundwater recharge (net vertical flux across the water table), positive up + real (kind=kind_phys), intent(inout) :: qdrain ! local integer :: iz !do-loop index integer :: iwtd !layer index above water table layer integer :: kwtd !layer index where the water table layer is - real :: wtdold - real :: dzup - real :: smceqdeep - real, dimension( 0:nsoil) :: zsoil0 + real (kind=kind_phys) :: wtdold + real (kind=kind_phys) :: dzup + real (kind=kind_phys) :: smceqdeep + real (kind=kind_phys), dimension( 0:nsoil) :: zsoil0 ! ------------------------------------------------------------- @@ -7888,30 +8090,30 @@ subroutine shallowwatertable (parameters,nsnow ,nsoil ,zsoil, dt , & !in wtdold=wtd if(smc(kwtd).gt.smceq(kwtd))then - if(smc(kwtd).eq.parameters%smcmax)then !wtd went to the layer above + if(smc(kwtd).eq.parameters%smcmax(kwtd))then !wtd went to the layer above wtd=zsoil0(iwtd) - rech=-(wtdold-wtd) * (parameters%smcmax-smceq(kwtd)) + rech=-(wtdold-wtd) * (parameters%smcmax(kwtd)-smceq(kwtd)) iwtd=iwtd-1 kwtd=kwtd-1 if(kwtd.ge.1)then if(smc(kwtd).gt.smceq(kwtd))then wtdold=wtd wtd = min( ( smc(kwtd)*dzsnso(kwtd) & - - smceq(kwtd)*zsoil0(iwtd) + parameters%smcmax*zsoil0(kwtd) ) / & - ( parameters%smcmax-smceq(kwtd) ), zsoil0(iwtd)) - rech=rech-(wtdold-wtd) * (parameters%smcmax-smceq(kwtd)) + - smceq(kwtd)*zsoil0(iwtd) + parameters%smcmax(kwtd)*zsoil0(kwtd) ) / & + ( parameters%smcmax(kwtd)-smceq(kwtd) ), zsoil0(iwtd)) + rech=rech-(wtdold-wtd) * (parameters%smcmax(kwtd)-smceq(kwtd)) endif endif else !wtd stays in the layer wtd = min( ( smc(kwtd)*dzsnso(kwtd) & - - smceq(kwtd)*zsoil0(iwtd) + parameters%smcmax*zsoil0(kwtd) ) / & - ( parameters%smcmax-smceq(kwtd) ), zsoil0(iwtd)) - rech=-(wtdold-wtd) * (parameters%smcmax-smceq(kwtd)) + - smceq(kwtd)*zsoil0(iwtd) + parameters%smcmax(kwtd)*zsoil0(kwtd) ) / & + ( parameters%smcmax(kwtd)-smceq(kwtd) ), zsoil0(iwtd)) + rech=-(wtdold-wtd) * (parameters%smcmax(kwtd)-smceq(kwtd)) endif else !wtd has gone down to the layer below wtd=zsoil0(kwtd) - rech=-(wtdold-wtd) * (parameters%smcmax-smceq(kwtd)) + rech=-(wtdold-wtd) * (parameters%smcmax(kwtd)-smceq(kwtd)) kwtd=kwtd+1 iwtd=iwtd+1 !wtd crossed to the layer below. now adjust it there @@ -7919,13 +8121,13 @@ subroutine shallowwatertable (parameters,nsnow ,nsoil ,zsoil, dt , & !in wtdold=wtd if(smc(kwtd).gt.smceq(kwtd))then wtd = min( ( smc(kwtd)*dzsnso(kwtd) & - - smceq(kwtd)*zsoil0(iwtd) + parameters%smcmax*zsoil0(kwtd) ) / & - ( parameters%smcmax-smceq(kwtd) ) , zsoil0(iwtd) ) + - smceq(kwtd)*zsoil0(iwtd) + parameters%smcmax(kwtd)*zsoil0(kwtd) ) / & + ( parameters%smcmax(kwtd)-smceq(kwtd) ) , zsoil0(iwtd) ) else wtd=zsoil0(kwtd) endif rech = rech - (wtdold-wtd) * & - (parameters%smcmax-smceq(kwtd)) + (parameters%smcmax(kwtd)-smceq(kwtd)) else wtdold=wtd @@ -7934,38 +8136,42 @@ subroutine shallowwatertable (parameters,nsnow ,nsoil ,zsoil, dt , & !in ! qdrain = qdrain - 1000 * (smceq(nsoil)-smc(nsoil)) * dzsnso(nsoil) / dt ! smc(nsoil)=smceq(nsoil) !adjust wtd in the ficticious layer below - smceqdeep = parameters%smcmax * ( -parameters%psisat / ( -parameters%psisat - dzsnso(nsoil) ) ) ** (1./parameters%bexp) + smceqdeep = parameters%smcmax(nsoil) * ( -parameters%psisat(nsoil) / ( -parameters%psisat(nsoil) - dzsnso(nsoil) ) ) ** (1./parameters%bexp(nsoil)) wtd = min( ( smcwtd*dzsnso(nsoil) & - - smceqdeep*zsoil0(nsoil) + parameters%smcmax*(zsoil0(nsoil)-dzsnso(nsoil)) ) / & - ( parameters%smcmax-smceqdeep ) , zsoil0(nsoil) ) + - smceqdeep*zsoil0(nsoil) + parameters%smcmax(nsoil)*(zsoil0(nsoil)-dzsnso(nsoil)) ) / & + ( parameters%smcmax(nsoil)-smceqdeep ) , zsoil0(nsoil) ) rech = rech - (wtdold-wtd) * & - (parameters%smcmax-smceqdeep) + (parameters%smcmax(nsoil)-smceqdeep) endif endif elseif(wtd.ge.zsoil0(nsoil)-dzsnso(nsoil))then !if wtd was already below the bottom of the resolved soil crust wtdold=wtd - smceqdeep = parameters%smcmax * ( -parameters%psisat / ( -parameters%psisat - dzsnso(nsoil) ) ) ** (1./parameters%bexp) + smceqdeep = parameters%smcmax(nsoil) * ( -parameters%psisat(nsoil) / ( -parameters%psisat(nsoil) - dzsnso(nsoil) ) ) ** (1./parameters%bexp(nsoil)) if(smcwtd.gt.smceqdeep)then wtd = min( ( smcwtd*dzsnso(nsoil) & - - smceqdeep*zsoil0(nsoil) + parameters%smcmax*(zsoil0(nsoil)-dzsnso(nsoil)) ) / & - ( parameters%smcmax-smceqdeep ) , zsoil0(nsoil) ) - rech = -(wtdold-wtd) * (parameters%smcmax-smceqdeep) + - smceqdeep*zsoil0(nsoil) + parameters%smcmax(nsoil)*(zsoil0(nsoil)-dzsnso(nsoil)) ) / & + ( parameters%smcmax(nsoil)-smceqdeep ) , zsoil0(nsoil) ) + rech = -(wtdold-wtd) * (parameters%smcmax(nsoil)-smceqdeep) else - rech = -(wtdold-(zsoil0(nsoil)-dzsnso(nsoil))) * (parameters%smcmax-smceqdeep) + rech = -(wtdold-(zsoil0(nsoil)-dzsnso(nsoil))) * (parameters%smcmax(nsoil)-smceqdeep) wtdold=zsoil0(nsoil)-dzsnso(nsoil) !and now even further down - dzup=(smceqdeep-smcwtd)*dzsnso(nsoil)/(parameters%smcmax-smceqdeep) + dzup=(smceqdeep-smcwtd)*dzsnso(nsoil)/(parameters%smcmax(nsoil)-smceqdeep) wtd=wtdold-dzup - rech = rech - (parameters%smcmax-smceqdeep)*dzup + rech = rech - (parameters%smcmax(nsoil)-smceqdeep)*dzup smcwtd=smceqdeep endif endif -if(iwtd.lt.nsoil)smcwtd=parameters%smcmax +if(iwtd.lt.nsoil .and. iwtd.gt.0) then + smcwtd=parameters%smcmax(iwtd) +elseif(iwtd.lt.nsoil .and. iwtd.le.0) then + smcwtd=parameters%smcmax(1) +end if end subroutine shallowwatertable @@ -7994,51 +8200,51 @@ subroutine carbon (parameters,nsnow ,nsoil ,vegtyp ,dt ,zsoil , & !in integer , intent(in) :: vegtyp !vegetation type integer , intent(in) :: nsnow !number of snow layers integer , intent(in) :: nsoil !number of soil layers - real , intent(in) :: lat !latitude (radians) - real , intent(in) :: dt !time step (s) - real, dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottom from soil surface - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature [k] - real, dimension( 1:nsoil), intent(in) :: smc !soil moisture (ice + liq.) [m3/m3] - real , intent(in) :: tv !vegetation temperature (k) - real , intent(in) :: tg !ground temperature (k) - real , intent(in) :: foln !foliage nitrogen (%) - real , intent(in) :: btran !soil water transpiration factor (0 to 1) - real , intent(in) :: psn !total leaf photosyn (umolco2/m2/s) [+] - real , intent(in) :: apar !par by canopy (w/m2) - real , intent(in) :: igs !growing season index (0=off, 1=on) - real , intent(in) :: fveg !vegetation greenness fraction - real , intent(in) :: troot !root-zone averaged temperature (k) + real (kind=kind_phys) , intent(in) :: lat !latitude (radians) + real (kind=kind_phys) , intent(in) :: dt !time step (s) + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottom from soil surface + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature [k] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: smc !soil moisture (ice + liq.) [m3/m3] + real (kind=kind_phys) , intent(in) :: tv !vegetation temperature (k) + real (kind=kind_phys) , intent(in) :: tg !ground temperature (k) + real (kind=kind_phys) , intent(in) :: foln !foliage nitrogen (%) + real (kind=kind_phys) , intent(in) :: btran !soil water transpiration factor (0 to 1) + real (kind=kind_phys) , intent(in) :: psn !total leaf photosyn (umolco2/m2/s) [+] + real (kind=kind_phys) , intent(in) :: apar !par by canopy (w/m2) + real (kind=kind_phys) , intent(in) :: igs !growing season index (0=off, 1=on) + real (kind=kind_phys) , intent(in) :: fveg !vegetation greenness fraction + real (kind=kind_phys) , intent(in) :: troot !root-zone averaged temperature (k) integer , intent(in) :: ist !surface type 1->soil; 2->lake ! input & output (carbon) - real , intent(inout) :: lfmass !leaf mass [g/m2] - real , intent(inout) :: rtmass !mass of fine roots [g/m2] - real , intent(inout) :: stmass !stem mass [g/m2] - real , intent(inout) :: wood !mass of wood (incl. woody roots) [g/m2] - real , intent(inout) :: stblcp !stable carbon in deep soil [g/m2] - real , intent(inout) :: fastcp !short-lived carbon in shallow soil [g/m2] + real (kind=kind_phys) , intent(inout) :: lfmass !leaf mass [g/m2] + real (kind=kind_phys) , intent(inout) :: rtmass !mass of fine roots [g/m2] + real (kind=kind_phys) , intent(inout) :: stmass !stem mass [g/m2] + real (kind=kind_phys) , intent(inout) :: wood !mass of wood (incl. woody roots) [g/m2] + real (kind=kind_phys) , intent(inout) :: stblcp !stable carbon in deep soil [g/m2] + real (kind=kind_phys) , intent(inout) :: fastcp !short-lived carbon in shallow soil [g/m2] ! outputs: (carbon) - real , intent(out) :: gpp !net instantaneous assimilation [g/m2/s c] - real , intent(out) :: npp !net primary productivity [g/m2/s c] - real , intent(out) :: nee !net ecosystem exchange [g/m2/s co2] - real , intent(out) :: autors !net ecosystem respiration [g/m2/s c] - real , intent(out) :: heters !organic respiration [g/m2/s c] - real , intent(out) :: totsc !total soil carbon [g/m2 c] - real , intent(out) :: totlb !total living carbon ([g/m2 c] - real , intent(out) :: xlai !leaf area index [-] - real , intent(out) :: xsai !stem area index [-] -! real , intent(out) :: vocflx(5) ! voc fluxes [ug c m-2 h-1] + real (kind=kind_phys) , intent(out) :: gpp !net instantaneous assimilation [g/m2/s c] + real (kind=kind_phys) , intent(out) :: npp !net primary productivity [g/m2/s c] + real (kind=kind_phys) , intent(out) :: nee !net ecosystem exchange [g/m2/s co2] + real (kind=kind_phys) , intent(out) :: autors !net ecosystem respiration [g/m2/s c] + real (kind=kind_phys) , intent(out) :: heters !organic respiration [g/m2/s c] + real (kind=kind_phys) , intent(out) :: totsc !total soil carbon [g/m2 c] + real (kind=kind_phys) , intent(out) :: totlb !total living carbon ([g/m2 c] + real (kind=kind_phys) , intent(out) :: xlai !leaf area index [-] + real (kind=kind_phys) , intent(out) :: xsai !stem area index [-] +! real (kind=kind_phys) , intent(out) :: vocflx(5) ! voc fluxes [ug c m-2 h-1] ! local variables integer :: j !do-loop index - real :: wroot !root zone soil water [-] - real :: wstres !water stress coeficient [-] (1. for wilting ) - real :: lapm !leaf area per unit mass [m2/g] + real (kind=kind_phys) :: wroot !root zone soil water [-] + real (kind=kind_phys) :: wstres !water stress coeficient [-] (1. for wilting ) + real (kind=kind_phys) :: lapm !leaf area per unit mass [m2/g] ! ------------------------------------------------------------------------------------------ if ( ( vegtyp == parameters%iswater ) .or. ( vegtyp == parameters%isbarren ) .or. & @@ -8070,7 +8276,7 @@ subroutine carbon (parameters,nsnow ,nsoil ,vegtyp ,dt ,zsoil , & !in wroot = 0. do j=1,parameters%nroot - wroot = wroot + smc(j)/parameters%smcmax * dzsnso(j) / (-zsoil(parameters%nroot)) + wroot = wroot + smc(j)/parameters%smcmax(j) * dzsnso(j) / (-zsoil(parameters%nroot)) enddo call co2flux (parameters,nsnow ,nsoil ,vegtyp ,igs ,dt , & !in @@ -8112,102 +8318,102 @@ subroutine co2flux (parameters,nsnow ,nsoil ,vegtyp ,igs ,dt , & !in integer , intent(in) :: vegtyp !vegetation physiology type integer , intent(in) :: nsnow !number of snow layers integer , intent(in) :: nsoil !number of soil layers - real , intent(in) :: dt !time step (s) - real , intent(in) :: lat !latitude (radians) - real , intent(in) :: igs !growing season index (0=off, 1=on) - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature [k] - real , intent(in) :: psn !total leaf photosynthesis (umolco2/m2/s) - real , intent(in) :: troot !root-zone averaged temperature (k) - real , intent(in) :: tv !leaf temperature (k) - real , intent(in) :: wroot !root zone soil water - real , intent(in) :: wstres !soil water stress - real , intent(in) :: foln !foliage nitrogen (%) - real , intent(in) :: lapm !leaf area per unit mass [m2/g] - real , intent(in) :: fveg !vegetation greenness fraction + real (kind=kind_phys) , intent(in) :: dt !time step (s) + real (kind=kind_phys) , intent(in) :: lat !latitude (radians) + real (kind=kind_phys) , intent(in) :: igs !growing season index (0=off, 1=on) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature [k] + real (kind=kind_phys) , intent(in) :: psn !total leaf photosynthesis (umolco2/m2/s) + real (kind=kind_phys) , intent(in) :: troot !root-zone averaged temperature (k) + real (kind=kind_phys) , intent(in) :: tv !leaf temperature (k) + real (kind=kind_phys) , intent(in) :: wroot !root zone soil water + real (kind=kind_phys) , intent(in) :: wstres !soil water stress + real (kind=kind_phys) , intent(in) :: foln !foliage nitrogen (%) + real (kind=kind_phys) , intent(in) :: lapm !leaf area per unit mass [m2/g] + real (kind=kind_phys) , intent(in) :: fveg !vegetation greenness fraction ! input and output - real , intent(inout) :: xlai !leaf area index from leaf carbon [-] - real , intent(inout) :: xsai !stem area index from leaf carbon [-] - real , intent(inout) :: lfmass !leaf mass [g/m2] - real , intent(inout) :: rtmass !mass of fine roots [g/m2] - real , intent(inout) :: stmass !stem mass [g/m2] - real , intent(inout) :: fastcp !short lived carbon [g/m2] - real , intent(inout) :: stblcp !stable carbon pool [g/m2] - real , intent(inout) :: wood !mass of wood (incl. woody roots) [g/m2] + real (kind=kind_phys) , intent(inout) :: xlai !leaf area index from leaf carbon [-] + real (kind=kind_phys) , intent(inout) :: xsai !stem area index from leaf carbon [-] + real (kind=kind_phys) , intent(inout) :: lfmass !leaf mass [g/m2] + real (kind=kind_phys) , intent(inout) :: rtmass !mass of fine roots [g/m2] + real (kind=kind_phys) , intent(inout) :: stmass !stem mass [g/m2] + real (kind=kind_phys) , intent(inout) :: fastcp !short lived carbon [g/m2] + real (kind=kind_phys) , intent(inout) :: stblcp !stable carbon pool [g/m2] + real (kind=kind_phys) , intent(inout) :: wood !mass of wood (incl. woody roots) [g/m2] ! output - real , intent(out) :: gpp !net instantaneous assimilation [g/m2/s] - real , intent(out) :: npp !net primary productivity [g/m2] - real , intent(out) :: nee !net ecosystem exchange (autors+heters-gpp) - real , intent(out) :: autors !net ecosystem resp. (maintance and growth) - real , intent(out) :: heters !organic respiration - real , intent(out) :: totsc !total soil carbon (g/m2) - real , intent(out) :: totlb !total living carbon (g/m2) + real (kind=kind_phys) , intent(out) :: gpp !net instantaneous assimilation [g/m2/s] + real (kind=kind_phys) , intent(out) :: npp !net primary productivity [g/m2] + real (kind=kind_phys) , intent(out) :: nee !net ecosystem exchange (autors+heters-gpp) + real (kind=kind_phys) , intent(out) :: autors !net ecosystem resp. (maintance and growth) + real (kind=kind_phys) , intent(out) :: heters !organic respiration + real (kind=kind_phys) , intent(out) :: totsc !total soil carbon (g/m2) + real (kind=kind_phys) , intent(out) :: totlb !total living carbon (g/m2) ! local - real :: cflux !carbon flux to atmosphere [g/m2/s] - real :: lfmsmn !minimum leaf mass [g/m2] - real :: rswood !wood respiration [g/m2] - real :: rsleaf !leaf maintenance respiration per timestep [g/m2] - real :: rsroot !fine root respiration per time step [g/m2] - real :: nppl !leaf net primary productivity [g/m2/s] - real :: nppr !root net primary productivity [g/m2/s] - real :: nppw !wood net primary productivity [g/m2/s] - real :: npps !wood net primary productivity [g/m2/s] - real :: dielf !death of leaf mass per time step [g/m2] - - real :: addnpplf !leaf assimil after resp. losses removed [g/m2] - real :: addnppst !stem assimil after resp. losses removed [g/m2] - real :: carbfx !carbon assimilated per model step [g/m2] - real :: grleaf !growth respiration rate for leaf [g/m2/s] - real :: grroot !growth respiration rate for root [g/m2/s] - real :: grwood !growth respiration rate for wood [g/m2/s] - real :: grstem !growth respiration rate for stem [g/m2/s] - real :: leafpt !fraction of carbon allocated to leaves [-] - real :: lfdel !maximum leaf mass available to change [g/m2/s] - real :: lftovr !stem turnover per time step [g/m2] - real :: sttovr !stem turnover per time step [g/m2] - real :: wdtovr !wood turnover per time step [g/m2] - real :: rssoil !soil respiration per time step [g/m2] - real :: rttovr !root carbon loss per time step by turnover [g/m2] - real :: stablc !decay rate of fast carbon to slow carbon [g/m2/s] - real :: woodf !calculated wood to root ratio [-] - real :: nonlef !fraction of carbon to root and wood [-] - real :: rootpt !fraction of carbon flux to roots [-] - real :: woodpt !fraction of carbon flux to wood [-] - real :: stempt !fraction of carbon flux to stem [-] - real :: resp !leaf respiration [umol/m2/s] - real :: rsstem !stem respiration [g/m2/s] - - real :: fsw !soil water factor for microbial respiration - real :: fst !soil temperature factor for microbial respiration - real :: fnf !foliage nitrogen adjustemt to respiration (<= 1) - real :: tf !temperature factor - real :: rf !respiration reduction factor (<= 1) - real :: stdel - real :: stmsmn - real :: sapm !stem area per unit mass (m2/g) - real :: diest + real (kind=kind_phys) :: cflux !carbon flux to atmosphere [g/m2/s] + real (kind=kind_phys) :: lfmsmn !minimum leaf mass [g/m2] + real (kind=kind_phys) :: rswood !wood respiration [g/m2] + real (kind=kind_phys) :: rsleaf !leaf maintenance respiration per timestep [g/m2] + real (kind=kind_phys) :: rsroot !fine root respiration per time step [g/m2] + real (kind=kind_phys) :: nppl !leaf net primary productivity [g/m2/s] + real (kind=kind_phys) :: nppr !root net primary productivity [g/m2/s] + real (kind=kind_phys) :: nppw !wood net primary productivity [g/m2/s] + real (kind=kind_phys) :: npps !wood net primary productivity [g/m2/s] + real (kind=kind_phys) :: dielf !death of leaf mass per time step [g/m2] + + real (kind=kind_phys) :: addnpplf !leaf assimil after resp. losses removed [g/m2] + real (kind=kind_phys) :: addnppst !stem assimil after resp. losses removed [g/m2] + real (kind=kind_phys) :: carbfx !carbon assimilated per model step [g/m2] + real (kind=kind_phys) :: grleaf !growth respiration rate for leaf [g/m2/s] + real (kind=kind_phys) :: grroot !growth respiration rate for root [g/m2/s] + real (kind=kind_phys) :: grwood !growth respiration rate for wood [g/m2/s] + real (kind=kind_phys) :: grstem !growth respiration rate for stem [g/m2/s] + real (kind=kind_phys) :: leafpt !fraction of carbon allocated to leaves [-] + real (kind=kind_phys) :: lfdel !maximum leaf mass available to change [g/m2/s] + real (kind=kind_phys) :: lftovr !stem turnover per time step [g/m2] + real (kind=kind_phys) :: sttovr !stem turnover per time step [g/m2] + real (kind=kind_phys) :: wdtovr !wood turnover per time step [g/m2] + real (kind=kind_phys) :: rssoil !soil respiration per time step [g/m2] + real (kind=kind_phys) :: rttovr !root carbon loss per time step by turnover [g/m2] + real (kind=kind_phys) :: stablc !decay rate of fast carbon to slow carbon [g/m2/s] + real (kind=kind_phys) :: woodf !calculated wood to root ratio [-] + real (kind=kind_phys) :: nonlef !fraction of carbon to root and wood [-] + real (kind=kind_phys) :: rootpt !fraction of carbon flux to roots [-] + real (kind=kind_phys) :: woodpt !fraction of carbon flux to wood [-] + real (kind=kind_phys) :: stempt !fraction of carbon flux to stem [-] + real (kind=kind_phys) :: resp !leaf respiration [umol/m2/s] + real (kind=kind_phys) :: rsstem !stem respiration [g/m2/s] + + real (kind=kind_phys) :: fsw !soil water factor for microbial respiration + real (kind=kind_phys) :: fst !soil temperature factor for microbial respiration + real (kind=kind_phys) :: fnf !foliage nitrogen adjustemt to respiration (<= 1) + real (kind=kind_phys) :: tf !temperature factor + real (kind=kind_phys) :: rf !respiration reduction factor (<= 1) + real (kind=kind_phys) :: stdel + real (kind=kind_phys) :: stmsmn + real (kind=kind_phys) :: sapm !stem area per unit mass (m2/g) + real (kind=kind_phys) :: diest ! -------------------------- constants ------------------------------- - real :: bf !parameter for present wood allocation [-] - real :: rswoodc !wood respiration coeficient [1/s] - real :: stovrc !stem turnover coefficient [1/s] - real :: rsdryc !degree of drying that reduces soil respiration [-] - real :: rtovrc !root turnover coefficient [1/s] - real :: wstrc !water stress coeficient [-] - real :: laimin !minimum leaf area index [m2/m2] - real :: xsamin !minimum leaf area index [m2/m2] - real :: sc - real :: sd - real :: vegfrac + real (kind=kind_phys) :: bf !parameter for present wood allocation [-] + real (kind=kind_phys) :: rswoodc !wood respiration coeficient [1/s] + real (kind=kind_phys) :: stovrc !stem turnover coefficient [1/s] + real (kind=kind_phys) :: rsdryc !degree of drying that reduces soil respiration [-] + real (kind=kind_phys) :: rtovrc !root turnover coefficient [1/s] + real (kind=kind_phys) :: wstrc !water stress coeficient [-] + real (kind=kind_phys) :: laimin !minimum leaf area index [m2/m2] + real (kind=kind_phys) :: xsamin !minimum leaf area index [m2/m2] + real (kind=kind_phys) :: sc + real (kind=kind_phys) :: sd + real (kind=kind_phys) :: vegfrac ! respiration as a function of temperature - real :: r,x + real (kind=kind_phys) :: r,x r(x) = exp(0.08*(x-298.16)) ! --------------------------------------------------------------------------------- @@ -8258,10 +8464,10 @@ subroutine co2flux (parameters,nsnow ,nsoil ,vegtyp ,igs ,dt , & !in ! fraction of carbon into wood versus root - if(wood.gt.0) then + if(wood > 1.e-6) then woodf = (1.-exp(-bf*(parameters%wrrat*rtmass/wood))/bf)*parameters%wdpool else - woodf = 0. + woodf = parameters%wdpool endif rootpt = nonlef*(1.-woodf) @@ -8360,6 +8566,585 @@ subroutine co2flux (parameters,nsnow ,nsoil ,vegtyp ,igs ,dt , & !in end subroutine co2flux +!== begin carbon_crop ============================================================================== + + subroutine carbon_crop (parameters,nsnow ,nsoil ,vegtyp ,dt ,zsoil ,julian , & !in + dzsnso ,stc ,smc ,tv ,psn ,foln ,btran , & !in + soldn ,t2m , & !in + lfmass ,rtmass ,stmass ,wood ,stblcp ,fastcp ,grain , & !inout + xlai ,xsai ,gdd , & !inout + gpp ,npp ,nee ,autors ,heters ,totsc ,totlb, pgs ) !out +! ------------------------------------------------------------------------------------------ +! initial crop version created by xing liu +! initial crop version added by barlage v3.8 + +! ------------------------------------------------------------------------------------------ + implicit none +! ------------------------------------------------------------------------------------------ +! inputs (carbon) + + type (noahmp_parameters), intent(in) :: parameters + integer , intent(in) :: nsnow !number of snow layers + integer , intent(in) :: nsoil !number of soil layers + integer , intent(in) :: vegtyp !vegetation type + real (kind=kind_phys) , intent(in) :: dt !time step (s) + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottomfrom soil surface + real (kind=kind_phys) , intent(in) :: julian !julian day of year(fractional) ( 0 <= julian < yearlen ) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layerthickness [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature[k] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: smc !soil moisture (ice +liq.) [m3/m3] + real (kind=kind_phys) , intent(in) :: tv !vegetation temperature(k) + real (kind=kind_phys) , intent(in) :: psn !total leaf photosyn(umolco2/m2/s) [+] + real (kind=kind_phys) , intent(in) :: foln !foliage nitrogen (%) + real (kind=kind_phys) , intent(in) :: btran !soil watertranspiration factor (0 to 1) + real (kind=kind_phys) , intent(in) :: soldn !downward solar radiation + real (kind=kind_phys) , intent(in) :: t2m !air temperature + +! input & output (carbon) + + real (kind=kind_phys) , intent(inout) :: lfmass !leaf mass [g/m2] + real (kind=kind_phys) , intent(inout) :: rtmass !mass of fine roots[g/m2] + real (kind=kind_phys) , intent(inout) :: stmass !stem mass [g/m2] + real (kind=kind_phys) , intent(inout) :: wood !mass of wood (incl.woody roots) [g/m2] + real (kind=kind_phys) , intent(inout) :: stblcp !stable carbon in deepsoil [g/m2] + real (kind=kind_phys) , intent(inout) :: fastcp !short-lived carbon inshallow soil [g/m2] + real (kind=kind_phys) , intent(inout) :: grain !mass of grain [g/m2] + real (kind=kind_phys) , intent(inout) :: xlai !leaf area index [-] + real (kind=kind_phys) , intent(inout) :: xsai !stem area index [-] + real (kind=kind_phys) , intent(inout) :: gdd !growing degree days + +! outout + real (kind=kind_phys) , intent(out) :: gpp !net instantaneous assimilation [g/m2/s c] + real (kind=kind_phys) , intent(out) :: npp !net primary productivity [g/m2/s c] + real (kind=kind_phys) , intent(out) :: nee !net ecosystem exchange[g/m2/s co2] + real (kind=kind_phys) , intent(out) :: autors !net ecosystem respiration [g/m2/s c] + real (kind=kind_phys) , intent(out) :: heters !organic respiration[g/m2/s c] + real (kind=kind_phys) , intent(out) :: totsc !total soil carbon [g/m2c] + real (kind=kind_phys) , intent(out) :: totlb !total living carbon ([g/m2 c] + +! local variables + + integer :: j !do-loop index + real (kind=kind_phys) :: wroot !root zone soil water [-] + real (kind=kind_phys) :: wstres !water stress coeficient [-] (1. for wilting ) + integer :: ipa !planting index + integer :: iha !havestindex(0=on,1=off) + integer, intent(out) :: pgs !plant growth stage + + real (kind=kind_phys) :: psncrop + +! ------------------------------------------------------------------------------------------ + if ( ( vegtyp == parameters%iswater ) .or. ( vegtyp == parameters%isbarren ) .or. & + ( vegtyp == parameters%isice ) .or. (parameters%urban_flag) ) then + xlai = 0. + xsai = 0. + gpp = 0. + npp = 0. + nee = 0. + autors = 0. + heters = 0. + totsc = 0. + totlb = 0. + lfmass = 0. + rtmass = 0. + stmass = 0. + wood = 0. + stblcp = 0. + fastcp = 0. + grain = 0. + return + end if + +! water stress + + + wstres = 1.- btran + + wroot = 0. + do j=1,parameters%nroot + wroot = wroot + smc(j)/parameters%smcmax(j) * dzsnso(j) / (-zsoil(parameters%nroot)) + enddo + + call psn_crop ( parameters, & !in + soldn, xlai, t2m, & !in + psncrop ) !out + + call growing_gdd (parameters, & !in + t2m , dt, julian, & !in + gdd , & !inout + ipa , iha, pgs) !out + + call co2flux_crop (parameters, & !in + dt ,stc(1) ,psn ,tv ,wroot ,wstres ,foln , & !in + ipa ,iha ,pgs , & !in xing + xlai ,xsai ,lfmass ,rtmass ,stmass , & !inout + fastcp ,stblcp ,wood ,grain ,gdd , & !inout + gpp ,npp ,nee ,autors ,heters , & !out + totsc ,totlb ) !out + + end subroutine carbon_crop + +!== begin co2flux_crop ============================================================================= + + subroutine co2flux_crop (parameters, & !in + dt ,stc ,psn ,tv ,wroot ,wstres ,foln , & !in + ipa ,iha ,pgs , & !in xing + xlai ,xsai ,lfmass ,rtmass ,stmass , & !inout + fastcp ,stblcp ,wood ,grain ,gdd, & !inout + gpp ,npp ,nee ,autors ,heters , & !out + totsc ,totlb ) !out +! ----------------------------------------------------------------------------------------- +! the original code from re dickinson et al.(1998) and guo-yue niu(2004), +! modified by xing liu, 2014. +! +! ----------------------------------------------------------------------------------------- + implicit none +! ----------------------------------------------------------------------------------------- + +! input + + type (noahmp_parameters), intent(in) :: parameters + real (kind=kind_phys) , intent(in) :: dt !time step (s) + real (kind=kind_phys) , intent(in) :: stc !soil temperature[k] + real (kind=kind_phys) , intent(in) :: psn !total leaf photosynthesis (umolco2/m2/s) + real (kind=kind_phys) , intent(in) :: tv !leaf temperature (k) + real (kind=kind_phys) , intent(in) :: wroot !root zone soil water + real (kind=kind_phys) , intent(in) :: wstres !soil water stress + real (kind=kind_phys) , intent(in) :: foln !foliage nitrogen (%) + integer , intent(in) :: ipa + integer , intent(in) :: iha + integer , intent(in) :: pgs + +! input and output + + real (kind=kind_phys) , intent(inout) :: xlai !leaf area index from leaf carbon [-] + real (kind=kind_phys) , intent(inout) :: xsai !stem area index from leaf carbon [-] + real (kind=kind_phys) , intent(inout) :: lfmass !leaf mass [g/m2] + real (kind=kind_phys) , intent(inout) :: rtmass !mass of fine roots [g/m2] + real (kind=kind_phys) , intent(inout) :: stmass !stem mass [g/m2] + real (kind=kind_phys) , intent(inout) :: fastcp !short lived carbon [g/m2] + real (kind=kind_phys) , intent(inout) :: stblcp !stable carbon pool [g/m2] + real (kind=kind_phys) , intent(inout) :: wood !mass of wood (incl. woody roots) [g/m2] + real (kind=kind_phys) , intent(inout) :: grain !mass of grain (xing) [g/m2] + real (kind=kind_phys) , intent(inout) :: gdd !growing degree days (xing) + +! output + + real (kind=kind_phys) , intent(out) :: gpp !net instantaneous assimilation [g/m2/s] + real (kind=kind_phys) , intent(out) :: npp !net primary productivity [g/m2] + real (kind=kind_phys) , intent(out) :: nee !net ecosystem exchange (autors+heters-gpp) + real (kind=kind_phys) , intent(out) :: autors !net ecosystem resp. (maintance and growth) + real (kind=kind_phys) , intent(out) :: heters !organic respiration + real (kind=kind_phys) , intent(out) :: totsc !total soil carbon (g/m2) + real (kind=kind_phys) , intent(out) :: totlb !total living carbon (g/m2) + +! local + + real (kind=kind_phys) :: cflux !carbon flux to atmosphere [g/m2/s] + real (kind=kind_phys) :: lfmsmn !minimum leaf mass [g/m2] + real (kind=kind_phys) :: rswood !wood respiration [g/m2] + real (kind=kind_phys) :: rsleaf !leaf maintenance respiration per timestep[g/m2] + real (kind=kind_phys) :: rsroot !fine root respiration per time step [g/m2] + real (kind=kind_phys) :: rsgrain !grain respiration [g/m2] + real (kind=kind_phys) :: nppl !leaf net primary productivity [g/m2/s] + real (kind=kind_phys) :: nppr !root net primary productivity [g/m2/s] + real (kind=kind_phys) :: nppw !wood net primary productivity [g/m2/s] + real (kind=kind_phys) :: npps !wood net primary productivity [g/m2/s] + real (kind=kind_phys) :: nppg !grain net primary productivity [g/m2/s] + real (kind=kind_phys) :: dielf !death of leaf mass per time step [g/m2] + + real (kind=kind_phys) :: addnpplf !leaf assimil after resp. losses removed[g/m2] + real (kind=kind_phys) :: addnppst !stem assimil after resp. losses removed[g/m2] + real (kind=kind_phys) :: carbfx !carbon assimilated per model step [g/m2] + real (kind=kind_phys) :: cbhydrafx!carbonhydrate assimilated per model step [g/m2] + real (kind=kind_phys) :: grleaf !growth respiration rate for leaf [g/m2/s] + real (kind=kind_phys) :: grroot !growth respiration rate for root [g/m2/s] + real (kind=kind_phys) :: grwood !growth respiration rate for wood [g/m2/s] + real (kind=kind_phys) :: grstem !growth respiration rate for stem [g/m2/s] + real (kind=kind_phys) :: grgrain !growth respiration rate for stem [g/m2/s] + real (kind=kind_phys) :: leafpt !fraction of carbon allocated to leaves [-] + real (kind=kind_phys) :: lfdel !maximum leaf mass available to change[g/m2/s] + real (kind=kind_phys) :: lftovr !stem turnover per time step [g/m2] + real (kind=kind_phys) :: sttovr !stem turnover per time step [g/m2] + real (kind=kind_phys) :: wdtovr !wood turnover per time step [g/m2] + real (kind=kind_phys) :: grtovr !grainturnover per time step [g/m2] + real (kind=kind_phys) :: rssoil !soil respiration per time step [g/m2] + real (kind=kind_phys) :: rttovr !root carbon loss per time step by turnover[g/m2] + real (kind=kind_phys) :: stablc !decay rate of fast carbon to slow carbon[g/m2/s] + real (kind=kind_phys) :: woodf !calculated wood to root ratio [-] + real (kind=kind_phys) :: nonlef !fraction of carbon to root and wood [-] + real (kind=kind_phys) :: resp !leaf respiration [umol/m2/s] + real (kind=kind_phys) :: rsstem !stem respiration [g/m2/s] + + real (kind=kind_phys) :: fsw !soil water factor for microbial respiration + real (kind=kind_phys) :: fst !soil temperature factor for microbialrespiration + real (kind=kind_phys) :: fnf !foliage nitrogen adjustemt to respiration(<= 1) + real (kind=kind_phys) :: tf !temperature factor + real (kind=kind_phys) :: stdel + real (kind=kind_phys) :: stmsmn + real (kind=kind_phys) :: sapm !stem area per unit mass (m2/g) + real (kind=kind_phys) :: diest + real (kind=kind_phys) :: stconvert !stem to grain conversion [g/m2/s] + real (kind=kind_phys) :: rtconvert !root to grain conversion [g/m2/s] +! -------------------------- constants ------------------------------- + real (kind=kind_phys) :: bf !parameter for present wood allocation [-] + real (kind=kind_phys) :: rswoodc !wood respiration coeficient [1/s] + real (kind=kind_phys) :: stovrc !stem turnover coefficient [1/s] + real (kind=kind_phys) :: rsdryc !degree of drying that reduces soilrespiration [-] + real (kind=kind_phys) :: rtovrc !root turnover coefficient [1/s] + real (kind=kind_phys) :: wstrc !water stress coeficient [-] + real (kind=kind_phys) :: laimin !minimum leaf area index [m2/m2] + real (kind=kind_phys) :: xsamin !minimum leaf area index [m2/m2] + real (kind=kind_phys) :: sc + real (kind=kind_phys) :: sd + real (kind=kind_phys) :: vegfrac + real (kind=kind_phys) :: temp + +! respiration as a function of temperature + + real (kind=kind_phys) :: r,x + r(x) = exp(0.08*(x-298.16)) +! --------------------------------------------------------------------------------- + +! constants + rsdryc = 40.0 !original was 40.0 + rswoodc = 3.0e-10 ! + bf = 0.90 !original was 0.90 ! carbon to roots + wstrc = 100.0 + laimin = 0.05 + xsamin = 0.05 + + sapm = 3.*0.001 ! m2/kg -->m2/g + lfmsmn = laimin/0.035 + stmsmn = xsamin/sapm +! --------------------------------------------------------------------------------- + +! carbon assimilation +! 1 mole -> 12 g carbon or 44 g co2 or 30 g ch20 + + carbfx = psn*12.e-6!*ipa !umol co2 /m2/ s -> g/m2/s c + cbhydrafx = psn*30.e-6!*ipa + +! mainteinance respiration + fnf = min( foln/max(1.e-06,parameters%foln_mx), 1.0 ) + tf = parameters%q10mr**( (tv-298.16)/10. ) + resp = parameters%lfmr25 * tf * fnf * xlai * (1.-wstres) ! umol/m2/s + rsleaf = min((lfmass-lfmsmn)/dt,resp*30.e-6) ! g/m2/s + rsroot = parameters%rtmr25*(rtmass*1e-3)*tf * 30.e-6 ! g/m2/s + rsstem = parameters%stmr25*(stmass*1e-3)*tf * 30.e-6 ! g/m2/s + rsgrain = parameters%grainmr25*(grain*1e-3)*tf * 30.e-6 ! g/m2/s + +! calculate growth respiration for leaf, rtmass and grain + + grleaf = max(0.0,parameters%fra_gr*(parameters%lfpt(pgs)*cbhydrafx - rsleaf)) + grstem = max(0.0,parameters%fra_gr*(parameters%stpt(pgs)*cbhydrafx - rsstem)) + grroot = max(0.0,parameters%fra_gr*(parameters%rtpt(pgs)*cbhydrafx - rsroot)) + grgrain = max(0.0,parameters%fra_gr*(parameters%grainpt(pgs)*cbhydrafx - rsgrain)) + +! leaf turnover, stem turnover, root turnover and leaf death caused by soil +! water and soil temperature stress + + lftovr = parameters%lf_ovrc(pgs)*1.e-6*lfmass + rttovr = parameters%rt_ovrc(pgs)*1.e-6*rtmass + sttovr = parameters%st_ovrc(pgs)*1.e-6*stmass + sc = exp(-0.3*max(0.,tv-parameters%lefreez)) * (lfmass/120.) + sd = exp((wstres-1.)*wstrc) + dielf = lfmass*1.e-6*(parameters%dile_fw(pgs) * sd + parameters%dile_fc(pgs)*sc) + +! allocation of cbhydrafx to leaf, stem, root and grain at each growth stage + + + addnpplf = max(0.,parameters%lfpt(pgs)*cbhydrafx - grleaf-rsleaf) + addnpplf = parameters%lfpt(pgs)*cbhydrafx - grleaf-rsleaf + addnppst = max(0.,parameters%stpt(pgs)*cbhydrafx - grstem-rsstem) + addnppst = parameters%stpt(pgs)*cbhydrafx - grstem-rsstem + + +! avoid reducing leaf mass below its minimum value but conserve mass + + lfdel = (lfmass - lfmsmn)/dt + stdel = (stmass - stmsmn)/dt + lftovr = min(lftovr,lfdel+addnpplf) + sttovr = min(sttovr,stdel+addnppst) + dielf = min(dielf,lfdel+addnpplf-lftovr) + +! net primary productivities + + nppl = max(addnpplf,-lfdel) + nppl = addnpplf + npps = max(addnppst,-stdel) + npps = addnppst + nppr = parameters%rtpt(pgs)*cbhydrafx - rsroot - grroot + nppg = parameters%grainpt(pgs)*cbhydrafx - rsgrain - grgrain + +! masses of plant components + + lfmass = lfmass + (nppl-lftovr-dielf)*dt + stmass = stmass + (npps-sttovr)*dt ! g/m2 + rtmass = rtmass + (nppr-rttovr)*dt + grain = grain + nppg*dt + + gpp = cbhydrafx* 0.4 !!g/m2/s c 0.4=12/30, ch20 to c + + stconvert = 0.0 + rtconvert = 0.0 + if(pgs==6) then + stconvert = stmass*(0.00005*dt/3600.0) + stmass = stmass - stconvert + rtconvert = rtmass*(0.0005*dt/3600.0) + rtmass = rtmass - rtconvert + grain = grain + stconvert + rtconvert + end if + + if(rtmass.lt.0.0) then + rttovr = nppr + rtmass = 0.0 + endif + + if(grain.lt.0.0) then + grain = 0.0 + endif + + ! soil carbon budgets + +! if(pgs == 1 .or. pgs == 2 .or. pgs == 8) then +! fastcp=1000 +! else + fastcp = fastcp + (rttovr+lftovr+sttovr+dielf)*dt +! end if + fst = 2.0**( (stc-283.16)/10. ) + fsw = wroot / (0.20+wroot) * 0.23 / (0.23+wroot) + rssoil = fsw * fst * parameters%mrp* max(0.,fastcp*1.e-3)*12.e-6 + + stablc = 0.1*rssoil + fastcp = fastcp - (rssoil + stablc)*dt + stblcp = stblcp + stablc*dt + +! total carbon flux + + cflux = - carbfx + rsleaf + rsroot + rsstem & + + rssoil + grleaf + grroot ! g/m2/s 0.4=12/30, ch20 to c + +! for outputs + !g/m2/s c + + npp = (nppl + npps+ nppr +nppg)*0.4 !!g/m2/s c 0.4=12/30, ch20 to c + + + autors = rsroot + rsgrain + rsleaf + & !g/m2/s c + grleaf + grroot + grgrain !g/m2/s c + + heters = rssoil !g/m2/s c + nee = (autors + heters - gpp)*44./30. !g/m2/s co2 + totsc = fastcp + stblcp !g/m2 c + + totlb = lfmass + rtmass + grain + +! leaf area index and stem area index + + xlai = max(lfmass*parameters%bio2lai,laimin) + xsai = max(stmass*sapm,xsamin) + + +!after harversting +! if(pgs == 8 ) then +! lfmass = 0.62 +! stmass = 0 +! grain = 0 +! end if + +! if(pgs == 1 .or. pgs == 2 .or. pgs == 8) then + if(pgs == 8 .and. (grain > 0. .or. lfmass > 0 .or. stmass > 0 .or. rtmass > 0)) then + xlai = 0.05 + xsai = 0.05 + lfmass = lfmsmn + stmass = stmsmn + rtmass = 0 + grain = 0 + end if + +end subroutine co2flux_crop + +!== begin growing_gdd ============================================================================== + + subroutine growing_gdd (parameters, & !in + t2m , dt, julian, & !in + gdd , & !inout + ipa, iha, pgs) !out +!=================================================================================================== + +! input + + type (noahmp_parameters), intent(in) :: parameters + real (kind=kind_phys) , intent(in) :: t2m !air temperature + real (kind=kind_phys) , intent(in) :: dt !time step (s) + real (kind=kind_phys) , intent(in) :: julian !julian day of year (fractional) ( 0 <= julian < yearlen ) + +! input and output + + real (kind=kind_phys) , intent(inout) :: gdd !growing degress days + +! output + + integer , intent(out) :: ipa !planting index index(0=off, 1=on) + integer , intent(out) :: iha !havestindex(0=on,1=off) + integer , intent(out) :: pgs !plant growth stage(1=s1,2=s2,3=s3) + +!local + + real (kind=kind_phys) :: gddday !gap bewtween gdd and gdd8 + real (kind=kind_phys) :: dayofs2 !days in stage2 + real (kind=kind_phys) :: tdiff !temperature difference for growing degree days calculation + real (kind=kind_phys) :: tc + + tc = t2m - 273.15 + +!havestindex(0=on,1=off) + + ipa = 1 + iha = 1 + +!turn on/off the planting + + if(julian < parameters%pltday) ipa = 0 + +!turn on/off the harvesting + if(julian >= parameters%hsday) iha = 0 + +!calculate the growing degree days + + if(tc < parameters%gddtbase) then + tdiff = 0.0 + elseif(tc >= parameters%gddtcut) then + tdiff = parameters%gddtcut - parameters%gddtbase + else + tdiff = tc - parameters%gddtbase + end if + + gdd = (gdd + tdiff * dt / 86400.0) * ipa * iha + + gddday = gdd + + ! decide corn growth stage, based on hybrid-maize + ! pgs = 1 : before planting + ! pgs = 2 : from tassel initiation to silking + ! pgs = 3 : from silking to effective grain filling + ! pgs = 4 : from effective grain filling to pysiological maturity + ! pgs = 5 : gddm=1389 + ! pgs = 6 : + ! pgs = 7 : + ! pgs = 8 : + ! gddm = 1389 + ! gddm = 1555 + ! gddsk = 0.41*gddm +145.4+150 !from hybrid-maize + ! gdds1 = ((gddsk-96)/38.9-4)*21 + ! gdds1 = 0.77*gddsk + ! gdds3 = gddsk+170 + ! gdds3 = 170 + + pgs = 1 ! mb: set pgs = 1 (for initialization during growing season when no gdd) + + if(gddday > 0.0) pgs = 2 + + if(gddday >= parameters%gdds1) pgs = 3 + + if(gddday >= parameters%gdds2) pgs = 4 + + if(gddday >= parameters%gdds3) pgs = 5 + + if(gddday >= parameters%gdds4) pgs = 6 + + if(gddday >= parameters%gdds5) pgs = 7 + + if(julian >= parameters%hsday) pgs = 8 + + if(julian < parameters%pltday) pgs = 1 + +end subroutine growing_gdd + +!== begin psn_crop ================================================================================= + +subroutine psn_crop ( parameters, & !in + soldn, xlai,t2m, & !in + psncrop ) !out +!=================================================================================================== + +! input + + type (noahmp_parameters), intent(in) :: parameters + real (kind=kind_phys) , intent(in) :: soldn ! downward solar radiation + real (kind=kind_phys) , intent(in) :: xlai ! lai + real (kind=kind_phys) , intent(in) :: t2m ! air temp + real (kind=kind_phys) , intent(out) :: psncrop ! + +!local + + real (kind=kind_phys) :: par ! photosynthetically active radiation (w/m2) 1 w m-2 = 0.0864 mj m-2 day-1 + real (kind=kind_phys) :: amax ! maximum co2 assimulation rate g/co2/s + real (kind=kind_phys) :: l1 ! three gaussian method + real (kind=kind_phys) :: l2 ! three gaussian method + real (kind=kind_phys) :: l3 ! three gaussian method + real (kind=kind_phys) :: i1 ! three gaussian method + real (kind=kind_phys) :: i2 ! three gaussian method + real (kind=kind_phys) :: i3 ! three gaussian method + real (kind=kind_phys) :: a1 ! three gaussian method + real (kind=kind_phys) :: a2 ! three gaussian method + real (kind=kind_phys) :: a3 ! three gaussian method + real (kind=kind_phys) :: a ! co2 assimulation + real (kind=kind_phys) :: tc + + tc = t2m - 273.15 + + par = parameters%i2par * soldn * 0.0036 !w to mj m-2 + + if(tc < parameters%tassim0) then + amax = 1e-10 + elseif(tc >= parameters%tassim0 .and. tc < parameters%tassim1) then + amax = (tc - parameters%tassim0) * parameters%aref / (parameters%tassim1 - parameters%tassim0) + elseif(tc >= parameters%tassim1 .and. tc < parameters%tassim2) then + amax = parameters%aref + else + amax= parameters%aref - 0.2 * (t2m - parameters%tassim2) + endif + + amax = max(amax,0.01) + + if(xlai <= 0.05) then + l1 = 0.1127 * 0.05 !use initial lai(0.05), avoid error + l2 = 0.5 * 0.05 + l3 = 0.8873 * 0.05 + else + l1 = 0.1127 * xlai + l2 = 0.5 * xlai + l3 = 0.8873 * xlai + end if + + i1 = parameters%k * par * exp(-parameters%k * l1) + i2 = parameters%k * par * exp(-parameters%k * l2) + i3 = parameters%k * par * exp(-parameters%k * l3) + + i1 = max(i1,1e-10) + i2 = max(i2,1e-10) + i3 = max(i3,1e-10) + + a1 = amax * (1 - exp(-parameters%epsi * i1 / amax)) + a2 = amax * (1 - exp(-parameters%epsi * i2 / amax)) * 1.6 + a3 = amax * (1 - exp(-parameters%epsi * i3 / amax)) + + if (xlai <= 0.05) then + a = (a1+a2+a3) / 3.6 * 0.05 + elseif (xlai > 0.05 .and. xlai <= 4.0) then + a = (a1+a2+a3) / 3.6 * xlai + else + a = (a1+a2+a3) / 3.6 * 4 + end if + + a = a * parameters%psnrf ! attainable + + psncrop = 6.313 * a ! (1/44) * 1000000)/3600 = 6.313 + +end subroutine psn_crop + !== begin bvocflux ================================================================================= ! subroutine bvocflux(parameters,vocflx, vegtyp, vegfrac, apar, tv ) @@ -8390,32 +9175,32 @@ end subroutine co2flux ! ------------------------ input/output variables ----------------- ! input ! integer ,intent(in) :: vegtyp !vegetation type -! real ,intent(in) :: vegfrac !green vegetation fraction [0.0-1.0] -! real ,intent(in) :: apar !photosynthesis active energy by canopy (w/m2) -! real ,intent(in) :: tv !vegetation canopy temperature (k) +! real (kind=kind_phys) ,intent(in) :: vegfrac !green vegetation fraction [0.0-1.0] +! real (kind=kind_phys) ,intent(in) :: apar !photosynthesis active energy by canopy (w/m2) +! real (kind=kind_phys) ,intent(in) :: tv !vegetation canopy temperature (k) ! ! output -! real ,intent(out) :: vocflx(5) ! voc fluxes [ug c m-2 h-1] +! real (kind=kind_phys) ,intent(out) :: vocflx(5) ! voc fluxes [ug c m-2 h-1] ! ! local variables ! -! real, parameter :: r = 8.314 ! univ. gas constant [j k-1 mol-1] -! real, parameter :: alpha = 0.0027 ! empirical coefficient -! real, parameter :: cl1 = 1.066 ! empirical coefficient -! real, parameter :: ct1 = 95000.0 ! empirical coefficient [j mol-1] -! real, parameter :: ct2 = 230000.0 ! empirical coefficient [j mol-1] -! real, parameter :: ct3 = 0.961 ! empirical coefficient -! real, parameter :: tm = 314.0 ! empirical coefficient [k] -! real, parameter :: tstd = 303.0 ! std temperature [k] -! real, parameter :: bet = 0.09 ! beta empirical coefficient [k-1] +! real (kind=kind_phys), parameter :: r = 8.314 ! univ. gas constant [j k-1 mol-1] +! real (kind=kind_phys), parameter :: alpha = 0.0027 ! empirical coefficient +! real (kind=kind_phys), parameter :: cl1 = 1.066 ! empirical coefficient +! real (kind=kind_phys), parameter :: ct1 = 95000.0 ! empirical coefficient [j mol-1] +! real (kind=kind_phys), parameter :: ct2 = 230000.0 ! empirical coefficient [j mol-1] +! real (kind=kind_phys), parameter :: ct3 = 0.961 ! empirical coefficient +! real (kind=kind_phys), parameter :: tm = 314.0 ! empirical coefficient [k] +! real (kind=kind_phys), parameter :: tstd = 303.0 ! std temperature [k] +! real (kind=kind_phys), parameter :: bet = 0.09 ! beta empirical coefficient [k-1] ! ! integer ivoc ! do-loop index ! integer ityp ! do-loop index -! real epsilon(5) -! real gamma(5) -! real density -! real elai -! real par,cl,reciprod,ct +! real (kind=kind_phys) epsilon(5) +! real (kind=kind_phys) gamma(5) +! real (kind=kind_phys) density +! real (kind=kind_phys) elai +! real (kind=kind_phys) par,cl,reciprod,ct ! ! epsilon : ! @@ -8460,7 +9245,8 @@ end subroutine co2flux !>\ingroup NoahMP_LSM subroutine noahmp_options(idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc ,iopt_frz , & - iopt_inf ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc ) + iopt_inf ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc, & + iopt_rsf , iopt_soil, iopt_pedo, iopt_crop ) implicit none @@ -8478,6 +9264,10 @@ subroutine noahmp_options(idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc integer, intent(in) :: iopt_stc !snow/soil temperature time scheme (only layer 1) ! 1 -> semi-implicit; 2 -> full implicit (original noah) + integer, intent(in) :: iopt_rsf !surface resistance (1->sakaguchi/zeng; 2->seller; 3->mod sellers; 4->1+snow) + integer, intent(in) :: iopt_soil !soil parameters set-up option + integer, intent(in) :: iopt_pedo !pedo-transfer function (1->saxton and rawls) + integer, intent(in) :: iopt_crop !crop model option (0->none; 1->liu et al.) ! ------------------------------------------------------------------------------------------------- @@ -8494,9 +9284,12 @@ subroutine noahmp_options(idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc opt_snf = iopt_snf opt_tbot = iopt_tbot opt_stc = iopt_stc + opt_rsf = iopt_rsf + opt_soil = iopt_soil + opt_pedo = iopt_pedo + opt_crop = iopt_crop end subroutine noahmp_options - end module module_sf_noahmplsm diff --git a/physics/noahmp_tables.f90 b/physics/noahmp_tables.f90 index 7bab292fb..6341ae61a 100644 --- a/physics/noahmp_tables.f90 +++ b/physics/noahmp_tables.f90 @@ -11,19 +11,15 @@ module noahmp_tables implicit none - integer :: i integer, private, parameter :: mvt = 30 ! use 30 instead of 27 integer, private, parameter :: mband = 2 integer, private, parameter :: msc = 8 integer, private, parameter :: max_soiltyp = 30 - integer, private, parameter :: slcats = 30 - real :: slope_table(9) !slope factor for soil drainage - -! crops - integer, private, parameter :: ncrop = 5 integer, private, parameter :: nstage = 8 + integer :: i + integer, private, parameter :: slcats = 30 ! mptable.tbl vegetation parameters @@ -31,7 +27,12 @@ module noahmp_tables integer :: iswater_table = 17 integer :: isbarren_table = 16 integer :: isice_table = 15 - integer :: eblforest_table = 2 + integer :: iscrop_table = 12 + integer :: eblforest_table = 2 + integer :: natural_table = 14 + integer :: low_density_residential_table = 31 + integer :: high_density_residential_table = 32 + integer :: high_intensity_industrial_table = 33 ! real :: ch2op_table(mvt) !maximum intercepted h2o per unit lai+sai (mm) @@ -88,12 +89,20 @@ module noahmp_tables & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / real :: mfsno_table(mvt) !snowmelt curve parameter () - data ( mfsno_table(i),i=1,mvt) / 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, & - & 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, & - & 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, & - & 2.50, 2.50, 0.00, 0.00, 0.00, 0.00, & + data ( mfsno_table(i),i=1,mvt) / 1.00, 1.00, 1.00, 1.00, 1.00, 2.00, & + & 2.00, 2.00, 2.00, 2.00, 3.00, 3.00, & + & 4.00, 4.00, 2.50, 3.00, 3.00, 3.50, & + & 3.50, 3.50, 0.00, 0.00, 0.00, 0.00, & & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + real :: scffac_table(mvt) !snow cover factor (m) + data (scffac_table(i),i=1,mvt) / 0.005, 0.005, 0.005, 0.005, 0.005, & + & 0.008, 0.008, 0.010, 0.010, 0.010, & + & 0.010, 0.007, 0.021, 0.013, 0.015, & + & 0.008, 0.015, 0.015, 0.015, 0.015, & + & 0.000, 0.000, 0.000, 0.000, 0.000, & + & 0.000, 0.000, 0.000, 0.000, 0.000 / + ! real :: saim_table(mvt,12) !monthly stem area index, one-sided @@ -501,10 +510,10 @@ module noahmp_tables ! real :: cwpvt_table(mvt) !empirical canopy wind parameter - data ( cwpvt_table (i),i=1,mvt) / 0.18, 0.18, 0.18, 0.18, 0.18, 0.18, & - & 0.18, 0.18, 0.18, 0.18, 0.18, 0.18, & - & 0.18, 0.18, 0.18, 0.18, 0.18, 0.18, & - & 0.18, 0.18, 0.00, 0.00, 0.00, 0.00, & + data ( cwpvt_table (i),i=1,mvt) / 0.18, 0.67, 0.18, 0.67, 0.29, 1.00, & + & 2.00, 1.30, 1.00, 5.00, 1.17, 1.67, & + & 1.67, 1.67, 0.18, 0.18, 0.18, 0.67, & + & 1.00, 0.18, 0.00, 0.00, 0.00, 0.00, & & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / @@ -635,15 +644,15 @@ module noahmp_tables real :: bexp_table(max_soiltyp) - data (bexp_table(i), i=1,slcats) /2.79, 4.26, 4.74, 5.33, 5.33, 5.25,& + data (bexp_table(i), i=1,slcats) /2.79, 4.26, 4.74, 5.33, 3.86, 5.25,& & 6.77, 8.72, 8.17, 10.73, 10.39, 11.55, & & 5.25, 0.0, 2.79, 4.26, 11.55, 2.79, & & 2.79, 0.00, 0.00, 0.00, 0.00, 0.00, & & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / real :: smcdry_table(max_soiltyp) - data (smcdry_table(i), i=1,slcats) /0.010, 0.028, 0.047, 0.084, 0.084,& - & 0.066, 0.067, 0.120, 0.103, 0.100, 0.126, 0.138, & + data (smcdry_table(i), i=1,slcats) /0.010, 0.028, 0.047, 0.084, 0.061,& + & 0.066, 0.069, 0.120, 0.103, 0.100, 0.126, 0.138, & & 0.066, 0.0, 0.006, 0.028, 0.030, 0.006, & & 0.010, 0.000, 0.000, 0.000, 0.000, 0.000, & & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000 / @@ -658,7 +667,7 @@ module noahmp_tables real :: smcmax_table(max_soiltyp) - data (smcmax_table(i), i=1,slcats) /0.339, 0.421, 0.434, 0.476, 0.476,& + data (smcmax_table(i), i=1,slcats) /0.339, 0.421, 0.434, 0.476, 0.484,& & 0.439, 0.404, 0.464, 0.465, 0.406, 0.468, 0.468, & & 0.439, 1.000, 0.200, 0.421, 0.468, 0.200, & & 0.339, 0.339, 0.000, 0.000, 0.000, 0.000, & @@ -666,15 +675,15 @@ module noahmp_tables real :: smcref_table(max_soiltyp) - data (smcref_table(i), i=1,slcats) /0.236, 0.383, 0.383, 0.360, 0.383, & - & 0.329, 0.314, 0.387, 0.382, 0.338, 0.404, 0.412, & + data (smcref_table(i), i=1,slcats) /0.192, 0.283, 0.312, 0.360, 0.347, & + & 0.329, 0.315, 0.387, 0.382, 0.338, 0.404, 0.412, & & 0.329, 0.000, 0.170, 0.283, 0.454, 0.170, & - & 0.236, 0.000, 0.000, 0.000, 0.000, 0.000, & + & 0.192, 0.000, 0.000, 0.000, 0.000, 0.000, & & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000 / real :: psisat_table(max_soiltyp) - data (psisat_table(i), i=1,slcats) /0.069, 0.036, 0.141, 0.759, 0.759, & + data (psisat_table(i), i=1,slcats) /0.069, 0.036, 0.141, 0.759, 0.955, & & 0.355, 0.135, 0.617, 0.263, 0.098, 0.324, 0.468, & & 0.355, 0.00, 0.069, 0.036, 0.468, 0.069, & & 0.069, 0.00, 0.00, 0.00, 0.00, 0.00, & @@ -683,7 +692,7 @@ module noahmp_tables real :: dksat_table(max_soiltyp) data (dksat_table(i), i=1,slcats) /4.66e-5, 1.41e-5, 5.23e-6, 2.81e-6, & - & 2.81e-6, 3.38e-6, 4.45e-6, 2.03e-6, 2.45e-6,7.22e-6, & + & 2.18e-6, 3.38e-6, 4.45e-6, 2.03e-6, 2.45e-6,7.22e-6, & & 1.34e-6, 9.74e-7, 3.38e-6, 0.00, 1.41e-4, & & 1.41e-5, 9.74e-7, 1.41e-4, 4.66e-5,0.0, & & 0.00, 0.00, 0.00, 0.00, 0.00, & @@ -691,18 +700,18 @@ module noahmp_tables real :: dwsat_table(max_soiltyp) - data (dwsat_table(i), i=1,slcats) /0.608e-6, 0.514e-5, 0.805e-5, & - & 0.239e-4, 0.239e-4,0.143e-4, 0.99e-5, 0.237e-4, 0.113e-4, 0.187e-4, & - & 0.964e-5, 0.112e-4,0.143e-4,0.00, 0.136e-3, 0.514e-5, & - & 0.112e-4, 0.136e-3, 0.608e-6, 0.00, 0.00, & - & 0.00, 0.00, 0.00, 0.00, & + data (dwsat_table(i), i=1,slcats) / 2.65e-5, 5.14e-6, 8.05e-6, & + & 2.39e-5, 1.66e-5, 1.43e-5, 1.01e-5, 2.35e-5, 1.13e-5, 1.87e-5, & + & 9.64e-6, 1.12e-5, 1.43e-5, 0.00, 1.36e-4, 5.14e-6, & + & 1.12e-5, 1.36e-4, 2.65e-5, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, & & 0.00, 0.00, 0.00, 0.00, 0.00 / real :: smcwlt_table(max_soiltyp) - data (smcwlt_table(i), i=1,slcats) /0.010, 0.028, 0.047, 0.084, 0.084,& - & 0.066, 0.067, 0.120, 0.103, 0.100, 0.126, 0.138, & - & 0.066, 0.00, 0.006, 0.028, 0.03, 0.006, & + data (smcwlt_table(i), i=1,slcats) /0.010, 0.028, 0.047, 0.084, 0.061,& + & 0.066, 0.069, 0.120, 0.103, 0.100, 0.126, 0.138, & + & 0.066, 0.000, 0.006, 0.028, 0.030, 0.006, & & 0.010, 0.000, 0.000, 0.000, 0.000, 0.000, & & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000 / @@ -717,6 +726,7 @@ module noahmp_tables ! genparm.tbl parameters + real :: slope_table(9) !slope factor for soil drainage data (slope_table(i), i=1,9) /0.1, 0.6, 1.0, 0.35, 0.55, 0.8, & & 0.63, 0.0, 0.0 / @@ -725,7 +735,7 @@ module noahmp_tables real :: refkdt_table = 3.0 !parameter in the surface runoff parameterization real :: frzk_table =0.15 !frozen ground parameter real :: zbot_table = -8.0 !depth [m] of lower boundary soil temperature - real :: czil_table = 0.075 !parameter used in the calculation of the roughness length for heat + real :: czil_table = 0.1 !parameter used in the calculation of the roughness length for heat ! mptable.tbl radiation parameters @@ -763,10 +773,26 @@ module noahmp_tables real :: o2_table = 0.209 !o2 partial pressure real :: timean_table = 10.5 !gridcell mean topgraphic index (global mean) real :: fsatmx_table = 0.38 !maximum surface saturated fraction (global mean) - real :: z0sno_table = 0.002 !snow surface roughness length (m) (0.002) - real :: ssi_table = 0.03 !liquid water holding capacity for snowpack (m3/m3) (0.03) - real :: swemx_table = 1.00 !new snow mass to fully cover old snow (mm) - real :: rsurf_snow_table = 50.0 !surface resistance for snow(s/m) + + real :: z0sno_table = 0.002 !snow surface roughness length (m) (0.002) + real :: ssi_table = 0.03 !liquid water holding capacity for snowpack (m3/m3) (0.03) + real :: snow_ret_fac_table = 5.e-5 !snowpack water release timescale factor (1/s) + real :: swemx_table = 1.00 !new snow mass to fully cover old snow (mm) + + real :: tau0_table = 1.e6 !tau0 from yang97 eqn. 10a + real :: grain_growth_table = 5000. !growth from vapor diffusion yang97 eqn. 10b + real :: extra_growth_table = 10. !extra growth near freezing yang97 eqn. 10c + real :: dirt_soot_table = 0.3 !dirt and soot term yang97 eqn. 10d + real :: bats_cosz_table = 2.0 !zenith angle snow albedo adjustment; b in yang97 eqn. 15 + real :: bats_vis_new_table = 0.95 !new snow visible albedo + real :: bats_nir_new_table = 0.65 !new snow nir albedo + real :: bats_vis_age_table = 0.2 !age factor for diffuse visible snow albedo yang97 eqn. 17 + real :: bats_nir_age_table = 0.5 !age factor for diffuse nir snow albedo yang97 eqn. 18 + real :: bats_vis_dir_table = 0.4 !cosz factor for direct visible snow albedo yang97 eqn. 15 + real :: bats_nir_dir_table = 0.4 !cosz factor for direct nir snow albedo yang97 eqn. 16 + real :: rsurf_snow_table = 50.0 !surface resistance for snow(s/m) + real :: rsurf_exp_table = 5.0 !exponent in the shape parameter for soil resistance option 1 + real :: snow_emis_table = 0.95 !surface emissivity ! Noah mp crops @@ -960,5 +986,61 @@ module noahmp_tables real :: bio2lai_table(ncrop) ! leaf are per living leaf biomass [m^2/kg] data (bio2lai_table(i),i=1,5) /0.035,0.015,0.015,0.015,0.015/ +! mptable.tbl optional parameters + + !------------------------------------------------------------------------------ + ! Saxton and Rawls 2006 Pedo-transfer function coefficients + !------------------------------------------------------------------------------ + + real :: sr2006_theta_1500t_a = -0.024 ! sand coefficient + real :: sr2006_theta_1500t_b = 0.487 ! clay coefficient + real :: sr2006_theta_1500t_c = 0.006 ! orgm coefficient + real :: sr2006_theta_1500t_d = 0.005 ! sand*orgm coefficient + real :: sr2006_theta_1500t_e = -0.013 ! clay*orgm coefficient + real :: sr2006_theta_1500t_f = 0.068 ! sand*clay coefficient + real :: sr2006_theta_1500t_g = 0.031 ! constant adjustment + + real :: sr2006_theta_1500_a = 0.14 ! theta_1500t coefficient + real :: sr2006_theta_1500_b = -0.02 ! constant adjustment + + real :: sr2006_theta_33t_a = -0.251 ! sand coefficient + real :: sr2006_theta_33t_b = 0.195 ! clay coefficient + real :: sr2006_theta_33t_c = 0.011 ! orgm coefficient + real :: sr2006_theta_33t_d = 0.006 ! sand*orgm coefficient + real :: sr2006_theta_33t_e = -0.027 ! clay*orgm coefficient + real :: sr2006_theta_33t_f = 0.452 ! sand*clay coefficient + real :: sr2006_theta_33t_g = 0.299 ! constant adjustment + + real :: sr2006_theta_33_a = 1.283 ! theta_33t*theta_33t coefficient + real :: sr2006_theta_33_b = -0.374 ! theta_33t coefficient + real :: sr2006_theta_33_c = -0.015 ! constant adjustment + + real :: sr2006_theta_s33t_a = 0.278 ! sand coefficient + real :: sr2006_theta_s33t_b = 0.034 ! clay coefficient + real :: sr2006_theta_s33t_c = 0.022 ! orgm coefficient + real :: sr2006_theta_s33t_d = -0.018 ! sand*orgm coefficient + real :: sr2006_theta_s33t_e = -0.027 ! clay*orgm coefficient + real :: sr2006_theta_s33t_f = -0.584 ! sand*clay coefficient + real :: sr2006_theta_s33t_g = 0.078 ! constant adjustment + + real :: sr2006_theta_s33_a = 0.636 ! theta_s33t coefficient + real :: sr2006_theta_s33_b = -0.107 ! constant adjustment + + real :: sr2006_psi_et_a = -21.67 ! sand coefficient + real :: sr2006_psi_et_b = -27.93 ! clay coefficient + real :: sr2006_psi_et_c = -81.97 ! theta_s33 coefficient + real :: sr2006_psi_et_d = 71.12 ! sand*theta_s33 coefficient + real :: sr2006_psi_et_e = 8.29 ! clay*theta_s33 coefficient + real :: sr2006_psi_et_f = 14.05 ! sand*clay coefficient + real :: sr2006_psi_et_g = 27.16 ! constant adjustment + + real :: sr2006_psi_e_a = 0.02 ! psi_et*psi_et coefficient + real :: sr2006_psi_e_b = -0.113 ! psi_et coefficient + real :: sr2006_psi_e_c = -0.7 ! constant adjustment + + real :: sr2006_smcmax_a = -0.097 ! sand adjustment + real :: sr2006_smcmax_b = 0.043 ! constant adjustment + + end module noahmp_tables diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index f0cbdd18a..11b9741c5 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -205,6 +205,12 @@ subroutine sfc_init & print *,' - Using MODIS based land surface albedo for sw' endif + elseif ( ialbflg == 2 ) then ! use albedo from land model + + if ( me == 0 ) then + print *,' - Using Albedo From Land Model' + endif + else print *,' !! ERROR in Albedo Scheme Setting, IALB=',ialbflg stop @@ -265,6 +271,12 @@ subroutine sfc_init & close(NIRADSF) endif ! end if_file_exist_block + elseif ( iemslw == 2 ) then ! use emiss from land model + + if ( me == 0 ) then + print *,' - Using Surface Emissivity From Land Model' + endif + else print *,' !! ERROR in Emissivity Scheme Setting, IEMS=',iemsflg stop @@ -319,7 +331,7 @@ end subroutine sfc_init subroutine setalb & & ( slmsk,snowf,sncovr,snoalb,zorlf,coszf,tsknf,tairf,hprif, & ! --- inputs: & alvsf,alnsf,alvwf,alnwf,facsf,facwf,fice,tisfc, & - & IMAX, & + & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir,IMAX, & & albPpert, pertalb, & ! sfc-perts, mgehne & sfcalb & ! --- outputs: & ) @@ -389,6 +401,7 @@ subroutine setalb & real (kind=kind_phys), dimension(:), intent(in) :: & & slmsk, snowf, zorlf, coszf, tsknf, tairf, hprif, & & alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & + & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir, & & sncovr, snoalb, albPpert ! sfc-perts, mgehne real (kind=kind_phys), intent(in) :: pertalb ! sfc-perts, mgehne @@ -513,7 +526,7 @@ subroutine setalb & enddo ! end_do_i_loop !> - If use modis based albedo for land area: - else + elseif ( ialbflg == 1 ) then do i = 1, IMAX @@ -623,6 +636,117 @@ subroutine setalb & enddo ! end_do_i_loop +!> -# use land model output for land area: + elseif ( ialbflg == 2 ) then + do i = 1, IMAX + +!> - albedo from noah mp already includes the snow portion + + fsno0 = f_zero + + if (nint(slmsk(i))==0 .and. tsknf(i)>con_tice) fsno0 = f_zero + + if (nint(slmsk(i)) == 2) then + asnow = 0.02*snowf(i) + argh = min(0.50, max(.025, 0.01*zorlf(i))) + hrgh = min(f_one, max(0.20, 1.0577-1.1538e-3*hprif(i) ) ) + fsno0 = asnow / (argh + asnow) * hrgh + endif + + fsno1 = f_one - fsno0 + flnd0 = min(f_one, facsf(i)+facwf(i)) + fsea0 = max(f_zero, f_one-flnd0) + fsno = fsno0 + fsea = fsea0 * fsno1 + flnd = flnd0 * fsno1 + +!> - Calculate diffused sea surface albedo. + + if (tsknf(i) >= 271.5) then + asevd = 0.06 + asend = 0.06 + elseif (tsknf(i) < 271.1) then + asevd = 0.70 + asend = 0.65 + else + a1 = (tsknf(i) - 271.1)**2 + asevd = 0.7 - 4.0*a1 + asend = 0.65 - 3.6875*a1 + endif + +!> - Calculate diffused snow albedo, land area use input max snow +!! albedo. + + if (nint(slmsk(i)) == 2) then + ffw = f_one - fice(i) + if (ffw < f_one) then + dtgd = max(f_zero, min(5.0, (con_ttp-tisfc(i)) )) + b1 = 0.03 * dtgd + else + b1 = f_zero + endif + + b3 = 0.06 * ffw + asnvd = (0.70 + b1) * fice(i) + b3 + asnnd = (0.60 + b1) * fice(i) + b3 + asevd = 0.70 * fice(i) + b3 + asend = 0.60 * fice(i) + b3 + else + asnvd = snoalb(i) + asnnd = snoalb(i) + endif + +!> - Calculate direct snow albedo. + + if (nint(slmsk(i)) == 2) then + if (coszf(i) < 0.5) then + csnow = 0.5 * (3.0 / (f_one+4.0*coszf(i)) - f_one) + asnvb = min( 0.98, asnvd+(f_one-asnvd)*csnow ) + asnnb = min( 0.98, asnnd+(f_one-asnnd)*csnow ) + else + asnvb = asnvd + asnnb = asnnd + endif + else + asnvb = asnvd + asnnb = asnnd + endif + +!> - Calculate direct sea surface albedo, use fanglin's zenith angle +!! treatment. + + if (coszf(i) > 0.0001) then + +! rfcs = 1.89 - 3.34*coszf(i) + 4.13*coszf(i)*coszf(i) & +! & - 2.02*coszf(i)*coszf(i)*coszf(i) + rfcs = 1.775/(1.0+1.55*coszf(i)) + + if (tsknf(i) >= con_t0c) then + asevb = max(asevd, 0.026/(coszf(i)**1.7+0.065) & + & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & + & * (coszf(i)-f_one)) + asenb = asevb + else + asevb = asevd + asenb = asend + endif + else + rfcs = f_one + asevb = asevd + asenb = asend + endif + + sfcalb(i,1) = min(0.99,max(0.01,lsmalbdnir(i)))*flnd & + & + asenb*fsea + asnnb*fsno + sfcalb(i,2) = min(0.99,max(0.01,lsmalbinir(i)))*flnd & + & + asend*fsea + asnnd*fsno + sfcalb(i,3) = min(0.99,max(0.01,lsmalbdvis(i)))*flnd & + & + asevb*fsea + asnvb*fsno + sfcalb(i,4) = min(0.99,max(0.01,lsmalbivis(i)))*flnd & + & + asevd*fsea + asnvd*fsno + + enddo ! end_do_i_loop + endif ! end if_ialbflg ! @@ -673,7 +797,7 @@ end subroutine setalb !----------------------------------- subroutine setemis & & ( xlon,xlat,slmsk,snowf,sncovr,zorlf,tsknf,tairf,hprif, & ! --- inputs: - & IMAX, & + & lsmemiss,IMAX, & & sfcemis & ! --- outputs: & ) @@ -699,6 +823,7 @@ subroutine setemis & ! tsknf (IMAX) - ground surface temperature in k ! ! tairf (IMAX) - lowest model layer air temperature in k ! ! hprif (IMAX) - topographic sdv in m ! +! lsmemiss(IMAX)- emissivity from lsm ! ! IMAX - array horizontal dimension ! ! ! ! outputs: ! @@ -722,7 +847,8 @@ subroutine setemis & integer, intent(in) :: IMAX real (kind=kind_phys), dimension(:), intent(in) :: & - & xlon,xlat, slmsk, snowf,sncovr, zorlf, tsknf, tairf, hprif + & xlon,xlat, slmsk, snowf,sncovr, zorlf, tsknf, tairf, hprif,& + & lsmemiss ! --- outputs real (kind=kind_phys), dimension(:), intent(out) :: sfcemis @@ -749,7 +875,7 @@ subroutine setemis & sfcemis(:) = f_one return - else ! emiss set by sfc type and condition + elseif ( iemslw == 1 ) then ! emiss set by sfc type and condition dltg = 360.0 / float(IMXEMS) hdlt = 0.5 * dltg @@ -830,6 +956,26 @@ subroutine setemis & enddo lab_do_IMAX + elseif ( iemslw == 2 ) then ! sfc emiss updated in land model + + do i = 1, IMAX + + if ( nint(slmsk(i)) == 0 ) then ! sea point + + sfcemis(i) = emsref(1) + + else if ( nint(slmsk(i)) == 2 ) then ! sea-ice + + sfcemis(i) = emsref(7) + + else ! land + + sfcemis(i) = lsmemiss(i) + + endif ! end if_slmsk_block + enddo + + endif ! end if_iemslw_block !chk print *,' In setemis, iemsflg, sfcemis =',iemsflg,sfcemis diff --git a/physics/rrtmg_lw_pre.F90 b/physics/rrtmg_lw_pre.F90 index d96a1f486..276a0a5bd 100644 --- a/physics/rrtmg_lw_pre.F90 +++ b/physics/rrtmg_lw_pre.F90 @@ -13,7 +13,7 @@ end subroutine rrtmg_lw_pre_init !! \htmlinclude rrtmg_lw_pre_run.html !! subroutine rrtmg_lw_pre_run (im, lslwr, xlat, xlon, slmsk, snowd, sncovr,& - zorl, hprime, tsfg, tsfa, semis, errmsg, errflg) + zorl, hprime, tsfg, tsfa, semis, emiss, errmsg, errflg) use machine, only: kind_phys use module_radiation_surface, only: setemis @@ -23,7 +23,8 @@ subroutine rrtmg_lw_pre_run (im, lslwr, xlat, xlon, slmsk, snowd, sncovr,& integer, intent(in) :: im logical, intent(in) :: lslwr real(kind=kind_phys), dimension(im), intent(in) :: xlat, xlon, slmsk, & - snowd, sncovr, zorl, hprime, tsfg, tsfa + snowd, sncovr, zorl, hprime, tsfg, tsfa + real(kind=kind_phys), dimension(:), intent(in) :: emiss real(kind=kind_phys), dimension(im), intent(out) :: semis character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -36,7 +37,7 @@ subroutine rrtmg_lw_pre_run (im, lslwr, xlat, xlon, slmsk, snowd, sncovr,& !> - Call module_radiation_surface::setemis(),to setup surface !! emissivity for LW radiation. call setemis (xlon, xlat, slmsk, snowd, sncovr, zorl, tsfg, tsfa, & - hprime, im, & ! --- inputs + hprime, emiss, im, & ! --- inputs semis) ! --- outputs endif diff --git a/physics/rrtmg_lw_pre.meta b/physics/rrtmg_lw_pre.meta index bfb0bd61f..d62d9881c 100644 --- a/physics/rrtmg_lw_pre.meta +++ b/physics/rrtmg_lw_pre.meta @@ -113,6 +113,15 @@ kind = kind_phys intent = out optional = F +[emiss] + standard_name = surface_emissivity_lsm + long_name = surface emissivity from lsm + units = frac + dimensions = (horizontal_loop_extent) + 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/rrtmg_sw_pre.F90 b/physics/rrtmg_sw_pre.F90 index f54a5a963..b281d42a7 100644 --- a/physics/rrtmg_sw_pre.F90 +++ b/physics/rrtmg_sw_pre.F90 @@ -12,10 +12,10 @@ end subroutine rrtmg_sw_pre_init !> \section arg_table_rrtmg_sw_pre_run Argument Table !! \htmlinclude rrtmg_sw_pre_run.html !! - subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, lndp_prt_list, tsfg, tsfa, coszen, & - alb1d, slmsk, snowd, sncovr, snoalb, zorl, hprime, alvsf, alnsf, alvwf,& - alnwf, facsf, facwf, fice, tisfc, sfalb, nday, idxday, sfcalb1, & - sfcalb2, sfcalb3, sfcalb4, errmsg, errflg) + subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, lndp_prt_list, tsfg, tsfa, coszen, & + alb1d, slmsk, snowd, sncovr, snoalb, zorl, hprime, alvsf, alnsf, alvwf, & + alnwf, facsf, facwf, fice, tisfc, albdvis, albdnir, albivis, albinir, & + sfalb, nday, idxday, sfcalb1, sfcalb2, sfcalb3, sfcalb4, errmsg, errflg) use machine, only: kind_phys @@ -36,6 +36,8 @@ subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, ln alvwf, alnwf, & facsf, facwf, & fice, tisfc + real(kind=kind_phys), dimension(:), intent(in) :: albdvis, albdnir, & + albivis, albinir real(kind=kind_phys), dimension(im), intent(inout) :: sfalb integer, intent(out) :: nday integer, dimension(im), intent(out) :: idxday @@ -83,8 +85,9 @@ subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, ln call setalb (slmsk, snowd, sncovr, snoalb, zorl, coszen, tsfg, tsfa, & ! --- inputs hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, & - tisfc, IM, alb1d, lndp_alb, & ! mg, sfc-perts - sfcalb) ! --- outputs + tisfc, albdvis, albdnir, albivis, albinir,IM, alb1d, & ! mg, sfc-perts + lndp_alb, sfcalb) ! --- outputs + !> -# Approximate mean surface albedo from vis- and nir- diffuse values. sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) diff --git a/physics/rrtmg_sw_pre.meta b/physics/rrtmg_sw_pre.meta index b965b5381..49d83ff89 100644 --- a/physics/rrtmg_sw_pre.meta +++ b/physics/rrtmg_sw_pre.meta @@ -219,6 +219,42 @@ kind = kind_phys intent = in optional = F +[albdvis] + standard_name = surface_albedo_direct_visible + long_name = direct surface albedo visible band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albdnir] + standard_name = surface_albedo_direct_NIR + long_name = direct surface albedo NIR band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albivis] + standard_name = surface_albedo_diffuse_visible + long_name = diffuse surface albedo visible band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albinir] + standard_name = surface_albedo_diffuse_NIR + long_name = diffuse surface albedo NIR band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [sfalb] standard_name = surface_diffused_shortwave_albedo long_name = mean surface diffused sw albedo diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 index 907230180..f4ee288f7 100644 --- a/physics/rrtmgp_lw_pre.F90 +++ b/physics/rrtmgp_lw_pre.F90 @@ -26,8 +26,8 @@ end subroutine rrtmgp_lw_pre_init !! \htmlinclude rrtmgp_lw_pre_run.html !! subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, & - tsfg, tsfa, hprime, sfc_emiss_byband, semis, errmsg, errflg) - + tsfg, tsfa, hprime, sfc_emiss_byband, emiss, semis, errmsg, errflg) + ! Inputs logical, intent(in) :: & doLWrad ! Logical flag for longwave radiation call @@ -43,6 +43,8 @@ subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, snc tsfg, & ! Surface ground temperature for radiation (K) tsfa, & ! Lowest model layer air temperature for radiation (K) hprime ! Standard deviation of subgrid orography + real(kind_phys), dimension(:), intent(in) :: & + emiss ! Surface emissivity from Noah MP ! Outputs real(kind_phys), dimension(lw_gas_props%get_nband(),ncol), intent(out) :: & @@ -66,7 +68,7 @@ subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, snc ! ####################################################################################### ! Call module_radiation_surface::setemis(),to setup surface emissivity for LW radiation. ! ####################################################################################### - call setemis (xlon, xlat, slmsk, snowd, sncovr, zorl, tsfg, tsfa, hprime, nCol, semis) + call setemis (xlon, xlat, slmsk, snowd, sncovr, zorl, tsfg, tsfa, hprime, emiss, nCol, semis) ! Assign same emissivity to all bands do iBand=1,lw_gas_props%get_nband() diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta index af287b2f7..5446580df 100644 --- a/physics/rrtmgp_lw_pre.meta +++ b/physics/rrtmgp_lw_pre.meta @@ -104,6 +104,15 @@ kind = kind_phys intent = in optional = F +[emiss] + standard_name = surface_emissivity_lsm + long_name = surface emissivity from lsm + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [semis] standard_name = surface_longwave_emissivity long_name = surface lw emissivity in fraction diff --git a/physics/sfc_noah_wrfv4.meta b/physics/sfc_noah_wrfv4.meta index 1895c56bf..5cb925808 100644 --- a/physics/sfc_noah_wrfv4.meta +++ b/physics/sfc_noah_wrfv4.meta @@ -216,7 +216,7 @@ intent = in optional = F [sthick] - standard_name = soil_layer_thickness + standard_name = thickness_of_soil_levels_for_land_surface_model long_name = soil layer thickness units = m dimensions = (soil_vertical_dimension) diff --git a/physics/sfc_noah_wrfv4_interstitial.meta b/physics/sfc_noah_wrfv4_interstitial.meta index b6ebcfe39..4364897a9 100644 --- a/physics/sfc_noah_wrfv4_interstitial.meta +++ b/physics/sfc_noah_wrfv4_interstitial.meta @@ -664,7 +664,7 @@ intent = inout optional = F [sthick] - standard_name = soil_layer_thickness + standard_name = thickness_of_soil_levels_for_land_surface_model long_name = soil layer thickness units = m dimensions = (soil_vertical_dimension) diff --git a/physics/sfc_noahmp_drv.F90 b/physics/sfc_noahmp_drv.F90 new file mode 100644 index 000000000..392e29071 --- /dev/null +++ b/physics/sfc_noahmp_drv.F90 @@ -0,0 +1,1527 @@ +#define CCPP +!> \file sfc_noahmp_drv.F90 +!! This file contains the NoahMP land surface scheme driver. + +!>\defgroup NoahMP_LSM NoahMP LSM Model +!! \brief This is the NoahMP LSM driver module, with the functionality of +!! preparing variables to run the NoahMP LSM subroutine noahmp_sflx(), calling NoahMP LSM and post-processing +!! variables for return to the parent model suite including unit conversion, as well +!! as diagnotics calculation. + +!> This module contains the CCPP-compliant NoahMP land surface model driver. + module noahmpdrv + + implicit none + + private + + public :: noahmpdrv_init, noahmpdrv_run, noahmpdrv_finalize + + contains + +!> \ingroup NoahMP_LSM +!! \brief This subroutine is called during the CCPP initialization phase and calls set_soilveg() to +!! initialize soil and vegetation parameters for the chosen soil and vegetation data sources. +!! \section arg_table_noahmpdrv_init Argument Table +!! \htmlinclude noahmpdrv_init.html +!! + subroutine noahmpdrv_init(me, isot, ivegsrc, nlunit, pores, resid, & + errmsg, errflg) + + use machine, only: kind_phys + use set_soilveg_mod, only: set_soilveg + use namelist_soilveg + + implicit none + + integer, intent(in) :: me, isot, ivegsrc, nlunit + + real (kind=kind_phys), dimension(:), intent(out) :: pores, resid + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (ivegsrc /= 1) then + errmsg = 'The NOAHMP LSM expects that the ivegsrc physics '// & + 'namelist parameter is 1. Exiting...' + errflg = 1 + return + end if + if (isot /= 1) then + errmsg = 'The NOAHMP LSM expects that the isot physics '// & + 'namelist parameter is 1. Exiting...' + errflg = 1 + return + end if + + !--- initialize soil vegetation + call set_soilveg(me, isot, ivegsrc, nlunit) + + pores (:) = maxsmc (:) + resid (:) = drysmc (:) + + end subroutine noahmpdrv_init + + subroutine noahmpdrv_finalize + end subroutine noahmpdrv_finalize + +!> \ingroup NoahMP_LSM +!! \brief This subroutine is the main CCPP entry point for the NoahMP LSM. +!! \section arg_table_noahmpdrv_run Argument Table +!! \htmlinclude noahmpdrv_run.html +!! +!! \section general_noahmpdrv NoahMP Driver General Algorithm +!! @{ +!! - Initialize CCPP error handling variables. +!! - Set a flag to only continue with each grid cell if the fraction of land is non-zero. +!! - This driver may be called as part of an iterative loop. If called as the first "guess" run, +!! save land-related prognostic fields to restore. +!! - Initialize output variables to zero and prepare variables for input into the NoahMP LSM. +!! - Call transfer_mp_parameters() to fill a derived datatype for input into the NoahMP LSM. +!! - Call noahmp_options() to set module-level scheme options for the NoahMP LSM. +!! - If the vegetation type is ice for the grid cell, call noahmp_options_glacier() to set +!! module-level scheme options for NoahMP Glacier and call noahmp_glacier(). +!! - For other vegetation types, call noahmp_sflx(), the entry point of the NoahMP LSM. +!! - Set output variables from the output of noahmp_glacier() and/or noahmp_sflx(). +!! - Call penman() to calculate potential evaporation. +!! - Calculate the surface specific humidity and convert surface sensible and latent heat fluxes in W m-2 from their kinematic values. +!! - If a "guess" run, restore the land-related prognostic fields. +! ! +!----------------------------------- + subroutine noahmpdrv_run & +!................................... +! --- inputs: + ( im, km, itime, ps, u1, v1, t1, q1, soiltyp, vegtype, & + sigmaf, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & + prsl1, prslki, zf, dry, wind, slopetyp, & + shdmin, shdmax, snoalb, sfalb, flag_iter, flag_guess, & + idveg, iopt_crs, iopt_btr, iopt_run, iopt_sfc, iopt_frz, & + iopt_inf, iopt_rad, iopt_alb, iopt_snf, iopt_tbot, & + iopt_stc, xlatin, xcoszin, iyrlen, julian, & + rainn_mp, rainc_mp, snow_mp, graupel_mp, ice_mp, & + con_hvap, con_cp, con_jcal, rhoh2o, con_eps, con_epsm1, & + con_fvirt, con_rd, con_hfus, & + +! --- in/outs: + weasd, snwdph, tskin, tprcp, srflag, smc, stc, slc, & + canopy, trans, tsurf, zorl, & + +! --- Noah MP specific + + snowxy, tvxy, tgxy, canicexy, canliqxy, eahxy, tahxy, cmxy,& + chxy, fwetxy, sneqvoxy, alboldxy, qsnowxy, wslakexy, zwtxy,& + waxy, wtxy, tsnoxy, zsnsoxy, snicexy, snliqxy, lfmassxy, & + rtmassxy, stmassxy, woodxy, stblcpxy, fastcpxy, xlaixy, & + xsaixy, taussxy, smoiseq, smcwtdxy, deeprechxy, rechxy, & + albdvis, albdnir, albivis, albinir,emiss, & + +! --- outputs: + sncovr1, qsurf, gflux, drain, evap, hflx, ep, runoff, & + cmm, chh, evbs, evcw, sbsno, snowc, stm, snohf, & + smcwlt2, smcref2, wet1, t2mmp, q2mp, errmsg, errflg) + + use machine , only : kind_phys + use funcphys, only : fpvs + + use module_sf_noahmplsm + use module_sf_noahmp_glacier + use noahmp_tables, only : isice_table, co2_table, o2_table, & + isurban_table,smcref_table,smcdry_table, & + smcmax_table,co2_table,o2_table, & + saim_table,laim_table + + implicit none + + real(kind=kind_phys), parameter :: a2 = 17.2693882 + real(kind=kind_phys), parameter :: a3 = 273.16 + real(kind=kind_phys), parameter :: a4 = 35.86 + real(kind=kind_phys), parameter :: a23m4 = a2*(a3-a4) + + real, parameter :: undefined = 9.99e20_kind_phys + + integer, parameter :: nsoil = 4 ! hardwired to Noah + integer, parameter :: nsnow = 3 ! max. snow layers + + real(kind=kind_phys), save :: zsoil(nsoil) + data zsoil / -0.1, -0.4, -1.0, -2.0 / + +! +! --- CCPP interface fields (in call order) +! + + integer , intent(in) :: im ! horiz dimension and num of used pts + integer , intent(in) :: km ! vertical soil layer dimension + integer , intent(in) :: itime ! NOT USED + real(kind=kind_phys), dimension(im) , intent(in) :: ps ! surface pressure [Pa] + real(kind=kind_phys), dimension(im) , intent(in) :: u1 ! u-component of wind [m/s] + real(kind=kind_phys), dimension(im) , intent(in) :: v1 ! u-component of wind [m/s] + real(kind=kind_phys), dimension(im) , intent(in) :: t1 ! layer 1 temperature [K] + real(kind=kind_phys), dimension(im) , intent(in) :: q1 ! layer 1 specific humidity [kg/kg] + integer , dimension(im) , intent(in) :: soiltyp ! soil type (integer index) + integer , dimension(im) , intent(in) :: vegtype ! vegetation type (integer index) + real(kind=kind_phys), dimension(im) , intent(in) :: sigmaf ! areal fractional cover of green vegetation + real(kind=kind_phys), dimension(im) , intent(in) :: dlwflx ! downward longwave radiation [W/m2] + real(kind=kind_phys), dimension(im) , intent(in) :: dswsfc ! downward shortwave radiation [W/m2] + real(kind=kind_phys), dimension(im) , intent(in) :: snet ! total sky sfc netsw flx into ground[W/m2] + real(kind=kind_phys) , intent(in) :: delt ! time interval [s] + real(kind=kind_phys), dimension(im) , intent(in) :: tg3 ! deep soil temperature [K] + real(kind=kind_phys), dimension(im) , intent(in) :: cm ! surface exchange coeff for momentum [-] + real(kind=kind_phys), dimension(im) , intent(in) :: ch ! surface exchange coeff heat & moisture[-] + real(kind=kind_phys), dimension(im) , intent(in) :: prsl1 ! sfc layer 1 mean pressure [Pa] + real(kind=kind_phys), dimension(im) , intent(in) :: prslki ! to calculate potential temperature + real(kind=kind_phys), dimension(im) , intent(in) :: zf ! height of bottom layer [m] + logical , dimension(im) , intent(in) :: dry ! = T if a point with any land + real(kind=kind_phys), dimension(im) , intent(in) :: wind ! wind speed [m/s] + integer , dimension(im) , intent(in) :: slopetyp ! surface slope classification + real(kind=kind_phys), dimension(im) , intent(in) :: shdmin ! min green vegetation coverage [fraction] + real(kind=kind_phys), dimension(im) , intent(in) :: shdmax ! max green vegetation coverage [fraction] + real(kind=kind_phys), dimension(im) , intent(in) :: snoalb ! upper bound on max albedo over deep snow + real(kind=kind_phys), dimension(im) , intent(inout) :: sfalb ! mean surface albedo [fraction] + logical , dimension(im) , intent(in) :: flag_iter ! + logical , dimension(im) , intent(in) :: flag_guess ! + integer , intent(in) :: idveg ! option for dynamic vegetation + integer , intent(in) :: iopt_crs ! option for canopy stomatal resistance + integer , intent(in) :: iopt_btr ! option for soil moisture factor for stomatal resistance + integer , intent(in) :: iopt_run ! option for runoff and groundwater + integer , intent(in) :: iopt_sfc ! option for surface layer drag coeff (ch & cm) + integer , intent(in) :: iopt_frz ! option for supercooled liquid water (or ice fraction) + integer , intent(in) :: iopt_inf ! option for frozen soil permeability + integer , intent(in) :: iopt_rad ! option for radiation transfer + integer , intent(in) :: iopt_alb ! option for ground snow surface albedo + integer , intent(in) :: iopt_snf ! option for partitioning precipitation into rainfall & snowfall + integer , intent(in) :: iopt_tbot ! option for lower boundary condition of soil temperature + integer , intent(in) :: iopt_stc ! option for snow/soil temperature time scheme (only layer 1) + real(kind=kind_phys), dimension(im) , intent(in) :: xlatin ! latitude + real(kind=kind_phys), dimension(im) , intent(in) :: xcoszin ! cosine of zenith angle + integer , intent(in) :: iyrlen ! year length [days] + real(kind=kind_phys) , intent(in) :: julian ! julian day of year + real(kind=kind_phys), dimension(im) , intent(in) :: rainn_mp ! microphysics non-convective precipitation [mm] + real(kind=kind_phys), dimension(im) , intent(in) :: rainc_mp ! microphysics convective precipitation [mm] + real(kind=kind_phys), dimension(im) , intent(in) :: snow_mp ! microphysics snow [mm] + real(kind=kind_phys), dimension(im) , intent(in) :: graupel_mp ! microphysics graupel [mm] + real(kind=kind_phys), dimension(im) , intent(in) :: ice_mp ! microphysics ice/hail [mm] + real(kind=kind_phys) , intent(in) :: con_hvap ! latent heat condensation [J/kg] + real(kind=kind_phys) , intent(in) :: con_cp ! specific heat air [J/kg/K] + real(kind=kind_phys) , intent(in) :: con_jcal ! joules per calorie (not used) + real(kind=kind_phys) , intent(in) :: rhoh2o ! density of water [kg/m^3] + real(kind=kind_phys) , intent(in) :: con_eps ! Rd/Rv + real(kind=kind_phys) , intent(in) :: con_epsm1 ! Rd/Rv - 1 + real(kind=kind_phys) , intent(in) :: con_fvirt ! Rv/Rd - 1 + real(kind=kind_phys) , intent(in) :: con_rd ! gas constant air [J/kg/K] + real(kind=kind_phys) , intent(in) :: con_hfus ! lat heat H2O fusion [J/kg] + real(kind=kind_phys), dimension(im) , intent(inout) :: weasd ! water equivalent accumulated snow depth [mm] + real(kind=kind_phys), dimension(im) , intent(inout) :: snwdph ! snow depth [mm] + real(kind=kind_phys), dimension(im) , intent(inout) :: tskin ! ground surface skin temperature [K] + real(kind=kind_phys), dimension(im) , intent(inout) :: tprcp ! total precipitation [m] + real(kind=kind_phys), dimension(im) , intent(inout) :: srflag ! snow/rain flag for precipitation + real(kind=kind_phys), dimension(im,km) , intent(inout) :: smc ! total soil moisture content [m3/m3] + real(kind=kind_phys), dimension(im,km) , intent(inout) :: stc ! soil temp [K] + real(kind=kind_phys), dimension(im,km) , intent(inout) :: slc ! liquid soil moisture [m3/m3] + real(kind=kind_phys), dimension(im) , intent(inout) :: canopy ! canopy moisture content [mm] + real(kind=kind_phys), dimension(im) , intent(inout) :: trans ! total plant transpiration [m/s] + real(kind=kind_phys), dimension(im) , intent(inout) :: tsurf ! surface skin temperature [after iteration] + real(kind=kind_phys), dimension(im) , intent(inout) :: zorl ! surface roughness [cm] + real(kind=kind_phys), dimension(im) , intent(inout) :: snowxy ! actual no. of snow layers + real(kind=kind_phys), dimension(im) , intent(inout) :: tvxy ! vegetation leaf temperature [K] + real(kind=kind_phys), dimension(im) , intent(inout) :: tgxy ! bulk ground surface temperature [K] + real(kind=kind_phys), dimension(im) , intent(inout) :: canicexy ! canopy-intercepted ice [mm] + real(kind=kind_phys), dimension(im) , intent(inout) :: canliqxy ! canopy-intercepted liquid water [mm] + real(kind=kind_phys), dimension(im) , intent(inout) :: eahxy ! canopy air vapor pressure [Pa] + real(kind=kind_phys), dimension(im) , intent(inout) :: tahxy ! canopy air temperature [K] + real(kind=kind_phys), dimension(im) , intent(inout) :: cmxy ! bulk momentum drag coefficient [m/s] + real(kind=kind_phys), dimension(im) , intent(inout) :: chxy ! bulk sensible heat exchange coefficient [m/s] + real(kind=kind_phys), dimension(im) , intent(inout) :: fwetxy ! wetted or snowed fraction of the canopy [-] + real(kind=kind_phys), dimension(im) , intent(inout) :: sneqvoxy ! snow mass at last time step[mm h2o] + real(kind=kind_phys), dimension(im) , intent(inout) :: alboldxy ! snow albedo at last time step [-] + real(kind=kind_phys), dimension(im) , intent(inout) :: qsnowxy ! snowfall on the ground [mm/s] + real(kind=kind_phys), dimension(im) , intent(inout) :: wslakexy ! lake water storage [mm] + real(kind=kind_phys), dimension(im) , intent(inout) :: zwtxy ! water table depth [m] + real(kind=kind_phys), dimension(im) , intent(inout) :: waxy ! water in the "aquifer" [mm] + real(kind=kind_phys), dimension(im) , intent(inout) :: wtxy ! groundwater storage [mm] + real(kind=kind_phys), dimension(im,-2:0), intent(inout) :: tsnoxy ! snow temperature [K] + real(kind=kind_phys), dimension(im,-2:4), intent(inout) :: zsnsoxy ! snow/soil layer depth [m] + real(kind=kind_phys), dimension(im,-2:0), intent(inout) :: snicexy ! snow layer ice [mm] + real(kind=kind_phys), dimension(im,-2:0), intent(inout) :: snliqxy ! snow layer liquid water [mm] + real(kind=kind_phys), dimension(im) , intent(inout) :: lfmassxy ! leaf mass [g/m2] + real(kind=kind_phys), dimension(im) , intent(inout) :: rtmassxy ! mass of fine roots [g/m2] + real(kind=kind_phys), dimension(im) , intent(inout) :: stmassxy ! stem mass [g/m2] + real(kind=kind_phys), dimension(im) , intent(inout) :: woodxy ! mass of wood (incl. woody roots) [g/m2] + real(kind=kind_phys), dimension(im) , intent(inout) :: stblcpxy ! stable carbon in deep soil [g/m2] + real(kind=kind_phys), dimension(im) , intent(inout) :: fastcpxy ! short-lived carbon, shallow soil [g/m2] + real(kind=kind_phys), dimension(im) , intent(inout) :: xlaixy ! leaf area index [m2/m2] + real(kind=kind_phys), dimension(im) , intent(inout) :: xsaixy ! stem area index [m2/m2] + real(kind=kind_phys), dimension(im) , intent(inout) :: taussxy ! snow age factor [-] + real(kind=kind_phys), dimension(im,1:4) , intent(inout) :: smoiseq ! eq volumetric soil moisture [m3/m3] + real(kind=kind_phys), dimension(im) , intent(inout) :: smcwtdxy ! soil moisture content in the layer to the water table when deep + real(kind=kind_phys), dimension(im) , intent(inout) :: deeprechxy ! recharge to the water table when deep + real(kind=kind_phys), dimension(im) , intent(inout) :: rechxy ! recharge to the water table + real(kind=kind_phys), dimension(im) , intent(out) :: albdvis ! albedo - direct visible [fraction] + real(kind=kind_phys), dimension(im) , intent(out) :: albdnir ! albedo - direct NIR [fraction] + real(kind=kind_phys), dimension(im) , intent(out) :: albivis ! albedo - diffuse visible [fraction] + real(kind=kind_phys), dimension(im) , intent(out) :: albinir ! albedo - diffuse NIR [fraction] + real(kind=kind_phys), dimension(im) , intent(out) :: emiss ! sfc lw emissivity [fraction] + real(kind=kind_phys), dimension(im) , intent(out) :: sncovr1 ! snow cover over land [fraction] + real(kind=kind_phys), dimension(im) , intent(out) :: qsurf ! specific humidity at sfc [kg/kg] + real(kind=kind_phys), dimension(im) , intent(out) :: gflux ! soil heat flux [W/m2] + real(kind=kind_phys), dimension(im) , intent(out) :: drain ! subsurface runoff [mm/s] + real(kind=kind_phys), dimension(im) , intent(out) :: evap ! total latent heat flux [W/m2] + real(kind=kind_phys), dimension(im) , intent(out) :: hflx ! sensible heat flux [W/m2] + real(kind=kind_phys), dimension(im) , intent(out) :: ep ! potential evaporation [mm/s?] + real(kind=kind_phys), dimension(im) , intent(out) :: runoff ! surface runoff [mm/s] + real(kind=kind_phys), dimension(im) , intent(out) :: cmm ! cm*U [m/s] + real(kind=kind_phys), dimension(im) , intent(out) :: chh ! ch*U*rho [kg/m2/s] + real(kind=kind_phys), dimension(im) , intent(out) :: evbs ! direct soil evaporation [m/s] + real(kind=kind_phys), dimension(im) , intent(out) :: evcw ! canopy water evaporation [m/s] + real(kind=kind_phys), dimension(im) , intent(out) :: sbsno ! sublimation/deposit from snopack [W/m2] + real(kind=kind_phys), dimension(im) , intent(out) :: snowc ! fractional snow cover [-] + real(kind=kind_phys), dimension(im) , intent(out) :: stm ! total soil column moisture content [mm] + real(kind=kind_phys), dimension(im) , intent(out) :: snohf ! snow/freezing-rain latent heat flux [W/m2] + real(kind=kind_phys), dimension(im) , intent(out) :: smcwlt2 ! dry soil moisture threshold [m3/m3] + real(kind=kind_phys), dimension(im) , intent(out) :: smcref2 ! soil moisture threshold [m3/m3] + real(kind=kind_phys), dimension(im) , intent(out) :: wet1 ! normalized surface soil saturated fraction + real(kind=kind_phys), dimension(im) , intent(out) :: t2mmp ! combined T2m from tiles + real(kind=kind_phys), dimension(im) , intent(out) :: q2mp ! combined q2m from tiles + character(len=*) , intent(out) :: errmsg + integer , intent(out) :: errflg + +! +! --- some new options, hard code for now +! + + integer :: iopt_rsf = 4 ! option for surface resistance + integer :: iopt_soil = 1 ! option for soil parameter treatment + integer :: iopt_pedo = 1 ! option for pedotransfer function + integer :: iopt_crop = 0 ! option for crop model + integer :: iopt_gla = 2 ! option for glacier treatment + +! +! --- guess iteration fields - target for removal +! + + real(kind=kind_phys), dimension(im) :: weasd_old + real(kind=kind_phys), dimension(im) :: snwdph_old + real(kind=kind_phys), dimension(im) :: tskin_old + real(kind=kind_phys), dimension(im) :: canopy_old + real(kind=kind_phys), dimension(im) :: tprcp_old + real(kind=kind_phys), dimension(im) :: srflag_old + real(kind=kind_phys), dimension(im) :: snow_old + real(kind=kind_phys), dimension(im) :: tv_old + real(kind=kind_phys), dimension(im) :: tg_old + real(kind=kind_phys), dimension(im) :: canice_old + real(kind=kind_phys), dimension(im) :: canliq_old + real(kind=kind_phys), dimension(im) :: eah_old + real(kind=kind_phys), dimension(im) :: tah_old + real(kind=kind_phys), dimension(im) :: fwet_old + real(kind=kind_phys), dimension(im) :: sneqvo_old + real(kind=kind_phys), dimension(im) :: albold_old + real(kind=kind_phys), dimension(im) :: qsnow_old + real(kind=kind_phys), dimension(im) :: wslake_old + real(kind=kind_phys), dimension(im) :: zwt_old + real(kind=kind_phys), dimension(im) :: wa_old + real(kind=kind_phys), dimension(im) :: wt_old + real(kind=kind_phys), dimension(im) :: lfmass_old + real(kind=kind_phys), dimension(im) :: rtmass_old + real(kind=kind_phys), dimension(im) :: stmass_old + real(kind=kind_phys), dimension(im) :: wood_old + real(kind=kind_phys), dimension(im) :: stblcp_old + real(kind=kind_phys), dimension(im) :: fastcp_old + real(kind=kind_phys), dimension(im) :: xlai_old + real(kind=kind_phys), dimension(im) :: xsai_old + real(kind=kind_phys), dimension(im) :: tauss_old + real(kind=kind_phys), dimension(im) :: smcwtd_old + real(kind=kind_phys), dimension(im) :: rech_old + real(kind=kind_phys), dimension(im) :: deeprech_old + real(kind=kind_phys), dimension(im, km) :: smc_old + real(kind=kind_phys), dimension(im, km) :: stc_old + real(kind=kind_phys), dimension(im, km) :: slc_old + real(kind=kind_phys), dimension(im, km) :: smoiseq_old + real(kind=kind_phys), dimension(im,-2: 0) :: tsno_old + real(kind=kind_phys), dimension(im,-2: 0) :: snice_old + real(kind=kind_phys), dimension(im,-2: 0) :: snliq_old + real(kind=kind_phys), dimension(im,-2:km) :: zsnso_old + real(kind=kind_phys), dimension(im,-2:km) :: tsnso_old + +! +! --- local inputs to noah-mp and glacier subroutines; listed in order in noah-mp call +! + ! intent + integer :: i_location ! in | grid index + integer :: j_location ! in | grid index (not used in ccpp) + real (kind=kind_phys) :: latitude ! in | latitude [radians] + integer :: year_length ! in | number of days in the current year + real (kind=kind_phys) :: julian_day ! in | julian day of year [floating point] + real (kind=kind_phys) :: cosine_zenith ! in | cosine solar zenith angle [-1,1] + real (kind=kind_phys) :: timestep ! in | time step [sec] + real (kind=kind_phys) :: spatial_scale ! in | spatial scale [m] (not used in noah-mp) + real (kind=kind_phys) :: atmosphere_thickness ! in | thickness of lowest atmo layer [m] (not used in noah-mp) + integer :: soil_levels ! in | soil levels + real (kind=kind_phys), dimension( 1:nsoil) :: soil_interface_depth ! in | soil layer-bottom depth from surface [m] + integer :: max_snow_levels ! in | maximum number of snow levels + real (kind=kind_phys) :: vegetation_frac ! in | vegetation fraction [0.0-1.0] + real (kind=kind_phys) :: max_vegetation_frac ! in | annual maximum vegetation fraction [0.0-1.0] + integer :: vegetation_category ! in | vegetation category + integer :: ice_flag ! in | ice flag (1->ice) + integer :: surface_type ! in | surface type flag 1->soil; 2->lake + integer :: crop_type ! in | crop type category + real (kind=kind_phys), dimension( 1:nsoil) :: eq_soil_water_vol ! in | (opt_run=5) equilibrium soil water content [m3/m3] + real (kind=kind_phys) :: temperature_forcing ! in | forcing air temperature [K] + real (kind=kind_phys) :: air_pressure_surface ! in | surface air pressure [Pa] + real (kind=kind_phys) :: air_pressure_forcing ! in | forcing air pressure [Pa] + real (kind=kind_phys) :: uwind_forcing ! in | forcing u-wind [m/s] + real (kind=kind_phys) :: vwind_forcing ! in | forcing v-wind [m/s] + real (kind=kind_phys) :: spec_humidity_forcing ! in | forcing mixing ratio [kg/kg] + real (kind=kind_phys) :: cloud_water_forcing ! in | cloud water mixing ratio [kg/kg] (not used in noah-mp) + real (kind=kind_phys) :: sw_radiation_forcing ! in | forcing downward shortwave radiation [W/m2] + real (kind=kind_phys) :: radiation_lw_forcing ! in | forcing downward longwave radiation [W/m2] + real (kind=kind_phys) :: precipitation_forcing ! in | total precipitation [mm/s] + real (kind=kind_phys) :: precip_convective ! in | convective precipitation [mm/s] + real (kind=kind_phys) :: precip_non_convective ! in | non-convective precipitation [mm/s] + real (kind=kind_phys) :: precip_sh_convective ! in | shallow convective precipitation [mm/s] + real (kind=kind_phys) :: precip_snow ! in | snow precipitation [mm/s] + real (kind=kind_phys) :: precip_graupel ! in | graupel precipitation [mm/s] + real (kind=kind_phys) :: precip_hail ! in | hail precipitation [mm/s] + real (kind=kind_phys) :: temperature_soil_bot ! in | soil bottom boundary condition temperature [K] + real (kind=kind_phys) :: co2_air ! in | atmospheric co2 concentration [Pa] + real (kind=kind_phys) :: o2_air ! in | atmospheric o2 concentration [Pa] + real (kind=kind_phys) :: foliage_nitrogen ! in | foliage nitrogen [%] [1-saturated] + real (kind=kind_phys), dimension(-nsnow+1: 0) :: snow_ice_frac_old ! in | snow ice fraction at last timestep [-] + real (kind=kind_phys) :: forcing_height ! inout | forcing height [m] + real (kind=kind_phys) :: snow_albedo_old ! inout | snow albedo at last time step (class option) [-] + real (kind=kind_phys) :: snow_water_equiv_old ! inout | snow water equivalent at last time step [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: temperature_snow_soil ! inout | snow/soil temperature [K] + real (kind=kind_phys), dimension( 1:nsoil) :: soil_liquid_vol ! inout | volumetric liquid soil moisture [m3/m3] + real (kind=kind_phys), dimension( 1:nsoil) :: soil_moisture_vol ! inout | volumetric soil moisture (ice + liq.) [m3/m3] + real (kind=kind_phys) :: temperature_canopy_air! inout | canopy air tmeperature [K] + real (kind=kind_phys) :: vapor_pres_canopy_air ! inout | canopy air vapor pressure [Pa] + real (kind=kind_phys) :: canopy_wet_fraction ! inout | wetted or snowed fraction of canopy (-) + real (kind=kind_phys) :: canopy_liquid ! inout | canopy intercepted liquid [mm] + real (kind=kind_phys) :: canopy_ice ! inout | canopy intercepted ice [mm] + real (kind=kind_phys) :: temperature_leaf ! inout | leaf temperature [K] + real (kind=kind_phys) :: temperature_ground ! inout | grid ground surface temperature [K] + real (kind=kind_phys) :: spec_humidity_surface ! inout | surface specific humidty [kg/kg] + real (kind=kind_phys) :: snowfall ! inout | land model partitioned snowfall [mm/s] + real (kind=kind_phys) :: rainfall ! inout | land model partitioned rainfall [mm/s] + integer :: snow_levels ! inout | active snow levels [-] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: interface_depth ! inout | layer-bottom depth from snow surf [m] + real (kind=kind_phys) :: snow_depth ! inout | snow depth [m] + real (kind=kind_phys) :: snow_water_equiv ! inout | snow water equivalent [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0) :: snow_level_ice ! inout | snow level ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0) :: snow_level_liquid ! inout | snow level liquid [mm] + real (kind=kind_phys) :: depth_water_table ! inout | depth to water table [m] + real (kind=kind_phys) :: aquifer_water ! inout | water storage in aquifer [mm] + real (kind=kind_phys) :: saturated_water ! inout | water in aquifer+saturated soil [mm] + real (kind=kind_phys) :: lake_water ! inout | lake water storage (can be neg.) [mm] + real (kind=kind_phys) :: leaf_carbon ! inout | leaf mass [g/m2] + real (kind=kind_phys) :: root_carbon ! inout | mass of fine roots [g/m2] + real (kind=kind_phys) :: stem_carbon ! inout | stem mass [g/m2] + real (kind=kind_phys) :: wood_carbon ! inout | mass of wood (incl. woody roots) [g/m2] + real (kind=kind_phys) :: soil_carbon_stable ! inout | stable soil carbon [g/m2] + real (kind=kind_phys) :: soil_carbon_fast ! inout | short-lived soil carbon [g/m2] + real (kind=kind_phys) :: leaf_area_index ! inout | leaf area index [-] + real (kind=kind_phys) :: stem_area_index ! inout | stem area index [-] + real (kind=kind_phys) :: cm_noahmp ! inout | grid momentum drag coefficient [m/s] + real (kind=kind_phys) :: ch_noahmp ! inout | grid heat exchange coefficient [m/s] + real (kind=kind_phys) :: snow_age ! inout | non-dimensional snow age [-] + real (kind=kind_phys) :: grain_carbon ! inout | grain mass [g/m2] + real (kind=kind_phys) :: growing_deg_days ! inout | growing degree days [-] + integer :: plant_growth_stage ! inout | plant growing stage [-] + real (kind=kind_phys) :: soil_moisture_wtd ! inout | (opt_run=5) soil water content between bottom of the soil and water table [m3/m3] + real (kind=kind_phys) :: deep_recharge ! inout | (opt_run=5) recharge to or from the water table when deep [m] + real (kind=kind_phys) :: recharge ! inout | (opt_run=5) recharge to or from the water table when shallow [m] (diagnostic) + real (kind=kind_phys) :: z0_total ! out | weighted z0 sent to coupled model [m] + real (kind=kind_phys) :: sw_absorbed_total ! out | total absorbed solar radiation [W/m2] + real (kind=kind_phys) :: sw_reflected_total ! out | total reflected solar radiation [W/m2] + real (kind=kind_phys) :: lw_absorbed_total ! out | total net lw rad [W/m2] [+ to atm] + real (kind=kind_phys) :: sensible_heat_total ! out | total sensible heat [W/m2] [+ to atm] + real (kind=kind_phys) :: ground_heat_total ! out | ground heat flux [W/m2] [+ to soil] + real (kind=kind_phys) :: latent_heat_canopy ! out | canopy evaporation heat flux [W/m2] [+ to atm] + real (kind=kind_phys) :: latent_heat_ground ! out | ground evaporation heat flux [W/m2] [+ to atm] + real (kind=kind_phys) :: transpiration_heat ! out | transpiration heat flux [W/m2] [+ to atm] + real (kind=kind_phys) :: evaporation_canopy ! out | canopy evaporation [mm/s] + real (kind=kind_phys) :: transpiration ! out | transpiration [mm/s] + real (kind=kind_phys) :: evaporation_soil ! out | soil surface evaporation [mm/s] + real (kind=kind_phys) :: temperature_radiative ! out | surface radiative temperature [K] + real (kind=kind_phys) :: temperature_bare_grd ! out | bare ground surface temperature [K] + real (kind=kind_phys) :: temperature_veg_grd ! out | below_canopy ground surface temperature [K] + real (kind=kind_phys) :: temperature_veg_2m ! out | vegetated 2-m air temperature [K] + real (kind=kind_phys) :: temperature_bare_2m ! out | bare ground 2-m air temperature [K] + real (kind=kind_phys) :: spec_humidity_veg_2m ! out | vegetated 2-m air specific humidity [K] + real (kind=kind_phys) :: spec_humidity_bare_2m ! out | bare ground 2-m air specfic humidity [K] + real (kind=kind_phys) :: runoff_surface ! out | surface runoff [mm/s] + real (kind=kind_phys) :: runoff_baseflow ! out | baseflow runoff [mm/s] + real (kind=kind_phys) :: par_absorbed ! out | absorbed photosynthesis active radiation [W/m2] + real (kind=kind_phys) :: photosynthesis ! out | total photosynthesis [umol CO2/m2/s] [+ out] + real (kind=kind_phys) :: sw_absorbed_veg ! out | solar radiation absorbed by vegetation [W/m2] + real (kind=kind_phys) :: sw_absorbed_ground ! out | solar radiation absorbed by ground [W/m2] + real (kind=kind_phys) :: snow_cover_fraction ! out | snow cover fraction on the ground [-] + real (kind=kind_phys) :: net_eco_exchange ! out | net ecosystem exchange [g/m2/s CO2] + real (kind=kind_phys) :: global_prim_prod ! out | global primary production [g/m2/s C] + real (kind=kind_phys) :: net_prim_prod ! out | net primary productivity [g/m2/s C] + real (kind=kind_phys) :: vegetation_fraction ! out | vegetation fraction [0.0-1.0] + real (kind=kind_phys) :: albedo_total ! out | total surface albedo [-] + real (kind=kind_phys) :: snowmelt_out ! out | snowmelt out bottom of pack [mm/s] + real (kind=kind_phys) :: snowmelt_shallow ! out | shallow snow melt [mm] + real (kind=kind_phys) :: snowmelt_shallow_1 ! out | additional shallow snow melt [mm] + real (kind=kind_phys) :: snowmelt_shallow_2 ! out | additional shallow snow melt [mm] + real (kind=kind_phys) :: rs_sunlit ! out | sunlit leaf stomatal resistance [s/m] + real (kind=kind_phys) :: rs_shaded ! out | shaded leaf stomatal resistance [s/m] + real (kind=kind_phys), dimension(1:2) :: albedo_direct ! out | direct vis/nir albedo [-] + real (kind=kind_phys), dimension(1:2) :: albedo_diffuse ! out | diffuse vis/nir albedo [-] + real (kind=kind_phys), dimension(1:2) :: albedo_direct_snow ! out | direct vis/nir snow albedo [-] + real (kind=kind_phys), dimension(1:2) :: albedo_diffuse_snow ! out | diffuse vis/nir snow albedo [-] + real (kind=kind_phys) :: canopy_gap_fraction ! out | between canopy gap fraction [-] + real (kind=kind_phys) :: incanopy_gap_fraction ! out | within canopy gap fraction for beam [-] + real (kind=kind_phys) :: ch_vegetated ! out | vegetated heat exchange coefficient [m/s] + real (kind=kind_phys) :: ch_bare_ground ! out | bare-ground heat exchange coefficient [m/s] + real (kind=kind_phys) :: emissivity_total ! out | grid emissivity [-] + real (kind=kind_phys) :: sensible_heat_grd_veg ! out | below-canopy ground sensible heat flux [W/m2] + real (kind=kind_phys) :: sensible_heat_leaf ! out | leaf-to-canopy sensible heat flux [W/m2] + real (kind=kind_phys) :: sensible_heat_grd_bar ! out | bare ground sensible heat flux [W/m2] + real (kind=kind_phys) :: latent_heat_grd_veg ! out | below-canopy ground evaporation heat flux [W/m2] + real (kind=kind_phys) :: latent_heat_grd_bare ! out | bare ground evaporation heat flux [W/m2] + real (kind=kind_phys) :: ground_heat_veg ! out | below-canopy ground heat flux [W/m2] + real (kind=kind_phys) :: ground_heat_bare ! out | bare ground heat flux [W/m2] + real (kind=kind_phys) :: lw_absorbed_grd_veg ! out | below-canopy ground absorbed longwave radiation [W/m2] + real (kind=kind_phys) :: lw_absorbed_leaf ! out | leaf absorbed longwave radiation [W/m2] + real (kind=kind_phys) :: lw_absorbed_grd_bare ! out | bare ground net longwave radiation [W/m2] + real (kind=kind_phys) :: latent_heat_trans ! out | transpiration [W/m2] + real (kind=kind_phys) :: latent_heat_leaf ! out | leaf evaporation [W/m2] + real (kind=kind_phys) :: ch_leaf ! out | leaf exchange coefficient [m/s] + real (kind=kind_phys) :: ch_below_canopy ! out | below-canopy exchange coefficient [m/s] + real (kind=kind_phys) :: ch_vegetated_2m ! out | 2-m vegetated heat exchange coefficient [m/s] + real (kind=kind_phys) :: ch_bare_ground_2m ! out | 2-m bare-ground heat exchange coefficient [m/s] + real (kind=kind_phys) :: precip_frozen_frac ! out | precipitation snow fraction [-] + real (kind=kind_phys) :: precip_adv_heat_veg ! out | precipitation advected heat - vegetation net [W/m2] + real (kind=kind_phys) :: precip_adv_heat_grd_v ! out | precipitation advected heat - below-canopy net [W/m2] + real (kind=kind_phys) :: precip_adv_heat_grd_b ! out | precipitation advected heat - bare ground net [W/m2] + real (kind=kind_phys) :: precip_adv_heat_total ! out | precipitation advected heat - total [W/m2) + real (kind=kind_phys) :: snow_sublimation ! out | snow sublimation [W/m2] + real (kind=kind_phys) :: lai_sunlit ! out | sunlit leaf area index [m2/m2] + real (kind=kind_phys) :: lai_shaded ! out | shaded leaf area index [m2/m2] + real (kind=kind_phys) :: leaf_air_resistance ! out | leaf boundary layer resistance [s/m] + +! +! --- local variable +! + + integer :: soil_category(nsoil) + integer :: slope_category + integer :: soil_color_category + + real (kind=kind_phys) :: spec_humidity_sat ! saturation specific humidity + real (kind=kind_phys) :: vapor_pressure_sat ! saturation vapor pressure + real (kind=kind_phys) :: latent_heat_total ! total latent heat flux [W/m2] + real (kind=kind_phys) :: density ! air density + real (kind=kind_phys) :: virtual_temperature ! used for penman calculation and density + real (kind=kind_phys) :: potential_evaporation ! used for penman calculation + real (kind=kind_phys) :: potential_temperature ! used for penman calculation + real (kind=kind_phys) :: penman_radiation ! used for penman calculation + real (kind=kind_phys) :: dqsdt ! used for penman calculation + real (kind=kind_phys) :: precip_freeze_frac_in ! used for penman calculation + + logical :: is_snowing ! used for penman calculation + logical :: is_freeze_rain ! used for penman calculation + integer :: i, k + +! +! --- local derived constants: +! + + type(noahmp_parameters) :: parameters + +! +! --- end declaration +! + +! +! --- Initialize CCPP error handling variables +! + errmsg = '' + errflg = 0 + +! +! --- save land-related prognostic fields for guess run TARGET FOR REMOVAL +! + do i = 1, im + if (dry(i) .and. flag_guess(i)) then + weasd_old(i) = weasd(i) + snwdph_old(i) = snwdph(i) + tskin_old(i) = tskin(i) + canopy_old(i) = canopy(i) + tprcp_old(i) = tprcp(i) + srflag_old(i) = srflag(i) + snow_old(i) = snowxy(i) + tv_old(i) = tvxy(i) + tg_old(i) = tgxy(i) + canice_old(i) = canicexy(i) + canliq_old(i) = canliqxy(i) + eah_old(i) = eahxy(i) + tah_old(i) = tahxy(i) + fwet_old(i) = fwetxy(i) + sneqvo_old(i) = sneqvoxy(i) + albold_old(i) = alboldxy(i) + qsnow_old(i) = qsnowxy(i) + wslake_old(i) = wslakexy(i) + zwt_old(i) = zwtxy(i) + wa_old(i) = waxy(i) + wt_old(i) = wtxy(i) + lfmass_old(i) = lfmassxy(i) + rtmass_old(i) = rtmassxy(i) + stmass_old(i) = stmassxy(i) + wood_old(i) = woodxy(i) + stblcp_old(i) = stblcpxy(i) + fastcp_old(i) = fastcpxy(i) + xlai_old(i) = xlaixy(i) + xsai_old(i) = xsaixy(i) + tauss_old(i) = taussxy(i) + smcwtd_old(i) = smcwtdxy(i) + rech_old(i) = rechxy(i) + deeprech_old(i) = deeprechxy(i) + + do k = 1, km + smc_old(i,k) = smc(i,k) + stc_old(i,k) = stc(i,k) + slc_old(i,k) = slc(i,k) + smoiseq_old(i,k) = smoiseq(i,k) + end do + + do k = -2, 0 + tsno_old(i,k) = tsnoxy(i,k) + snice_old(i,k) = snicexy(i,k) + snliq_old(i,k) = snliqxy(i,k) + end do + + do k = -2, km + zsnso_old (i,k) = zsnsoxy(i,k) + end do + + end if ! dry(i) .and. flag_guess(i) + + end do ! im _old loop + + do i = 1, im + + if (flag_iter(i) .and. dry(i)) then + +! +! --- variable checks and derived fields +! + + if(vegtype(i) == isice_table ) then + if(weasd(i) < 0.1) then + weasd(i) = 0.1 + end if + end if + +! +! --- noah-mp input variables (except snow_ice_frac_old done later) +! + + i_location = i + j_location = -9999 + latitude = xlatin(i) + year_length = iyrlen + julian_day = julian + cosine_zenith = xcoszin(i) + timestep = delt + spatial_scale = -9999.0 + atmosphere_thickness = -9999.0 + soil_levels = km + soil_interface_depth = zsoil + max_snow_levels = nsnow + vegetation_frac = sigmaf(i) + max_vegetation_frac = shdmax(i) + vegetation_category = vegtype(i) + surface_type = 1 + crop_type = 0 + eq_soil_water_vol = smoiseq(i,:) ! only need for run=5 + temperature_forcing = t1(i) + air_pressure_surface = ps(i) + air_pressure_forcing = prsl1(i) + uwind_forcing = u1(i) + vwind_forcing = v1(i) + + spec_humidity_forcing = max(q1(i), 1.e-8) ! specific humidity at level 1 (kg/kg) + virtual_temperature = temperature_forcing * & + (1.0 + con_fvirt * spec_humidity_forcing) ! virtual temperature + vapor_pressure_sat = fpvs( temperature_forcing ) ! sat. vapor pressure at level 1 (Pa) + spec_humidity_sat = con_eps*vapor_pressure_sat / & + (prsl1(i) + con_epsm1*vapor_pressure_sat) ! sat. specific humidity at level 1 (kg/kg) + spec_humidity_sat = max(spec_humidity_sat, 1.e-8) ! lower limit sat. specific humidity (kg/kg) + spec_humidity_forcing = min(spec_humidity_sat,spec_humidity_forcing) ! limit specific humidity at level 1 (kg/kg) + + cloud_water_forcing = -9999.0 + sw_radiation_forcing = dswsfc(i) + radiation_lw_forcing = dlwflx(i) + precipitation_forcing = 1000.0 * tprcp(i) / delt + precip_convective = rainc_mp(i) + precip_non_convective = rainn_mp(i) + precip_sh_convective = 0. + precip_snow = snow_mp(i) + precip_graupel = graupel_mp(i) + precip_hail = ice_mp(i) + temperature_soil_bot = tg3(i) + co2_air = co2_table * air_pressure_forcing + o2_air = o2_table * air_pressure_forcing + foliage_nitrogen = 1.0 + +! +! --- noah-mp inout variables +! + + forcing_height = zf(i) + snow_albedo_old = alboldxy(i) + snow_water_equiv_old = sneqvoxy(i) + temperature_snow_soil(-2: 0) = tsnoxy(i,:) + temperature_snow_soil( 1:km) = stc(i,:) + soil_liquid_vol = slc(i,:) + soil_moisture_vol = smc(i,:) + temperature_canopy_air = tahxy(i) + vapor_pres_canopy_air = eahxy(i) + canopy_wet_fraction = fwetxy(i) + canopy_liquid = canliqxy(i) + canopy_ice = canicexy(i) + temperature_leaf = tvxy(i) + temperature_ground = tgxy(i) + spec_humidity_surface = undefined ! doesn't need inout; should be out + snowfall = qsnowxy(i) ! doesn't need inout; should be out + rainfall = -9999.0 ! doesn't need inout; should be out + snow_levels = nint(snowxy(i)) + interface_depth = zsnsoxy(i,:) + snow_depth = snwdph(i) * 0.001 ! convert from mm to m + snow_water_equiv = weasd(i) + if (snow_water_equiv /= 0.0 .and. snow_depth == 0.0) then + snow_depth = 10.0 * snow_water_equiv /1000.0 + endif + snow_level_ice = snicexy(i,:) + snow_level_liquid = snliqxy(i,:) + depth_water_table = zwtxy(i) + aquifer_water = waxy(i) + saturated_water = wtxy(i) + lake_water = wslakexy(i) + leaf_carbon = lfmassxy(i) + root_carbon = rtmassxy(i) + stem_carbon = stmassxy(i) + wood_carbon = woodxy(i) + soil_carbon_stable = stblcpxy(i) + soil_carbon_fast = fastcpxy(i) + leaf_area_index = xlaixy(i) + stem_area_index = xsaixy(i) + cm_noahmp = cmxy(i) + ch_noahmp = chxy(i) + snow_age = taussxy(i) +! grain_carbon ! new variable +! growing_deg_days ! new variable +! plant_growth_stage ! new variable + soil_moisture_wtd = smcwtdxy(i) + deep_recharge = deeprechxy(i) + recharge = rechxy(i) + + snow_ice_frac_old = 0.0 + do k = snow_levels+1, 0 + if(snow_level_ice(k) > 0.0 ) & + snow_ice_frac_old(k) = snow_level_ice(k) /(snow_level_ice(k)+snow_level_liquid(k)) + end do + +! +! --- some outputs for atm model? +! + density = air_pressure_forcing / (con_rd * virtual_temperature) + chh(i) = ch(i) * wind(i) * density + cmm(i) = cm(i) * wind(i) +! +! --- noah-mp additional variables +! + + soil_category = soiltyp(i) + slope_category = slopetyp(i) + soil_color_category = 4 + + call transfer_mp_parameters(vegetation_category,soil_category, & + slope_category,soil_color_category,crop_type,parameters) + + call noahmp_options(idveg ,iopt_crs, iopt_btr , iopt_run, iopt_sfc, & + iopt_frz, iopt_inf , iopt_rad, iopt_alb, & + iopt_snf, iopt_tbot, iopt_stc, & + iopt_rsf, iopt_soil, iopt_pedo, iopt_crop ) + + if ( vegetation_category == isice_table ) then + + if (precipitation_forcing > 0.0) then + if (srflag(i) > 0.0) then + snowfall = srflag(i) * precipitation_forcing ! need snowfall for glacier snow age + endif + endif + + ice_flag = -1 + temperature_soil_bot = min(temperature_soil_bot,263.15) + + call noahmp_options_glacier(iopt_alb, iopt_snf, iopt_tbot, iopt_stc, iopt_gla ) + + call noahmp_glacier ( & + i_location ,1 ,cosine_zenith ,nsnow , & + nsoil ,timestep , & + temperature_forcing ,air_pressure_forcing ,uwind_forcing ,vwind_forcing , & + spec_humidity_forcing,sw_radiation_forcing ,precipitation_forcing,radiation_lw_forcing , & + temperature_soil_bot ,forcing_height ,snow_ice_frac_old ,zsoil , & + snowfall ,snow_water_equiv_old ,snow_albedo_old , & + cm_noahmp ,ch_noahmp ,snow_levels ,snow_water_equiv , & + soil_moisture_vol ,interface_depth ,snow_depth ,snow_level_ice , & + snow_level_liquid ,temperature_ground ,temperature_snow_soil,soil_liquid_vol , & + snow_age ,spec_humidity_surface,sw_absorbed_total ,sw_reflected_total , & + lw_absorbed_total ,sensible_heat_total ,latent_heat_ground ,ground_heat_total , & + temperature_radiative,evaporation_soil ,runoff_surface ,runoff_baseflow , & + sw_absorbed_ground ,albedo_total ,snowmelt_out ,snowmelt_shallow , & + snowmelt_shallow_1 ,snowmelt_shallow_2 ,temperature_bare_2m ,spec_humidity_bare_2m, & + emissivity_total ,precip_frozen_frac ,ch_bare_ground_2m ,snow_sublimation , & +#ifdef CCPP + albedo_direct ,albedo_diffuse ,errmsg ,errflg ) +#else + albedo_direct ,albedo_diffuse ) +#endif + +#ifdef CCPP + if (errflg /= 0) return +#endif + +! +! set some non-glacier fields over the glacier +! + + snow_cover_fraction = 1.0 + temperature_leaf = undefined + canopy_ice = undefined + canopy_liquid = undefined + vapor_pres_canopy_air = undefined + temperature_canopy_air = undefined + canopy_wet_fraction = undefined + lake_water = undefined + depth_water_table = undefined + aquifer_water = undefined + saturated_water = undefined + leaf_carbon = undefined + root_carbon = undefined + stem_carbon = undefined + wood_carbon = undefined + soil_carbon_stable = undefined + soil_carbon_fast = undefined + leaf_area_index = undefined + stem_area_index = undefined + soil_moisture_wtd = 0.0 + recharge = 0.0 + deep_recharge = 0.0 + eq_soil_water_vol = soil_moisture_vol + transpiration_heat = undefined + latent_heat_canopy = undefined + z0_total = 0.002 + latent_heat_total = latent_heat_ground + t2mmp(i) = temperature_bare_2m + q2mp(i) = spec_humidity_bare_2m + + else ! not glacier + + ice_flag = 0 + + call noahmp_sflx (parameters , & + i_location ,j_location ,latitude , & + year_length ,julian_day ,cosine_zenith , & + timestep ,spatial_scale ,atmosphere_thickness , & + soil_levels ,soil_interface_depth ,max_snow_levels , & + vegetation_frac ,max_vegetation_frac ,vegetation_category , & + ice_flag ,surface_type ,crop_type , & + eq_soil_water_vol ,temperature_forcing ,air_pressure_forcing , & + air_pressure_surface ,uwind_forcing ,vwind_forcing , & + spec_humidity_forcing ,cloud_water_forcing ,sw_radiation_forcing , & + radiation_lw_forcing ,precip_convective , & + precip_non_convective ,precip_sh_convective ,precip_snow , & + precip_graupel ,precip_hail ,temperature_soil_bot , & + co2_air ,o2_air ,foliage_nitrogen , & + snow_ice_frac_old , & + forcing_height ,snow_albedo_old ,snow_water_equiv_old , & + temperature_snow_soil ,soil_liquid_vol ,soil_moisture_vol , & + temperature_canopy_air,vapor_pres_canopy_air ,canopy_wet_fraction , & + canopy_liquid ,canopy_ice ,temperature_leaf , & + temperature_ground ,spec_humidity_surface ,snowfall , & + rainfall ,snow_levels ,interface_depth , & + snow_depth ,snow_water_equiv ,snow_level_ice , & + snow_level_liquid ,depth_water_table ,aquifer_water , & + saturated_water , & + lake_water ,leaf_carbon ,root_carbon , & + stem_carbon ,wood_carbon ,soil_carbon_stable , & + soil_carbon_fast ,leaf_area_index ,stem_area_index , & + cm_noahmp ,ch_noahmp ,snow_age , & + grain_carbon ,growing_deg_days ,plant_growth_stage , & + soil_moisture_wtd ,deep_recharge ,recharge , & + z0_total ,sw_absorbed_total ,sw_reflected_total , & + lw_absorbed_total ,sensible_heat_total ,ground_heat_total , & + latent_heat_canopy ,latent_heat_ground ,transpiration_heat , & + evaporation_canopy ,transpiration ,evaporation_soil , & + temperature_radiative ,temperature_bare_grd ,temperature_veg_grd , & + temperature_veg_2m ,temperature_bare_2m ,spec_humidity_veg_2m , & + spec_humidity_bare_2m ,runoff_surface ,runoff_baseflow , & + par_absorbed ,photosynthesis ,sw_absorbed_veg , & + sw_absorbed_ground ,snow_cover_fraction ,net_eco_exchange , & + global_prim_prod ,net_prim_prod ,vegetation_fraction , & + albedo_total ,snowmelt_out ,snowmelt_shallow , & + snowmelt_shallow_1 ,snowmelt_shallow_2 ,rs_sunlit , & + rs_shaded ,albedo_direct ,albedo_diffuse , & + albedo_direct_snow ,albedo_diffuse_snow ,canopy_gap_fraction , & + incanopy_gap_fraction ,ch_vegetated ,ch_bare_ground , & + emissivity_total ,sensible_heat_grd_veg ,sensible_heat_leaf , & + sensible_heat_grd_bar ,latent_heat_grd_veg ,latent_heat_grd_bare , & + ground_heat_veg ,ground_heat_bare ,lw_absorbed_grd_veg , & + lw_absorbed_leaf ,lw_absorbed_grd_bare ,latent_heat_trans , & + latent_heat_leaf ,ch_leaf ,ch_below_canopy , & + ch_vegetated_2m ,ch_bare_ground_2m ,precip_frozen_frac , & + precip_adv_heat_veg ,precip_adv_heat_grd_v ,precip_adv_heat_grd_b , & + precip_adv_heat_total ,snow_sublimation ,lai_sunlit , & +#ifdef CCPP + lai_shaded ,leaf_air_resistance , & + errmsg ,errflg ) +#else + lai_shaded ,leaf_air_resistance ) +#endif + +#ifdef CCPP + if (errflg /= 0) return +#endif + + latent_heat_total = latent_heat_canopy + latent_heat_ground + transpiration_heat + + t2mmp(i) = temperature_veg_2m * vegetation_fraction + & + temperature_bare_2m * (1-vegetation_fraction) + q2mp(i) = spec_humidity_veg_2m * vegetation_fraction + & + spec_humidity_bare_2m * (1-vegetation_fraction) + + endif ! glacial split ends + +! +! --- noah-mp inout and out variables +! + + tsnoxy (i,:) = temperature_snow_soil(-2: 0) + stc (i,:) = temperature_snow_soil( 1:km) + hflx (i) = sensible_heat_total !note unit change below + evap (i) = latent_heat_total !note unit change below + evbs (i) = latent_heat_ground + evcw (i) = latent_heat_canopy + trans (i) = transpiration_heat + gflux (i) = -1.0*ground_heat_total ! opposite sign to be consistent with noah + snohf (i) = snowmelt_out * con_hfus ! only snow that exits pack + sbsno (i) = snow_sublimation + + cmxy (i) = cm_noahmp + chxy (i) = ch_noahmp + zorl (i) = z0_total * 100.0 ! convert to cm + + smc (i,:) = soil_moisture_vol + slc (i,:) = soil_liquid_vol + snowxy (i) = float(snow_levels) + weasd (i) = snow_water_equiv + snicexy (i,:) = snow_level_ice + snliqxy (i,:) = snow_level_liquid + snwdph (i) = snow_depth * 1000.0 ! convert from mm to m + canopy (i) = canopy_ice + canopy_liquid + canliqxy (i) = canopy_liquid + canicexy (i) = canopy_ice + zwtxy (i) = depth_water_table + waxy (i) = aquifer_water + wtxy (i) = saturated_water + qsnowxy (i) = snowfall + drain (i) = runoff_baseflow + runoff (i) = runoff_surface + + lfmassxy (i) = leaf_carbon + rtmassxy (i) = root_carbon + stmassxy (i) = stem_carbon + woodxy (i) = wood_carbon + stblcpxy (i) = soil_carbon_stable + fastcpxy (i) = soil_carbon_fast + xlaixy (i) = leaf_area_index + xsaixy (i) = stem_area_index + + snowc (i) = snow_cover_fraction + sncovr1 (i) = snow_cover_fraction + qsurf (i) = q1(i) + evap(i) / (con_hvap / con_cp * density * ch(i) * wind(i)) + tskin (i) = temperature_radiative + tsurf (i) = temperature_radiative + tvxy (i) = temperature_leaf + tgxy (i) = temperature_ground + tahxy (i) = temperature_canopy_air + eahxy (i) = vapor_pres_canopy_air + emiss (i) = emissivity_total + + if(albedo_total > 0.0) then + sfalb(i) = albedo_total + albdvis(i) = albedo_direct(1) + albdnir(i) = albedo_direct(2) + albivis(i) = albedo_diffuse(1) + albinir(i) = albedo_diffuse(2) + end if + + zsnsoxy (i,:) = interface_depth + + wslakexy (i) = lake_water ! not active + fwetxy (i) = canopy_wet_fraction + taussxy (i) = snow_age + alboldxy (i) = snow_albedo_old + sneqvoxy (i) = snow_water_equiv_old + + smcwtdxy (i) = soil_moisture_wtd ! only need for run=5 + deeprechxy(i) = deep_recharge ! only need for run=5 + rechxy (i) = recharge ! only need for run=5 + smoiseq (i,:) = eq_soil_water_vol ! only need for run=5; listed as in + + stm (i) = (0.1*soil_moisture_vol(1) + & + 0.3*soil_moisture_vol(2) + & + 0.6*soil_moisture_vol(3) + & ! clean up and use depths above + 1.0*soil_moisture_vol(4))*1000.0 ! unit conversion from m to kg m-2 + + wet1 (i) = soil_moisture_vol(1) / smcmax_table(soil_category(1)) + smcwlt2(i) = smcdry_table(soil_category(1)) !!!change to wilt? + smcref2(i) = smcref_table(soil_category(1)) + +! +! --- change units for output +! + hflx(i) = hflx(i) / density / con_cp + evap(i) = evap(i) / density / con_hvap + +! +! --- calculate potential evaporation using noah code +! + potential_temperature = temperature_forcing * prslki(i) + virtual_temperature = temperature_forcing * (1.0 + 0.61*spec_humidity_forcing) + penman_radiation = sw_absorbed_total + radiation_lw_forcing + dqsdt = spec_humidity_sat * a23m4/(temperature_forcing-a4)**2 + + precip_freeze_frac_in = srflag(i) + is_snowing = .false. + is_freeze_rain = .false. + if (precipitation_forcing > 0.0) then + if (precip_freeze_frac_in > 0.0) then ! rain/snow flag, one condition is enough? + is_snowing = .true. + else + if (temperature_forcing <= 275.15) is_freeze_rain = .true. + end if + end if + + call penman (temperature_forcing, air_pressure_forcing , ch_noahmp , & + virtual_temperature, potential_temperature, precipitation_forcing, & + penman_radiation , ground_heat_total , spec_humidity_forcing, & + spec_humidity_sat , potential_evaporation, is_snowing , & + is_freeze_rain , precip_freeze_frac_in, dqsdt , & + emissivity_total , snow_cover_fraction ) + + ep(i) = potential_evaporation + + end if ! flag_iter(i) .and. dry(i) + + end do ! im loop + +! +! --- restore land-related prognostic fields for guess run TARGET FOR REMOVAL +! + + do i = 1, im + if (dry(i) .and. flag_guess(i)) then + weasd(i) = weasd_old(i) + snwdph(i) = snwdph_old(i) + tskin(i) = tskin_old(i) + canopy(i) = canopy_old(i) + tprcp(i) = tprcp_old(i) + srflag(i) = srflag_old(i) + snowxy(i) = snow_old(i) + tvxy(i) = tv_old(i) + tgxy(i) = tg_old(i) + canicexy(i) = canice_old(i) + canliqxy(i) = canliq_old(i) + eahxy(i) = eah_old(i) + tahxy(i) = tah_old(i) + fwetxy(i) = fwet_old(i) + sneqvoxy(i) = sneqvo_old(i) + alboldxy(i) = albold_old(i) + qsnowxy(i) = qsnow_old(i) + wslakexy(i) = wslake_old(i) + zwtxy(i) = zwt_old(i) + waxy(i) = wa_old(i) + wtxy(i) = wt_old(i) + lfmassxy(i) = lfmass_old(i) + rtmassxy(i) = rtmass_old(i) + stmassxy(i) = stmass_old(i) + woodxy(i) = wood_old(i) + stblcpxy(i) = stblcp_old(i) + fastcpxy(i) = fastcp_old(i) + xlaixy(i) = xlai_old(i) + xsaixy(i) = xsai_old(i) + taussxy(i) = tauss_old(i) + smcwtdxy(i) = smcwtd_old(i) + rechxy(i) = rech_old(i) + deeprechxy(i) = deeprech_old(i) + + do k = 1, km + smc(i,k) = smc_old(i,k) + stc(i,k) = stc_old(i,k) + slc(i,k) = slc_old(i,k) + smoiseq(i,k) = smoiseq_old(i,k) + end do + + do k = -2,0 + tsnoxy(i,k) = tsno_old(i,k) + snicexy(i,k) = snice_old(i,k) + snliqxy(i,k) = snliq_old(i,k) + end do + + do k = -2, km + zsnsoxy(i,k) = zsnso_old(i,k) + end do + + else + tskin(i) = tsurf(i) + + end if + end do + + return + + end subroutine noahmpdrv_run +!> @} +!----------------------------------- + +!> \ingroup NoahMP_LSM +!! \brief This subroutine fills in a derived data type of type noahmp_parameters with data +!! from the module \ref noahmp_tables. + subroutine transfer_mp_parameters (vegtype,soiltype,slopetype, & + soilcolor,croptype,parameters) + + use noahmp_tables + use module_sf_noahmplsm + + implicit none + + integer, intent(in) :: vegtype + integer, intent(in) :: soiltype(4) + integer, intent(in) :: slopetype + integer, intent(in) :: soilcolor + integer, intent(in) :: croptype + + type (noahmp_parameters), intent(out) :: parameters + + real :: refdk + real :: refkdt + real :: frzk + real :: frzfact + integer :: isoil + + parameters%iswater = iswater_table + parameters%isbarren = isbarren_table + parameters%isice = isice_table + parameters%iscrop = iscrop_table + parameters%eblforest = eblforest_table + +!-----------------------------------------------------------------------& + parameters%urban_flag = .false. + if( vegtype == isurban_table .or. vegtype == 31 & + & .or.vegtype == 32 .or. vegtype == 33) then + parameters%urban_flag = .true. + endif + +!------------------------------------------------------------------------------------------! +! transfer veg parameters +!------------------------------------------------------------------------------------------! + + parameters%ch2op = ch2op_table(vegtype) !maximum intercepted h2o per unit lai+sai (mm) + parameters%dleaf = dleaf_table(vegtype) !characteristic leaf dimension (m) + parameters%z0mvt = z0mvt_table(vegtype) !momentum roughness length (m) + parameters%hvt = hvt_table(vegtype) !top of canopy (m) + parameters%hvb = hvb_table(vegtype) !bottom of canopy (m) + parameters%den = den_table(vegtype) !tree density (no. of trunks per m2) + parameters%rc = rc_table(vegtype) !tree crown radius (m) + parameters%mfsno = mfsno_table(vegtype) !snowmelt m parameter () + parameters%scffac = scffac_table(vegtype) !snow cover factor + parameters%saim = saim_table(vegtype,:) !monthly stem area index, one-sided + parameters%laim = laim_table(vegtype,:) !monthly leaf area index, one-sided + parameters%sla = sla_table(vegtype) !single-side leaf area per kg [m2/kg] + parameters%dilefc = dilefc_table(vegtype) !coeficient for leaf stress death [1/s] + parameters%dilefw = dilefw_table(vegtype) !coeficient for leaf stress death [1/s] + parameters%fragr = fragr_table(vegtype) !fraction of growth respiration !original was 0.3 + parameters%ltovrc = ltovrc_table(vegtype) !leaf turnover [1/s] + + parameters%c3psn = c3psn_table(vegtype) !photosynthetic pathway: 0. = c4, 1. = c3 + parameters%kc25 = kc25_table(vegtype) !co2 michaelis-menten constant at 25c (pa) + parameters%akc = akc_table(vegtype) !q10 for kc25 + parameters%ko25 = ko25_table(vegtype) !o2 michaelis-menten constant at 25c (pa) + parameters%ako = ako_table(vegtype) !q10 for ko25 + parameters%vcmx25 = vcmx25_table(vegtype) !maximum rate of carboxylation at 25c (umol co2/m**2/s) + parameters%avcmx = avcmx_table(vegtype) !q10 for vcmx25 + parameters%bp = bp_table(vegtype) !minimum leaf conductance (umol/m**2/s) + parameters%mp = mp_table(vegtype) !slope of conductance-to-photosynthesis relationship + parameters%qe25 = qe25_table(vegtype) !quantum efficiency at 25c (umol co2 / umol photon) + parameters%aqe = aqe_table(vegtype) !q10 for qe25 + parameters%rmf25 = rmf25_table(vegtype) !leaf maintenance respiration at 25c (umol co2/m**2/s) + parameters%rms25 = rms25_table(vegtype) !stem maintenance respiration at 25c (umol co2/kg bio/s) + parameters%rmr25 = rmr25_table(vegtype) !root maintenance respiration at 25c (umol co2/kg bio/s) + parameters%arm = arm_table(vegtype) !q10 for maintenance respiration + parameters%folnmx = folnmx_table(vegtype) !foliage nitrogen concentration when f(n)=1 (%) + parameters%tmin = tmin_table(vegtype) !minimum temperature for photosynthesis (k) + + parameters%xl = xl_table(vegtype) !leaf/stem orientation index + parameters%rhol = rhol_table(vegtype,:) !leaf reflectance: 1=vis, 2=nir + parameters%rhos = rhos_table(vegtype,:) !stem reflectance: 1=vis, 2=nir + parameters%taul = taul_table(vegtype,:) !leaf transmittance: 1=vis, 2=nir + parameters%taus = taus_table(vegtype,:) !stem transmittance: 1=vis, 2=nir + + parameters%mrp = mrp_table(vegtype) !microbial respiration parameter (umol co2 /kg c/ s) + parameters%cwpvt = cwpvt_table(vegtype) !empirical canopy wind parameter + + parameters%wrrat = wrrat_table(vegtype) !wood to non-wood ratio + parameters%wdpool = wdpool_table(vegtype) !wood pool (switch 1 or 0) depending on woody or not [-] + parameters%tdlef = tdlef_table(vegtype) !characteristic t for leaf freezing [k] + + parameters%nroot = nroot_table(vegtype) !number of soil layers with root present + parameters%rgl = rgl_table(vegtype) !parameter used in radiation stress function + parameters%rsmin = rs_table(vegtype) !minimum stomatal resistance [s m-1] + parameters%hs = hs_table(vegtype) !parameter used in vapor pressure deficit function + parameters%topt = topt_table(vegtype) !optimum transpiration air temperature [k] + parameters%rsmax = rsmax_table(vegtype) !maximal stomatal resistance [s m-1] + +!------------------------------------------------------------------------------------------! +! transfer rad parameters +!------------------------------------------------------------------------------------------! + + parameters%albsat = albsat_table(soilcolor,:) + parameters%albdry = albdry_table(soilcolor,:) + parameters%albice = albice_table + parameters%alblak = alblak_table + parameters%omegas = omegas_table + parameters%betads = betads_table + parameters%betais = betais_table + parameters%eg = eg_table + +!------------------------------------------------------------------------------------------! +! Transfer crop parameters +!------------------------------------------------------------------------------------------! + + if(croptype > 0) then + parameters%pltday = pltday_table(croptype) ! planting date + parameters%hsday = hsday_table(croptype) ! harvest date + parameters%plantpop = plantpop_table(croptype) ! plant density [per ha] - used? + parameters%irri = irri_table(croptype) ! irrigation strategy 0= non-irrigation 1=irrigation (no water-stress) + parameters%gddtbase = gddtbase_table(croptype) ! base temperature for gdd accumulation [c] + parameters%gddtcut = gddtcut_table(croptype) ! upper temperature for gdd accumulation [c] + parameters%gdds1 = gdds1_table(croptype) ! gdd from seeding to emergence + parameters%gdds2 = gdds2_table(croptype) ! gdd from seeding to initial vegetative + parameters%gdds3 = gdds3_table(croptype) ! gdd from seeding to post vegetative + parameters%gdds4 = gdds4_table(croptype) ! gdd from seeding to intial reproductive + parameters%gdds5 = gdds5_table(croptype) ! gdd from seeding to pysical maturity + parameters%c3c4 = c3c4_table(croptype) ! photosynthetic pathway: 1. = c3 2. = c4 + parameters%aref = aref_table(croptype) ! reference maximum co2 assimulation rate + parameters%psnrf = psnrf_table(croptype) ! co2 assimulation reduction factor(0-1) (e.g.pests, weeds) + parameters%i2par = i2par_table(croptype) ! fraction of incoming solar radiation to photosynthetically active radiation + parameters%tassim0 = tassim0_table(croptype) ! minimum temperature for co2 assimulation [c] + parameters%tassim1 = tassim1_table(croptype) ! co2 assimulation linearly increasing until temperature reaches t1 [c] + parameters%tassim2 = tassim2_table(croptype) ! co2 assmilation rate remain at aref until temperature reaches t2 [c] + parameters%k = k_table(croptype) ! light extinction coefficient + parameters%epsi = epsi_table(croptype) ! initial light use efficiency + parameters%q10mr = q10mr_table(croptype) ! q10 for maintainance respiration + parameters%foln_mx = foln_mx_table(croptype) ! foliage nitrogen concentration when f(n)=1 (%) + parameters%lefreez = lefreez_table(croptype) ! characteristic t for leaf freezing [k] + parameters%dile_fc = dile_fc_table(croptype,:) ! coeficient for temperature leaf stress death [1/s] + parameters%dile_fw = dile_fw_table(croptype,:) ! coeficient for water leaf stress death [1/s] + parameters%fra_gr = fra_gr_table(croptype) ! fraction of growth respiration + parameters%lf_ovrc = lf_ovrc_table(croptype,:) ! fraction of leaf turnover [1/s] + parameters%st_ovrc = st_ovrc_table(croptype,:) ! fraction of stem turnover [1/s] + parameters%rt_ovrc = rt_ovrc_table(croptype,:) ! fraction of root tunrover [1/s] + parameters%lfmr25 = lfmr25_table(croptype) ! leaf maintenance respiration at 25c [umol co2/m**2 /s] + parameters%stmr25 = stmr25_table(croptype) ! stem maintenance respiration at 25c [umol co2/kg bio/s] + parameters%rtmr25 = rtmr25_table(croptype) ! root maintenance respiration at 25c [umol co2/kg bio/s] + parameters%grainmr25 = grainmr25_table(croptype) ! grain maintenance respiration at 25c [umol co2/kg bio/s] + parameters%lfpt = lfpt_table(croptype,:) ! fraction of carbohydrate flux to leaf + parameters%stpt = stpt_table(croptype,:) ! fraction of carbohydrate flux to stem + parameters%rtpt = rtpt_table(croptype,:) ! fraction of carbohydrate flux to root + parameters%grainpt = grainpt_table(croptype,:) ! fraction of carbohydrate flux to grain + parameters%bio2lai = bio2lai_table(croptype) ! leaf are per living leaf biomass [m^2/kg] + end if + +!------------------------------------------------------------------------------------------! +! transfer global parameters +!------------------------------------------------------------------------------------------! + + parameters%co2 = co2_table + parameters%o2 = o2_table + parameters%timean = timean_table + parameters%fsatmx = fsatmx_table + parameters%z0sno = z0sno_table + parameters%ssi = ssi_table + parameters%snow_ret_fac = snow_ret_fac_table + parameters%swemx = swemx_table + parameters%tau0 = tau0_table + parameters%grain_growth = grain_growth_table + parameters%extra_growth = extra_growth_table + parameters%dirt_soot = dirt_soot_table + parameters%bats_cosz = bats_cosz_table + parameters%bats_vis_new = bats_vis_new_table + parameters%bats_nir_new = bats_nir_new_table + parameters%bats_vis_age = bats_vis_age_table + parameters%bats_nir_age = bats_nir_age_table + parameters%bats_vis_dir = bats_vis_dir_table + parameters%bats_nir_dir = bats_nir_dir_table + parameters%rsurf_snow = rsurf_snow_table + parameters%rsurf_exp = rsurf_exp_table + parameters%snow_emis = snow_emis_table + +! ---------------------------------------------------------------------- +! transfer soil parameters +! ---------------------------------------------------------------------- + + do isoil = 1, size(soiltype) + parameters%bexp(isoil) = bexp_table (soiltype(isoil)) + parameters%dksat(isoil) = dksat_table (soiltype(isoil)) + parameters%dwsat(isoil) = dwsat_table (soiltype(isoil)) + parameters%psisat(isoil) = psisat_table (soiltype(isoil)) + parameters%quartz(isoil) = quartz_table (soiltype(isoil)) + parameters%smcdry(isoil) = smcdry_table (soiltype(isoil)) + parameters%smcmax(isoil) = smcmax_table (soiltype(isoil)) + parameters%smcref(isoil) = smcref_table (soiltype(isoil)) + parameters%smcwlt(isoil) = smcwlt_table (soiltype(isoil)) + end do + + parameters%f1 = f1_table(soiltype(1)) + parameters%refdk = refdk_table + parameters%refkdt = refkdt_table + +! ---------------------------------------------------------------------- +! transfer genparm parameters +! ---------------------------------------------------------------------- + parameters%csoil = csoil_table + parameters%zbot = zbot_table + parameters%czil = czil_table + + frzk = frzk_table + parameters%kdt = parameters%refkdt * parameters%dksat(1) / parameters%refdk + parameters%slope = slope_table(slopetype) + + if(parameters%urban_flag)then ! hardcoding some urban parameters for soil + parameters%smcmax = 0.45 + parameters%smcref = 0.42 + parameters%smcwlt = 0.40 + parameters%smcdry = 0.40 + parameters%csoil = 3.e6 + endif + + ! adjust frzk parameter to actual soil type: frzk * frzfact + +!-----------------------------------------------------------------------& + if(soiltype(1) /= 14) then + frzfact = (parameters%smcmax(1) / parameters%smcref(1)) * (0.412 / 0.468) + parameters%frzx = frzk * frzfact + end if + + end subroutine transfer_mp_parameters + +!> \ingroup NoahMP_LSM +!! \brief This subroutine uses a pedotransfer method to calculate soil properties. +SUBROUTINE PEDOTRANSFER_SR2006(nsoil,sand,clay,orgm,parameters) + + use module_sf_noahmplsm + use noahmp_tables + + implicit none + + integer, intent(in ) :: nsoil ! number of soil layers + real, dimension( 1:nsoil ), intent(inout) :: sand + real, dimension( 1:nsoil ), intent(inout) :: clay + real, dimension( 1:nsoil ), intent(inout) :: orgm + + real, dimension( 1:nsoil ) :: theta_1500t + real, dimension( 1:nsoil ) :: theta_1500 + real, dimension( 1:nsoil ) :: theta_33t + real, dimension( 1:nsoil ) :: theta_33 + real, dimension( 1:nsoil ) :: theta_s33t + real, dimension( 1:nsoil ) :: theta_s33 + real, dimension( 1:nsoil ) :: psi_et + real, dimension( 1:nsoil ) :: psi_e + + type(noahmp_parameters), intent(inout) :: parameters + integer :: k + + do k = 1,4 + if(sand(k) <= 0 .or. clay(k) <= 0) then + sand(k) = 0.41 + clay(k) = 0.18 + end if + if(orgm(k) <= 0 ) orgm(k) = 0.0 + end do + + theta_1500t = sr2006_theta_1500t_a*sand & + + sr2006_theta_1500t_b*clay & + + sr2006_theta_1500t_c*orgm & + + sr2006_theta_1500t_d*sand*orgm & + + sr2006_theta_1500t_e*clay*orgm & + + sr2006_theta_1500t_f*sand*clay & + + sr2006_theta_1500t_g + + theta_1500 = theta_1500t & + + sr2006_theta_1500_a*theta_1500t & + + sr2006_theta_1500_b + + theta_33t = sr2006_theta_33t_a*sand & + + sr2006_theta_33t_b*clay & + + sr2006_theta_33t_c*orgm & + + sr2006_theta_33t_d*sand*orgm & + + sr2006_theta_33t_e*clay*orgm & + + sr2006_theta_33t_f*sand*clay & + + sr2006_theta_33t_g + + theta_33 = theta_33t & + + sr2006_theta_33_a*theta_33t*theta_33t & + + sr2006_theta_33_b*theta_33t & + + sr2006_theta_33_c + + theta_s33t = sr2006_theta_s33t_a*sand & + + sr2006_theta_s33t_b*clay & + + sr2006_theta_s33t_c*orgm & + + sr2006_theta_s33t_d*sand*orgm & + + sr2006_theta_s33t_e*clay*orgm & + + sr2006_theta_s33t_f*sand*clay & + + sr2006_theta_s33t_g + + theta_s33 = theta_s33t & + + sr2006_theta_s33_a*theta_s33t & + + sr2006_theta_s33_b + + psi_et = sr2006_psi_et_a*sand & + + sr2006_psi_et_b*clay & + + sr2006_psi_et_c*theta_s33 & + + sr2006_psi_et_d*sand*theta_s33 & + + sr2006_psi_et_e*clay*theta_s33 & + + sr2006_psi_et_f*sand*clay & + + sr2006_psi_et_g + + psi_e = psi_et & + + sr2006_psi_e_a*psi_et*psi_et & + + sr2006_psi_e_b*psi_et & + + sr2006_psi_e_c + + parameters%smcwlt = theta_1500 + parameters%smcref = theta_33 + parameters%smcmax = theta_33 & + + theta_s33 & + + sr2006_smcmax_a*sand & + + sr2006_smcmax_b + + parameters%bexp = 3.816712826 / (log(theta_33) - log(theta_1500) ) + parameters%psisat = psi_e + parameters%dksat = 1930.0 * (parameters%smcmax - theta_33) ** (3.0 - 1.0/parameters%bexp) + parameters%quartz = sand + +! Units conversion + + parameters%psisat = max(0.1,parameters%psisat) ! arbitrarily impose a limit of 0.1kpa + parameters%psisat = 0.101997 * parameters%psisat ! convert kpa to m + parameters%dksat = parameters%dksat / 3600000.0 ! convert mm/h to m/s + parameters%dwsat = parameters%dksat * parameters%psisat *parameters%bexp / parameters%smcmax ! units should be m*m/s + parameters%smcdry = parameters%smcwlt + +! Introducing somewhat arbitrary limits (based on SOILPARM) to prevent bad things + + parameters%smcmax = max(0.32 ,min(parameters%smcmax, 0.50 )) + parameters%smcref = max(0.17 ,min(parameters%smcref,parameters%smcmax )) + parameters%smcwlt = max(0.01 ,min(parameters%smcwlt,parameters%smcref )) + parameters%smcdry = max(0.01 ,min(parameters%smcdry,parameters%smcref )) + parameters%bexp = max(2.50 ,min(parameters%bexp, 12.0 )) + parameters%psisat = max(0.03 ,min(parameters%psisat, 1.00 )) + parameters%dksat = max(5.e-7,min(parameters%dksat, 1.e-5)) + parameters%dwsat = max(1.e-6,min(parameters%dwsat, 3.e-5)) + parameters%quartz = max(0.05 ,min(parameters%quartz, 0.95 )) + + END SUBROUTINE PEDOTRANSFER_SR2006 + +!-----------------------------------------------------------------------& + +!> \ingroup NoahMP_LSM +!! brief Calculate 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 (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil, & + & q2,q2sat,etp,snowng,frzgra,ffrozp, & + & dqsdt2,emissi_in,sncovr) + +! etp is calcuated right after ssoil + +! ---------------------------------------------------------------------- +! subroutine penman +! ---------------------------------------------------------------------- + implicit none + logical, intent(in) :: snowng, frzgra + real, intent(in) :: ch, dqsdt2,fdown,prcp,ffrozp, & + & q2, q2sat,ssoil, sfcprs, sfctmp, & + & t2v, th2,emissi_in,sncovr + real, intent(out) :: etp + real :: epsca,flx2,rch,rr,t24 + real :: a, delta, fnet,rad,rho,emissi,elcp1,lvs + + real, parameter :: elcp = 2.4888e+3, lsubc = 2.501000e+6,cp = 1004.6 + real, parameter :: lsubs = 2.83e+6, rd = 287.05, cph2o = 4.1855e+3 + real, parameter :: cpice = 2.106e+3, lsubf = 3.335e5 + real, parameter :: sigma = 5.6704e-8 + +! ---------------------------------------------------------------------- +! executable code begins here: +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! prepare partial quantities for penman equation. +! ---------------------------------------------------------------------- + emissi=emissi_in +! elcp1 = (1.0-sncovr)*elcp + sncovr*elcp*lsubs/lsubc + lvs = (1.0-sncovr)*lsubc + sncovr*lsubs + + flx2 = 0.0 + delta = elcp * dqsdt2 +! delta = elcp1 * dqsdt2 + t24 = sfctmp * sfctmp * sfctmp * sfctmp + rr = t24 * 6.48e-8 / (sfcprs * ch) + 1.0 +! rr = emissi*t24 * 6.48e-8 / (sfcprs * ch) + 1.0 + rho = sfcprs / (rd * t2v) + +! ---------------------------------------------------------------------- +! adjust the partial sums / products with the latent heat +! effects caused by falling precipitation. +! ---------------------------------------------------------------------- + rch = rho * cp * ch + if (.not. snowng) then + if (prcp > 0.0) rr = rr + cph2o * prcp / rch + else +! ---- ... fractional snowfall/rainfall + rr = rr + (cpice*ffrozp+cph2o*(1.-ffrozp)) & + & *prcp/rch + end if + +! ---------------------------------------------------------------------- +! include the latent heat effects of frzng rain converting to ice on +! impact in the calculation of flx2 and fnet. +! ---------------------------------------------------------------------- +! fnet = fdown - sigma * t24- ssoil + fnet = fdown - emissi*sigma * t24- ssoil + if (frzgra) then + flx2 = - lsubf * prcp + fnet = fnet - flx2 +! ---------------------------------------------------------------------- +! finish penman equation calculations. +! ---------------------------------------------------------------------- + end if + rad = fnet / rch + th2- sfctmp + a = elcp * (q2sat - q2) +! a = elcp1 * (q2sat - q2) + epsca = (a * rr + rad * delta) / (delta + rr) + etp = epsca * rch / lsubc +! etp = epsca * rch / lvs + +! ---------------------------------------------------------------------- + end subroutine penman + + end module noahmpdrv diff --git a/physics/sfc_noahmp_drv.f b/physics/sfc_noahmp_drv.f deleted file mode 100644 index 4dd419f0f..000000000 --- a/physics/sfc_noahmp_drv.f +++ /dev/null @@ -1,1257 +0,0 @@ -#define CCPP -!> \file sfc_noahmp_drv.f -!! This file contains the NoahMP land surface scheme driver. - -!>\defgroup NoahMP_LSM NoahMP LSM Model -!! \brief This is the NoahMP LSM driver module, with the functionality of -!! preparing variables to run the NoahMP LSM subroutine noahmp_sflx(), calling NoahMP LSM and post-processing -!! variables for return to the parent model suite including unit conversion, as well -!! as diagnotics calculation. - -!> This module contains the CCPP-compliant NoahMP land surface model driver. - module noahmpdrv - - implicit none - - private - - public :: noahmpdrv_init, noahmpdrv_run, noahmpdrv_finalize - - contains - -!> \ingroup NoahMP_LSM -!! \brief This subroutine is called during the CCPP initialization phase and calls set_soilveg() to -!! initialize soil and vegetation parameters for the chosen soil and vegetation data sources. -!! \section arg_table_noahmpdrv_init Argument Table -!! \htmlinclude noahmpdrv_init.html -!! - subroutine noahmpdrv_init(me, isot, ivegsrc, nlunit, pores, resid, - & errmsg, errflg) - - use machine, only: kind_phys - use set_soilveg_mod, only: set_soilveg - use namelist_soilveg - - implicit none - - integer, intent(in) :: me, isot, ivegsrc, nlunit - - real (kind=kind_phys), dimension(:), intent(out) :: pores, resid - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (ivegsrc /= 1) then - errmsg = 'The NOAHMP LSM expects that the ivegsrc physics '// - & 'namelist parameter is 1. Exiting...' - errflg = 1 - return - end if - if (isot /= 1) then - errmsg = 'The NOAHMP LSM expects that the isot physics '// - & 'namelist parameter is 1. Exiting...' - errflg = 1 - return - end if - - !--- initialize soil vegetation - call set_soilveg(me, isot, ivegsrc, nlunit) - - pores (:) = maxsmc (:) - resid (:) = drysmc (:) - - end subroutine noahmpdrv_init - - subroutine noahmpdrv_finalize - end subroutine noahmpdrv_finalize - -!> \ingroup NoahMP_LSM -!! \brief This subroutine is the main CCPP entry point for the NoahMP LSM. -!! \section arg_table_noahmpdrv_run Argument Table -!! \htmlinclude noahmpdrv_run.html -!! -!! \section general_noahmpdrv NoahMP Driver General Algorithm -!! @{ -!! - Initialize CCPP error handling variables. -!! - Set a flag to only continue with each grid cell if the fraction of land is non-zero. -!! - This driver may be called as part of an iterative loop. If called as the first "guess" run, -!! save land-related prognostic fields to restore. -!! - Initialize output variables to zero and prepare variables for input into the NoahMP LSM. -!! - Call transfer_mp_parameters() to fill a derived datatype for input into the NoahMP LSM. -!! - Call noahmp_options() to set module-level scheme options for the NoahMP LSM. -!! - If the vegetation type is ice for the grid cell, call noahmp_options_glacier() to set -!! module-level scheme options for NoahMP Glacier and call noahmp_glacier(). -!! - For other vegetation types, call noahmp_sflx(), the entry point of the NoahMP LSM. -!! - Set output variables from the output of noahmp_glacier() and/or noahmp_sflx(). -!! - Call penman() to calculate potential evaporation. -!! - Calculate the surface specific humidity and convert surface sensible and latent heat fluxes in W m-2 from their kinematic values. -!! - If a "guess" run, restore the land-related prognostic fields. -! ! -!----------------------------------- - subroutine noahmpdrv_run & -!................................... -! --- inputs: - & ( im, km, itime, ps, u1, v1, t1, q1, soiltyp, vegtype, & - & sigmaf, sfcemis, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & - & prsl1, prslki, zf, dry, wind, slopetyp, & - & shdmin, shdmax, snoalb, sfalb, flag_iter, flag_guess, & - & idveg, iopt_crs, iopt_btr, iopt_run, iopt_sfc, iopt_frz, & - & iopt_inf, iopt_rad, iopt_alb, iopt_snf, iopt_tbot, & - & iopt_stc, xlatin, xcoszin, iyrlen, julian, & - & rainn_mp, rainc_mp, snow_mp, graupel_mp, ice_mp, & - & con_hvap, con_cp, con_jcal, rhoh2o, con_eps, con_epsm1, & - & con_fvirt, con_rd, con_hfus, & - -! --- in/outs: - & weasd, snwdph, tskin, tprcp, srflag, smc, stc, slc, & - & canopy, trans, tsurf, zorl, & - -! --- Noah MP specific - - & snowxy, tvxy, tgxy, canicexy, canliqxy, eahxy, tahxy, cmxy,& - & chxy, fwetxy, sneqvoxy, alboldxy, qsnowxy, wslakexy, zwtxy,& - & waxy, wtxy, tsnoxy, zsnsoxy, snicexy, snliqxy, lfmassxy, & - & rtmassxy, stmassxy, woodxy, stblcpxy, fastcpxy, xlaixy, & - & xsaixy, taussxy, smoiseq, smcwtdxy, deeprechxy, rechxy, & - -! --- outputs: - & sncovr1, qsurf, gflux, drain, evap, hflx, ep, runoff, & - & cmm, chh, evbs, evcw, sbsno, snowc, stm, snohf, & - & smcwlt2, smcref2, wet1, t2mmp, q2mp, errmsg, errflg) -! -! - use machine , only : kind_phys -! use date_def, only : idate - use funcphys, only : fpvs - - use module_sf_noahmplsm - use module_sf_noahmp_glacier - use noahmp_tables, only : isice_table, co2_table, o2_table, & - & isurban_table,smcref_table,smcdry_table, & - & smcmax_table,co2_table,o2_table, & - & saim_table,laim_table - - implicit none - - real(kind=kind_phys), parameter :: a2 = 17.2693882 - real(kind=kind_phys), parameter :: a3 = 273.16 - real(kind=kind_phys), parameter :: a4 = 35.86 - real(kind=kind_phys), parameter :: a23m4 = a2*(a3-a4) - - real, parameter :: undefined = -1.e36 - - real :: dz8w = undefined - real :: dx = undefined - real :: qc = undefined - real :: foln = 1.0 ! foliage - integer :: nsoil = 4 ! hardwired to Noah - integer :: nsnow = 3 ! max. snow layers - integer :: ist = 1 ! soil type, 1 soil; 2 lake; 14 is water - integer :: isc = 4 ! middle day soil color: soil 1-9 lightest - - real(kind=kind_phys), save :: zsoil(4),sldpth(4) - data zsoil / -0.1, -0.4, -1.0, -2.0 / - data sldpth /0.1, 0.3, 0.6, 1.0 / -! data dzs /0.1, 0.3, 0.6, 1.0 / - -! -! --- input: -! - - integer, intent(in) :: im, km, itime - - integer, dimension(im), intent(in) :: soiltyp, vegtype, slopetyp - - real (kind=kind_phys), dimension(im), intent(in) :: ps, u1, v1, & - & t1, q1, sigmaf, sfcemis, dlwflx, dswsfc, snet, tg3, cm, & - & ch, prsl1, prslki, wind, shdmin, shdmax, & - & snoalb, sfalb, zf, & - & rainn_mp,rainc_mp,snow_mp,graupel_mp,ice_mp - - logical, dimension(im), intent(in) :: dry - - real (kind=kind_phys),dimension(im),intent(in) :: xlatin,xcoszin - - integer, intent(in) :: idveg, iopt_crs,iopt_btr,iopt_run, & - & iopt_sfc,iopt_frz,iopt_inf,iopt_rad, & - & iopt_alb,iopt_snf,iopt_tbot,iopt_stc - - real (kind=kind_phys), intent(in) :: julian - integer, intent(in) :: iyrlen - - - real (kind=kind_phys), intent(in) :: delt - logical, dimension(im), intent(in) :: flag_iter, flag_guess - - real (kind=kind_phys), intent(in) :: con_hvap, con_cp, con_jcal, & - & rhoh2o, con_eps, con_epsm1, con_fvirt, & - & con_rd, con_hfus - -! --- in/out: - real (kind=kind_phys), dimension(im), intent(inout) :: weasd, & - & snwdph, tskin, tprcp, srflag, canopy, trans, tsurf, zorl - - real (kind=kind_phys), dimension(im,km), intent(inout) :: & - & smc, stc, slc - - real (kind=kind_phys), dimension(im), intent(inout) :: snowxy, & - & tvxy,tgxy,canicexy,canliqxy,eahxy,tahxy, & - & cmxy,chxy,fwetxy,sneqvoxy,alboldxy,qsnowxy, & - & wslakexy,zwtxy,waxy,wtxy,lfmassxy,rtmassxy, & - & stmassxy,woodxy,stblcpxy,fastcpxy,xlaixy, & - & xsaixy,taussxy,smcwtdxy,deeprechxy,rechxy - - real (kind=kind_phys),dimension(im,-2:0),intent(inout) :: tsnoxy - real (kind=kind_phys),dimension(im,-2:0),intent(inout) :: snicexy - real (kind=kind_phys),dimension(im,-2:0),intent(inout) :: snliqxy - real (kind=kind_phys),dimension(im,1:4), intent(inout) :: smoiseq - real (kind=kind_phys),dimension(im,-2:4),intent(inout) :: zsnsoxy - - integer, dimension(im) :: jsnowxy - real (kind=kind_phys),dimension(im) :: snodep - real (kind=kind_phys),dimension(im,-2:4) :: tsnsoxy - -! --- output: - - real (kind=kind_phys), dimension(im), intent(out) :: sncovr1, & - & qsurf, gflux, drain, evap, hflx, ep, runoff, cmm, chh, & - & evbs, evcw, sbsno, snowc, stm, snohf, smcwlt2, smcref2, wet1 - real (kind=kind_phys), dimension(:), intent(out) :: t2mmp, q2mp - -! error messages - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -! --- locals: - real (kind=kind_phys), dimension(im) :: rch, rho, & - & q0, qs1, theta1, tv1, weasd_old, snwdph_old, & - & tprcp_old, srflag_old, tskin_old, canopy_old - - real (kind=kind_phys), dimension(km) :: et,stsoil,smsoil, slsoil - - real (kind=kind_phys),dimension(im,km) :: smc_old,stc_old,slc_old - - real (kind=kind_phys), dimension(im) :: snow_old, tv_old,tg_old, & - & canice_old,canliq_old,eah_old,tah_old,fwet_old,sneqvo_old, & - & albold_old,qsnow_old,wslake_old,zwt_old,wa_old,wt_old, & - & lfmass_old,rtmass_old,stmass_old,wood_old,stblcp_old, & - & fastcp_old,xlai_old,xsai_old,tauss_old,smcwtd_old, & - & deeprech_old,rech_old - - real(kind=kind_phys),dimension(im,1:4) :: smoiseq_old - real(kind=kind_phys),dimension(im,-2:0) :: tsno_old - real(kind=kind_phys),dimension(im,-2:0) :: snice_old - real(kind=kind_phys),dimension(im,-2:0) :: snliq_old - real(kind=kind_phys),dimension(im,-2:4) :: zsnso_old - real(kind=kind_phys),dimension(im,-2:4) :: tsnso_old - - - real (kind=kind_phys) :: alb, albedo, beta, chx, cmx, cmc, & - & dew, drip, dqsdt2, ec, edir, ett, eta, esnow, etp, & - & flx1, flx2, flx3, ffrozp, lwdn, pc, prcp, ptu, q2, & - & q2sat, solnet, rc, rcs, rct, rcq, rcsoil, rsmin, & - & runoff1, runoff2, runoff3, sfcspd, sfcprs, sfctmp, & - & sfcems, sheat, shdfac, shdmin1d, shdmax1d, smcwlt, & - & smcdry, smcref, smcmax, sneqv, snoalb1d, snowh, & - & snomlt, sncovr, soilw, soilm, ssoil, tsea, th2, & - & xlai, zlvl, swdn, tem, psfc,fdown,t2v,tbot - - real (kind=kind_phys) :: pconv,pnonc,pshcv,psnow,pgrpl,phail - real (kind=kind_phys) :: lat,cosz,uu,vv,swe - integer :: isnowx - - real (kind=kind_phys) :: tvx,tgx,canicex,canliqx,eahx, & - & tahx,fwetx,sneqvox,alboldx,qsnowx,wslakex,zwtx, & - & wax,wtx,lfmassx, rtmassx,stmassx, woodx,stblcpx, & - & fastcpx,xlaix,xsaix,taussx,smcwtdx,deeprechx,rechx, & - & qsfc1d - - real (kind=kind_phys), dimension(-2:0) :: tsnox, snicex, snliqx - real (kind=kind_phys), dimension(-2:0) :: ficeold - real (kind=kind_phys), dimension( km ) :: smoiseqx - real (kind=kind_phys), dimension(-2:4) :: zsnsox - real (kind=kind_phys), dimension(-2:4) :: tsnsox - - real (kind=kind_phys) :: z0wrf,fsa,fsr,fira,fsh,fcev,fgev, & - & fctr,ecan,etran,trad,tgb,tgv,t2mv, & - & t2mb,q2v,q2b,runsrf,runsub,apar, & - & psn,sav,sag,fsno,nee,gpp,npp,fveg, & - & qsnbot,ponding,ponding1,ponding2, & - & rssun,rssha,bgap,wgap,chv,chb,emissi, & - & shg,shc,shb,evg,evb,ghv,ghb,irg,irc, & - & irb,tr,evc,chleaf,chuc,chv2,chb2, & - & fpice,pahv,pahg,pahb,pah,co2pp,o2pp,ch2b - - integer :: i, k, ice, stype, vtype ,slope,nroot,couple - logical :: flag(im) - logical :: snowng,frzgra - - ! --- local derived constants: - - real(kind=kind_phys) :: cpinv, hvapi, convrad, elocp - - type(noahmp_parameters) :: parameters - -! -!===> ... begin here -! - cpinv = 1.0/con_cp - hvapi = 1.0/con_hvap - convrad = con_jcal*1.e4/60.0 - elocp = con_hvap/con_cp - -! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - -! --- ... set flag for land points - - do i = 1, im - flag(i) = dry(i) - enddo - -! --- ... save land-related prognostic fields for guess run - - do i = 1, im - if (flag(i) .and. flag_guess(i)) then - weasd_old(i) = weasd(i) - snwdph_old(i) = snwdph(i) - tskin_old(i) = tskin(i) - canopy_old(i) = canopy(i) - tprcp_old(i) = tprcp(i) - srflag_old(i) = srflag(i) -! -! - snow_old(i) = snowxy(i) - tv_old(i) = tvxy(i) - tg_old(i) = tgxy(i) - canice_old(i) = canicexy(i) - canliq_old(i) = canliqxy(i) - eah_old(i) = eahxy(i) - tah_old(i) = tahxy(i) - fwet_old(i) = fwetxy(i) - sneqvo_old(i) = sneqvoxy(i) - albold_old(i) = alboldxy(i) - qsnow_old(i) = qsnowxy(i) - wslake_old(i) = wslakexy(i) - zwt_old(i) = zwtxy(i) - wa_old(i) = waxy(i) - wt_old(i) = wtxy(i) - lfmass_old(i) = lfmassxy(i) - rtmass_old(i) = rtmassxy(i) - stmass_old(i) = stmassxy(i) - wood_old(i) = woodxy(i) - stblcp_old(i) = stblcpxy(i) - fastcp_old(i) = fastcpxy(i) - xlai_old(i) = xlaixy(i) - xsai_old(i) = xsaixy(i) - tauss_old(i) = taussxy(i) - smcwtd_old(i) = smcwtdxy(i) - rech_old(i) = rechxy(i) - - deeprech_old(i) = deeprechxy(i) -! - do k = 1, km - smc_old(i,k) = smc(i,k) - stc_old(i,k) = stc(i,k) - slc_old(i,k) = slc(i,k) - enddo - -! - do k = 1, km - smoiseq_old(i,k) = smoiseq(i,k) - enddo - - do k = -2,0 - tsno_old(i,k) = tsnoxy(i,k) - snice_old(i,k) = snicexy(i,k) - snliq_old(i,k) = snliqxy(i,k) - enddo - - do k = -2,4 - zsnso_old (i,k) = zsnsoxy(i,k) - enddo - - endif - enddo - -! -! call to init MP options -! -! &_________________________________________________________________ & - -! --- ... initialization block - - do i = 1, im - if (flag_iter(i) .and. flag(i)) then - ep(i) = 0.0 - evap (i) = 0.0 - hflx (i) = 0.0 - gflux(i) = 0.0 - drain(i) = 0.0 - canopy(i) = max(canopy(i), 0.0) - - evbs (i) = 0.0 - evcw (i) = 0.0 - trans(i) = 0.0 - sbsno(i) = 0.0 - snowc(i) = 0.0 - snohf(i) = 0.0 - endif - enddo - -! --- ... initialize variables - - do i = 1, im - if (flag_iter(i) .and. flag(i)) then - q0(i) = max(q1(i), 1.e-8) !* q1=specific humidity at level 1 (kg/kg) - theta1(i) = t1(i) * prslki(i) !* adiabatic temp at level 1 (k) - - tv1(i) = t1(i) * (1.0 + con_fvirt*q0(i)) - rho(i) = prsl1(i) / (con_rd * tv1(i)) - qs1(i) = fpvs( t1(i) ) !* qs1=sat. humidity at level 1 (kg/kg) - qs1(i) = con_eps*qs1(i) / (prsl1(i) + con_epsm1*qs1(i)) - qs1(i) = max(qs1(i), 1.e-8) - q0 (i) = min(qs1(i), q0(i)) - - if (vegtype(i) == isice_table ) then - if (weasd(i) < 0.1) then - weasd(i) = 0.1 - endif - endif - - endif - enddo - -! --- ... noah: prepare variables to run noah lsm -! 1. configuration information (c): -! ------------------------------ -! couple - couple-uncouple flag (=1: coupled, =0: uncoupled) -! ffrozp - fraction for snow-rain (1.=snow, 0.=rain, 0-1 mixed)) -! ice - sea-ice flag (=1: sea-ice, =0: land) -! dt - timestep (sec) (dt should not exceed 3600 secs) = delt -! zlvl - height (m) above ground of atmospheric forcing variables -! nsoil - number of soil layers (at least 2) -! sldpth - the thickness of each soil layer (m) - - do i = 1, im - - if (flag_iter(i) .and. flag(i)) then - - - couple = 1 - - ice = 0 - nsoil = km - snowng = .false. - frzgra = .false. - - -! if (srflag(i) == 1.0) then ! snow phase -! ffrozp = 1.0 -! elseif (srflag(i) == 0.0) then ! rain phase -! ffrozp = 0.0 -! endif -! use srflag directly to allow fractional rain/snow - ffrozp = srflag(i) - - zlvl = zf(i) - -! 2. forcing data (f): -! ----------------- -! lwdn - lw dw radiation flux (w/m2) -! solnet - net sw radiation flux (dn-up) (w/m2) -! sfcprs - pressure at height zlvl above ground (pascals) -! prcp - precip rate (kg m-2 s-1) -! sfctmp - air temperature (k) at height zlvl above ground -! th2 - air potential temperature (k) at height zlvl above ground -! q2 - mixing ratio at height zlvl above ground (kg kg-1) - - lat = xlatin(i) ! in radian - cosz = xcoszin(i) - - lwdn = dlwflx(i) !..downward lw flux at sfc in w/m2 - swdn = dswsfc(i) !..downward sw flux at sfc in w/m2 - solnet = snet(i) !..net sw rad flx (dn-up) at sfc in w/m2 - sfcems = sfcemis(i) - - sfctmp = t1(i) - sfcprs = prsl1(i) - psfc = ps(i) - prcp = rhoh2o * tprcp(i) / delt - - if (prcp > 0.0) then - if (ffrozp > 0.0) then ! rain/snow flag, one condition is enough? - snowng = .true. - qsnowxy(i) = ffrozp * prcp/10.0 !still use rho water? - else - if (sfctmp <= 275.15) frzgra = .true. - endif - endif - - th2 = theta1(i) - q2 = q0(i) - -! 3. other forcing (input) data (i): -! ------------------------------ -! sfcspd - wind speed (m s-1) at height zlvl above ground -! q2sat - sat mixing ratio at height zlvl above ground (kg kg-1) -! dqsdt2 - slope of sat specific humidity curve at t=sfctmp (kg kg-1 k-1) - - uu = u1(i) - vv = v1(i) - - sfcspd = wind(i) - q2sat = qs1(i) - dqsdt2 = q2sat * a23m4/(sfctmp-a4)**2 - -! 4. canopy/soil characteristics (s): -! -------------------------------- -! vegtyp - vegetation type (integer index) -> vtype -! soiltyp - soil type (integer index) -> stype -! slopetyp- class of sfc slope (integer index) -> slope -! shdfac - areal fractional coverage of green vegetation (0.0-1.0) -! shdmin - minimum areal fractional coverage of green vegetation -> shdmin1d -! ptu - photo thermal unit (plant phenology for annuals/crops) -! alb - backround snow-free surface albedo (fraction) -! snoalb - upper bound on maximum albedo over deep snow -> snoalb1d -! tbot - bottom soil temperature (local yearly-mean sfc air temp) - - vtype = vegtype(i) - stype = soiltyp(i) - slope = slopetyp(i) - shdfac= sigmaf(i) - - shdmin1d = shdmin(i) - shdmax1d = shdmax(i) - snoalb1d = snoalb(i) - - alb = sfalb(i) - - tbot = tg3(i) - ptu = 0.0 - - - cmc = canopy(i)/1000. ! convert from mm to m - tsea = tsurf(i) ! clu_q2m_iter - - snowh = snwdph(i) * 0.001 ! convert from mm to m - sneqv = weasd(i) * 0.001 ! convert from mm to m - - - -! 5. history (state) variables (h): -! ------------------------------ -! cmc - canopy moisture content (m) -! t1 - ground/canopy/snowpack) effective skin temperature (k) -> tsea -! stc(nsoil) - soil temp (k) -> stsoil -! smc(nsoil) - total soil moisture content (volumetric fraction) -> smsoil -! sh2o(nsoil)- unfrozen soil moisture content (volumetric fraction) -> slsoil -! snowh - actual snow depth (m) -! sneqv - liquid water-equivalent snow depth (m) -! albedo - surface albedo including snow effect (unitless fraction) -! ch - surface exchange coefficient for heat and moisture (m s-1) -> chx -! cm - surface exchange coefficient for momentum (m s-1) -> cmx - - isnowx = nint(snowxy(i)) - tvx = tvxy(i) - tgx = tgxy(i) - canliqx = canliqxy(i) !in mm - canicex = canicexy(i) - - eahxy(i) = (ps(i)*q2)/(0.622+q2) ! use q0 to reinit; - eahx = eahxy(i) - tahx = tahxy(i) - - co2pp = co2_table * sfcprs - o2pp = o2_table * sfcprs - fwetx = fwetxy(i) - - sneqvox = sneqvoxy(i) - alboldx = alboldxy(i) - - qsnowx = qsnowxy(i) - wslakex = wslakexy(i) - - zwtx = zwtxy(i) - wax = waxy(i) - wtx = waxy(i) - - do k = -2,0 - tsnsoxy(i,k) = tsnoxy(i,k) - enddo - - do k = 1,4 - tsnsoxy(i,k) = stc(i,k) - enddo - - do k = -2,0 - snicex(k) = snicexy(i,k) ! in k/m3; mm - snliqx(k) = snliqxy(i,k) ! in k/m3; mm - tsnox (k) = tsnoxy(i,k) - - ficeold(k) = 0.0 ! derived - - if (snicex(k) > 0.0 ) then - ficeold(k) = snicex(k) /(snicex(k)+snliqx(k)) - - endif - enddo - - do k = -2, km - zsnsox(k) = zsnsoxy(i,k) - tsnsox(k) = tsnsoxy(i,k) - enddo - - lfmassx = lfmassxy(i) - rtmassx = rtmassxy(i) - stmassx = stmassxy(i) - - woodx = woodxy(i) - stblcpx = stblcpxy(i) - fastcpx = fastcpxy(i) - - xsaix = xsaixy(i) - xlaix = xlaixy(i) - - taussx = taussxy(i) - - qsfc1d = undefined ! derive later, it is an in/out? - swe = weasd(i) - - do k = 1, km - smoiseqx(k) = smoiseq(i,k) - enddo - - smcwtdx = smcwtdxy(i) - rechx = rechxy(i) - deeprechx = deeprechxy(i) -!-- -! the optional details for precip -!-- - -! pconv = 0. ! convective - may introduce later -! pnonc = (1 - ffrozp) * prcp ! large scale total in mm/s; -! pshcv = 0. -! psnow = ffrozp * prcp /10.0 ! snow = qsnowx? -! pgrpl = 0. -! phail = 0. - pnonc = rainn_mp(i) - pconv = rainc_mp(i) - pshcv = 0. - psnow = snow_mp(i) - pgrpl = graupel_mp(i) - phail = ice_mp(i) -! -!-- old -! - do k = 1, km -! stsoil(k) = stc(i,k) - smsoil(k) = smc(i,k) - slsoil(k) = slc(i,k) - enddo - - snowh = snwdph(i) * 0.001 ! convert from mm to m - - if (swe /= 0.0 .and. snowh == 0.0) then - snowh = 10.0 * swe /1000.0 - endif - - chx = chxy(i) ! maybe chxy - cmx = cmxy(i) - - chh(i) = ch(i) * wind(i) * rho(i) - cmm(i) = cm(i) * wind(i) - - - - call transfer_mp_parameters(vtype,stype,slope,isc,parameters) - - call noahmp_options(idveg ,iopt_crs,iopt_btr,iopt_run,iopt_sfc, & - & iopt_frz,iopt_inf,iopt_rad,iopt_alb,iopt_snf,iopt_tbot,iopt_stc) - - if ( vtype == isice_table ) then - - ice = -1 - tbot = min(tbot,263.15) - - call noahmp_options_glacier & - & (idveg ,iopt_crs ,iopt_btr, iopt_run ,iopt_sfc ,iopt_frz, & - & iopt_inf ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc ) - - call noahmp_glacier ( & - & i ,1 ,cosz ,nsnow ,nsoil ,delt , & ! in : time/space/model-related - & sfctmp ,sfcprs ,uu ,vv ,q2 ,swdn , & ! in : forcing - & prcp ,lwdn ,tbot ,zlvl ,ficeold ,zsoil , & ! in : forcing - & qsnowx ,sneqvox ,alboldx ,cmx ,chx ,isnowx, & ! in/out :sneqvox + alboldx -LST - & swe ,smsoil ,zsnsox ,snowh ,snicex ,snliqx , & ! in/out : sneqvx + snowhx are avgd - & tgx ,tsnsox ,slsoil ,taussx ,qsfc1d , & ! in/out : - & fsa ,fsr ,fira ,fsh ,fgev ,ssoil , & ! out : - & trad ,edir ,runsrf ,runsub ,sag ,albedo , & ! out : albedo is surface albedo - & qsnbot ,ponding ,ponding1,ponding2,t2mb ,q2b , & ! out : -#ifdef CCPP - & emissi ,fpice ,ch2b ,esnow, errmsg, errflg ) -#else - & emissi ,fpice ,ch2b ,esnow ) -#endif - -#ifdef CCPP - if (errflg /= 0) return -#endif -! -! in/out and outs -! - - fsno = 1.0 - - tvx = undefined - canicex = undefined - canliqx = undefined - eahx = undefined - tahx = undefined - - fwetx = undefined - wslakex = undefined - zwtx = undefined - wax = undefined - wtx = undefined - - lfmassx = undefined - rtmassx = undefined - stmassx = undefined - woodx = undefined - stblcpx = undefined - fastcpx = undefined - xlaix = undefined - xsaix = undefined - - smcwtdx = 0.0 - rechx = 0.0 - deeprechx = 0.0 - - do k = 1,4 - smoiseqx(k) = smsoil(k) - enddo - - fctr = undefined - fcev = undefined - - z0wrf = 0.002 - - eta = fgev - t2mmp(i) = t2mb - q2mp(i) = q2b -! -! Non-glacial case -! - else - ice = 0 - -! write(*,*)'tsnsox(1)=',tsnsox,'tgx=',tgx - call noahmp_sflx (parameters ,& - & i , 1 , lat , iyrlen , julian , cosz ,& ! in : time/space-related - & delt , dx , dz8w , nsoil , zsoil , nsnow ,& ! in : model configuration - & shdfac , shdmax1d, vtype , ice , ist ,& ! in : vegetation/soil - & smoiseqx ,& ! in - & sfctmp , sfcprs , psfc , uu , vv , q2 ,& ! in : forcing - & qc , swdn , lwdn ,& ! in : forcing - & pconv , pnonc , pshcv , psnow , pgrpl , phail ,& ! in : forcing - & tbot , co2pp , o2pp , foln , ficeold , zlvl ,& ! in : forcing - & alboldx , sneqvox ,& ! in/out : - & tsnsox , slsoil , smsoil , tahx , eahx , fwetx ,& ! in/out : - & canliqx , canicex , tvx , tgx , qsfc1d , qsnowx ,& ! in/out : - & isnowx , zsnsox , snowh , swe , snicex , snliqx ,& ! in/out : - & zwtx , wax , wtx , wslakex , lfmassx , rtmassx,& ! in/out : - & stmassx , woodx , stblcpx , fastcpx , xlaix ,xsaix ,& ! in/out : - & cmx , chx , taussx ,& ! in/out : - & smcwtdx ,deeprechx, rechx ,& ! in/out : - & z0wrf ,& ! out - & fsa , fsr , fira , fsh , ssoil , fcev ,& ! out : - & fgev , fctr , ecan , etran , edir , trad ,& ! out : - & tgb , tgv , t2mv , t2mb , q2v , q2b ,& ! out : - & runsrf , runsub , apar , psn , sav , sag ,& ! out : - & fsno , nee , gpp , npp , fveg , albedo ,& ! out : - & qsnbot , ponding , ponding1, ponding2, rssun , rssha ,& ! out : - & bgap , wgap , chv , chb , emissi ,& ! out : - & shg , shc , shb , evg , evb , ghv ,&! out : - & ghb , irg , irc , irb , tr , evc ,& ! out : - & chleaf , chuc , chv2 , chb2 , fpice , pahv ,& ! out -#ifdef CCPP - & pahg , pahb , pah , esnow, errmsg, errflg ) -#else - & pahg , pahb , pah , esnow ) -#endif - -#ifdef CCPP - if (errflg /= 0) return -#endif - - eta = fcev + fgev + fctr ! the flux w/m2 - - t2mmp(i) = t2mv*fveg+t2mb*(1-fveg) - q2mp(i) = q2v*fveg+q2b*(1-fveg) - - endif ! glacial split ends - -! -! mp in/out -! - snowxy (i) = float(isnowx) - tvxy (i) = tvx - tgxy (i) = tgx - canliqxy (i) = canliqx - canicexy (i) = canicex - eahxy (i) = eahx - tahxy (i) = tahx - - cmxy (i) = cmx - chxy (i) = chx - - fwetxy (i) = fwetx - sneqvoxy (i) = sneqvox - alboldxy (i) = alboldx - qsnowxy (i) = qsnowx - - wslakexy (i) = wslakex - zwtxy (i) = zwtx - waxy (i) = wax - wtxy (i) = wtx - - do k = -2,0 - tsnoxy (i,k) = tsnsox(k) - snicexy (i,k) = snicex (k) - snliqxy (i,k) = snliqx (k) - enddo - - do k = -2,4 - zsnsoxy (i,k) = zsnsox(k) - enddo - - lfmassxy (i) = lfmassx - rtmassxy (i) = rtmassx - stmassxy (i) = stmassx - woodxy (i) = woodx - stblcpxy (i) = stblcpx - fastcpxy (i) = fastcpx - - xlaixy (i) = xlaix - xsaixy (i) = xsaix - - taussxy (i) = taussx - - rechxy (i) = rechx - deeprechxy(i) = deeprechx - smcwtdxy(i) = smcwtdx - smoiseq(i,1:4) = smoiseqx(1:4) - -! -! generic in/outs -! - do k = 1, km - stc(i,k) = tsnsox(k) - smc(i,k) = smsoil(k) - slc(i,k) = slsoil(k) - enddo - - canopy(i) = canicex + canliqx - weasd(i) = swe - snwdph(i) = snowh * 1000.0 - -! write(*,*) 'swe,snowh,can' -! write (*,*) swe,snowh*1000.0,canopy(i) -! - smcmax = smcmax_table(stype) - smcref = smcref_table(stype) - smcwlt = smcdry_table(stype) -! -! outs -! - wet1(i) = smsoil(1) / smcmax - smcwlt2(i) = smcwlt - smcref2(i) = smcref - - runoff(i) = runsrf - drain(i) = runsub - - zorl(i) = z0wrf * 100.0 - - sncovr1(i) = fsno - snowc (i) = fsno - - sbsno(i) = esnow - gflux(i) = -1.0*ssoil - hflx(i) = fsh - evbs(i) = fgev - evcw(i) = fcev - trans(i) = fctr - evap(i) = eta - -! write(*,*) 'vtype, stype are',vtype,stype -! write(*,*) 'fsh,gflx,eta',fsh,ssoil,eta -! write(*,*) 'esnow,runsrf,runsub',esnow,runsrf,runsub -! write(*,*) 'evbs,evcw,trans',fgev,fcev,fctr -! write(*,*) 'snowc',fsno - - tsurf(i) = trad - - stm(i) = (0.1*smsoil(1)+0.3*smsoil(2)+0.6*smsoil(3)+ & - & 1.0*smsoil(4))*1000.0 ! unit conversion from m to kg m-2 -! - snohf (i) = qsnbot * con_hfus ! only part of it but is diagnostic -! write(*,*) 'snohf',snohf(i) - - fdown = fsa + lwdn - t2v = sfctmp * (1.0 + 0.61*q2) -! ssoil = -1.0 *ssoil - - call penman (sfctmp,sfcprs,chx,t2v,th2,prcp,fdown,ssoil, & - & q2,q2sat,etp,snowng,frzgra,ffrozp,dqsdt2,emissi,fsno) - - ep(i) = etp - - endif ! end if_flag_iter_and_flag_block - enddo ! end do_i_loop - -! --- ... compute qsurf (specific humidity at sfc) - - do i = 1, im - if (flag_iter(i) .and. flag(i)) then - rch(i) = rho(i) * con_cp * ch(i) * wind(i) - qsurf(i) = q1(i) + evap(i) / (elocp * rch(i)) - endif - enddo - - do i = 1, im - if (flag_iter(i) .and. flag(i)) then - tem = 1.0 / rho(i) - hflx(i) = hflx(i) * tem * cpinv - evap(i) = evap(i) * tem * hvapi - endif - enddo - -! --- ... restore land-related prognostic fields for guess run - - do i = 1, im - if (flag(i)) then - if (flag_guess(i)) then - weasd(i) = weasd_old(i) - snwdph(i) = snwdph_old(i) - tskin(i) = tskin_old(i) - canopy(i) = canopy_old(i) - tprcp(i) = tprcp_old(i) - srflag(i) = srflag_old(i) - - - snowxy(i) = snow_old(i) - tvxy(i) = tv_old(i) - tgxy(i) = tg_old(i) - - canicexy(i) = canice_old(i) - canliqxy(i) = canliq_old(i) - eahxy(i) = eah_old(i) - tahxy(i) = tah_old(i) - fwetxy(i) = fwet_old(i) - sneqvoxy(i) = sneqvo_old(i) - alboldxy(i) = albold_old(i) - qsnowxy(i) = qsnow_old(i) - wslakexy(i) = wslake_old(i) - zwtxy(i) = zwt_old(i) - waxy(i) = wa_old(i) - wtxy(i) = wt_old(i) - lfmassxy(i) = lfmass_old(i) - rtmassxy(i) = rtmass_old(i) - stmassxy(i) = stmass_old(i) - woodxy(i) = wood_old(i) - stblcpxy(i) = stblcp_old(i) - fastcpxy(i) = fastcp_old(i) - xlaixy(i) = xlai_old(i) - xsaixy(i) = xsai_old(i) - taussxy(i) = tauss_old(i) - smcwtdxy(i) = smcwtd_old(i) - deeprechxy(i) = deeprech_old(i) - rechxy(i) = rech_old(i) - - do k = 1, km - smc(i,k) = smc_old(i,k) - stc(i,k) = stc_old(i,k) - slc(i,k) = slc_old(i,k) - enddo -! - do k = 1, km - smoiseq(i,k) = smoiseq_old(i,k) - enddo - - do k = -2,0 - tsnoxy(i,k) = tsno_old(i,k) - snicexy(i,k) = snice_old(i,k) - snliqxy(i,k) = snliq_old(i,k) - enddo - - do k = -2,4 - zsnsoxy(i,k) = zsnso_old(i,k) - enddo - else - tskin(i) = tsurf(i) - endif - endif - enddo -! - return -!................................... - end subroutine noahmpdrv_run -!> @} -!----------------------------------- - -!> \ingroup NoahMP_LSM -!! \brief This subroutine fills in a derived data type of type noahmp_parameters with data -!! from the module \ref noahmp_tables. - subroutine transfer_mp_parameters (vegtype,soiltype,slopetype, & - & soilcolor,parameters) - - use noahmp_tables - use module_sf_noahmplsm - - implicit none - - integer, intent(in) :: vegtype - integer, intent(in) :: soiltype - integer, intent(in) :: slopetype - integer, intent(in) :: soilcolor - - type (noahmp_parameters), intent(out) :: parameters - - real :: refdk - real :: refkdt - real :: frzk - real :: frzfact - - parameters%iswater = iswater_table - parameters%isbarren = isbarren_table - parameters%isice = isice_table - parameters%eblforest = eblforest_table - -!-----------------------------------------------------------------------& - parameters%urban_flag = .false. - if( vegtype == isurban_table .or. vegtype == 31 & - & .or.vegtype == 32 .or. vegtype == 33) then - parameters%urban_flag = .true. - endif - -!------------------------------------------------------------------------------------------! -! transfer veg parameters -!------------------------------------------------------------------------------------------! - - parameters%ch2op = ch2op_table(vegtype) !maximum intercepted h2o per unit lai+sai (mm) - parameters%dleaf = dleaf_table(vegtype) !characteristic leaf dimension (m) - parameters%z0mvt = z0mvt_table(vegtype) !momentum roughness length (m) - parameters%hvt = hvt_table(vegtype) !top of canopy (m) - parameters%hvb = hvb_table(vegtype) !bottom of canopy (m) - parameters%den = den_table(vegtype) !tree density (no. of trunks per m2) - parameters%rc = rc_table(vegtype) !tree crown radius (m) - parameters%mfsno = mfsno_table(vegtype) !snowmelt m parameter () - parameters%saim = saim_table(vegtype,:) !monthly stem area index, one-sided - parameters%laim = laim_table(vegtype,:) !monthly leaf area index, one-sided - parameters%sla = sla_table(vegtype) !single-side leaf area per kg [m2/kg] - parameters%dilefc = dilefc_table(vegtype) !coeficient for leaf stress death [1/s] - parameters%dilefw = dilefw_table(vegtype) !coeficient for leaf stress death [1/s] - parameters%fragr = fragr_table(vegtype) !fraction of growth respiration !original was 0.3 - parameters%ltovrc = ltovrc_table(vegtype) !leaf turnover [1/s] - - parameters%c3psn = c3psn_table(vegtype) !photosynthetic pathway: 0. = c4, 1. = c3 - parameters%kc25 = kc25_table(vegtype) !co2 michaelis-menten constant at 25c (pa) - parameters%akc = akc_table(vegtype) !q10 for kc25 - parameters%ko25 = ko25_table(vegtype) !o2 michaelis-menten constant at 25c (pa) - parameters%ako = ako_table(vegtype) !q10 for ko25 - parameters%vcmx25 = vcmx25_table(vegtype) !maximum rate of carboxylation at 25c (umol co2/m**2/s) - parameters%avcmx = avcmx_table(vegtype) !q10 for vcmx25 - parameters%bp = bp_table(vegtype) !minimum leaf conductance (umol/m**2/s) - parameters%mp = mp_table(vegtype) !slope of conductance-to-photosynthesis relationship - parameters%qe25 = qe25_table(vegtype) !quantum efficiency at 25c (umol co2 / umol photon) - parameters%aqe = aqe_table(vegtype) !q10 for qe25 - parameters%rmf25 = rmf25_table(vegtype) !leaf maintenance respiration at 25c (umol co2/m**2/s) - parameters%rms25 = rms25_table(vegtype) !stem maintenance respiration at 25c (umol co2/kg bio/s) - parameters%rmr25 = rmr25_table(vegtype) !root maintenance respiration at 25c (umol co2/kg bio/s) - parameters%arm = arm_table(vegtype) !q10 for maintenance respiration - parameters%folnmx = folnmx_table(vegtype) !foliage nitrogen concentration when f(n)=1 (%) - parameters%tmin = tmin_table(vegtype) !minimum temperature for photosynthesis (k) - - parameters%xl = xl_table(vegtype) !leaf/stem orientation index - parameters%rhol = rhol_table(vegtype,:) !leaf reflectance: 1=vis, 2=nir - parameters%rhos = rhos_table(vegtype,:) !stem reflectance: 1=vis, 2=nir - parameters%taul = taul_table(vegtype,:) !leaf transmittance: 1=vis, 2=nir - parameters%taus = taus_table(vegtype,:) !stem transmittance: 1=vis, 2=nir - - parameters%mrp = mrp_table(vegtype) !microbial respiration parameter (umol co2 /kg c/ s) - parameters%cwpvt = cwpvt_table(vegtype) !empirical canopy wind parameter - - parameters%wrrat = wrrat_table(vegtype) !wood to non-wood ratio - parameters%wdpool = wdpool_table(vegtype) !wood pool (switch 1 or 0) depending on woody or not [-] - parameters%tdlef = tdlef_table(vegtype) !characteristic t for leaf freezing [k] - - parameters%nroot = nroot_table(vegtype) !number of soil layers with root present - parameters%rgl = rgl_table(vegtype) !parameter used in radiation stress function - parameters%rsmin = rs_table(vegtype) !minimum stomatal resistance [s m-1] - parameters%hs = hs_table(vegtype) !parameter used in vapor pressure deficit function - parameters%topt = topt_table(vegtype) !optimum transpiration air temperature [k] - parameters%rsmax = rsmax_table(vegtype) !maximal stomatal resistance [s m-1] - -!------------------------------------------------------------------------------------------! -! transfer rad parameters -!------------------------------------------------------------------------------------------! - - parameters%albsat = albsat_table(soilcolor,:) - parameters%albdry = albdry_table(soilcolor,:) - parameters%albice = albice_table - parameters%alblak = alblak_table - parameters%omegas = omegas_table - parameters%betads = betads_table - parameters%betais = betais_table - parameters%eg = eg_table - -!------------------------------------------------------------------------------------------! -! transfer global parameters -!------------------------------------------------------------------------------------------! - - parameters%co2 = co2_table - parameters%o2 = o2_table - parameters%timean = timean_table - parameters%fsatmx = fsatmx_table - parameters%z0sno = z0sno_table - parameters%ssi = ssi_table - parameters%swemx = swemx_table - -! ---------------------------------------------------------------------- -! transfer soil parameters -! ---------------------------------------------------------------------- - - parameters%bexp = bexp_table (soiltype) - parameters%dksat = dksat_table (soiltype) - parameters%dwsat = dwsat_table (soiltype) - parameters%f1 = f1_table (soiltype) - parameters%psisat = psisat_table (soiltype) - parameters%quartz = quartz_table (soiltype) - parameters%smcdry = smcdry_table (soiltype) - parameters%smcmax = smcmax_table (soiltype) - parameters%smcref = smcref_table (soiltype) - parameters%smcwlt = smcwlt_table (soiltype) - -! ---------------------------------------------------------------------- -! transfer genparm parameters -! ---------------------------------------------------------------------- - parameters%csoil = csoil_table - parameters%zbot = zbot_table - parameters%czil = czil_table - - frzk = frzk_table - refdk = refdk_table - refkdt = refkdt_table - parameters%kdt = refkdt * parameters%dksat / refdk - parameters%slope = slope_table(slopetype) - - if(parameters%urban_flag)then ! hardcoding some urban parameters for soil - parameters%smcmax = 0.45 - parameters%smcref = 0.42 - parameters%smcwlt = 0.40 - parameters%smcdry = 0.40 - parameters%csoil = 3.e6 - endif - - ! adjust frzk parameter to actual soil type: frzk * frzfact - -!-----------------------------------------------------------------------& - if(soiltype /= 14) then - frzfact = (parameters%smcmax / parameters%smcref) & - & * (0.412 / 0.468) - parameters%frzx = frzk * frzfact - end if - - end subroutine transfer_mp_parameters - -!-----------------------------------------------------------------------& - -!> \ingroup NoahMP_LSM -!! brief Calculate 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 (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil, & - & q2,q2sat,etp,snowng,frzgra,ffrozp, & - & dqsdt2,emissi_in,sncovr) - -! etp is calcuated right after ssoil - -! ---------------------------------------------------------------------- -! subroutine penman -! ---------------------------------------------------------------------- - implicit none - logical, intent(in) :: snowng, frzgra - real, intent(in) :: ch, dqsdt2,fdown,prcp,ffrozp, & - & q2, q2sat,ssoil, sfcprs, sfctmp, & - & t2v, th2,emissi_in,sncovr - real, intent(out) :: etp - real :: epsca,flx2,rch,rr,t24 - real :: a, delta, fnet,rad,rho,emissi,elcp1,lvs - - real, parameter :: elcp = 2.4888e+3, lsubc = 2.501000e+6,cp = 1004.6 - real, parameter :: lsubs = 2.83e+6, rd = 287.05, cph2o = 4.1855e+3 - real, parameter :: cpice = 2.106e+3, lsubf = 3.335e5 - real, parameter :: sigma = 5.6704e-8 - -! ---------------------------------------------------------------------- -! executable code begins here: -! ---------------------------------------------------------------------- -! ---------------------------------------------------------------------- -! prepare partial quantities for penman equation. -! ---------------------------------------------------------------------- - emissi=emissi_in -! elcp1 = (1.0-sncovr)*elcp + sncovr*elcp*lsubs/lsubc - lvs = (1.0-sncovr)*lsubc + sncovr*lsubs - - flx2 = 0.0 - delta = elcp * dqsdt2 -! delta = elcp1 * dqsdt2 - t24 = sfctmp * sfctmp * sfctmp * sfctmp - rr = t24 * 6.48e-8 / (sfcprs * ch) + 1.0 -! rr = emissi*t24 * 6.48e-8 / (sfcprs * ch) + 1.0 - rho = sfcprs / (rd * t2v) - -! ---------------------------------------------------------------------- -! adjust the partial sums / products with the latent heat -! effects caused by falling precipitation. -! ---------------------------------------------------------------------- - rch = rho * cp * ch - if (.not. snowng) then - if (prcp > 0.0) rr = rr + cph2o * prcp / rch - else -! ---- ... fractional snowfall/rainfall - rr = rr + (cpice*ffrozp+cph2o*(1.-ffrozp)) & - & *prcp/rch - end if - -! ---------------------------------------------------------------------- -! include the latent heat effects of frzng rain converting to ice on -! impact in the calculation of flx2 and fnet. -! ---------------------------------------------------------------------- -! fnet = fdown - sigma * t24- ssoil - fnet = fdown - emissi*sigma * t24- ssoil - if (frzgra) then - flx2 = - lsubf * prcp - fnet = fnet - flx2 -! ---------------------------------------------------------------------- -! finish penman equation calculations. -! ---------------------------------------------------------------------- - end if - rad = fnet / rch + th2- sfctmp - a = elcp * (q2sat - q2) -! a = elcp1 * (q2sat - q2) - epsca = (a * rr + rad * delta) / (delta + rr) - etp = epsca * rch / lsubc -! etp = epsca * rch / lvs - -! ---------------------------------------------------------------------- - end subroutine penman - - end module noahmpdrv diff --git a/physics/sfc_noahmp_drv.meta b/physics/sfc_noahmp_drv.meta index 32fc2f15a..c0a6393fa 100644 --- a/physics/sfc_noahmp_drv.meta +++ b/physics/sfc_noahmp_drv.meta @@ -171,18 +171,9 @@ 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_loop_extent) - 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 + standard_name = surface_downwelling_longwave_flux + long_name = surface downwelling longwave flux at current time units = W m-2 dimensions = (horizontal_loop_extent) type = real @@ -869,7 +860,7 @@ standard_name = snow_temperature long_name = snow_temperature units = K - dimensions = (horizontal_loop_extent, -2:0) + dimensions = (horizontal_loop_extent,lower_bound_of_snow_vertical_dimension_for_land_surface_model:upper_bound_of_snow_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -878,7 +869,7 @@ standard_name = layer_bottom_depth_from_snow_surface long_name = depth from the top of the snow surface at the bottom of the layer units = m - dimensions = (horizontal_loop_extent, -2:4) + dimensions = (horizontal_loop_extent,lower_bound_of_snow_vertical_dimension_for_land_surface_model:soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -887,7 +878,7 @@ standard_name = snow_layer_ice long_name = snow_layer_ice units = mm - dimensions = (horizontal_loop_extent, -2:0) + dimensions = (horizontal_loop_extent,lower_bound_of_snow_vertical_dimension_for_land_surface_model:upper_bound_of_snow_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -896,7 +887,7 @@ standard_name = snow_layer_liquid_water long_name = snow layer liquid water units = mm - dimensions = (horizontal_loop_extent, -2:0) + dimensions = (horizontal_loop_extent,lower_bound_of_snow_vertical_dimension_for_land_surface_model:upper_bound_of_snow_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -1018,6 +1009,51 @@ kind = kind_phys intent = inout optional = F +[albdvis] + standard_name = surface_albedo_direct_visible + long_name = direct surface albedo visible band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albdnir] + standard_name = surface_albedo_direct_NIR + long_name = direct surface albedo NIR band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albivis] + standard_name = surface_albedo_diffuse_visible + long_name = diffuse surface albedo visible band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albinir] + standard_name = surface_albedo_diffuse_NIR + long_name = diffuse surface albedo NIR band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[emiss] + standard_name = surface_emissivity_lsm + long_name = surface emissivity from lsm + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F [sncovr1] standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction diff --git a/physics/sfcsub.F b/physics/sfcsub.F index 1a1a8eefa..a84e9aef9 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -801,6 +801,17 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & abssmx = 1.0 abssmn = .01 abslmn = .01 + elseif (ialb ==2) then + kpdabs = kpdabs_1 + kpdalb = kpdalb_1 + alblmx = .99 + albsmx = .99 + alblmn = .01 + albsmn = .01 + abslmx = 1.0 + abssmx = 1.0 + abssmn = .01 + abslmn = .01 else kpdabs = kpdabs_0 kpdalb = kpdalb_0 @@ -876,6 +887,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & enddo ! calbl = 0. !... albedo over land + if (ialb == 2) falbl=99999. if (falbl >= 99999.) calbl = 1. if (falbl > 0. .and. falbl < 99999) calbl = exp(-deltf/falbl) ! @@ -7212,7 +7224,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & cjfe kpd7=-1 - if (ialb == 1) then + if (ialb == 1 .or. ialb == 2) then !cbosu still need facsf and facwf. read them from the production file if ( index(fnalbc2, "tileX.nc") == 0) then ! grib file call fixrdc(lugb,fnalbc2,kpdalf(1),kpd7,kpd9,slmask @@ -7401,7 +7413,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & if (nn .eq. 2) mon = mon2 !cbosu !cbosu new snowfree albedo database is monthly. - if (ialb == 1) then + if (ialb == 1 .or. ialb == 2) then if ( index(fnalbc, "tileX.nc") == 0) then ! grib file kpd7=-1 do k = 1, 4 @@ -7685,7 +7697,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & mon = mon2 nn = k2 !cbosu - if (ialb == 1) then + if (ialb == 1 .or. ialb == 2) then if (me == 0) print*,'bosu 2nd time in clima for month ', & mon, k1,k2 if ( index(fnalbc, "tileX.nc") == 0) then ! grib file @@ -7995,7 +8007,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & if (me == 0) print*,'monthly albedo weights are ', & wei1m,' for k', k1, wei2m, ' for k', k2 - if (ialb == 1) then + if (ialb == 1 .or. ialb == 2) then do k=1,4 do i=1,len albclm(i,k) = wei1m * alb(i,k,k1) + wei2m * alb(i,k,k2)