hydro/CPL/WRF_cpl/module_wrf_HYDRO_downscale.F

   1 !  Program Name:
   2 !  Author(s)/Contact(s):
   3 !  Abstract:
   4 !  History Log:
   5 !  <brief list of changes to this source file>
   6 !
   7 !  Usage:
   8 !  Parameters: <Specify typical arguments passed>
   9 !  Input Files:
  10 !        <list file names and briefly describe the data they include>
  11 !  Output Files:
  12 !        <list file names and briefly describe the information they include>
  13 !
  14 !  Condition codes:
  15 !        <list exit condition or error codes returned >
  16 !        If appropriate, descriptive troubleshooting instructions or
  17 !        likely causes for failures could be mentioned here with the
  18 !        appropriate error code
  19 !
  20 !  User controllable options: <if applicable>
  21
  22 module module_WRF_HYDRO
  23
  24 #ifdef MPP_LAND
  25     use module_mpp_land, only: global_nx, global_ny, decompose_data_real, &
  26                  write_io_real, my_id, mpp_land_bcast_real1, IO_id, &
  27                 mpp_land_bcast_real, mpp_land_bcast_int1
  28 #endif
  29     use module_HYDRO_drv, only: HYDRO_ini, HYDRO_exe
  30
  31     use module_rt_data, only:  rt_domain
  32     use module_CPL_LAND, only: cpl_outdate
  33     use config_base, only: nlst
  34     USE module_domain, ONLY : domain, domain_clock_get
  35
  36     implicit none
  37
  38     !yw   added for check soil moisture and soiltype
  39     integer ::  checkSOIL_flag
  40
  41 !
  42 ! added to consider the adaptive time step from WRF model.
  43     real    :: dtrt0
  44     integer ::  mm0, itime
  45
  46
  47
  48
  49 CONTAINS
  50
  51 !wrf_cpl_HYDRO_finescale will not call the off-line lsm
  52     subroutine wrf_cpl_HYDRO_finescale(HYDRO_dt,grid,its,ite,jts,jte)
  53        use module_NoahMP_hrldas_driver, only: noah_timestep , land_driver_ini
  54        implicit none
  55        TYPE ( domain ), INTENT(INOUT) :: grid
  56        integer its, ite, jts, jte, ij
  57        real :: HYDRO_dt
  58
  59
  60         integer k, ix,jx, mm
  61
  62         integer ::  did
  63
  64         integer ntime
  65
  66         integer :: i,j
  67
  68
  69 !output flux and state variable
  70
  71         did = 1
  72         ix = ite - its + 1
  73         jx = jte - jts + 1
  74
  75         if(HYDRO_dt .le. 0) then
  76              write(6,*) "Warning: HYDRO_dt <= 0 from land input. set it to be 1 seconds."
  77              HYDRO_dt = 1
  78         endif
  79
  80         ntime = 1
  81
  82
  83             nlst(did)%dt = HYDRO_dt
  84
  85         itime = itime + 1
  86         if(.not. RT_DOMAIN(did)%initialized) then
  87            itime = 1
  88
  89            nlst(did)%nsoil = grid%num_soil_layers
  90
  91 #ifdef MPP_LAND
  92            call mpp_land_bcast_int1 (nlst(did)%nsoil)
  93 #endif
  94            allocate(nlst(did)%zsoil8(nlst(did)%nsoil))
  95            if(grid%zs(1) <  0) then
  96               nlst(did)%zsoil8(1:nlst(did)%nsoil) = grid%zs(1:nlst(did)%nsoil)
  97            else
  98               nlst(did)%zsoil8(1:nlst(did)%nsoil) = -1*grid%zs(1:nlst(did)%nsoil)
  99            endif
 100
 101             CALL domain_clock_get( grid, current_timestr=cpl_outdate)
 102             nlst(did)%startdate(1:19) = cpl_outdate(1:19)
 103             nlst(did)%olddate(1:19) = cpl_outdate(1:19)
 104
 105 !yw continue
 106
 107             call land_driver_ini(nn,its,ite,jts,jte)
 108
 109 #ifdef HYDRO_D
 110                write(6,*) "sf_surface_physics is ", grid%sf_surface_physics
 111 #endif
 112             nlst(did)%startdate(1:19) = cpl_outdate(1:19)
 113             nlst(did)%olddate(1:19) = cpl_outdate(1:19)
 114
 115             nlst(did)%dt = HYDRO_dt
 116             noah_timestep = nlst(did)%dt
 117
 118             if(nlst(did)%dtrt .lt. HYDRO_dt) then
 119                nlst(did)%dtrt = HYDRO_dt
 120                mm0 = 1
 121             else
 122                mm = HYDRO_dt/nlst(did)%dtrt
 123                if(mm*nlst(did)%dtrt .lt. HYDRO_dt) nlst(did)%dtrt = HYDRO_dt/mm
 124                mm0 = mm
 125             endif
 126
 127             dtrt0 = nlst(did)%dtrt
 128         endif
 129
 130             if((mm0*nlst(did)%dtrt) .ne. HYDRO_dt) then   ! WRF model time step changed.
 131                if(dtrt0 .lt. HYDRO_dt) then
 132                   nlst(did)%dtrt = HYDRO_dt
 133                   mm0 = 1
 134                else
 135                   mm = HYDRO_dt/dtrt0
 136                   if(mm*dtrt0 .lt. HYDRO_dt) nlst(did)%dtrt = HYDRO_dt/mm
 137                   mm0 = mm
 138                endif
 139             endif
 140
 141 #ifdef HYDRO_D
 142         write(6,*) "mm, nlst(did)%dt = ",mm, nlst(did)%dt
 143 #endif
 144
 145 ! get forcing data from WRF
 146          call wrf2l_finemesh(grid,its,ite,jts,jte)
 147
 148          call HYDRO_land_finemesh_exe(itime)
 149
 150          call l_finemesh2wrf(grid)
 151
 152          RT_DOMAIN(did)%initialized = .true.
 153
 154      end subroutine wrf_cpl_HYDRO_finescale
 155
 156 ! get the forcing data from WRF
 157 subroutine wrf2l_finemesh(,its,ite,jts,jte, T_PHY0,U_PHY0,V_PHY0,p_hyd_w0,RAINBL0,QV_CURR0,LAI0,VEGFRA0, &
 158           emiss0, albedo0   )
 159        use module_NoahMP_hrldas_driver, only: P8W, T_PHY, U_PHY, V_PHY, QV_CURR, RAINBL_tmp, LAI, VEGFRA, finemesh,finemesh_factor, &
 160               emiss,albedo
 161
 162        implicit none
 163        real, domain(:,:),INTENT(IN) :: T_PHY0,U_PHY0,V_PHY0,p_hyd_w0,RAINBL0,QV_CURR0,LAI0,VEGFRA0, &
 164              emiss0, albedo0, TSK0,HFX0, QFX0,LH0,GRDFLX0,SMSTAV0,SMSTOT0,SFCRUNOFF0, UDRUNOFF0, SNOWC0, SMOIS0, SH2O0, &
 165              TSLB0, SNOW0,SNOWH0,CANWAT0,ACSNOM0,ACSNOW0,QSFC0,ISNOWXY0,TVXY0,TGXY0,CANICEXY0,CANLIQXY0,EAHXY0,TAHXY0,CMXY0, &
 166              CHXY0,FWETXY0,SNEQVOXY0,ALBOLDXY0,QSNOWXY0,WSLAKEXY0,ZWTXY0,WAXY0,WTXY0,TSNOXY0,ZSNSOXY0,SNICEXY0,SNLIQXY0, &
 167              LFMASSXY0,RTMASSXY0,STMASSXY0,WOODXY0,STBLCPXY0,FASTCPXY0,XLAIXY0,XSAIXY0,TAUSSXY0,SMOISEQ0,SMCWTDXY0,DEEPRECHXY0, &
 168              RECHXY0, &
 169
 170        integer, intent(in):: its,ite,jts,jte
 171        call wrf2finegrid(T_PHY0(its:ite,jts:jte), T_PHY(:,1,:),ite-its+1,jte-jts+1,finemesh_factor)
 172        call wrf2finegrid(U_PHY0(its:ite,jts:jte), U_PHY(:,1,:),ite-its+1,jte-jts+1,finemesh_factor)
 173        call wrf2finegrid(V_PHY0(its:ite,jts:jte), V_PHY(:,1,:),ite-its+1,jte-jts+1,finemesh_factor)
 174        call wrf2finegrid(p_hyd_w0(its:ite,jts:jte), P8W(:,1,:),ite-its+1,jte-jts+1,finemesh_factor)
 175        call wrf2finegrid(RAINBL0(its:ite,jts:jte), RAINBL_tmp,ite-its+1,jte-jts+1,finemesh_factor)
 176        call wrf2finegrid(QV_CURR0(its:ite,jts:jte), QV_CURR(:,1,:),ite-its+1,jte-jts+1,finemesh_factor)
 177 !  update some varialbes.
 178        if(finemesh .ne. 1) then   ! update the LAI and VEGFRA for each time step. Note: this is from the WRF grid.
 179            call wrf2finegrid(albedo0(its:ite,jts:jte), albedo)
 180            call wrf2finegrid(emiss0(its:ite,jts:jte), emiss)
 181            call wrf2finegrid(LAI0(its:ite,jts:jte), LAI)
 182            call wrf2finegrid(VEGFRA0(its:ite,jts:jte), VEGFRA)
 183        endif
 184 end subroutine wrf2l_finemesh
 185
 186 subroutine l_finemesh2wrf(T_PHY0,U_PHY0,V_PHY0,p_hyd_w0,RAINBL0,QV_CURR0,LAI0,VEGFRA0,its,ite,jts,jte)
 187    use module_NoahMP_hrldas_driver, only: P8W, T_PHY, U_PHY, V_PHY, QV_CURR, RAINBL_tmp, LAI, VEGFRA, finemesh,finemesh_factor
 188    implicit none
 189 !variable for output only
 190    real,dimension(:,:), intent(out)::   T2MVXY0,T2MBXY0,Q2MVXY0,Q2MBXY0,TRADXY0,NEEXY0,GPPXY0,NPPXY0,FVEGXY0,RUNSFXY0,  &
 191              RUNSBXY0,ECANXY0,EDIRXY0,ETRANXY0,FSAXY0,&
 192              FIRAXY0,APARXY0,PSNXY0,SAVXY0,SAGXY0,RSSUNXY0,RSSHAXY0,BGAPXY0,WGAPXY0,TGVXY0,TGBXY0,CHVXY0,CHBXY0,SHGXY0,SHCXY0,SHBXY0, &
 193              EVGXY0,EVBXY0,GHVXY0,GHBXY0,IRGXY0,IRCXY0,IRBXY0,TRXY0,EVCXY0,CHLEAFXY0,CHUCXY0,CHV2XY0,CHB2XY0
 194
 195          call finegrid2wrf(T2MVXY,T2MVXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 196          call finegrid2wrf(T2MBXY,tt0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 197          call finegrid2wrf(FVEGXY,FVEGXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 198          call finegrid2wrf(Q2MVXY,Q2MVXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 199          call finegrid2wrf(Q2MBXY,Q2MBXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 200       if(finemesh .ne. 1) then
 201          call finegrid2wrf(TRADXY,TRADXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 202          call finegrid2wrf(NEEXY,NEEXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 203          call finegrid2wrf(GPPXY,GPPXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 204          call finegrid2wrf(NPPXY,NPPXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 205          call finegrid2wrf(RUNSFXY,RUNSFXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 206          call finegrid2wrf(RUNSBXY,RUNSBXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 207          call finegrid2wrf(ECANXY,ECANXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 208          call finegrid2wrf(EDIRXY,EDIRXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 209          call finegrid2wrf(ETRANXY,ETRANXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 210          call finegrid2wrf(FSAXY,FSAXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 211          call finegrid2wrf(FIRAXY,FIRAXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 212          call finegrid2wrf(APARXY,APARXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 213          call finegrid2wrf(PSNXY,PSNXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 214          call finegrid2wrf(SAVXY,SAVXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 215          call finegrid2wrf(SAGXY,SAGXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 216          call finegrid2wrf(RSSUNXY,RSSUNXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 217          call finegrid2wrf(RSSHAXY,RSSHAXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 218          call finegrid2wrf(BGAPXY,BGAPXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 219          call finegrid2wrf(WGAPXY,WGAPXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 220          call finegrid2wrf(TGVXY,TGVXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 221
 222          call finegrid2wrf(TGBXY,TGBXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 223          call finegrid2wrf(CHVXY,CHVXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 224          call finegrid2wrf(CHBXY,CHBXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 225          call finegrid2wrf(SHGXY,SHGXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 226          call finegrid2wrf(SHCXY,SHCXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 227          call finegrid2wrf(SHBXY,SHBXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 228          call finegrid2wrf(EVGXY,EVGXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 229          call finegrid2wrf(EVBXY,EVBXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 230          call finegrid2wrf(GHVXY,GHVXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 231          call finegrid2wrf(GHBXY,GHBXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 232          call finegrid2wrf(IRGXY,IRGXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 233          call finegrid2wrf(IRCXY,IRCXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 234          call finegrid2wrf(IRBXY,IRBXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 235          call finegrid2wrf(TRXY,TRXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 236          call finegrid2wrf(EVCXY,EVCXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 237          call finegrid2wrf(CHLEAFXY,CHLEAFXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 238          call finegrid2wrf(CHUCXY,CHUCXY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 239          call finegrid2wrf(CHV2XY,CHV2XY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 240          call finegrid2wrf(CHB2XY,CHB2XY0(its:ite,jts:jte),ite-its+1,jte-jts+1,finemesh_factor)
 241       endif
 242 end subroutine l_finemesh2wrf
 243
 244 subroutine wrf2finegrid(wrfGrid,fineGrid,ix,jx,AGGFACTRT)
 245    implicit none
 246    real, dimension(:,:), intent(in)::wrfGrid
 247    real, dimension(:,:), intent(out)::fineGrid
 248    integer:: i,j,ii,jj,ix,jx, AGGFACTRT
 249    do j = 1, jx
 250       do i = 1, ix
 251               do ii       =AGGFACTRT-1,0,-1
 252               do jj       =AGGFACTRT-1,0,-1
 253                   IXXRT=I*AGGFACTRT-ii
 254                   JYYRT=J*AGGFACTRT-jj
 255                   fineGrid(ixxrt,jyyrt) = wrfGrid(i,j)
 256               enddo
 257               enddo
 258       enddo ! end do loop for ix
 259    enddo ! end do loop for jx
 260 end subroutine wrf2finegrid
 261
 262 subroutine finegrid2wrf(fineGrid,wrfGrid,ix,jx,AGGFACTRT)
 263    implicit none
 264    real, dimension(:,:), intent(out)::wrfGrid
 265    real, dimension(:,:), intent(in)::fineGrid
 266    integer:: i,j,ii,jj,ix,jx, AGGFACTRT
 267    do j = 1, jx
 268       do i = 1, ix
 269               wrfGrid(k,j) = 0.0
 270               do ii       =AGGFACTRT-1,0,-1
 271               do jj       =AGGFACTRT-1,0,-1
 272                   IXXRT=I*AGGFACTRT-ii
 273                   JYYRT=J*AGGFACTRT-jj
 274                   wrfGrid(i,j) = wrfGrid(i,j) + fineGrid(ixxrt,jyyrt)
 275               enddo
 276               enddo
 277               wrfGrid(i,j) = wrfGrid(i,j) / (AGGFACTRT*AGGFACTRT)
 278       enddo ! end do loop for ix
 279    enddo ! end do loop for jx
 280 end subroutine finegrid2wrf
 281
 282
 283
 284 !program drive rtland
 285 ! This subroutine will be used if the 4-layer Noah lsm is not used.
 286       subroutine wrf2lsm (z1,v1,kk1,z,vout,ix,jx,kk,vegtyp)
 287 !  input: z1,v1,kk1,z,ix,jx,kk
 288 !  output: vout
 289 !  interpolate based on soil layer: z1 and z
 290 !  z :  soil layer of output variable.
 291 !  z1: array of soil layers of input variable.
 292          implicit none
 293          integer:: i,j,k
 294          integer:: kk1, ix,jx,kk, vegtyp(ix,jx)
 295          real :: z1(kk1), z(kk), v1(ix,kk1,jx),vout(ix,jx,kk)
 296
 297
 298          do j = 1, jx
 299             do i = 1, ix
 300                 do k = 1, kk
 301                   call interpLayer(Z1,v1(i,1:kk1,j),kk1,Z(k),vout(i,j,k))
 302                 end do
 303             end do
 304          end do
 305       end subroutine wrf2lsm
 306
 307 ! This subroutine will be used if the 4-layer Noah lsm is not used.
 308       subroutine lsm2wrf (z1,v1,kk1,z,vout,ix,jx,kk,vegtyp)
 309 !  input: z1,v1,kk1,z,ix,jx,kk
 310 !  output: vout
 311 !  interpolate based on soil layer: z1 and z
 312 !  z :  soil layer of output variable.
 313 !  z1: array of soil layers of input variable.
 314          implicit none
 315          integer:: i,j,k
 316          integer:: kk1, ix,jx,kk, vegtyp(ix,jx)
 317          real :: z1(kk1), z(kk), v1(ix,jx,kk1),vout(ix,kk,jx)
 318
 319
 320          do j = 1, jx
 321             do i = 1, ix
 322                  do k = 1, kk
 323                     call interpLayer(Z1,v1(i,j,1:kk1),kk1,Z(k),vout(i,k,j))
 324                  end do
 325             end do
 326          end do
 327       end subroutine lsm2wrf
 328
 329       subroutine interpLayer(inZ,inV,inK,outZ,outV)
 330          implicit none
 331          integer:: k, k1, k2
 332          integer :: inK
 333          real:: inV(inK),inZ(inK)
 334          real:: outV, outZ, w1, w2
 335
 336          if(outZ .le. inZ(1)) then
 337              w1 = (inZ(2)-outZ)/(inZ(2)-inZ(1))
 338              w2 = (inZ(1)-outZ)/(inZ(2)-inZ(1))
 339              outV = inV(1)*w1-inV(2)*w2
 340              return
 341          elseif(outZ .ge. inZ(inK)) then
 342              w1 = (outZ-inZ(inK-1))/(inZ(inK)-inZ(inK-1))
 343              w2 = (outZ-inZ(inK))  /(inZ(inK)-inZ(inK-1))
 344              outV = inV(inK)*w1 -inV(inK-1)* w2
 345              return
 346          else
 347             do k = 2, inK
 348              if((inZ(k) .ge. outZ).and.(inZ(k-1) .le. outZ) ) then
 349                 k1  = k-1
 350                 k2 = k
 351                 w1 = (outZ-inZ(k1))/(inZ(k2)-inZ(k1))
 352                 w2 = (inZ(k2)-outZ)/(inZ(k2)-inZ(k1))
 353                 outV = inV(k2)*w1 + inV(k1)*w2
 354                 return
 355              end if
 356             end do
 357          endif
 358       end subroutine interpLayer
 359
 360       subroutine lsm_wrf_input(did,vegtyp,soltyp,ix,jx)
 361          implicit none
 362          integer did, leng
 363          parameter(leng=100)
 364          integer :: i,j, nn, ix,jx
 365          integer, dimension(ix,jx) :: soltyp, vegtyp
 366          real, dimension(leng) :: xdum1, MAXSMC,refsmc,wltsmc
 367
 368
 369          where(soltyp == 14) VEGTYP = 16
 370          where(VEGTYP == 16 ) soltyp = 14
 371
 372          RT_DOMAIN(did)%VEGTYP = vegtyp
 373
 374 !      input OV_ROUGH from OVROUGH.TBL
 375 #ifdef MPP_LAND
 376        if(my_id .eq. IO_id) then
 377 #endif
 378
 379 #ifndef NCEP_WCOSS
 380        open(71,file="HYDRO.TBL", form="formatted")
 381 !read OV_ROUGH first
 382           read(71,*) nn
 383           read(71,*)
 384           do i = 1, nn
 385              read(71,*) RT_DOMAIN(did)%OV_ROUGH(i)
 386           end do
 387 !read parameter for LKSAT
 388           read(71,*) nn
 389           read(71,*)
 390           do i = 1, nn
 391              read(71,*) xdum1(i), MAXSMC(i),refsmc(i),wltsmc(i)
 392           end do
 393        close(71)
 394 #else
 395
 396        open(13, form="formatted")
 397 !read OV_ROUGH first
 398           read(13,*) nn
 399           read(13,*)
 400           do i = 1, nn
 401              read(13,*) RT_DOMAIN(did)%OV_ROUGH(i)
 402           end do
 403 !read parameter for LKSAT
 404           read(13,*) nn
 405           read(13,*)
 406           do i = 1, nn
 407              read(13,*) xdum1(i), MAXSMC(i),refsmc(i),wltsmc(i)
 408           end do
 409        close(13)
 410 #endif
 411
 412 #ifdef MPP_LAND
 413        endif
 414        call mpp_land_bcast_real(leng,RT_DOMAIN(did)%OV_ROUGH)
 415        call mpp_land_bcast_real(leng,xdum1)
 416        call mpp_land_bcast_real(leng,MAXSMC)
 417        call mpp_land_bcast_real(leng,refsmc)
 418        call mpp_land_bcast_real(leng,wltsmc)
 419 #endif
 420
 421        rt_domain(did)%lksat = 0.0
 422        do j = 1, RT_DOMAIN(did)%jx
 423              do i = 1, RT_DOMAIN(did)%ix
 424                 rt_domain(did)%lksat(i,j) = xdum1(soltyp(i,j) ) * 1000.0
 425                 IF(rt_domain(did)%VEGTYP(i,j) == 1 ) THEN   ! urban
 426                     rt_domain(did)%SMCMAX1(i,j) = 0.45
 427                     rt_domain(did)%SMCREF1(i,j) = 0.42
 428                     rt_domain(did)%SMCWLT1(i,j) = 0.40
 429                 else
 430                     rt_domain(did)%SMCMAX1(i,j) = MAXSMC(soltyp(I,J))
 431                     rt_domain(did)%SMCREF1(i,j) = refsmc(soltyp(I,J))
 432                     rt_domain(did)%SMCWLT1(i,j) = wltsmc(soltyp(I,J))
 433                 ENDIF
 434              end do
 435        end do
 436
 437       end subroutine lsm_wrf_input
 438
 439 end module module_wrf_HYDRO