phys/module_sf_pxsfclay.F

   1 !WRF:MODEL_LAYER:PHYSICS
   2 !
   3 MODULE module_sf_pxsfclay
   4
   5  REAL    , PARAMETER ::  RICRIT = 0.25            !critical Richardson number
   6  REAL    , PARAMETER ::  BETAH  = 5.0    ! 8.21
   7  REAL    , PARAMETER ::  BETAM  = 5.0    ! 6.0
   8  REAL    , PARAMETER ::  BM     = 13.0
   9  REAL    , PARAMETER ::  BH     = 15.7
  10  REAL    , PARAMETER ::  GAMAM  = 19.3
  11  REAL    , PARAMETER ::  GAMAH  = 11.6
  12  REAL    , PARAMETER ::  PR0    = 0.95
  13  REAL    , PARAMETER ::  CZO    = 0.032
  14  REAL    , PARAMETER ::  OZO    = 1.E-4
  15  REAL    , PARAMETER ::  VCONVC = 1.0
  16
  17
  18 CONTAINS
  19
  20 !-------------------------------------------------------------------
  21    SUBROUTINE PXSFCLAY(U3D,V3D,T3D,TH3D,QV3D,P3D,dz8w,             &
  22                      CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM,      &
  23                      ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
  24                      XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,QGH,QSFC,RMOL, &
  25                      U10,V10,                                      &
  26                      GZ1OZ0,WSPD,BR,ISFFLX,DX,                     &
  27                      SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,          &
  28                      itimestep,                                    &
  29                      ids,ide, jds,jde, kds,kde,                    &
  30                      ims,ime, jms,jme, kms,kme,                    &
  31                      its,ite, jts,jte, kts,kte                     )
  32 !-------------------------------------------------------------------
  33       IMPLICIT NONE
  34 !-------------------------------------------------------------------
  35 !   THIS MODULE COMPUTES SFC RELATED PARAMETERS (U*, RA, REGIME, etc.)
  36 !   USING A MODIFIED RICHARDSON NUMBER PARAMETERIZATIONS.
  37 !
  38 !   THE PARAMETERIZATIONS OF THE PSI FUNCTIONS FOR UNSTABLE CONDITIONS
  39 !   HAVE BEEN REPLACED WITH EMPIRICAL EXPRESSIONS WHICH RELATE RB DIRECTLY
  40 !   TO PSIH AND PSIM.  THESE EXPRESSIONS ARE FIT TO THE DYER (1974) FUNCTIONS
  41 !   WITH HOGSTROM (1988) REVISED COEFFICIENTS.  ALSO, THESE EXPERESSIONS
  42 !   ASSUME A LAMINAR SUBLAYER RESISTANCE FOR HEAT (Rb = 5/U*)   - JP 8/01
  43 !
  44 !   Reference: Pleim (2006): JAMC, 45, 341-347
  45 !
  46 !  REVISION HISTORY:
  47 !     A. Xiu        2/2005 - developed WRF version based on the MM5 PX LSM
  48 !     R. Gilliam    7/2006 - completed implementation into WRF model
  49 !     J. Pleim     12/2015 - Saturation WV mixing ratio was recomputed internally for all surfaces.
  50 !                            Now, it's only recomputed internally at initial timestep or over water.
  51 !                            Otherwise, the surface water vapor mixing ratio is read in from PXLSM where
  52 !                            it is computed from the water vapor surface flux from previous time step.
  53 !                            Also, The MOL calculation was modified to use the water vapor surface flux
  54 !                            from previous time step to compute surface buoyancy flux.
  55 !
  56 !***********************************************************************
  57 !-------------------------------------------------------------------
  58 !-- U3D         3D u-velocity interpolated to theta points (m/s)
  59 !-- V3D         3D v-velocity interpolated to theta points (m/s)
  60 !-- T3D         temperature (K)
  61 !-- TH3D        potential temperature (K)
  62 !-- QV3D        3D water vapor mixing ratio (Kg/Kg)
  63 !-- P3D         3D pressure (Pa)
  64 !-- dz8w        dz between full levels (m)
  65 !-- CP          heat capacity at constant pressure for dry air (J/kg/K)
  66 !-- G           acceleration due to gravity (m/s^2)
  67 !-- ROVCP       R/CP
  68 !-- R           gas constant for dry air (j/kg/k)
  69 !-- XLV         latent heat of vaporization (j/kg)
  70 !-- PSFC        surface pressure (Pa)
  71 !-- CHS         exchange coefficient for heat (m/s)
  72 !-- CHS2        exchange coefficient for heat at 2 m (m/s)
  73 !-- CQS2        exchange coefficient for moisture at 2 m (m/s)
  74 !-- CPM         heat capacity at constant pressure for moist air (J/kg/K)
  75 !-- ZNT         roughness length (m)
  76 !-- UST         u* in similarity theory (m/s)
  77 !-- PBLH        PBL height from previous time (m)
  78 !-- MAVAIL      surface moisture availability (between 0 and 1)
  79 !-- ZOL         z/L height over Monin-Obukhov length
  80 !-- MOL         T* (similarity theory) (K)
  81 !-- REGIME      flag indicating PBL regime (stable, unstable, etc.)
  82 !-- PSIM        similarity stability function for momentum
  83 !-- PSIH        similarity stability function for heat
  84 !-- XLAND       land mask (1 for land, 2 for water)
  85 !-- HFX         upward heat flux at the surface (W/m^2)
  86 !-- QFX         upward moisture flux at the surface (kg/m^2/s)
  87 !-- LH          net upward latent heat flux at surface (W/m^2)
  88 !-- TSK         surface temperature (K)
  89 !-- FLHC        exchange coefficient for heat (m/s)
  90 !-- FLQC        exchange coefficient for moisture (m/s)
  91 !-- QGH         lowest-level saturated mixing ratio
  92 !-- QSFC        SPECIFIC HUMIDITY AT LOWER BOUNDARY
  93 !-- RMOL        inverse Monin-Obukhov length (1/m)
  94 !-- U10         diagnostic 10m u wind
  95 !-- V10         diagnostic 10m v wind
  96 !-- GZ1OZ0      log(z/z0) where z0 is roughness length
  97 !-- WSPD        wind speed at lowest model level (m/s)
  98 !-- BR          bulk Richardson number in surface layer
  99 !-- ISFFLX      isfflx=1 for surface heat and moisture fluxes
 100 !-- DX          horizontal grid size (m)
 101 !-- SVP1        constant for saturation vapor pressure (kPa)
 102 !-- SVP2        constant for saturation vapor pressure (dimensionless)
 103 !-- SVP3        constant for saturation vapor pressure (K)
 104 !-- SVPT0       constant for saturation vapor pressure (K)
 105 !-- EP1         constant for virtual temperature (R_v/R_d - 1) (dimensionless)
 106 !-- EP2         constant for specific humidity calculation
 107 !               (R_d/R_v) (dimensionless)
 108 !-- KARMAN      Von Karman constant
 109 !-- ids         start index for i in domain
 110 !-- ide         end index for i in domain
 111 !-- jds         start index for j in domain
 112 !-- jde         end index for j in domain
 113 !-- kds         start index for k in domain
 114 !-- kde         end index for k in domain
 115 !-- ims         start index for i in memory
 116 !-- ime         end index for i in memory
 117 !-- jms         start index for j in memory
 118 !-- jme         end index for j in memory
 119 !-- kms         start index for k in memory
 120 !-- kme         end index for k in memory
 121 !-- its         start index for i in tile
 122 !-- ite         end index for i in tile
 123 !-- jts         start index for j in tile
 124 !-- jte         end index for j in tile
 125 !-- kts         start index for k in tile
 126 !-- kte         end index for k in tile
 127 !-------------------------------------------------------------------
 128       INTEGER,  INTENT(IN )   ::        ids,ide, jds,jde, kds,kde, &
 129                                         ims,ime, jms,jme, kms,kme, &
 130                                         its,ite, jts,jte, kts,kte
 131 !
 132       INTEGER,  INTENT(IN )   ::        ISFFLX, ITIMESTEP
 133       REAL,     INTENT(IN )   ::        SVP1,SVP2,SVP3,SVPT0
 134       REAL,     INTENT(IN )   ::        EP1,EP2,KARMAN
 135 !
 136       REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
 137                 INTENT(IN   )   ::                           dz8w
 138
 139       REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
 140                 INTENT(IN   )   ::                           QV3D, &
 141                                                               P3D, &
 142                                                               T3D, &
 143                                                              TH3D
 144
 145       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
 146                 INTENT(IN   )               ::             MAVAIL, &
 147                                                              PBLH, &
 148                                                             XLAND, &
 149                                                               TSK
 150       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
 151                 INTENT(OUT  )               ::                U10, &
 152                                                               V10
 153
 154 !
 155       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
 156                 INTENT(INOUT)               ::             REGIME, &
 157                                                               HFX, &
 158                                                               QFX, &
 159                                                                LH, &
 160                                                         MOL,RMOL,QSFC
 161 !m the following 5 are change to memory size
 162 !
 163       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
 164                 INTENT(INOUT)   ::                 GZ1OZ0,WSPD,BR, &
 165                                                         PSIM,PSIH
 166
 167       REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
 168                 INTENT(IN   )   ::                            U3D, &
 169                                                               V3D
 170
 171       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
 172                 INTENT(IN   )               ::               PSFC
 173
 174       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
 175                 INTENT(INOUT)   ::                            ZNT, &
 176                                                               ZOL, &
 177                                                               UST, &
 178                                                               CPM, &
 179                                                              CHS2, &
 180                                                              CQS2, &
 181                                                               CHS
 182
 183       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
 184                 INTENT(INOUT)   ::                      FLHC,FLQC
 185
 186       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
 187                 INTENT(INOUT)   ::                                 &
 188                                                               QGH
 189
 190
 191
 192       REAL,     INTENT(IN   )                  ::   CP,G,ROVCP,R,XLV,DX
 193
 194 ! LOCAL VARS
 195
 196       REAL,     DIMENSION( its:ite ) ::                       U1D, &
 197                                                               V1D, &
 198                                                              QV1D, &
 199                                                               P1D, &
 200                                                               T1D, &
 201                                                              TH1D
 202
 203       REAL,     DIMENSION( its:ite ) ::                    dz8w1d
 204
 205       INTEGER ::  I,J
 206
 207       DO J=jts,jte
 208
 209         DO i=its,ite
 210           dz8w1d(i) =dz8w(i,1,j)
 211           U1D(i)    =U3D(i,1,j)
 212           V1D(i)    =V3D(i,1,j)
 213           QV1D(i)   =QV3D(i,1,j)
 214           P1D(i)    =P3D(i,1,j)
 215           T1D(i)    =T3D(i,1,j)
 216           TH1D(i)   =TH3D(i,1,j)
 217         ENDDO
 218
 219         CALL PXSFCLAY1D(J,U1D,V1D,T1D,TH1D,QV1D,P1D,dz8w1d,          &
 220                 CP,G,ROVCP,R,XLV,PSFC(ims,j),CHS(ims,j),CHS2(ims,j), &
 221                 CQS2(ims,j),CPM(ims,j),PBLH(ims,j), RMOL(ims,j),   &
 222                 ZNT(ims,j),UST(ims,j),MAVAIL(ims,j),ZOL(ims,j),    &
 223                 MOL(ims,j),REGIME(ims,j),PSIM(ims,j),PSIH(ims,j),  &
 224                 XLAND(ims,j),HFX(ims,j),QFX(ims,j),TSK(ims,j),     &
 225                 U10(ims,j),V10(ims,j),                             &
 226                 FLHC(ims,j),FLQC(ims,j),QGH(ims,j),                &
 227                 QSFC(ims,j),LH(ims,j),                             &
 228                 GZ1OZ0(ims,j),WSPD(ims,j),BR(ims,j),ISFFLX,DX,     &
 229                 SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,               &
 230                 itimestep,                                         &
 231                 ids,ide, jds,jde, kds,kde,                         &
 232                 ims,ime, jms,jme, kms,kme,                         &
 233                 its,ite, jts,jte, kts,kte                          )
 234       ENDDO
 235
 236
 237    END SUBROUTINE PXSFCLAY
 238 !====================================================================
 239    SUBROUTINE PXSFCLAY1D(J,US,VS,T1D,THETA1,QV1D,P1D,dz8w1d,                &
 240                      CP,G,ROVCP,R,XLV,PSFCPA,CHS,CHS2,CQS2,CPM,PBLH,RMOL, &
 241                      ZNT,UST,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH,      &
 242                      XLAND,HFX,QFX,TG,                             &
 243                      U10,V10,FLHC,FLQC,QGH,                        &
 244                      QSFC,LH,GZ1OZ0,WSPD,BR,ISFFLX,DX,             &
 245                      SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,          &
 246                      itimestep,                                    &
 247                      ids,ide, jds,jde, kds,kde,                    &
 248                      ims,ime, jms,jme, kms,kme,                    &
 249                      its,ite, jts,jte, kts,kte                     )
 250 !-------------------------------------------------------------------
 251       IMPLICIT NONE
 252 !-------------------------------------------------------------------
 253       REAL,     PARAMETER     ::        XKA=2.4E-5
 254       REAL,     PARAMETER     ::        PRT=1.
 255
 256       INTEGER,  INTENT(IN )   ::        ids,ide, jds,jde, kds,kde, &
 257                                         ims,ime, jms,jme, kms,kme, &
 258                                         its,ite, jts,jte, kts,kte, &
 259                                         J
 260 !
 261       INTEGER,  INTENT(IN )   ::        ISFFLX, ITIMESTEP
 262       REAL,     INTENT(IN )   ::        SVP1,SVP2,SVP3,SVPT0
 263       REAL,     INTENT(IN )   ::        EP1,EP2,KARMAN
 264
 265 !
 266       REAL,     DIMENSION( ims:ime )                             , &
 267                 INTENT(IN   )               ::             MAVAIL, &
 268                                                              PBLH, &
 269                                                             XLAND, &
 270                                                               TG
 271 !
 272       REAL,     DIMENSION( ims:ime )                             , &
 273                 INTENT(IN   )               ::             PSFCPA
 274
 275       REAL,     DIMENSION( ims:ime )                             , &
 276                 INTENT(INOUT)               ::             REGIME, &
 277                                                               HFX, &
 278                                                               QFX, &
 279                                                          MOL,RMOL
 280 !m the following 5 are changed to memory size---
 281 !
 282       REAL,     DIMENSION( ims:ime )                             , &
 283                 INTENT(INOUT)   ::                 GZ1OZ0,WSPD,BR, &
 284                                                         PSIM,PSIH
 285
 286       REAL,     DIMENSION( ims:ime )                             , &
 287                 INTENT(INOUT)   ::                            ZNT, &
 288                                                               ZOL, &
 289                                                               UST, &
 290                                                               CPM, &
 291                                                              CHS2, &
 292                                                              CQS2, &
 293                                                               CHS
 294
 295       REAL,     DIMENSION( ims:ime )                             , &
 296                 INTENT(INOUT)   ::                      FLHC,FLQC
 297
 298       REAL,     DIMENSION( ims:ime )                             , &
 299                 INTENT(INOUT)   ::                                 &
 300                                                               QGH,QSFC
 301
 302       REAL,     DIMENSION( ims:ime )                             , &
 303                 INTENT(OUT)     ::                        U10,V10, &
 304                                                           LH
 305
 306       REAL,     INTENT(IN   )                    ::   CP,G,ROVCP,XLV,DX,R
 307
 308 ! MODULE-LOCAL VARIABLES, DEFINED IN SUBROUTINE SFCLAY
 309       REAL,     DIMENSION( its:ite ),  INTENT(IN   )   ::  dz8w1d
 310
 311       REAL,     DIMENSION( its:ite ),  INTENT(IN   )   ::      US, &
 312                                                                VS, &
 313                                                              QV1D, &
 314                                                               P1D, &
 315                                                               T1D, &
 316                                                            THETA1
 317
 318 ! LOCAL VARS
 319
 320       REAL,     DIMENSION( its:ite )        ::                 ZA, &
 321                                                               TH0, &
 322                                                            THETAG, &
 323                                                                WS, &
 324                                                             RICUT, &
 325                                                              USTM, &
 326                                                                RA, &
 327                                                           THETAV1, &
 328                                                          MOLENGTH
 329 !
 330       REAL,     DIMENSION( its:ite )        ::                     &
 331                                                       RHOX,GOVRTH
 332 !
 333       REAL,     DIMENSION( its:ite )        ::               PSFC
 334 !
 335       INTEGER                               ::                 KL
 336
 337       INTEGER ::  N,I,K,KK,L,NZOL,NK,NZOL2,NZOL10
 338
 339       REAL    ::  PL,THCON,TVCON,E1
 340       REAL    ::  ZL,TSKV,DTHVDZ,DTHVM,VCONV,RZOL,RZOL2,RZOL10,ZOL2,ZOL10
 341       REAL    ::  DTG,PSIX,DTTHX,PSIX10,PSIT,PSIT2,PSIQ,PSIQ2
 342       REAL    ::  FLUXC,VSGD
 343       REAL    ::  XMOL,ZOBOL,Z10OL,ZNTOL,YNT,YOB,X1,X2
 344       REAL    ::  G2OZ0,G10OZ0,RA2,ZOLL
 345       REAL    ::  TV0,CPOT,RICRITI,AM,AH,SQLNZZ0,RBH,RBW,TSTV
 346       REAL    ::  PSIH2, PSIM2, PSIH10, PSIM10, CQS,TMPVTCON,TST,QST
 347
 348 !-------------------------------Exicutable starts here--------------------
 349
 350       DO i = its,ite
 351         PSFC(I)   = PSFCPA(I)/1000.
 352         TVCON     = 1.0 + EP1 * QV1D(I)
 353         THETAV1(I)= THETA1(I) * TVCON
 354         RHOX(I)   = PSFCPA(I)/(R*T1D(I)*TVCON)
 355       ENDDO
 356
 357 !
 358 !-----Compute virtual potential temperature at surface
 359 !
 360       DO I=its,ite
 361         IF (TG(I) .LT. 273.15) THEN
 362            !SATURATION VAPOR PRESSURE WRT ICE (SVP1=.6112; 10*mb)
 363            E1= SVP1*EXP(4648*(1./273.15 - 1./TG(I)) - &
 364            & 11.64*LOG(273.15/TG(I)) + 0.02265*(273.15 - TG(I)))
 365         ELSE
 366            !SATURATION VAPOR PRESSURE WRT WATER (Bolton 1980)
 367            E1= SVP1*EXP( SVP2*(TG(I)-SVPT0)/(TG(I)-SVP3) )
 368         ENDIF
 369 !-- If water or initial timestep use saturation MR for qsfc, otherwise use from LSM
 370         IF (xland(i).gt.1.5 .or. QSFC(i).le.0.0.or.itimestep.eq.1) THEN
 371            QSFC(I)= EP2*E1/(PSFC(I)-E1)
 372         ENDIF
 373
 374 ! QGH CHANGED TO USE LOWEST-LEVEL AIR TEMP CONSISTENT WITH MYJSFC CHANGE
 375 ! Q2SAT = QGH IN LSM
 376         E1    = SVP1*EXP(SVP2*(T1D(I)-SVPT0)/(T1D(I)-SVP3))
 377         PL    = P1D(I)/1000.
 378         QGH(I)= EP2*E1/(PL-E1)
 379         CPM(I)= CP*(1.+0.8*QV1D(I))
 380       ENDDO
 381
 382 !.......... compute the thetav at ground
 383       DO I = its, ite
 384         TV0       = TG(I) * (1.0 + EP1 * QSFC(I))
 385         CPOT      = (100./PSFC(I))**ROVCP
 386         TH0(I)    = TV0 * CPOT
 387         THETAG(I) = CPOT * TG(I)
 388       ENDDO
 389 !
 390 !-----COMPUTE THE HEIGHT OF FULL- AND HALF-SIGMA LEVELS ABOVE GROUND
 391 !     LEVEL, AND THE LAYER THICKNESSES.
 392 !
 393 !... DZ8W1D is DZ between full sigma levels and Z0 is the height of the first
 394 !    half sigma level
 395       DO I = its,ite
 396         ZA(I) = 0.5 * DZ8W1D(I)
 397         WS(I) = SQRT(US(I) * US(I) + VS(I) * VS(I))
 398       ENDDO
 399 !
 400 !-----CALCULATE BULK RICHARDSON NO. OF SURFACE LAYER, ACCORDING TO
 401 !     AKB(1976), EQ(12).
 402
 403         RICRITI = 1.0 / RICRIT
 404
 405       DO i = its,ite
 406         GZ1OZ0(I) = ALOG(ZA(I) / ZNT(I))
 407         DTHVDZ    = THETAV1(I) - TH0(I)
 408         fluxc     = max(hfx(i)/rhox(i)/cp                    &
 409                     + ep1*TH0(I)*qfx(i)/rhox(i),0.)
 410         VCONV     = vconvc*(g/tg(i)*pblh(i)*fluxc)**.33
 411         VSGD      = 0.32 * (max(dx/5000.-1.,0.))**.33
 412         WSPD(I)   = SQRT(WS(I)*WS(I)+VCONV*VCONV+vsgd*vsgd)
 413         WSPD(I)   = AMAX1(WSPD(I),0.1)
 414         GOVRTH(I) = G / THETA1(I)
 415         BR(I)     = GOVRTH(I) * ZA(I) * DTHVDZ / (WSPD(I) * WSPD(I))
 416         RICUT(I)  = 1.0 / (RICRITI + GZ1OZ0(I))
 417       ENDDO
 418
 419       DO I = its,ite
 420 !       -- NOTE THAT THE REGIMES USED IN HIRPBL HAVE BEEN CHANGED:
 421         ZOLL = 0.0
 422         IF (BR(I) .GE. RICUT(I)) THEN
 423 !           -----CLASS 1; VERY STABLE CONDITIONS:  Z/L > 1
 424             REGIME(I) = 1.0
 425             ZOLL      = BR(I) * GZ1OZ0(I) / (1.0 - RICRITI * RICUT(I))
 426             PSIM(I)   = 1.0 - BETAM - ZOLL
 427             PSIH(I)   = 1.0 - BETAH - ZOLL
 428
 429         ELSE IF (BR(I) .GE. 0.0) THEN
 430 !           -----CLASS 2; STABLE: for 1 > Z/L >0
 431             REGIME(I) = 2.0
 432             ZOLL      = BR(I) * GZ1OZ0(I) / (1.0 - RICRITI * BR(I))
 433             PSIM(I)   = -BETAM * ZOLL
 434             PSIH(I)   = -BETAH * ZOLL
 435
 436         ELSE
 437 !        ----- CLASS 3 or 4; UNSTABLE:
 438 !        ----- CLASS 4 IS FOR ACM NON-LOCAL CONVECTION (H/L < -3)
 439             REGIME(I) = 3.0
 440             AM        = 0.031 + 0.276 * ALOG(GZ1OZ0(I))
 441             AH        = 0.04 + 0.355 * ALOG(GZ1OZ0(I))
 442             SQLNZZ0   = SQRT(GZ1OZ0(I))
 443             PSIM(I)   = AM * ALOG(1.0 - BM * SQLNZZ0 * BR(I))
 444             PSIH(I)   = AH * ALOG(1.0 - BH * SQLNZZ0 * BR(I))
 445
 446         ENDIF
 447       ENDDO
 448
 449 !     -------- COMPUTE THE FRICTIONAL VELOCITY AND SURFACE FLUXES:
 450       DO I = its,ite
 451         DTG       = THETA1(I) - THETAG(I)
 452         PSIX      = GZ1OZ0(I) - PSIM(I)
 453         UST(I)    = 0.5*UST(I)+0.5*KARMAN*WSPD(I)/PSIX
 454         USTM(I)   = UST(I)
 455
 456 !      ------- OVER WATER, ALTER ROUGHNESS LENGTH (Z0) ACCORDING TO WIND (UST).
 457         IF ((XLAND(I)-1.5) .GE. 0.0) THEN
 458           ZNT(I)    = CZO * USTM(I) * USTM(I) / G + OZO
 459           GZ1OZ0(I) = ALOG(ZA(I) / ZNT(I))
 460           PSIX      = GZ1OZ0(I) - PSIM(I)
 461           UST(I)    = KARMAN * WSPD(I) / PSIX
 462           USTM(I)   = UST(I)
 463         ENDIF
 464
 465         RA(I)       = PR0 * (GZ1OZ0(I) - PSIH(I)) / (KARMAN * UST(I))
 466         RBH         = 5.0 / UST(I)
 467         RBW         = 4.503/UST(I)
 468         CHS(I)      = 1./(RA(I) + RBH)
 469         CQS         = 1./(RA(I) + RBW)
 470         MOL(I)      = DTG * CHS(I) / UST(I)
 471         TMPVTCON    = 1.0 + EP1 * QV1D(i)
 472         TST         = DTG * CHS(I)/UST(i)
 473         TSTV        = (THETAV1(I) - TH0(I)) * CHS(I) / UST(I)
 474         IF (ABS(TSTV) .LT. 1.E-5)  TSTV = 1.E-5
 475         MOLENGTH(I) = THETAV1(I) * UST(I) * UST(I) / (KARMAN * G * TSTV)
 476
 477 !       ---Compute 2m surface exchange coefficients for heat and moisture
 478         XMOL = MOLENGTH(I)
 479         IF(MOLENGTH(I).GT.0.0) XMOL = AMAX1(MOLENGTH(I),2.0)
 480         RMOL(I) = 1/XMOL
 481         ZOL(I)  = ZA(I)*RMOL(I)
 482         ZOBOL   = 1.5*RMOL(I)
 483         Z10OL   = 10.0*RMOL(I)
 484         ZNTOL   = ZNT(I)*RMOL(I)
 485         IF(XMOL.LT.0.0) THEN
 486           YNT    = ( 1.0 - GAMAH * ZNTOL )**0.5
 487           YOB    = ( 1.0 - GAMAH * ZOBOL )**0.5
 488           PSIH2  = 2. * ALOG((YOB+1.0)/(YNT+1.0))
 489           x1     = (1.0 - gamam * z10ol)**0.25
 490           x2     = (1.0 - gamam * zntol)**0.25
 491           psim10 = 2.0 * ALOG( (1.0+x1) / (1.0+x2) ) +        &
 492                          ALOG( (1.0+x1*x1) / (1.0+x2*x2)) -   &
 493                          2.0 * ATAN(x1) + 2.0 * ATAN(x2)
 494         ELSE
 495           IF((ZOBOL-ZNTOL).LE.1.0) THEN
 496             PSIH2  = -BETAH*(ZOBOL-ZNTOL)
 497           ELSE
 498             PSIH2  = 1.-BETAH-(ZOBOL-ZNTOL)
 499           ENDIF
 500           IF((Z10OL-ZNTOL).LE.1.0) THEN
 501             PSIM10 = -BETAM*(Z10OL-ZNTOL)
 502           ELSE
 503             PSIM10 = 1.-BETAM-(Z10OL-ZNTOL)
 504           ENDIF
 505         ENDIF
 506         G2OZ0   = ALOG(1.5 / ZNT(I))
 507         G10OZ0  = ALOG(10.0 / ZNT(I))
 508         RA2     = PR0 * (G2OZ0 - PSIH2) / (KARMAN * UST(I))
 509         CHS2(I) = 1.0/(RA2 + RBH)
 510         CQS2(I) = 1.0/(RA2 + RBW)
 511         U10(I)  = US(I)*(G10OZ0-PSIM10)/PSIX
 512         V10(I)  = VS(I)*(G10OZ0-PSIM10)/PSIX
 513
 514 !       -----COMPUTE SURFACE HEAT AND MOIST FLUX:
 515         FLHC(i)= CPM(I)*RHOX(I)*CHS(I)
 516         FLQC(i)= RHOX(I)*CQS*MAVAIL(I)
 517         QFX(I) = FLQC(I)*(QSFC(I)-QV1D(I))
 518         QFX(I) = AMAX1(QFX(I),0.)
 519         LH(I)  = XLV*QFX(I)
 520         IF(XLAND(I)-1.5.GT.0.)THEN
 521           HFX(I)= -FLHC(I)*DTG
 522         ELSEIF(XLAND(I)-1.5.LT.0.)THEN
 523           HFX(I)= -FLHC(I)*DTG
 524           HFX(I)= AMAX1(HFX(I),-250.)
 525         ENDIF
 526       ENDDO
 527
 528
 529    END SUBROUTINE PXSFCLAY1D
 530
 531 !====================================================================
 532    SUBROUTINE pxsfclayinit( allowed_to_read )
 533
 534    LOGICAL , INTENT(IN)      ::      allowed_to_read
 535    INTEGER                   ::      N
 536    REAL                      ::      ZOLN,X,Y
 537
 538
 539    END SUBROUTINE pxsfclayinit
 540
 541 !-------------------------------------------------------------------
 542
 543 END MODULE module_sf_pxsfclay