From 28a920c573b2ad476eefee06a78f18b9ab141e26 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Fri, 13 Aug 2021 16:57:05 +0000 Subject: [PATCH] 1. Changes for fracional grid (frac_grid=.true.) 2. Replace logical variable for lakes from 'lake' to 'use_flake' 3. Added spp code from WRF version of RUC LSM in case it would be needed for RRFS. So far it is not hooked up to SPP weights. --- physics/module_sf_ruclsm.F90 | 19 +++----- physics/sfc_drv_ruc.F90 | 85 ++++++++++++++++++++++++++---------- physics/sfc_drv_ruc.meta | 11 ++++- 3 files changed, 77 insertions(+), 38 deletions(-) diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 1e0ec2fe2..b5238f366 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -708,8 +708,7 @@ SUBROUTINE LSMRUC( & ENDIF !> - Call soilvegin() to initialize soil and surface properties - IF((XLAND(I,J)-1.5).LT.0..and. xice(i,j).lt.xice_threshold)THEN - !-- land + !-- land or ice CALL SOILVEGIN ( debug_print, & soilfrac,nscat,shdmin(i,j),shdmax(i,j),mosaic_lu, mosaic_soil,& NLCAT,ILAND,ISOIL,iswater,MYJ,IFOREST,lufrac,VEGFRA(I,J), & @@ -724,16 +723,10 @@ SUBROUTINE LSMRUC( & print *,'after SOILVEGIN - z0,znt(1,26),lai(1,26)',z0(i,j),znt(i,j),lai(i,j) if(init)then -! print *,'NLCAT,iland,lufrac,EMISSL(I,J),PC(I,J),ZNT(I,J),LAI(I,J)', & -! NLCAT,iland,lufrac,EMISSL(I,J),PC(I,J),ZNT(I,J),LAI(I,J),i,j print *,'NLCAT,iland,EMISSL(I,J),PC(I,J),ZNT(I,J),LAI(I,J)', & NLCAT,iland,EMISSL(I,J),PC(I,J),ZNT(I,J),LAI(I,J),i,j - -! print *,'NSCAT,soilfrac,QWRTZ,RHOCS,BCLH,DQM,KSAT,PSIS,QMIN,REF,WILT',& -! NSCAT,soilfrac,QWRTZ,RHOCS,BCLH,DQM,KSAT,PSIS,QMIN,REF,WILT,i,j print *,'NSCAT,QWRTZ,RHOCS,BCLH,DQM,KSAT,PSIS,QMIN,REF,WILT',& NSCAT,QWRTZ,RHOCS,BCLH,DQM,KSAT,PSIS,QMIN,REF,WILT,i,j - endif ENDIF @@ -784,7 +777,6 @@ SUBROUTINE LSMRUC( & print *,'NROOT, meltfactor, iforest, ivgtyp, i,j ', nroot,meltfactor,iforest,ivgtyp(I,J),I,J ENDIF - ENDIF ! land !!*** SET ZERO-VALUE FOR SOME OUTPUT DIAGNOSTIC ARRAYS ! if(i.eq.397.and.j.eq.562) then ! print *,'RUC LSM - xland(i,j),xice(i,j),snow(i,j)',i,j,xland(i,j),xice(i,j),snow(i,j) @@ -7052,7 +7044,7 @@ END SUBROUTINE SOILVEGIN !> This subroutine computes liquid and forezen soil moisture from the !! total soil moisture, and also computes soil moisture availability in !! the top soil layer. - SUBROUTINE RUCLSMINIT( debug_print, slmsk, & + SUBROUTINE RUCLSMINIT( debug_print, landfrac, fice, min_seaice, & nzs, isltyp, ivgtyp, mavail, & sh2o, smfr3d, tslb, smois, & ims,ime, jms,jme, kms,kme, & @@ -7065,7 +7057,8 @@ SUBROUTINE RUCLSMINIT( debug_print, slmsk, & #endif IMPLICIT NONE LOGICAL, INTENT(IN ) :: debug_print - REAL, DIMENSION( ims:ime), INTENT(IN ) :: slmsk + REAL, DIMENSION( ims:ime), INTENT(IN ) :: landfrac, fice + REAL, INTENT(IN ) :: min_seaice INTEGER, INTENT(IN ) :: & ims,ime, jms,jme, kms,kme, & @@ -7125,7 +7118,7 @@ SUBROUTINE RUCLSMINIT( debug_print, slmsk, & ! has isltyp=14 for water if (isltyp(i,j) == 0) isltyp(i,j)=14 - if(slmsk(i) == 1. ) then + if(landfrac(i) > 0. ) then !-- land !-- Computate volumetric content of ice in soil !-- and initialize MAVAIL @@ -7158,7 +7151,7 @@ SUBROUTINE RUCLSMINIT( debug_print, slmsk, & endif ENDDO - elseif( slmsk(i) == 2.) then + elseif( fice(i) > min_seaice) then !-- ice mavail(i,j) = 1. DO L=1,NZS diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index f20b51141..8f7243fc3 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -33,7 +33,7 @@ module lsm_ruc subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & flag_restart, flag_init, con_fvirt, con_rd, & im, lsoil_ruc, lsoil, kice, nlev, & ! in - lsm_ruc, lsm, slmsk, stype, vtype, & ! in + lsm_ruc, lsm, slmsk, stype, vtype, landfrac, & ! in q1, prsl1, tsfc_lnd, tsfc_ice, tsfc_wat, & ! in tg3, smc, slc, stc, fice, min_seaice, & ! in sncovr_lnd, sncovr_ice, snoalb, & ! in @@ -64,6 +64,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & real (kind=kind_phys), dimension(:), intent(in) :: slmsk real (kind=kind_phys), dimension(:), intent(in) :: stype real (kind=kind_phys), dimension(:), intent(in) :: vtype + real (kind=kind_phys), dimension(:), intent(in) :: landfrac real (kind=kind_phys), dimension(:), intent(in) :: q1 real (kind=kind_phys), dimension(:), intent(in) :: prsl1 real (kind=kind_phys), dimension(:), intent(in) :: tsfc_lnd @@ -168,7 +169,8 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & vegtype(:) = 0 do i = 1, im ! i - horizontal loop - if (slmsk(i) == 2.) then + !if (slmsk(i) == 2.) then + if (fice(i) > min_seaice) then !-- ice if (isot == 1) then soiltyp(i) = 16 @@ -225,8 +227,8 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & call rucinit (flag_restart, im, lsoil_ruc, lsoil, nlev, & ! in me, master, lsm_ruc, lsm, slmsk, & ! in - soiltyp, vegtype, & ! in - tsfc_lnd, tsfc_wat, tg3, & ! in + soiltyp, vegtype, landfrac, fice, & ! in + min_seaice, tsfc_lnd, tsfc_wat, tg3, & ! in zs, dzs, smc, slc, stc, & ! in sh2o, smfrkeep, tslb, smois, & ! out wetness, errmsg, errflg) @@ -346,7 +348,7 @@ subroutine lsm_ruc_run & ! inputs & imp_physics, imp_physics_gfdl, imp_physics_thompson, & & do_mynnsfclay, lsoil_ruc, lsoil, rdlai, zs, & & t1, q1, qc, soiltyp, vegtype, sigmaf, laixy, & - & dlwflx, dswsfc, tg3, coszen, land, icy, lake, & + & dlwflx, dswsfc, tg3, coszen, land, icy, use_lake, & & rainnc, rainc, ice, snow, graupel, & & prsl1, zf, wind, shdmin, shdmax, & & srflag, sfalb_lnd_bck, snoalb, & @@ -414,7 +416,7 @@ subroutine lsm_ruc_run & ! inputs con_hvap, con_fvirt logical, dimension(:), intent(in) :: flag_iter, flag_guess - logical, dimension(:), intent(in) :: land, icy, lake + logical, dimension(:), intent(in) :: land, icy, use_lake logical, dimension(:), intent(in) :: flag_cice logical, intent(in) :: frac_grid logical, intent(in) :: do_mynnsfclay @@ -465,6 +467,10 @@ subroutine lsm_ruc_run & ! inputs character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg +! --- SPP - should be INTENT(IN) + integer :: spp_lsm + real(kind=kind_phys), dimension(im,nlev) :: pattern_spp + ! --- locals: real (kind=kind_phys), dimension(im) :: rho, & & q0, qs1, albbcksol, & @@ -480,6 +486,8 @@ subroutine lsm_ruc_run & ! inputs & sfcqv_ice_old, sfcqc_ice_old, z0rl_ice_old, & & sncovr1_ice_old + !-- local spp pattern array + real (kind=kind_phys), dimension(im,lsoil_ruc,1) :: pattern_spp_lsm real (kind=kind_phys), dimension(lsoil_ruc) :: et @@ -571,7 +579,7 @@ subroutine lsm_ruc_run & ! inputs endif ! - Set flag for ice points for uncoupled model (islmsk(i) == 4 when coupled to CICE) ! - Exclude ice on the lakes if the lake model is turned on. - flag_ice_uncoupled(i) = (flag_ice(i) .and. .not. lake(i)) + flag_ice_uncoupled(i) = (flag_ice(i) .and. .not. use_lake(i)) !> - Set flag for land and ice points. !- 10may19 - ice points are turned off. flag(i) = land(i) .or. flag_ice_uncoupled(i) @@ -622,6 +630,12 @@ subroutine lsm_ruc_run & ! inputs landusef (:,:,:) = 0.0 soilctop (:,:,:) = 0.0 + !-- spp + spp_lsm = 0 ! so far (10May2021) + if(spp_lsm == 0) then + pattern_spp (:,:) = 0.0 + endif + !> -- number of soil categories !if(isot == 1) then !nscat = 19 ! stasgo @@ -852,11 +866,6 @@ subroutine lsm_ruc_run & ! inputs !acsn(i,j) = acsnow(i) acsn(i,j) = 0.0 - ! --- units % - shdfac(i,j) = sigmaf(i)*100. - shdmin1d(i,j) = shdmin(i)*100. - shdmax1d(i,j) = shdmax(i)*100. - tbot(i,j) = tg3(i) !> - 3. canopy/soil characteristics (s): @@ -901,6 +910,10 @@ subroutine lsm_ruc_run & ! inputs endif semis_bck(i,j) = semisbase(i) + ! --- units % + shdfac(i,j) = sigmaf(i)*100. + shdmin1d(i,j) = shdmin(i)*100. + shdmax1d(i,j) = shdmax(i)*100. if (land(i)) then ! at least some land in the grid cell @@ -947,6 +960,27 @@ subroutine lsm_ruc_run & ! inputs snoalb1d_lnd(i,j) = snoalb(i) albbck_lnd(i,j) = albbcksol(i) !sfalb_lnd_bck(i) + + + !-- spp_lsm + if (spp_lsm == 1) then + !-- spp for LSM is dimentioned as (1:lsoil_ruc) + do k = 1, lsoil_ruc + pattern_spp_lsm (i,k,j) = pattern_spp(i,k) + enddo + !-- stochastic perturbation of snow-free albedo, emissivity and veg. + !-- fraction + albbck_lnd(i,j) = min(albbck_lnd(i,j) * (1. + 0.4*pattern_spp_lsm(i,1,j)), 1.) + sfcems_lnd(i,j) = min(sfcems_lnd(i,j) * (1. + 0.1*pattern_spp_lsm(i,1,j)), 1.) + shdfac(i,j) = min(0.01*shdfac(i,j) * (1. + 0.33*pattern_spp_lsm(i,1,j)),1.)*100. + if (kdt == 2) then + !-- stochastic perturbation of soil moisture at time step 2 + do k = 1, lsoil_ruc + smois(i,k) = smois(i,k)*(1+1.5*pattern_spp_lsm(i,k,j)) + enddo + endif + endif + alb_lnd(i,j) = albbck_lnd(i,j) * (1.-sncovr_lnd(i,j)) + snoalb(i) * sncovr_lnd(i,j) ! sfalb_lnd(i) solnet_lnd(i,j) = dswsfc(i)*(1.-alb_lnd(i,j)) !..net sw rad flx (dn-up) at sfc in w/m2 @@ -1486,8 +1520,8 @@ end subroutine lsm_ruc_run !! This subroutine contains RUC LSM initialization. subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in me, master, lsm_ruc, lsm, slmsk, & ! in - soiltyp, vegtype, & ! in - tskin_lnd, tskin_wat, tg3, & ! !in + soiltyp, vegtype, landfrac, fice, & ! in + min_seaice, tskin_lnd, tskin_wat, tg3, & ! in zs, dzs, smc, slc, stc, & ! in sh2o, smfrkeep, tslb, smois, & ! out wetness, errmsg, errflg) @@ -1500,7 +1534,10 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in integer, intent(in ) :: im, nlev integer, intent(in ) :: lsoil_ruc integer, intent(in ) :: lsoil + real (kind=kind_phys), intent(in ) :: min_seaice real (kind=kind_phys), dimension(im), intent(in ) :: slmsk + real (kind=kind_phys), dimension(im), intent(in ) :: landfrac + real (kind=kind_phys), dimension(im), intent(in ) :: fice real (kind=kind_phys), dimension(im), intent(in ) :: tskin_lnd, tskin_wat real (kind=kind_phys), dimension(im), intent(in ) :: tg3 real (kind=kind_phys), dimension(1:lsoil_ruc), intent(in ) :: zs @@ -1658,14 +1695,14 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in tbot(i,j) = tg3(i) ivgtyp(i,j) = vegtype(i) isltyp(i,j) = soiltyp(i) - if (slmsk(i) == 0.) then - !-- water - tsk(i,j) = tskin_wat(i) - landmask(i,j)=0. - else + if (landfrac(i) > 0. .or. fice(i) > 0.) then !-- land or ice tsk(i,j) = tskin_lnd(i) landmask(i,j)=1. + else + !-- water + tsk(i,j) = tskin_wat(i) + landmask(i,j)=0. endif ! land(i) enddo @@ -1680,7 +1717,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in sm_input(i,1,j)=0. !--- initialize smcwlt2 and smcref2 with Noah values - if(slmsk(i) == 1.) then + if(landfrac(i) > 0.) then smcref2 (i) = REFSMCnoah(soiltyp(i)) smcwlt2 (i) = WLTSMCnoah(soiltyp(i)) else @@ -1691,7 +1728,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in do k=1,lsoil st_input(i,k+1,j)=stc(i,k) ! convert volumetric soil moisture to SWI (soil wetness index) - if(slmsk(i) == 1. .and. swi_init) then + if(landfrac(i) > 0. .and. swi_init) then sm_input(i,k+1,j)=min(1.,max(0.,(smc(i,k) - smcwlt2(i))/ & (smcref2(i) - smcwlt2(i)))) else @@ -1726,7 +1763,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in do j=jts,jte do i=its,ite - if (slmsk(i) == 1.) then + if (landfrac(i) == 1.) then !-- land do k=1,lsoil_ruc ! convert from SWI to RUC volumetric soil moisture @@ -1767,7 +1804,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in do j=jts,jte do i=its,ite - if (slmsk(i) == 1.) then + if (landfrac(i) > 0.) then ! initialize factor do k=1,lsoil_ruc @@ -1844,7 +1881,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in ! and soil temperature, and also soil moisture availability in the top ! layer - call ruclsminit( debug_print, slmsk, & + call ruclsminit( debug_print, landfrac, fice, min_seaice, & lsoil_ruc, isltyp, ivgtyp, mavail, & soilh2o, smfr, soiltemp, soilm, & ims,ime, jms,jme, kms,kme, & diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index cf37670fe..fd542b67b 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -164,6 +164,15 @@ kind = kind_phys intent = in optional = F +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [q1] standard_name = water_vapor_specific_humidity_at_lowest_model_layer long_name = water vapor specific humidity at lowest model layer @@ -844,7 +853,7 @@ type = logical intent = in optional = F -[lake] +[use_lake] standard_name = flag_for_using_flake long_name = flag indicating lake points using flake model units = flag