wrfv2_fire/phys/module_sf_idealscmsfclay.F

   1 !WRF:MODEL_LAYER:PHYSICS
   2 !
   3 MODULE module_sf_idealscmsfclay
   4
   5 CONTAINS
   6
   7 !-------------------------------------------------------------------
   8    SUBROUTINE idealscmsfclay(u3d,v3d,th3d,qv3d,p3d,pi3d,rho,z,ht,         &
   9                      cp,g,rovcp,r,xlv,psfc,chs,chs2,cqs2,cpm,      &
  10                      znt,ust,mavail,xland,                         &
  11                      hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,            &
  12                      u10,v10,th2,t2,q2,                            &
  13                      svp1,svp2,svp3,svpt0,ep1,ep2,                 &
  14                      karman,fCor,exch_temf,                          &
  15                      hfx_force, lh_force, tsk_force,               &
  16                      hfx_force_tend, lh_force_tend, tsk_force_tend, &
  17                      dt,itimestep,                                 &
  18                      ids,ide, jds,jde, kds,kde,                    &
  19                      ims,ime, jms,jme, kms,kme,                    &
  20                      its,ite, jts,jte, kts,kte                    &
  21                      )
  22 !-------------------------------------------------------------------
  23       IMPLICIT NONE
  24 !-------------------------------------------------------------------
  25 !-- u3d         3D u-velocity interpolated to theta points (m/s)
  26 !-- v3d         3D v-velocity interpolated to theta points (m/s)
  27 !-- th3d        potential temperature (K)
  28 !-- qv3d        3D water vapor mixing ratio (Kg/Kg)
  29 !-- p3d         3D pressure (Pa)
  30 !-- cp          heat capacity at constant pressure for dry air (J/kg/K)
  31 !-- g           acceleration due to gravity (m/s^2)
  32 !-- rovcp       R/CP
  33 !-- r           gas constant for dry air (J/kg/K)
  34 !-- xlv         latent heat of vaporization for water (J/kg)
  35 !-- psfc        surface pressure (Pa)
  36 !-- chs         heat/moisture exchange coefficient for LSM (m/s)
  37 !-- chs2
  38 !-- cqs2
  39 !-- cpm
  40 !-- znt         roughness length (m)
  41 !-- ust         u* in similarity theory (m/s)
  42 !-- mavail      surface moisture availability (between 0 and 1)
  43 !-- xland       land mask (1 for land, 2 for water)
  44 !-- hfx         upward heat flux at the surface (W/m^2)
  45 !-- qfx         upward moisture flux at the surface (kg/m^2/s)
  46 !-- lh          net upward latent heat flux at surface (W/m^2)
  47 !-- tsk         surface temperature (K)
  48 !-- flhc        exchange coefficient for heat (W/m^2/K)
  49 !-- flqc        exchange coefficient for moisture (kg/m^2/s)
  50 !-- qgh         lowest-level saturated mixing ratio
  51 !-- qsfc        ground saturated mixing ratio
  52 !-- u10         diagnostic 10m u wind
  53 !-- v10         diagnostic 10m v wind
  54 !-- th2         diagnostic 2m theta (K)
  55 !-- t2          diagnostic 2m temperature (K)
  56 !-- q2          diagnostic 2m mixing ratio (kg/kg)
  57 !-- svp1        constant for saturation vapor pressure (kPa)
  58 !-- svp2        constant for saturation vapor pressure (dimensionless)
  59 !-- svp3        constant for saturation vapor pressure (K)
  60 !-- svpt0       constant for saturation vapor pressure (K)
  61 !-- ep1         constant for virtual temperature (R_v/R_d - 1) (dimensionless)
  62 !-- ep2         constant for specific humidity calculation
  63 !               (R_d/R_v) (dimensionless)
  64 !-- karman      Von Karman constant
  65 !-- fCor        Coriolis parameter
  66 !-- ids         start index for i in domain
  67 !-- ide         end index for i in domain
  68 !-- jds         start index for j in domain
  69 !-- jde         end index for j in domain
  70 !-- kds         start index for k in domain
  71 !-- kde         end index for k in domain
  72 !-- ims         start index for i in memory
  73 !-- ime         end index for i in memory
  74 !-- jms         start index for j in memory
  75 !-- jme         end index for j in memory
  76 !-- kms         start index for k in memory
  77 !-- kme         end index for k in memory
  78 !-- its         start index for i in tile
  79 !-- ite         end index for i in tile
  80 !-- jts         start index for j in tile
  81 !-- jte         end index for j in tile
  82 !-- kts         start index for k in tile
  83 !-- kte         end index for k in tile
  84 !-------------------------------------------------------------------
  85       INTEGER,  INTENT(IN )   ::        ids,ide, jds,jde, kds,kde, &
  86                                         ims,ime, jms,jme, kms,kme, &
  87                                         its,ite, jts,jte, kts,kte
  88 !
  89       REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
  90                 INTENT(IN   ) :: u3d, v3d, th3d, qv3d, p3d, pi3d, rho, z
  91       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
  92                 INTENT(IN   ) :: mavail, xland, fCor, ht, psfc, znt
  93       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
  94                 INTENT(INOUT) :: hfx, qfx, lh, flhc, flqc, tsk
  95       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
  96                 INTENT(INOUT) :: ust, chs2, cqs2, chs, cpm, qgh, qsfc
  97       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
  98                 INTENT(OUT  ) :: u10, v10, th2, t2, q2
  99       REAL,     DIMENSION( ims:ime, jms:jme )           , &
 100                 INTENT(  OUT) :: exch_temf
 101
 102       REAL,     INTENT(INOUT) :: hfx_force, lh_force, tsk_force
 103       REAL,     INTENT(IN   ) :: hfx_force_tend, lh_force_tend, tsk_force_tend
 104       REAL,     INTENT(IN   ) :: dt
 105       INTEGER,  INTENT(IN   ) :: itimestep
 106
 107       REAL,     INTENT(IN   ) :: cp,g,rovcp,r,xlv
 108       REAL,     INTENT(IN   ) :: svp1,svp2,svp3,svpt0
 109       REAL,     INTENT(IN   ) :: ep1,ep2,karman
 110 !
 111 ! LOCAL VARS
 112
 113       INTEGER ::  J
 114 !
 115 ! WA 1/6/10 This routine just populates HFX, QFX, and TSK
 116 ! with the suitable converted forcing values.
 117 ! Note that flhc,flqc are not populated, this will NOT WORK with
 118 ! an LSM.
 119
 120    ! Update forcing fluxes to the current timestep
 121    hfx_force = hfx_force + dt*hfx_force_tend
 122    lh_force  = lh_force  + dt*lh_force_tend
 123    tsk_force = tsk_force + dt*tsk_force_tend
 124
 125       DO J=jts,jte
 126
 127         CALL idealscmsfclay1d(j,u1d=u3d(ims,kms,j),v1d=v3d(ims,kms,j),     &
 128                 th1d=th3d(ims,kms,j),qv1d=qv3d(ims,kms,j),p1d=p3d(ims,kms,j), &
 129                 pi1d=pi3d(ims,kms,j),rho=rho(ims,kms,j),z=z(ims,kms,j),&
 130                 zsrf=ht(ims,j),      &
 131                 cp=cp,g=g,rovcp=rovcp,r=r,xlv=xlv,psfc=psfc(ims,j),    &
 132                 chs=chs(ims,j),chs2=chs2(ims,j),cqs2=cqs2(ims,j),      &
 133                 cpm=cpm(ims,j),znt=znt(ims,j),ust=ust(ims,j),          &
 134                 mavail=mavail(ims,j),xland=xland(ims,j),    &
 135                 hfx=hfx(ims,j),qfx=qfx(ims,j),lh=lh(ims,j),tsk=tsk(ims,j), &
 136                 flhc=flhc(ims,j),flqc=flqc(ims,j),qgh=qgh(ims,j),      &
 137                 qsfc=qsfc(ims,j),u10=u10(ims,j),v10=v10(ims,j),        &
 138                 th2=th2(ims,j),t2=t2(ims,j),q2=q2(ims,j),        &
 139                 svp1=svp1,svp2=svp2,svp3=svp3,svpt0=svpt0,             &
 140                 ep1=ep1,ep2=ep2,karman=karman,fCor=fCor(ims,j),  &
 141                 exch_temfx=exch_temf(ims,j),                     &
 142                 hfx_force=hfx_force,lh_force=lh_force,tsk_force=tsk_force, &
 143                 hfx_force_tend=hfx_force_tend,                         &
 144                 lh_force_tend=lh_force_tend,                           &
 145                 tsk_force_tend=tsk_force_tend,                         &
 146                 dt=dt,itimestep=itimestep,                             &
 147                 ids=ids,ide=ide, jds=jds,jde=jde, kds=kds,kde=kde,     &
 148                 ims=ims,ime=ime, jms=jms,jme=jme, kms=kms,kme=kme,     &
 149                 its=its,ite=ite, jts=jts,jte=jte, kts=kts,kte=kte      &
 150                                                                    )
 151       ENDDO
 152
 153    END SUBROUTINE idealscmsfclay
 154
 155
 156 !-------------------------------------------------------------------
 157    SUBROUTINE idealscmsfclay1d(j,u1d,v1d,th1d,qv1d,p1d, &
 158                 pi1d,rho,z,zsrf,cp,g,rovcp,r,xlv,psfc,    &
 159                 chs,chs2,cqs2,cpm,znt,ust,          &
 160                 mavail,xland,hfx,qfx,lh,tsk, &
 161                 flhc,flqc,qgh,qsfc,u10,v10,        &
 162                 th2,t2,q2,svp1,svp2,svp3,svpt0,             &
 163                 ep1,ep2,karman,fCor,  &
 164                 exch_temfx,           &
 165                 hfx_force,lh_force,tsk_force, &
 166                 hfx_force_tend,lh_force_tend,tsk_force_tend, &
 167                 dt,itimestep,                                 &
 168                 ids,ide, jds,jde, kds,kde,                    &
 169                 ims,ime, jms,jme, kms,kme,                    &
 170                 its,ite, jts,jte, kts,kte                    &
 171                      )
 172 !!-------------------------------------------------------------------
 173       IMPLICIT NONE
 174 !!-------------------------------------------------------------------
 175       INTEGER,  INTENT(IN   ) ::        ids,ide, jds,jde, kds,kde, &
 176                                         ims,ime, jms,jme, kms,kme, &
 177                                         its,ite, jts,jte, kts,kte, &
 178                                         j
 179
 180       REAL,     DIMENSION( ims:ime ), INTENT(IN   ) ::             &
 181                                         u1d,v1d,qv1d,p1d,th1d,pi1d,rho,z,zsrf
 182       REAL,     INTENT(IN   ) ::        cp,g,rovcp,r,xlv
 183       REAL,     DIMENSION( ims:ime ), INTENT(IN   ) :: psfc,znt
 184       REAL,     DIMENSION( ims:ime ), INTENT(INOUT) ::             &
 185                                         chs,chs2,cqs2,cpm,ust
 186       REAL,     DIMENSION( ims:ime ), INTENT(IN   ) :: mavail,xland
 187       REAL,     DIMENSION( ims:ime ), INTENT(INOUT) ::             &
 188                                         hfx,qfx,lh
 189       REAL,     DIMENSION( ims:ime ), INTENT(INOUT) :: tsk
 190       REAL,     DIMENSION( ims:ime ), INTENT(  OUT) ::             &
 191                                         flhc,flqc
 192       REAL,     DIMENSION( ims:ime ), INTENT(INOUT) ::             &
 193                                         qgh,qsfc
 194       REAL,     DIMENSION( ims:ime ), INTENT(  OUT) ::             &
 195                                         u10,v10,th2,t2,q2
 196       REAL,     INTENT(IN   ) ::        svp1,svp2,svp3,svpt0
 197       REAL,     INTENT(IN   ) ::        ep1,ep2,karman
 198       REAL,     DIMENSION( ims:ime ), INTENT(IN   ) :: fCor
 199       REAL,     DIMENSION( ims:ime ), INTENT(  OUT) :: exch_temfx
 200       REAL,     INTENT(INOUT) ::        hfx_force,lh_force,tsk_force
 201       REAL,     INTENT(IN   ) ::   hfx_force_tend,lh_force_tend,tsk_force_tend
 202       REAL,     INTENT(IN   ) :: dt
 203       INTEGER,  INTENT(IN   ) :: itimestep
 204 !
 205 !! LOCAL VARS
 206 ! TE model constants
 207    logical, parameter :: MFopt = .true.  ! Use mass flux or not
 208    real, parameter :: TEmin = 1e-3
 209    real, parameter :: ftau0 = 0.17
 210    real, parameter :: fth0 = 0.145
 211    real, parameter :: Cf = 0.185
 212    real, parameter :: CN = 2.0
 213 !   real, parameter :: Ceps = ftau0**1.5
 214    real, parameter :: Ceps = 0.070
 215    real, parameter :: Cgamma = Ceps
 216    real, parameter :: Cphi = Ceps
 217 !   real, parameter :: PrT0 = Cphi/Ceps * ftau0**2. / 2 / fth0**2.
 218    real, parameter :: PrT0 = Cphi/Ceps * ftau0**2 / 2. / fth0**2
 219 !
 220    integer :: i
 221    real :: e1
 222    real, dimension( its:ite)    ::  wstr, wm
 223    real, dimension( its:ite)    ::  z0t
 224    real, dimension( its:ite) :: dthdz, dqtdz, dudz, dvdz
 225    real, dimension( its:ite) :: lepsmin
 226    real, dimension( its:ite) :: thetav
 227    real, dimension( its:ite) :: N2, S, Ri, beta, fth, ratio
 228    real, dimension( its:ite) :: TKE, TE2
 229    real, dimension( its:ite) :: ustrtilde, linv
 230    real, dimension( its:ite) :: km, kh
 231    real, dimension( its:ite) :: qsfc_air
 232 !!-------------------------------------------------------------------
 233
 234 !!!!!!! ******
 235 ! WA Known outages:  None
 236
 237    do i = its,ite      ! Main loop
 238
 239       ! WA 1/6/10 This routine just populates HFX, QFX, and TSK
 240       ! with the suitable converted forcing values.
 241
 242       ! Populate surface heat and moisture fluxes
 243       hfx(i) = hfx_force
 244       lh(i)  = lh_force
 245       qfx(i) = lh(i) / xlv
 246       tsk(i) = tsk_force
 247
 248       ! Populate exchange coefficients
 249       flhc(i) = hfx(i) / (tsk(i) - th1d(i)*pi1d(i))
 250       exch_temfx(i)  = flhc(i) / (rho(i) * cp)
 251       ! flqc(i) = qfx(i) / (qsfc_air(i) - qv1d(i))
 252       flqc(i) = exch_temfx(i) * mavail(i)
 253
 254    end do  ! Main loop
 255
 256    END SUBROUTINE idealscmsfclay1d
 257
 258 !====================================================================
 259    SUBROUTINE idealscmsfclayinit( allowed_to_read )
 260
 261    LOGICAL , INTENT(IN)      ::      allowed_to_read
 262
 263    END SUBROUTINE idealscmsfclayinit
 264
 265 !-------------------------------------------------------------------
 266
 267 END MODULE module_sf_idealscmsfclay