PageRenderTime 57ms CodeModel.GetById 25ms RepoModel.GetById 1ms app.codeStats 0ms

/wrfv2_fire/phys/module_sf_pxsfclay.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 528 lines | 306 code | 61 blank | 161 comment | 0 complexity | 36971520013eeb1ad037a87d74cd94a4 MD5 | raw file
Possible License(s): AGPL-1.0 
    

  1. !WRF:MODEL_LAYER:PHYSICS
    2. 

  2. !
    3. 

  3. MODULE module_sf_pxsfclay
    4. 

  4. 

  5.  REAL    , PARAMETER ::  RICRIT = 0.25            !critical Richardson number
    6. 

  6.  REAL    , PARAMETER ::  BETAH  = 5.0    ! 8.21
    7. 

  7.  REAL    , PARAMETER ::  BETAM  = 5.0    ! 6.0
    8. 

  8.  REAL    , PARAMETER ::  BM     = 13.0
    9. 

  9.  REAL    , PARAMETER ::  BH     = 15.7
    10. 

  10.  REAL    , PARAMETER ::  GAMAM  = 19.3
    11. 

  11.  REAL    , PARAMETER ::  GAMAH  = 11.6
    12. 

  12.  REAL    , PARAMETER ::  PR0    = 0.95
    13. 

  13.  REAL    , PARAMETER ::  CZO    = 0.032
    14. 

  14.  REAL    , PARAMETER ::  OZO    = 1.E-4
    15. 

  15.  REAL    , PARAMETER ::  VCONVC = 1.0
    16. 

  16. 

  17. 

  18. CONTAINS
    19. 

  19. 

  20. !-------------------------------------------------------------------
    21. 

  21.    SUBROUTINE PXSFCLAY(U3D,V3D,T3D,TH3D,QV3D,P3D,dz8w,             &
    22. 

  22.                      CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM,      &
    23. 

  23.                      ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
    24. 

  24.                      XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,QGH,QSFC,RMOL, &
    25. 

  25.                      U10,V10,                                      &
    26. 

  26.                      GZ1OZ0,WSPD,BR,ISFFLX,DX,                     &
    27. 

  27.                      SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,          &
    28. 

  28.                      ids,ide, jds,jde, kds,kde,                    &
    29. 

  29.                      ims,ime, jms,jme, kms,kme,                    &
    30. 

  30.                      its,ite, jts,jte, kts,kte                     )
    31. 

  31. !-------------------------------------------------------------------
    32. 

  32.       IMPLICIT NONE
    33. 

  33. !-------------------------------------------------------------------
    34. 

  34. !   THIS MODULE COMPUTES SFC RELATED PARAMETERS (U*, RA, REGIME, etc.)
    35. 

  35. !   USING A MODIFIED RICHARDSON NUMBER PARAMETERIZATIONS.
    36. 

  36. !
    37. 

  37. !   THE PARAMETERIZATIONS OF THE PSI FUNCTIONS FOR UNSTABLE CONDITIONS
    38. 

  38. !   HAVE BEEN REPLACED WITH EMPIRICAL EXPRESSIONS WHICH RELATE RB DIRECTLY
    39. 

  39. !   TO PSIH AND PSIM.  THESE EXPRESSIONS ARE FIT TO THE DYER (1974) FUNCTIONS
    40. 

  40. !   WITH HOGSTROM (1988) REVISED COEFFICIENTS.  ALSO, THESE EXPERESSIONS
    41. 

  41. !   ASSUME A LAMINAR SUBLAYER RESISTANCE FOR HEAT (Rb = 5/U*)   - JP 8/01
    42. 

  42. ! 
    43. 

  43. !   Reference: Pleim (2006): JAMC, 45, 341-347
    44. 

  44. !
    45. 

  45. !  REVISION HISTORY:
    46. 

  46. !     A. Xiu        2/2005 - developed WRF version based on the MM5 PX LSM
    47. 

  47. !     R. Gilliam    7/2006 - completed implementation into WRF model
    48. 

  48. !*********************************************************************** 
    49. 

  49. !-------------------------------------------------------------------
    50. 

  50. !-- U3D         3D u-velocity interpolated to theta points (m/s)
    51. 

  51. !-- V3D         3D v-velocity interpolated to theta points (m/s)
    52. 

  52. !-- T3D         temperature (K)
    53. 

  53. !-- TH3D        potential temperature (K)
    54. 

  54. !-- QV3D        3D water vapor mixing ratio (Kg/Kg)
    55. 

  55. !-- P3D         3D pressure (Pa)
    56. 

  56. !-- dz8w        dz between full levels (m)
    57. 

  57. !-- CP          heat capacity at constant pressure for dry air (J/kg/K)
    58. 

  58. !-- G           acceleration due to gravity (m/s^2)
    59. 

  59. !-- ROVCP       R/CP
    60. 

  60. !-- R           gas constant for dry air (j/kg/k)
    61. 

  61. !-- XLV         latent heat of vaporization (j/kg)
    62. 

  62. !-- PSFC        surface pressure (Pa)
    63. 

  63. !-- CHS         exchange coefficient for heat (m/s)
    64. 

  64. !-- CHS2        exchange coefficient for heat at 2 m (m/s)
    65. 

  65. !-- CQS2        exchange coefficient for moisture at 2 m (m/s)
    66. 

  66. !-- CPM         heat capacity at constant pressure for moist air (J/kg/K)
    67. 

  67. !-- ZNT         roughness length (m)
    68. 

  68. !-- UST         u* in similarity theory (m/s)
    69. 

  69. !-- PBLH        PBL height from previous time (m)
    70. 

  70. !-- MAVAIL      surface moisture availability (between 0 and 1)
    71. 

  71. !-- ZOL         z/L height over Monin-Obukhov length
    72. 

  72. !-- MOL         T* (similarity theory) (K)
    73. 

  73. !-- REGIME      flag indicating PBL regime (stable, unstable, etc.)
    74. 

  74. !-- PSIM        similarity stability function for momentum
    75. 

  75. !-- PSIH        similarity stability function for heat
    76. 

  76. !-- XLAND       land mask (1 for land, 2 for water)
    77. 

  77. !-- HFX         upward heat flux at the surface (W/m^2)
    78. 

  78. !-- QFX         upward moisture flux at the surface (kg/m^2/s)
    79. 

  79. !-- LH          net upward latent heat flux at surface (W/m^2)
    80. 

  80. !-- TSK         surface temperature (K)
    81. 

  81. !-- FLHC        exchange coefficient for heat (m/s)
    82. 

  82. !-- FLQC        exchange coefficient for moisture (m/s)
    83. 

  83. !-- QGH         lowest-level saturated mixing ratio
    84. 

  84. !-- QSFC        SPECIFIC HUMIDITY AT LOWER BOUNDARY				
    85. 

  85. !-- RMOL        inverse Monin-Obukhov length (1/m)
    86. 

  86. !-- U10         diagnostic 10m u wind
    87. 

  87. !-- V10         diagnostic 10m v wind
    88. 

  88. !-- GZ1OZ0      log(z/z0) where z0 is roughness length
    89. 

  89. !-- WSPD        wind speed at lowest model level (m/s)
    90. 

  90. !-- BR          bulk Richardson number in surface layer
    91. 

  91. !-- ISFFLX      isfflx=1 for surface heat and moisture fluxes
    92. 

  92. !-- DX          horizontal grid size (m)
    93. 

  93. !-- SVP1        constant for saturation vapor pressure (kPa)
    94. 

  94. !-- SVP2        constant for saturation vapor pressure (dimensionless)
    95. 

  95. !-- SVP3        constant for saturation vapor pressure (K)
    96. 

  96. !-- SVPT0       constant for saturation vapor pressure (K)
    97. 

  97. !-- EP1         constant for virtual temperature (R_v/R_d - 1) (dimensionless)
    98. 

  98. !-- EP2         constant for specific humidity calculation 
    99. 

  99. !               (R_d/R_v) (dimensionless)
    100. 

  100. !-- KARMAN      Von Karman constant
    101. 

  101. !-- ids         start index for i in domain
    102. 

  102. !-- ide         end index for i in domain
    103. 

  103. !-- jds         start index for j in domain
    104. 

  104. !-- jde         end index for j in domain
    105. 

  105. !-- kds         start index for k in domain
    106. 

  106. !-- kde         end index for k in domain
    107. 

  107. !-- ims         start index for i in memory
    108. 

  108. !-- ime         end index for i in memory
    109. 

  109. !-- jms         start index for j in memory
    110. 

  110. !-- jme         end index for j in memory
    111. 

  111. !-- kms         start index for k in memory
    112. 

  112. !-- kme         end index for k in memory
    113. 

  113. !-- its         start index for i in tile
    114. 

  114. !-- ite         end index for i in tile
    115. 

  115. !-- jts         start index for j in tile
    116. 

  116. !-- jte         end index for j in tile
    117. 

  117. !-- kts         start index for k in tile
    118. 

  118. !-- kte         end index for k in tile
    119. 

  119. !-------------------------------------------------------------------
    120. 

  120.       INTEGER,  INTENT(IN )   ::        ids,ide, jds,jde, kds,kde, &
    121. 

  121.                                         ims,ime, jms,jme, kms,kme, &
    122. 

  122.                                         its,ite, jts,jte, kts,kte
    123. 

  123. !                                                               
    124. 

  124.       INTEGER,  INTENT(IN )   ::        ISFFLX
    125. 

  125.       REAL,     INTENT(IN )   ::        SVP1,SVP2,SVP3,SVPT0
    126. 

  126.       REAL,     INTENT(IN )   ::        EP1,EP2,KARMAN
    127. 

  127. !
    128. 

  128.       REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
    129. 

  129.                 INTENT(IN   )   ::                           dz8w
    130. 

  130.                                         
    131. 

  131.       REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
    132. 

  132.                 INTENT(IN   )   ::                           QV3D, &
    133. 

  133.                                                               P3D, &
    134. 

  134.                                                               T3D, &
    135. 

  135.                                                              TH3D
    136. 

  136. 

  137.       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    138. 

  138.                 INTENT(IN   )               ::             MAVAIL, &
    139. 

  139.                                                              PBLH, &
    140. 

  140.                                                             XLAND, &
    141. 

  141.                                                               TSK
    142. 

  142.       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    143. 

  143.                 INTENT(OUT  )               ::                U10, &
    144. 

  144.                                                               V10, &
    145. 

  145.                                                              QSFC
    146. 

  146. !
    147. 

  147.       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    148. 

  148.                 INTENT(INOUT)               ::             REGIME, &
    149. 

  149.                                                               HFX, &
    150. 

  150.                                                               QFX, &
    151. 

  151.                                                                LH, &
    152. 

  152.                                                           MOL,RMOL
    153. 

  153. !m the following 5 are change to memory size
    154. 

  154. !
    155. 

  155.       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    156. 

  156.                 INTENT(INOUT)   ::                 GZ1OZ0,WSPD,BR, &
    157. 

  157.                                                         PSIM,PSIH
    158. 

  158. 

  159.       REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
    160. 

  160.                 INTENT(IN   )   ::                            U3D, &
    161. 

  161.                                                               V3D
    162. 

  162.                                         
    163. 

  163.       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    164. 

  164.                 INTENT(IN   )               ::               PSFC
    165. 

  165. 

  166.       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    167. 

  167.                 INTENT(INOUT)   ::                            ZNT, &
    168. 

  168.                                                               ZOL, &
    169. 

  169.                                                               UST, &
    170. 

  170.                                                               CPM, &
    171. 

  171.                                                              CHS2, &
    172. 

  172.                                                              CQS2, &
    173. 

  173.                                                               CHS
    174. 

  174. 

  175.       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    176. 

  176.                 INTENT(INOUT)   ::                      FLHC,FLQC
    177. 

  177. 

  178.       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    179. 

  179.                 INTENT(INOUT)   ::                                 &
    180. 

  180.                                                               QGH
    181. 

  181. 

  182. 

  183.                                     
    184. 

  184.       REAL,     INTENT(IN   )                  ::   CP,G,ROVCP,R,XLV,DX
    185. 

  185.  
    186. 

  186. ! LOCAL VARS
    187. 

  187. 

  188.       REAL,     DIMENSION( its:ite ) ::                       U1D, &
    189. 

  189.                                                               V1D, &
    190. 

  190.                                                              QV1D, &
    191. 

  191.                                                               P1D, &
    192. 

  192.                                                               T1D, &
    193. 

  193.                                                              TH1D
    194. 

  194. 

  195.       REAL,     DIMENSION( its:ite ) ::                    dz8w1d
    196. 

  196. 

  197.       INTEGER ::  I,J
    198. 

  198. 

  199.       DO J=jts,jte
    200. 

  200.    
    201. 

  201.         DO i=its,ite
    202. 

  202.           dz8w1d(i) =dz8w(i,1,j)
    203. 

  203.           U1D(i)    =U3D(i,1,j)
    204. 

  204.           V1D(i)    =V3D(i,1,j)
    205. 

  205.           QV1D(i)   =QV3D(i,1,j)
    206. 

  206.           P1D(i)    =P3D(i,1,j)
    207. 

  207.           T1D(i)    =T3D(i,1,j)
    208. 

  208.           TH1D(i)   =TH3D(i,1,j)
    209. 

  209.         ENDDO
    210. 

  210.         
    211. 

  211.         
    212. 

  212.         !  TST, WST, MOLENGTH, USTM need to be recaculated or passed in
    213. 

  213.         
    214. 

  214.         CALL PXSFCLAY1D(J,U1D,V1D,T1D,TH1D,QV1D,P1D,dz8w1d,          &
    215. 

  215.                 CP,G,ROVCP,R,XLV,PSFC(ims,j),CHS(ims,j),CHS2(ims,j), &
    216. 

  216.                 CQS2(ims,j),CPM(ims,j),PBLH(ims,j), RMOL(ims,j),   &
    217. 

  217.                 ZNT(ims,j),UST(ims,j),MAVAIL(ims,j),ZOL(ims,j),    &
    218. 

  218.                 MOL(ims,j),REGIME(ims,j),PSIM(ims,j),PSIH(ims,j),  &
    219. 

  219.                 XLAND(ims,j),HFX(ims,j),QFX(ims,j),TSK(ims,j),     &
    220. 

  220.                 U10(ims,j),V10(ims,j),                             &
    221. 

  221.                 FLHC(ims,j),FLQC(ims,j),QGH(ims,j),                &
    222. 

  222.                 QSFC(ims,j),LH(ims,j),                             &
    223. 

  223.                 GZ1OZ0(ims,j),WSPD(ims,j),BR(ims,j),ISFFLX,DX,     &
    224. 

  224.                 SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,               &
    225. 

  225.                 ids,ide, jds,jde, kds,kde,                         &
    226. 

  226.                 ims,ime, jms,jme, kms,kme,                         &
    227. 

  227.                 its,ite, jts,jte, kts,kte                          )
    228. 

  228.       ENDDO
    229. 

  229. 

  230. 

  231.    END SUBROUTINE PXSFCLAY
    232. 

  232. !====================================================================
    233. 

  233.    SUBROUTINE PXSFCLAY1D(J,US,VS,T1D,THETA1,QV1D,P1D,dz8w1d,                &
    234. 

  234.                      CP,G,ROVCP,R,XLV,PSFCPA,CHS,CHS2,CQS2,CPM,PBLH,RMOL, &
    235. 

  235.                      ZNT,UST,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH,      &
    236. 

  236.                      XLAND,HFX,QFX,TG,                             &
    237. 

  237.                      U10,V10,FLHC,FLQC,QGH,                        &
    238. 

  238.                      QSFC,LH,GZ1OZ0,WSPD,BR,ISFFLX,DX,             &
    239. 

  239.                      SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,          &
    240. 

  240.                      ids,ide, jds,jde, kds,kde,                    &
    241. 

  241.                      ims,ime, jms,jme, kms,kme,                    &
    242. 

  242.                      its,ite, jts,jte, kts,kte                     )
    243. 

  243. !-------------------------------------------------------------------
    244. 

  244.       IMPLICIT NONE
    245. 

  245. !-------------------------------------------------------------------
    246. 

  246.       REAL,     PARAMETER     ::        XKA=2.4E-5
    247. 

  247.       REAL,     PARAMETER     ::        PRT=1.
    248. 

  248. 

  249.       INTEGER,  INTENT(IN )   ::        ids,ide, jds,jde, kds,kde, &
    250. 

  250.                                         ims,ime, jms,jme, kms,kme, &
    251. 

  251.                                         its,ite, jts,jte, kts,kte, &
    252. 

  252.                                         J
    253. 

  253. !                                                               
    254. 

  254.       INTEGER,  INTENT(IN )   ::        ISFFLX
    255. 

  255.       REAL,     INTENT(IN )   ::        SVP1,SVP2,SVP3,SVPT0
    256. 

  256.       REAL,     INTENT(IN )   ::        EP1,EP2,KARMAN
    257. 

  257. 

  258. !
    259. 

  259.       REAL,     DIMENSION( ims:ime )                             , &
    260. 

  260.                 INTENT(IN   )               ::             MAVAIL, &
    261. 

  261.                                                              PBLH, &
    262. 

  262.                                                             XLAND, &
    263. 

  263.                                                               TG
    264. 

  264. !
    265. 

  265.       REAL,     DIMENSION( ims:ime )                             , &
    266. 

  266.                 INTENT(IN   )               ::             PSFCPA
    267. 

  267. 

  268.       REAL,     DIMENSION( ims:ime )                             , &
    269. 

  269.                 INTENT(INOUT)               ::             REGIME, &
    270. 

  270.                                                               HFX, &
    271. 

  271.                                                               QFX, &
    272. 

  272.                                                          MOL,RMOL
    273. 

  273. !m the following 5 are changed to memory size---
    274. 

  274. !
    275. 

  275.       REAL,     DIMENSION( ims:ime )                             , &
    276. 

  276.                 INTENT(INOUT)   ::                 GZ1OZ0,WSPD,BR, &
    277. 

  277.                                                         PSIM,PSIH
    278. 

  278. 

  279.       REAL,     DIMENSION( ims:ime )                             , &
    280. 

  280.                 INTENT(INOUT)   ::                            ZNT, &
    281. 

  281.                                                               ZOL, &
    282. 

  282.                                                               UST, &
    283. 

  283.                                                               CPM, &
    284. 

  284.                                                              CHS2, &
    285. 

  285.                                                              CQS2, &
    286. 

  286.                                                               CHS
    287. 

  287. 

  288.       REAL,     DIMENSION( ims:ime )                             , &
    289. 

  289.                 INTENT(INOUT)   ::                      FLHC,FLQC
    290. 

  290. 

  291.       REAL,     DIMENSION( ims:ime )                             , &
    292. 

  292.                 INTENT(INOUT)   ::                                 &
    293. 

  293.                                                               QGH
    294. 

  294. 

  295.       REAL,     DIMENSION( ims:ime )                             , &
    296. 

  296.                 INTENT(OUT)     ::                        U10,V10, &
    297. 

  297.                                                           QSFC,LH
    298. 

  298.                                     
    299. 

  299.       REAL,     INTENT(IN   )                    ::   CP,G,ROVCP,XLV,DX,R
    300. 

  300. 

  301. ! MODULE-LOCAL VARIABLES, DEFINED IN SUBROUTINE SFCLAY
    302. 

  302.       REAL,     DIMENSION( its:ite ),  INTENT(IN   )   ::  dz8w1d
    303. 

  303. 

  304.       REAL,     DIMENSION( its:ite ),  INTENT(IN   )   ::      US, &
    305. 

  305.                                                                VS, &
    306. 

  306.                                                              QV1D, &
    307. 

  307.                                                               P1D, &
    308. 

  308.                                                               T1D, &
    309. 

  309.                                                            THETA1
    310. 

  310.  
    311. 

  311. ! LOCAL VARS
    312. 

  312. 

  313.       REAL,     DIMENSION( its:ite )        ::                 ZA, &
    314. 

  314.                                                               TH0, &
    315. 

  315.                                                            THETAG, &
    316. 

  316.                                                                WS, &
    317. 

  317.                                                             RICUT, &
    318. 

  318.                                                              USTM, &
    319. 

  319.                                                                RA, &
    320. 

  320.                                                           THETAV1, &
    321. 

  321.                                                          MOLENGTH
    322. 

  322. !
    323. 

  323.       REAL,     DIMENSION( its:ite )        ::                     &
    324. 

  324.                                                       RHOX,GOVRTH  
    325. 

  325. !
    326. 

  326.       REAL,     DIMENSION( its:ite )        ::               PSFC
    327. 

  327. !
    328. 

  328.       INTEGER                               ::                 KL
    329. 

  329. 

  330.       INTEGER ::  N,I,K,KK,L,NZOL,NK,NZOL2,NZOL10
    331. 

  331. 

  332.       REAL    ::  PL,THCON,TVCON,E1
    333. 

  333.       REAL    ::  ZL,TSKV,DTHVDZ,DTHVM,VCONV,RZOL,RZOL2,RZOL10,ZOL2,ZOL10
    334. 

  334.       REAL    ::  DTG,PSIX,DTTHX,PSIX10,PSIT,PSIT2,PSIQ,PSIQ2
    335. 

  335.       REAL    ::  FLUXC,VSGD
    336. 

  336.       REAL    ::  XMOL,ZOBOL,Z10OL,ZNTOL,YNT,YOB,X1,X2
    337. 

  337.       REAL    ::  G2OZ0,G10OZ0,RA2,ZOLL
    338. 

  338.       REAL    ::  TV0,CPOT,RICRITI,AM,AH,SQLNZZ0,RBH,RBW,TSTV
    339. 

  339.       REAL    ::  PSIH2, PSIM2, PSIH10, PSIM10, CQS
    340. 

  340. 

  341. !-------------------------------Exicutable starts here-------------------- 
    342. 

  342. 

  343.       DO i = its,ite
    344. 

  344. ! PSFC cb
    345. 

  345.         PSFC(I)   = PSFCPA(I)/1000.
    346. 

  346.         TVCON     = 1.0 + EP1 * QV1D(I)
    347. 

  347.         THETAV1(I)= THETA1(I) * TVCON
    348. 

  348.         RHOX(I)   = PSFCPA(I)/(R*T1D(I)*TVCON)
    349. 

  349.       ENDDO
    350. 

  350. 

  351. !
    352. 

  352. !-----Compute virtual potential temperature at surface
    353. 

  353. !
    354. 

  354.       DO I=its,ite
    355. 

  355.         E1=SVP1*EXP( SVP2*(TG(I)-SVPT0)/(TG(I)-SVP3) )                       
    356. 

  356.         QSFC(I)=EP2*E1/(PSFC(I)-E1)
    357. 

  357.         
    358. 

  358. ! QGH CHANGED TO USE LOWEST-LEVEL AIR TEMP CONSISTENT WITH MYJSFC CHANGE
    359. 

  359. ! Q2SAT = QGH IN LSM
    360. 

  360.         E1=SVP1*EXP(SVP2*(T1D(I)-SVPT0)/(T1D(I)-SVP3))  
    361. 

  361.         PL = P1D(I)/1000.                     
    362. 

  362.         QGH(I)=EP2*E1/(PL-E1)                                                 
    363. 

  363.         CPM(I)=CP*(1.+0.8*QV1D(I))                                   
    364. 

  364.       ENDDO                                                                   
    365. 

  365. 

  366. !.......... compute the thetav at ground
    367. 

  367.       DO I = its, ite
    368. 

  368.         TV0       = TG(I) * (1.0 + EP1 * QSFC(I)*MAVAIL(I))
    369. 

  369.         CPOT      = (100./PSFC(I))**ROVCP 
    370. 

  370.         TH0(I)    = TV0 * (100./PSFC(I))**ROVCP
    371. 

  371.         THETAG(I) = CPOT * TG(I)
    372. 

  372.       ENDDO
    373. 

  373. !                                                                                
    374. 

  374. !-----COMPUTE THE HEIGHT OF FULL- AND HALF-SIGMA LEVELS ABOVE GROUND             
    375. 

  375. !     LEVEL, AND THE LAYER THICKNESSES.                                          
    376. 

  376. !                                                                                
    377. 

  377. !... DZ8W1D is DZ between full sigma levels and Z0 is the height of the first 
    378. 

  378. !    half sigma level
    379. 

  379.       DO I = its,ite
    380. 

  380.         ZA(I) = 0.5 * DZ8W1D(I)                                
    381. 

  381.         WS(I)   = SQRT(US(I) * US(I) + VS(I) * VS(I))
    382. 

  382.       ENDDO                                                                   
    383. 

  383. !
    384. 

  384. !-----CALCULATE BULK RICHARDSON NO. OF SURFACE LAYER, ACCORDING TO
    385. 

  385. !     AKB(1976), EQ(12).
    386. 

  386. 

  387.         RICRITI = 1.0 / RICRIT
    388. 

  388. 

  389.       DO i = its,ite
    390. 

  390.         GZ1OZ0(I) = ALOG(ZA(I) / ZNT(I))
    391. 

  391.         DTHVDZ      = THETAV1(I) - TH0(I)
    392. 

  392.         fluxc = max(hfx(i)/rhox(i)/cp                    &
    393. 

  393.               + ep1*TH0(I)*qfx(i)/rhox(i),0.)
    394. 

  394.         VCONV = vconvc*(g/tg(i)*pblh(i)*fluxc)**.33
    395. 

  395.         VSGD = 0.32 * (max(dx/5000.-1.,0.))**.33
    396. 

  396.         WSPD(I)=SQRT(WS(I)*WS(I)+VCONV*VCONV+vsgd*vsgd)
    397. 

  397.         WSPD(I)   = AMAX1(WSPD(I),0.1)
    398. 

  398.         GOVRTH(I)   = G / THETA1(I)
    399. 

  399.         BR(I)     = GOVRTH(I) * ZA(I) * DTHVDZ / (WSPD(I) * WSPD(I))
    400. 

  400.         RICUT(I)    = 1.0 / (RICRITI + GZ1OZ0(I))
    401. 

  401.       ENDDO
    402. 

  402. 

  403.       DO I = its,ite
    404. 

  404. !       -- NOTE THAT THE REGIMES USED IN HIRPBL HAVE BEEN CHANGED:
    405. 

  405.         ZOLL = 0.0
    406. 

  406.         IF (BR(I) .GE. RICUT(I)) THEN
    407. 

  407. !           -----CLASS 1; VERY STABLE CONDITIONS:  Z/L > 1
    408. 

  408.             REGIME(I) = 1.0
    409. 

  409.             ZOLL      = BR(I) * GZ1OZ0(I) / (1.0 - RICRITI * RICUT(I))
    410. 

  410.             PSIM(I)   = 1.0 - BETAM - ZOLL
    411. 

  411.             PSIH(I)   = 1.0 - BETAH - ZOLL
    412. 

  412. 

  413.         ELSE IF (BR(I) .GE. 0.0) THEN
    414. 

  414. !           -----CLASS 2; STABLE: for 1 > Z/L >0
    415. 

  415.             REGIME(I) = 2.0
    416. 

  416.             ZOLL      = BR(I) * GZ1OZ0(I) / (1.0 - RICRITI * BR(I))
    417. 

  417.             PSIM(I)   = -BETAM * ZOLL
    418. 

  418.             PSIH(I)   = -BETAH * ZOLL
    419. 

  419. 

  420.         ELSE
    421. 

  421. !        ----- CLASS 3 or 4; UNSTABLE:
    422. 

  422. !        ----- CLASS 4 IS FOR ACM NON-LOCAL CONVECTION (H/L < -3)
    423. 

  423.             REGIME(I) = 3.0   ! Regime will be reset to 4 if ACM is used
    424. 

  424.             AM          = 0.031 + 0.276 * ALOG(GZ1OZ0(I))
    425. 

  425.             AH          = 0.04 + 0.355 * ALOG(GZ1OZ0(I))
    426. 

  426.             SQLNZZ0     = SQRT(GZ1OZ0(I))
    427. 

  427.             PSIM(I)   = AM * ALOG(1.0 - BM * SQLNZZ0 * BR(I))
    428. 

  428.             PSIH(I)   = AH * ALOG(1.0 - BH * SQLNZZ0 * BR(I))
    429. 

  429. 

  430.         ENDIF
    431. 

  431.       ENDDO
    432. 

  432. !
    433. 

  433. !     -------- COMPUTE THE FRICTIONAL VELOCITY AND SURFACE FLUXES:
    434. 

  434.       DO I = its,ite
    435. 

  435.         DTG       = THETA1(I) - THETAG(I)
    436. 

  436.         PSIX      = GZ1OZ0(I) - PSIM(I)
    437. 

  437.         UST(I)=0.5*UST(I)+0.5*KARMAN*WSPD(I)/PSIX                                             
    438. 

  438.         USTM(I) = UST(I)
    439. 

  439. 

  440. !      ------- OVER WATER, ALTER ROUGHNESS LENGTH (Z0) ACCORDING TO WIND (UST).
    441. 

  441. !
    442. 

  442.         IF ((XLAND(I)-1.5) .GE. 0.0) THEN
    443. 

  443.           ZNT(I) = CZO * USTM(I) * USTM(I) / G + OZO
    444. 

  444.           GZ1OZ0(I) = ALOG(ZA(I) / ZNT(I))
    445. 

  445.           PSIX      = GZ1OZ0(I) - PSIM(I)
    446. 

  446.           UST(I)  = KARMAN * WSPD(I) / PSIX
    447. 

  447.           USTM(I) = UST(I)
    448. 

  448.         ENDIF 
    449. 

  449. 

  450.         RA(I)  = PR0 * (GZ1OZ0(I) - PSIH(I)) / (KARMAN * UST(I))
    451. 

  451.         RBH    = 5.0 / UST(I)                ! 5/U*  ! WESELY AND HICKS (1977)
    452. 

  452. !       ------- RB FOR WATER VAPOR =  5*(0.599/0.709)^2/3 /UST = 4.47/UST    hi               
    453. 

  453.         RBW    = 4.47/UST(I)                                       
    454. 

  454.         CHS(I) = 1./(RA(I) + RBH)
    455. 

  455.         CQS    = 1./(RA(I) + RBW)
    456. 

  456.         MOL(I) = DTG * CHS(I) / UST(I)                       ! This is really TST
    457. 

  457.         TSTV     = (THETAV1(I) - TH0(I)) * CHS(I) / UST(I) 
    458. 

  458.         IF (ABS(TSTV) .LT. 1.E-5)  TSTV = 1.E-5 
    459. 

  459.         MOLENGTH(I) = THETAV1(I) * UST(I) * UST(I) / (KARMAN *             &
    460. 

  460.                         G * TSTV)
    461. 

  461. !
    462. 

  462. !       ---Compute 2m surface exchange coefficients for heat and moisture
    463. 

  463.         XMOL = MOLENGTH(I)
    464. 

  464.         IF(MOLENGTH(I).GT.0.0) XMOL = AMAX1(MOLENGTH(I),2.0)       
    465. 

  465.         RMOL(I) = 1/XMOL                                           
    466. 

  466.         ZOL(I)   = ZA(I)*RMOL(I)                                                        
    467. 

  467.         ZOBOL = 1.5*RMOL(I)  
    468. 

  468.         Z10OL = 10.0*RMOL(I)                                                      
    469. 

  469.         ZNTOL = ZNT(I)*RMOL(I)                                                  
    470. 

  470.         IF(XMOL.LT.0.0) THEN
    471. 

  471.           YNT = ( 1.0 - GAMAH * ZNTOL )**0.5
    472. 

  472.           YOB = ( 1.0 - GAMAH * ZOBOL )**0.5
    473. 

  473.           PSIH2 =  2. * ALOG((YOB+1.0)/(YNT+1.0))
    474. 

  474.           x1   = (1.0 - gamam * z10ol)**0.25
    475. 

  475.           x2   = (1.0 - gamam * zntol)**0.25
    476. 

  476.           psim10 = 2.0 * ALOG( (1.0+x1) / (1.0+x2) ) +        &
    477. 

  477.                          ALOG( (1.0+x1*x1) / (1.0+x2*x2)) -   &
    478. 

  478.                          2.0 * ATAN(x1) + 2.0 * ATAN(x2)
    479. 

  479.         ELSE 
    480. 

  480.           IF((ZOBOL-ZNTOL).LE.1.0) THEN                                       
    481. 

  481.             PSIH2 = -BETAH*(ZOBOL-ZNTOL)                                     
    482. 

  482.           ELSE                                                                
    483. 

  483.             PSIH2 = 1.-BETAH-(ZOBOL-ZNTOL)                                   
    484. 

  484.           ENDIF                                                               
    485. 

  485.           IF((Z10OL-ZNTOL).LE.1.0) THEN                                       
    486. 

  486.             PSIM10 = -BETAM*(Z10OL-ZNTOL)                                     
    487. 

  487.           ELSE                                                                
    488. 

  488.             PSIM10 = 1.-BETAM-(Z10OL-ZNTOL)                                   
    489. 

  489.           ENDIF                                                               
    490. 

  490.         ENDIF 
    491. 

  491.         G2OZ0  = ALOG(1.5 / ZNT(I))
    492. 

  492.         G10OZ0 = ALOG(10.0 / ZNT(I))
    493. 

  493.         RA2  = PR0 * (G2OZ0 - PSIH2) / (KARMAN * UST(I))
    494. 

  494.         CHS2(I) = 1.0/(RA2 + RBH)
    495. 

  495.         CQS2(I) = 1.0/(RA2 + RBW) 
    496. 

  496.         U10(I)  = US(I)*(G10OZ0-PSIM10)/PSIX                                    
    497. 

  497.         V10(I)  = VS(I)*(G10OZ0-PSIM10)/PSIX                                            
    498. 

  498. 

  499. !       -----COMPUTE SURFACE HEAT AND MOIST FLUX:                                                
    500. 

  500.         FLHC(i)=CPM(I)*RHOX(I)*CHS(I)
    501. 

  501.         FLQC(i)=RHOX(I)*CQS*MAVAIL(I)
    502. 

  502.         QFX(I)=FLQC(I)*(QSFC(I)-QV1D(I))                                     
    503. 

  503.         QFX(I)=AMAX1(QFX(I),0.)                                            
    504. 

  504.         LH(I)=XLV*QFX(I)
    505. 

  505.         IF(XLAND(I)-1.5.GT.0.)THEN                                           
    506. 

  506.           HFX(I)=-FLHC(I)*DTG                               
    507. 

  507.         ELSEIF(XLAND(I)-1.5.LT.0.)THEN                                       
    508. 

  508.           HFX(I)=-FLHC(I)*DTG                               
    509. 

  509.           HFX(I)=AMAX1(HFX(I),-250.)                                       
    510. 

  510.         ENDIF      
    511. 

  511.       ENDDO                                           
    512. 

  512. 

  513. 

  514.    END SUBROUTINE PXSFCLAY1D
    515. 

  515. 

  516. !====================================================================
    517. 

  517.    SUBROUTINE pxsfclayinit( allowed_to_read )         
    518. 

  518. 

  519.    LOGICAL , INTENT(IN)      ::      allowed_to_read
    520. 

  520.    INTEGER                   ::      N
    521. 

  521.    REAL                      ::      ZOLN,X,Y
    522. 

  522. 

  523. 

  524.    END SUBROUTINE pxsfclayinit
    525. 

  525. 

  526. !-------------------------------------------------------------------          
    527. 

  527. 

  528. END MODULE module_sf_pxsfclay
    529. 

  529.