PageRenderTime 67ms CodeModel.GetById 32ms RepoModel.GetById 0ms app.codeStats 1ms

/wrfv2_fire/phys/module_sf_noahdrv.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 1834 lines | 1144 code | 180 blank | 510 comment | 22 complexity | afe644bb40ac0e37a1f4953dbdf3283e MD5 | raw file
Possible License(s): AGPL-1.0

Large files files are truncated, but you can click here to view the full file

    

  1. MODULE module_sf_noahdrv
    2. 

  2. 

  3. !-------------------------------
    4. 

  4.   USE module_sf_noahlsm
    5. 

  5.   USE module_sf_urban
    6. 

  6.   USE module_sf_bep
    7. 

  7.   USE module_sf_bep_bem
    8. 

  8. #ifdef WRF_CHEM
    9. 

  9.   USE module_data_gocart_dust
    10. 

  10. #endif
    11. 

  11. !-------------------------------
    12. 

  12. 

  13. !
    14. 

  14. CONTAINS
    15. 

  15. !
    16. 

  16. !----------------------------------------------------------------
    17. 

  17. ! Urban related variable are added to arguments - urban
    18. 

  18. !----------------------------------------------------------------
    19. 

  19.    SUBROUTINE lsm(DZ8W,QV3D,P8W3D,T3D,TSK,                      &
    20. 

  20.                   HFX,QFX,LH,GRDFLX, QGH,GSW,SWDOWN,GLW,SMSTAV,SMSTOT, &
    21. 

  21.                   SFCRUNOFF, UDRUNOFF,IVGTYP,ISLTYP,ISURBAN,ISICE,VEGFRA,    &
    22. 

  22.                   ALBEDO,ALBBCK,ZNT,Z0,TMN,XLAND,XICE,EMISS,EMBCK,   &
    23. 

  23.                   SNOWC,QSFC,RAINBL,MMINLU,                     &
    24. 

  24.                   num_soil_layers,DT,DZS,ITIMESTEP,             &
    25. 

  25.                   SMOIS,TSLB,SNOW,CANWAT,                       &
    26. 

  26.                   CHS,CHS2,CQS2,CPM,ROVCP,SR,chklowq,lai,qz0,   & !H
    27. 

  27.                   myj,frpcpn,                                   &
    28. 

  28.                   SH2O,SNOWH,                                   & !H
    29. 

  29.                   U_PHY,V_PHY,                                  & !I
    30. 

  30.                   SNOALB,SHDMIN,SHDMAX,                         & !I
    31. 

  31.                   SNOTIME,                                      & !?
    32. 

  32.                   ACSNOM,ACSNOW,                                & !O
    33. 

  33.                   SNOPCX,                                       & !O
    34. 

  34.                   POTEVP,                                       & !O
    35. 

  35.                   SMCREL,                                       & !O
    36. 

  36.                   XICE_THRESHOLD,                               &
    37. 

  37.                   RDLAI2D,USEMONALB,                            &
    38. 

  38.                   RIB,                                          & !?
    39. 

  39.                   NOAHRES,                                      &
    40. 

  40.                   ids,ide, jds,jde, kds,kde,                    &
    41. 

  41.                   ims,ime, jms,jme, kms,kme,                    &
    42. 

  42.                   its,ite, jts,jte, kts,kte,                    &
    43. 

  43.                   sf_urban_physics,                             &
    44. 

  44.                   CMR_SFCDIF,CHR_SFCDIF,CMC_SFCDIF,CHC_SFCDIF,  &
    45. 

  45. !Optional Urban
    46. 

  46.                   TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & !H urban
    47. 

  47.                   UC_URB2D,                                     & !H urban
    48. 

  48.                   XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D,  & !H urban
    49. 

  49.                   TRL_URB3D,TBL_URB3D,TGL_URB3D,                & !H urban
    50. 

  50.                   SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D,TS_URB2D,  & !H urban
    51. 

  51.                   PSIM_URB2D,PSIH_URB2D,U10_URB2D,V10_URB2D,    & !O urban
    52. 

  52.                   GZ1OZ0_URB2D,  AKMS_URB2D,                    & !O urban
    53. 

  53.                   TH2_URB2D,Q2_URB2D, UST_URB2D,                & !O urban
    54. 

  54.                   DECLIN_URB,COSZ_URB2D,OMG_URB2D,              & !I urban
    55. 

  55.                   XLAT_URB2D,                                   & !I urban
    56. 

  56.                   num_roof_layers, num_wall_layers,             & !I urban
    57. 

  57.                   num_road_layers, DZR, DZB, DZG,               & !I urban
    58. 

  58.                   FRC_URB2D,UTYPE_URB2D,                        & !O
    59. 

  59.                   num_urban_layers,                             & !I multi-layer urban
    60. 

  60.                   trb_urb4d,tw1_urb4d,tw2_urb4d,tgb_urb4d,      & !H multi-layer urban
    61. 

  61.                   tlev_urb3d,qlev_urb3d,                        & !H multi-layer urban
    62. 

  62.                   tw1lev_urb3d,tw2lev_urb3d,                    & !H multi-layer urban
    63. 

  63.                   tglev_urb3d,tflev_urb3d,                      & !H multi-layer urban
    64. 

  64.                   sf_ac_urb3d,lf_ac_urb3d,cm_ac_urb3d,          & !H multi-layer urban
    65. 

  65.                   sfvent_urb3d,lfvent_urb3d,                    & !H multi-layer urban
    66. 

  66.                   sfwin1_urb3d,sfwin2_urb3d,                    & !H multi-layer urban
    67. 

  67.                   sfw1_urb3d,sfw2_urb3d,sfr_urb3d,sfg_urb3d,    & !H multi-layer urban
    68. 

  68.                   th_phy,rho,p_phy,ust,                         & !I multi-layer urban
    69. 

  69.                   gmt,julday,xlong,xlat,                        & !I multi-layer urban
    70. 

  70.                   a_u_bep,a_v_bep,a_t_bep,a_q_bep,              & !O multi-layer urban
    71. 

  71.                   a_e_bep,b_u_bep,b_v_bep,                      & !O multi-layer urban
    72. 

  72.                   b_t_bep,b_q_bep,b_e_bep,dlg_bep,              & !O multi-layer urban
    73. 

  73.                   dl_u_bep,sf_bep,vl_bep                         )   !O multi-layer urban         
    74. 

  74. 

  75. !----------------------------------------------------------------
    76. 

  76.     IMPLICIT NONE
    77. 

  77. !----------------------------------------------------------------
    78. 

  78. !----------------------------------------------------------------
    79. 

  79. ! --- atmospheric (WRF generic) variables
    80. 

  80. !-- DT          time step (seconds)
    81. 

  81. !-- DZ8W        thickness of layers (m)
    82. 

  82. !-- T3D         temperature (K)
    83. 

  83. !-- QV3D        3D water vapor mixing ratio (Kg/Kg)
    84. 

  84. !-- P3D         3D pressure (Pa)
    85. 

  85. !-- FLHC        exchange coefficient for heat (m/s)
    86. 

  86. !-- FLQC        exchange coefficient for moisture (m/s)
    87. 

  87. !-- PSFC        surface pressure (Pa)
    88. 

  88. !-- XLAND       land mask (1 for land, 2 for water)
    89. 

  89. !-- QGH         saturated mixing ratio at 2 meter
    90. 

  90. !-- GSW         downward short wave flux at ground surface (W/m^2)
    91. 

  91. !-- GLW         downward long wave flux at ground surface (W/m^2)
    92. 

  92. !-- History variables
    93. 

  93. !-- CANWAT      canopy moisture content (mm)
    94. 

  94. !-- TSK         surface temperature (K)
    95. 

  95. !-- TSLB        soil temp (k)
    96. 

  96. !-- SMOIS       total soil moisture content (volumetric fraction)
    97. 

  97. !-- SH2O        unfrozen soil moisture content (volumetric fraction)
    98. 

  98. !                note: frozen soil moisture (i.e., soil ice) = SMOIS - SH2O
    99. 

  99. !-- SNOWH       actual snow depth (m)
    100. 

  100. !-- SNOW        liquid water-equivalent snow depth (m)
    101. 

  101. !-- ALBEDO      time-varying surface albedo including snow effect (unitless fraction)
    102. 

  102. !-- ALBBCK      background surface albedo (unitless fraction)
    103. 

  103. !-- CHS          surface exchange coefficient for heat and moisture (m s-1);
    104. 

  104. !-- CHS2        2m surface exchange coefficient for heat  (m s-1);
    105. 

  105. !-- CQS2        2m surface exchange coefficient for moisture (m s-1);
    106. 

  106. ! --- soil variables
    107. 

  107. !-- num_soil_layers   the number of soil layers
    108. 

  108. !-- ZS          depths of centers of soil layers   (m)
    109. 

  109. !-- DZS         thicknesses of soil layers (m)
    110. 

  110. !-- SLDPTH      thickness of each soil layer (m, same as DZS)
    111. 

  111. !-- TMN         soil temperature at lower boundary (K)
    112. 

  112. !-- SMCWLT      wilting point (volumetric)
    113. 

  113. !-- SMCDRY      dry soil moisture threshold where direct evap from
    114. 

  114. !               top soil layer ends (volumetric)
    115. 

  115. !-- SMCREF      soil moisture threshold below which transpiration begins to
    116. 

  116. !                   stress (volumetric)
    117. 

  117. !-- SMCMAX      porosity, i.e. saturated value of soil moisture (volumetric)
    118. 

  118. !-- NROOT       number of root layers, a function of veg type, determined
    119. 

  119. !               in subroutine redprm.
    120. 

  120. !-- SMSTAV      Soil moisture availability for evapotranspiration (
    121. 

  121. !                   fraction between SMCWLT and SMCMXA)
    122. 

  122. !-- SMSTOT      Total soil moisture content frozen+unfrozen) in the soil column (mm)
    123. 

  123. ! --- snow variables
    124. 

  124. !-- SNOWC       fraction snow coverage (0-1.0)
    125. 

  125. ! --- vegetation variables
    126. 

  126. !-- SNOALB      upper bound on maximum albedo over deep snow
    127. 

  127. !-- SHDMIN      minimum areal fractional coverage of annual green vegetation
    128. 

  128. !-- SHDMAX      maximum areal fractional coverage of annual green vegetation
    129. 

  129. !-- XLAI        leaf area index (dimensionless)
    130. 

  130. !-- Z0BRD       Background fixed roughness length (M)
    131. 

  131. !-- Z0          Background vroughness length (M) as function
    132. 

  132. !-- ZNT         Time varying roughness length (M) as function
    133. 

  133. !-- ALBD(IVGTPK,ISN) background albedo reading from a table
    134. 

  134. ! --- LSM output
    135. 

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

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

  137. !-- LH          upward moisture flux at the surface (W m-2)
    138. 

  138. !-- GRDFLX(I,J) ground heat flux (W m-2)
    139. 

  139. !-- FDOWN       radiation forcing at the surface (W m-2) = SOLDN*(1-alb)+LWDN
    140. 

  140. !----------------------------------------------------------------------------
    141. 

  141. !-- EC          canopy water evaporation ((W m-2)
    142. 

  142. !-- EDIR        direct soil evaporation (W m-2)
    143. 

  143. !-- ET          plant transpiration from a particular root layer (W m-2)
    144. 

  144. !-- ETT         total plant transpiration (W m-2)
    145. 

  145. !-- ESNOW       sublimation from (or deposition to if <0) snowpack (W m-2)
    146. 

  146. !-- DRIP        through-fall of precip and/or dew in excess of canopy
    147. 

  147. !                 water-holding capacity (m)
    148. 

  148. !-- DEW         dewfall (or frostfall for t<273.15) (M)
    149. 

  149. !-- SMAV        Soil Moisture Availability for each layer, as a fraction
    150. 

  150. !                 between SMCWLT and SMCMAX (dimensionless fraction)
    151. 

  151. ! ----------------------------------------------------------------------
    152. 

  152. !-- BETA        ratio of actual/potential evap (dimensionless)
    153. 

  153. !-- ETP         potential evaporation (W m-2)
    154. 

  154. ! ----------------------------------------------------------------------
    155. 

  155. !-- FLX1        precip-snow sfc (W m-2)
    156. 

  156. !-- FLX2        freezing rain latent heat flux (W m-2)
    157. 

  157. !-- FLX3        phase-change heat flux from snowmelt (W m-2)
    158. 

  158. ! ----------------------------------------------------------------------
    159. 

  159. !-- ACSNOM      snow melt (mm) (water equivalent)
    160. 

  160. !-- ACSNOW      accumulated snow fall (mm) (water equivalent)
    161. 

  161. !-- SNOPCX      snow phase change heat flux (W/m^2)
    162. 

  162. !-- POTEVP      accumulated potential evaporation (W/m^2)
    163. 

  163. !-- RIB         Documentation needed!!!
    164. 

  164. ! ----------------------------------------------------------------------
    165. 

  165. !-- RUNOFF1     surface runoff (m s-1), not infiltrating the surface
    166. 

  166. !-- RUNOFF2     subsurface runoff (m s-1), drainage out bottom of last
    167. 

  167. !                  soil layer (baseflow)
    168. 

  168. !  important note: here RUNOFF2 is actually the sum of RUNOFF2 and RUNOFF3
    169. 

  169. !-- RUNOFF3     numerical trunctation in excess of porosity (smcmax)
    170. 

  170. !                  for a given soil layer at the end of a time step (m s-1).
    171. 

  171. !SFCRUNOFF     Surface Runoff (mm)
    172. 

  172. !UDRUNOFF      Total Underground Runoff (mm), which is the sum of RUNOFF2 and RUNOFF3
    173. 

  173. ! ----------------------------------------------------------------------
    174. 

  174. !-- RC          canopy resistance (s m-1)
    175. 

  175. !-- PC          plant coefficient (unitless fraction, 0-1) where PC*ETP = actual transp
    176. 

  176. !-- RSMIN       minimum canopy resistance (s m-1)
    177. 

  177. !-- RCS         incoming solar rc factor (dimensionless)
    178. 

  178. !-- RCT         air temperature rc factor (dimensionless)
    179. 

  179. !-- RCQ         atmos vapor pressure deficit rc factor (dimensionless)
    180. 

  180. !-- RCSOIL      soil moisture rc factor (dimensionless)
    181. 

  181. 

  182. !-- EMISS       surface emissivity (between 0 and 1)
    183. 

  183. !-- EMBCK       Background surface emissivity (between 0 and 1)
    184. 

  184. 

  185. !-- ROVCP       R/CP
    186. 

  186. !               (R_d/R_v) (dimensionless)
    187. 

  187. !-- ids         start index for i in domain
    188. 

  188. !-- ide         end index for i in domain
    189. 

  189. !-- jds         start index for j in domain
    190. 

  190. !-- jde         end index for j in domain
    191. 

  191. !-- kds         start index for k in domain
    192. 

  192. !-- kde         end index for k in domain
    193. 

  193. !-- ims         start index for i in memory
    194. 

  194. !-- ime         end index for i in memory
    195. 

  195. !-- jms         start index for j in memory
    196. 

  196. !-- jme         end index for j in memory
    197. 

  197. !-- kms         start index for k in memory
    198. 

  198. !-- kme         end index for k in memory
    199. 

  199. !-- its         start index for i in tile
    200. 

  200. !-- ite         end index for i in tile
    201. 

  201. !-- jts         start index for j in tile
    202. 

  202. !-- jte         end index for j in tile
    203. 

  203. !-- kts         start index for k in tile
    204. 

  204. !-- kte         end index for k in tile
    205. 

  205. !
    206. 

  206. !-- SR          fraction of frozen precip (0.0 to 1.0)
    207. 

  207. !----------------------------------------------------------------
    208. 

  208. 

  209. ! IN only
    210. 

  210. 

  211.    INTEGER,  INTENT(IN   )   ::     ids,ide, jds,jde, kds,kde,  &
    212. 

  212.                                     ims,ime, jms,jme, kms,kme,  &
    213. 

  213.                                     its,ite, jts,jte, kts,kte
    214. 

  214. 

  215.    INTEGER,  INTENT(IN   )   ::  sf_urban_physics               !urban
    216. 

  216.    INTEGER,  INTENT(IN   )   ::  isurban
    217. 

  217.    INTEGER,  INTENT(IN   )   ::  isice
    218. 

  218. 

  219.    REAL,    DIMENSION( ims:ime, jms:jme )                     , &
    220. 

  220.             INTENT(IN   )    ::                            TMN, &
    221. 

  221.                                                          XLAND, &
    222. 

  222.                                                           XICE, &
    223. 

  223.                                                         VEGFRA, &
    224. 

  224.                                                         SHDMIN, &
    225. 

  225.                                                         SHDMAX, &
    226. 

  226.                                                         SNOALB, &
    227. 

  227.                                                            GSW, &
    228. 

  228.                                                         SWDOWN, & !added 10 jan 2007
    229. 

  229.                                                            GLW, &
    230. 

  230.                                                         RAINBL, &
    231. 

  231.                                                         EMBCK,  &
    232. 

  232.                                                         SR
    233. 

  233. 

  234.    REAL,    DIMENSION( ims:ime, jms:jme )                     , &
    235. 

  235.             INTENT(INOUT)    ::                         ALBBCK, &
    236. 

  236.                                                             Z0
    237. 

  237.    CHARACTER(LEN=*), INTENT(IN   )    ::                 MMINLU
    238. 

  238. 

  239.    REAL,    DIMENSION( ims:ime, kms:kme, jms:jme )            , &
    240. 

  240.             INTENT(IN   )    ::                           QV3D, &
    241. 

  241.                                                          p8w3D, &
    242. 

  242.                                                           DZ8W, &
    243. 

  243.                                                           T3D
    244. 

  244.    REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    245. 

  245.              INTENT(IN   )               ::               QGH,  &
    246. 

  246.                                                           CPM
    247. 

  247. 

  248.    INTEGER, DIMENSION( ims:ime, jms:jme )                     , &
    249. 

  249.             INTENT(IN   )    ::                         IVGTYP, &
    250. 

  250.                                                         ISLTYP
    251. 

  251. 

  252.    INTEGER, INTENT(IN)       ::     num_soil_layers,ITIMESTEP
    253. 

  253. 

  254.    REAL,     INTENT(IN   )   ::     DT,ROVCP
    255. 

  255. 

  256.    REAL,     DIMENSION(1:num_soil_layers), INTENT(IN)::DZS
    257. 

  257. 

  258. ! IN and OUT
    259. 

  259. 

  260.    REAL,     DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &
    261. 

  261.              INTENT(INOUT)   ::                          SMOIS, & ! total soil moisture
    262. 

  262.                                                          SH2O,  & ! new soil liquid
    263. 

  263.                                                          TSLB     ! TSLB     STEMP
    264. 

  264. 

  265.    REAL,     DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &
    266. 

  266.              INTENT(OUT)     ::                         SMCREL
    267. 

  267. 

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

  269.             INTENT(INOUT)    ::                            TSK, & !was TGB (temperature)
    270. 

  270.                                                            HFX, &
    271. 

  271.                                                            QFX, &
    272. 

  272.                                                             LH, &
    273. 

  273.                                                         GRDFLX, &
    274. 

  274.                                                           QSFC,&
    275. 

  275.                                                           CQS2,&
    276. 

  276.                                                           CHS,   &
    277. 

  277.                                                           CHS2,&
    278. 

  278.                                                           SNOW, &
    279. 

  279.                                                          SNOWC, &
    280. 

  280.                                                          SNOWH, & !new
    281. 

  281.                                                         CANWAT, &
    282. 

  282.                                                         SMSTAV, &
    283. 

  283.                                                         SMSTOT, &
    284. 

  284.                                                      SFCRUNOFF, &
    285. 

  285.                                                       UDRUNOFF, &
    286. 

  286.                                                         ACSNOM, &
    287. 

  287.                                                         ACSNOW, &
    288. 

  288.                                                        SNOTIME, &
    289. 

  289.                                                         SNOPCX, &
    290. 

  290.                                                         EMISS,  &
    291. 

  291.                                                           RIB,  &
    292. 

  292.                                                         POTEVP, &
    293. 

  293.                                                         ALBEDO, &
    294. 

  294.                                                            ZNT
    295. 

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

  296.             INTENT(OUT)      ::                         NOAHRES
    297. 

  297. 

  298.    REAL,    DIMENSION( ims:ime, jms:jme )                     , &
    299. 

  299.                INTENT(OUT)    ::                        CHKLOWQ
    300. 

  300.    REAL,    DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LAI
    301. 

  301.    REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) ::        QZ0
    302. 

  302. 

  303.    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMR_SFCDIF
    304. 

  304.    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHR_SFCDIF
    305. 

  305.    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMC_SFCDIF
    306. 

  306.    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHC_SFCDIF
    307. 

  307. ! Local variables (moved here from driver to make routine thread safe, 20031007 jm)
    308. 

  308. 

  309.       REAL, DIMENSION(1:num_soil_layers) ::  ET
    310. 

  310. 

  311.       REAL, DIMENSION(1:num_soil_layers) ::  SMAV
    312. 

  312. 

  313.       REAL  ::  BETA, ETP, SSOIL,EC, EDIR, ESNOW, ETT,        &
    314. 

  314.                 FLX1,FLX2,FLX3, DRIP,DEW,FDOWN,RC,PC,RSMIN,XLAI,  &
    315. 

  315. !                RCS,RCT,RCQ,RCSOIL
    316. 

  316.                 RCS,RCT,RCQ,RCSOIL,FFROZP
    317. 

  317. 

  318.     LOGICAL,    INTENT(IN   )    ::     myj,frpcpn
    319. 

  319. 

  320. ! DECLARATIONS - LOGICAL
    321. 

  321. ! ----------------------------------------------------------------------
    322. 

  322.       LOGICAL, PARAMETER :: LOCAL=.false.
    323. 

  323.       LOGICAL :: FRZGRA, SNOWNG
    324. 

  324. 

  325.       LOGICAL :: IPRINT
    326. 

  326. 

  327. ! ----------------------------------------------------------------------
    328. 

  328. ! DECLARATIONS - INTEGER
    329. 

  329. ! ----------------------------------------------------------------------
    330. 

  330.       INTEGER :: I,J, ICE,NSOIL,SLOPETYP,SOILTYP,VEGTYP
    331. 

  331.       INTEGER :: NROOT
    332. 

  332.       INTEGER :: KZ ,K
    333. 

  333.       INTEGER :: NS
    334. 

  334. ! ----------------------------------------------------------------------
    335. 

  335. ! DECLARATIONS - REAL
    336. 

  336. ! ----------------------------------------------------------------------
    337. 

  337. 

  338.       REAL  :: SHMIN,SHMAX,DQSDT2,LWDN,PRCP,PRCPRAIN,                    &
    339. 

  339.                Q2SAT,Q2SATI,SFCPRS,SFCSPD,SFCTMP,SHDFAC,SNOALB1,         &
    340. 

  340.                SOLDN,TBOT,ZLVL, Q2K,ALBBRD, ALBEDOK, ETA, ETA_KINEMATIC, &
    341. 

  341.                EMBRD,                                                    &
    342. 

  342.                Z0K,RUNOFF1,RUNOFF2,RUNOFF3,SHEAT,SOLNET,E2SAT,SFCTSNO,   &
    343. 

  343. ! mek, WRF testing, expanded diagnostics
    344. 

  344.                SOLUP,LWUP,RNET,RES,Q1SFC,TAIRV,SATFLG
    345. 

  345. ! MEK MAY 2007
    346. 

  346.       REAL ::  FDTLIW
    347. 

  347. ! MEK JUL2007 for pot. evap.
    348. 

  348.       REAL :: RIBB
    349. 

  349.       REAL ::  FDTW
    350. 

  350. 

  351.       REAL  :: EMISSI
    352. 

  352. 

  353.       REAL  :: SNCOVR,SNEQV,SNOWHK,CMC, CHK,TH2
    354. 

  354. 

  355.       REAL  :: SMCDRY,SMCMAX,SMCREF,SMCWLT,SNOMLT,SOILM,SOILW,Q1,T1
    356. 

  356.       REAL  :: SNOTIME1    ! LSTSNW1 INITIAL NUMBER OF TIMESTEPS SINCE LAST SNOWFALL
    357. 

  357. 

  358.       REAL  :: DUMMY,Z0BRD
    359. 

  359. !
    360. 

  360.       REAL  :: COSZ, SOLARDIRECT
    361. 

  361. !
    362. 

  362.       REAL, DIMENSION(1:num_soil_layers)::  SLDPTH, STC,SMC,SWC
    363. 

  363. !
    364. 

  364.       REAL, DIMENSION(1:num_soil_layers) ::     ZSOIL, RTDIS
    365. 

  365.       REAL, PARAMETER  :: TRESH=.95E0, A2=17.67,A3=273.15,A4=29.65,   &
    366. 

  366.                           T0=273.16E0, ELWV=2.50E6,  A23M4=A2*(A3-A4)
    367. 

  367. ! MEK MAY 2007
    368. 

  368.       REAL, PARAMETER  :: ROW=1.E3,ELIW=XLF,ROWLIW=ROW*ELIW
    369. 

  369. 

  370. ! ----------------------------------------------------------------------
    371. 

  371. ! DECLARATIONS START - urban
    372. 

  372. ! ----------------------------------------------------------------------
    373. 

  373. 

  374. ! input variables surface_driver --> lsm
    375. 

  375.      INTEGER, INTENT(IN) :: num_roof_layers
    376. 

  376.      INTEGER, INTENT(IN) :: num_wall_layers
    377. 

  377.      INTEGER, INTENT(IN) :: num_road_layers
    378. 

  378.      REAL, OPTIONAL, DIMENSION(1:num_roof_layers), INTENT(IN) :: DZR
    379. 

  379.      REAL, OPTIONAL, DIMENSION(1:num_wall_layers), INTENT(IN) :: DZB
    380. 

  380.      REAL, OPTIONAL, DIMENSION(1:num_road_layers), INTENT(IN) :: DZG
    381. 

  381.      REAL, OPTIONAL, INTENT(IN) :: DECLIN_URB
    382. 

  382.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZ_URB2D
    383. 

  383.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: OMG_URB2D
    384. 

  384.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: XLAT_URB2D
    385. 

  385.      REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) :: U_PHY
    386. 

  386.      REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) :: V_PHY
    387. 

  387.      REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) :: TH_PHY
    388. 

  388.      REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) :: P_PHY
    389. 

  389.      REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) :: RHO
    390. 

  390.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UST
    391. 

  391. 

  392.      LOGICAL, intent(in) :: rdlai2d
    393. 

  393.      LOGICAL, intent(in) :: USEMONALB
    394. 

  394. 

  395. ! input variables lsm --> urban
    396. 

  396.      INTEGER :: UTYPE_URB ! urban type [urban=1, suburban=2, rural=3]
    397. 

  397.      REAL :: TA_URB       ! potential temp at 1st atmospheric level [K]
    398. 

  398.      REAL :: QA_URB       ! mixing ratio at 1st atmospheric level  [kg/kg]
    399. 

  399.      REAL :: UA_URB       ! wind speed at 1st atmospheric level    [m/s]
    400. 

  400.      REAL :: U1_URB       ! u at 1st atmospheric level             [m/s]
    401. 

  401.      REAL :: V1_URB       ! v at 1st atmospheric level             [m/s]
    402. 

  402.      REAL :: SSG_URB      ! downward total short wave radiation    [W/m/m]
    403. 

  403.      REAL :: LLG_URB      ! downward long wave radiation           [W/m/m]
    404. 

  404.      REAL :: RAIN_URB     ! precipitation                          [mm/h]
    405. 

  405.      REAL :: RHOO_URB     ! air density                            [kg/m^3]
    406. 

  406.      REAL :: ZA_URB       ! first atmospheric level                [m]
    407. 

  407.      REAL :: DELT_URB     ! time step                              [s]
    408. 

  408.      REAL :: SSGD_URB     ! downward direct short wave radiation   [W/m/m]
    409. 

  409.      REAL :: SSGQ_URB     ! downward diffuse short wave radiation  [W/m/m]
    410. 

  410.      REAL :: XLAT_URB     ! latitude                               [deg]
    411. 

  411.      REAL :: COSZ_URB     ! cosz
    412. 

  412.      REAL :: OMG_URB      ! hour angle
    413. 

  413.      REAL :: ZNT_URB      ! roughness length                       [m]
    414. 

  414.      REAL :: TR_URB
    415. 

  415.      REAL :: TB_URB
    416. 

  416.      REAL :: TG_URB
    417. 

  417.      REAL :: TC_URB
    418. 

  418.      REAL :: QC_URB
    419. 

  419.      REAL :: UC_URB
    420. 

  420.      REAL :: XXXR_URB
    421. 

  421.      REAL :: XXXB_URB
    422. 

  422.      REAL :: XXXG_URB
    423. 

  423.      REAL :: XXXC_URB
    424. 

  424.      REAL, DIMENSION(1:num_roof_layers) :: TRL_URB  ! roof layer temp [K]
    425. 

  425.      REAL, DIMENSION(1:num_wall_layers) :: TBL_URB  ! wall layer temp [K]
    426. 

  426.      REAL, DIMENSION(1:num_road_layers) :: TGL_URB  ! road layer temp [K]
    427. 

  427.      LOGICAL  :: LSOLAR_URB
    428. 

  428. ! state variable surface_driver <--> lsm <--> urban
    429. 

  429.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D
    430. 

  430.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D
    431. 

  431.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D
    432. 

  432.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D
    433. 

  433.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D
    434. 

  434.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UC_URB2D
    435. 

  435.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D
    436. 

  436.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D
    437. 

  437.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D
    438. 

  438.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D
    439. 

  439.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D
    440. 

  440.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D
    441. 

  441.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D
    442. 

  442.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D
    443. 

  443. !
    444. 

  444.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D
    445. 

  445. 

  446.      REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D
    447. 

  447.      REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_wall_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D
    448. 

  448.      REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_road_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D
    449. 

  449. 

  450. ! output variable lsm --> surface_driver
    451. 

  451.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: PSIM_URB2D
    452. 

  452.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: PSIH_URB2D
    453. 

  453.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: GZ1OZ0_URB2D
    454. 

  454.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: U10_URB2D
    455. 

  455.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: V10_URB2D
    456. 

  456.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: TH2_URB2D
    457. 

  457.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: Q2_URB2D
    458. 

  458. !
    459. 

  459.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: AKMS_URB2D
    460. 

  460. !
    461. 

  461.      REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: UST_URB2D
    462. 

  462.      REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: FRC_URB2D
    463. 

  463.      INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: UTYPE_URB2D
    464. 

  464. 

  465. 

  466. ! output variables urban --> lsm
    467. 

  467.      REAL :: TS_URB     ! surface radiative temperature    [K]
    468. 

  468.      REAL :: QS_URB     ! surface humidity                 [-]
    469. 

  469.      REAL :: SH_URB     ! sensible heat flux               [W/m/m]
    470. 

  470.      REAL :: LH_URB     ! latent heat flux                 [W/m/m]
    471. 

  471.      REAL :: LH_KINEMATIC_URB ! latent heat flux, kinetic  [kg/m/m/s]
    472. 

  472.      REAL :: SW_URB     ! upward short wave radiation flux [W/m/m]
    473. 

  473.      REAL :: ALB_URB    ! time-varying albedo            [fraction]
    474. 

  474.      REAL :: LW_URB     ! upward long wave radiation flux  [W/m/m]
    475. 

  475.      REAL :: G_URB      ! heat flux into the ground        [W/m/m]
    476. 

  476.      REAL :: RN_URB     ! net radiation                    [W/m/m]
    477. 

  477.      REAL :: PSIM_URB   ! shear f for momentum             [-]
    478. 

  478.      REAL :: PSIH_URB   ! shear f for heat                 [-]
    479. 

  479.      REAL :: GZ1OZ0_URB   ! shear f for heat                 [-]
    480. 

  480.      REAL :: U10_URB    ! wind u component at 10 m         [m/s]
    481. 

  481.      REAL :: V10_URB    ! wind v component at 10 m         [m/s]
    482. 

  482.      REAL :: TH2_URB    ! potential temperature at 2 m     [K]
    483. 

  483.      REAL :: Q2_URB     ! humidity at 2 m                  [-]
    484. 

  484.      REAL :: CHS_URB
    485. 

  485.      REAL :: CHS2_URB
    486. 

  486.      REAL :: UST_URB
    487. 

  487. ! Variables for multi-layer UCM (Martilli et al. 2002)
    488. 

  488.    REAL, OPTIONAL, INTENT(IN  )   ::                                   GMT 
    489. 

  489.    INTEGER, OPTIONAL, INTENT(IN  ) ::                               JULDAY
    490. 

  490.    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   )        ::XLAT, XLONG
    491. 

  491.    INTEGER, INTENT(IN  ) ::                               NUM_URBAN_LAYERS
    492. 

  492.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: trb_urb4d
    493. 

  493.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw1_urb4d
    494. 

  494.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw2_urb4d
    495. 

  495.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tgb_urb4d
    496. 

  496.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tlev_urb3d
    497. 

  497.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: qlev_urb3d
    498. 

  498.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw1lev_urb3d
    499. 

  499.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw2lev_urb3d
    500. 

  500.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tglev_urb3d
    501. 

  501.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tflev_urb3d
    502. 

  502.    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: lf_ac_urb3d
    503. 

  503.    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sf_ac_urb3d
    504. 

  504.    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: cm_ac_urb3d
    505. 

  505.    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sfvent_urb3d
    506. 

  506.    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: lfvent_urb3d
    507. 

  507.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfwin1_urb3d
    508. 

  508.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfwin2_urb3d
    509. 

  509.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfw1_urb3d
    510. 

  510.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfw2_urb3d
    511. 

  511.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfr_urb3d
    512. 

  512.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfg_urb3d
    513. 

  513.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_u_bep   !Implicit momemtum component X-direction
    514. 

  514.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_v_bep   !Implicit momemtum component Y-direction
    515. 

  515.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_t_bep   !Implicit component pot. temperature
    516. 

  516.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_q_bep   !Implicit momemtum component X-direction
    517. 

  517.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_e_bep   !Implicit component TKE
    518. 

  518.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_u_bep   !Explicit momentum component X-direction
    519. 

  519.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_v_bep   !Explicit momentum component Y-direction
    520. 

  520.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_t_bep   !Explicit component pot. temperature
    521. 

  521.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_q_bep   !Implicit momemtum component Y-direction
    522. 

  522.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_e_bep   !Explicit component TKE
    523. 

  523.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::vl_bep    !Fraction air volume in grid cell
    524. 

  524.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::dlg_bep   !Height above ground
    525. 

  525.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::sf_bep  !Fraction air at the face of grid cell
    526. 

  526.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::dl_u_bep  !Length scale
    527. 

  527. 

  528. ! Local variables for multi-layer UCM (Martilli et al. 2002)
    529. 

  529.    REAL,    DIMENSION( ims:ime, jms:jme ) :: HFX_RURAL,LH_RURAL,GRDFLX_RURAL,RN_RURAL
    530. 

  530.    REAL,    DIMENSION( ims:ime, jms:jme ) :: QFX_RURAL,QSFC_RURAL,UMOM_RURAL,VMOM_RURAL
    531. 

  531.    REAL,    DIMENSION( ims:ime, jms:jme ) :: ALB_RURAL,EMISS_RURAL,UST_RURAL,TSK_RURAL
    532. 

  532. !   REAL,    DIMENSION( ims:ime, jms:jme ) :: GRDFLX_URB
    533. 

  533. !   REAL,    DIMENSION( ims:ime, jms:jme ) :: QFX_URB,QSFC_URB,UMOM_URB,VMOM_URB
    534. 

  534.    REAL,    DIMENSION( ims:ime, jms:jme ) :: HFX_URB,UMOM_URB,VMOM_URB
    535. 

  535.    REAL,    DIMENSION( ims:ime, jms:jme ) :: QFX_URB
    536. 

  536. !   REAL,    DIMENSION( ims:ime, jms:jme ) :: ALBEDO_URB,EMISS_URB,UMOM,VMOM,UST
    537. 

  537.    REAL, DIMENSION(ims:ime,jms:jme) ::EMISS_URB
    538. 

  538.    REAL, DIMENSION(ims:ime,jms:jme) :: RL_UP_URB
    539. 

  539.    REAL, DIMENSION(ims:ime,jms:jme) ::RS_ABS_URB
    540. 

  540.    REAL, DIMENSION(ims:ime,jms:jme) ::GRDFLX_URB
    541. 

  541.    REAL :: SIGMA_SB,RL_UP_RURAL,RL_UP_TOT,RS_ABS_TOT,UMOM,VMOM
    542. 

  542.    REAL :: r1,r2,r3
    543. 

  543.    REAL :: CMR_URB, CHR_URB, CMC_URB, CHC_URB
    544. 

  544. ! ----------------------------------------------------------------------
    545. 

  545. ! DECLARATIONS END - urban
    546. 

  546. ! ----------------------------------------------------------------------
    547. 

  547. 

  548.   REAL, PARAMETER  :: CAPA=R_D/CP
    549. 

  549.   REAL :: APELM,APES,SFCTH2,PSFC
    550. 

  550.   real, intent(in) :: xice_threshold
    551. 

  551.   character(len=80) :: message_text
    552. 

  552. 

  553. ! MEK MAY 2007
    554. 

  554.       FDTLIW=DT/ROWLIW
    555. 

  555. ! MEK JUL2007
    556. 

  556.       FDTW=DT/(XLV*RHOWATER)
    557. 

  557. ! debug printout
    558. 

  558.          IPRINT=.false.
    559. 

  559. 

  560. !      SLOPETYP=2
    561. 

  561.       SLOPETYP=1
    562. 

  562. !      SHDMIN=0.00
    563. 

  563. 

  564. 

  565.       NSOIL=num_soil_layers
    566. 

  566. 

  567.      DO NS=1,NSOIL
    568. 

  568.      SLDPTH(NS)=DZS(NS)
    569. 

  569.      ENDDO
    570. 

  570. 

  571.      JLOOP : DO J=jts,jte
    572. 

  572. 

  573.       IF(ITIMESTEP.EQ.1)THEN
    574. 

  574.         DO 50 I=its,ite
    575. 

  575. !*** initialize soil conditions for IHOP 31 May case
    576. 

  576. !         IF((XLAND(I,J)-1.5) < 0.)THEN
    577. 

  577. !            if (I==108.and.j==85) then
    578. 

  578. !                  DO NS=1,NSOIL
    579. 

  579. !                      SMOIS(I,NS,J)=0.10
    580. 

  580. !                      SH2O(I,NS,J)=0.10
    581. 

  581. !                  enddo
    582. 

  582. !             endif
    583. 

  583. !         ENDIF
    584. 

  584. 

  585. !*** SET ZERO-VALUE FOR SOME OUTPUT DIAGNOSTIC ARRAYS
    586. 

  586.           IF((XLAND(I,J)-1.5).GE.0.)THEN
    587. 

  587. ! check sea-ice point
    588. 

  588. #if 0
    589. 

  589.             IF( XICE(I,J).GE. XICE_THRESHOLD .and. IPRINT ) PRINT*, ' sea-ice at water point, I=',I,'J=',J
    590. 

  590. #endif
    591. 

  591. !***   Open Water Case
    592. 

  592.             SMSTAV(I,J)=1.0
    593. 

  593.             SMSTOT(I,J)=1.0
    594. 

  594.             DO NS=1,NSOIL
    595. 

  595.               SMOIS(I,NS,J)=1.0
    596. 

  596.               TSLB(I,NS,J)=273.16                                          !STEMP
    597. 

  597.               SMCREL(I,NS,J)=1.0
    598. 

  598.             ENDDO
    599. 

  599.           ELSE
    600. 

  600.             IF ( XICE(I,J) .GE. XICE_THRESHOLD ) THEN
    601. 

  601. !***        SEA-ICE CASE
    602. 

  602.               SMSTAV(I,J)=1.0
    603. 

  603.               SMSTOT(I,J)=1.0
    604. 

  604.               DO NS=1,NSOIL
    605. 

  605.                 SMOIS(I,NS,J)=1.0
    606. 

  606.                 SMCREL(I,NS,J)=1.0
    607. 

  607.               ENDDO
    608. 

  608.             ENDIF
    609. 

  609.           ENDIF
    610. 

  610. !
    611. 

  611.    50   CONTINUE
    612. 

  612.       ENDIF                                                               ! end of initialization over ocean
    613. 

  613. 

  614. !-----------------------------------------------------------------------
    615. 

  615.       ILOOP : DO I=its,ite
    616. 

  616. ! surface pressure
    617. 

  617.         PSFC=P8w3D(i,1,j)
    618. 

  618. ! pressure in middle of lowest layer
    619. 

  619.         SFCPRS=(P8W3D(I,KTS+1,j)+P8W3D(i,KTS,j))*0.5
    620. 

  620. ! convert from mixing ratio to specific humidity
    621. 

  621.          Q2K=QV3D(i,1,j)/(1.0+QV3D(i,1,j))
    622. 

  622. !
    623. 

  623. !         Q2SAT=QGH(I,j)
    624. 

  624.          Q2SAT=QGH(I,J)/(1.0+QGH(I,J))        ! Q2SAT is sp humidity
    625. 

  625. ! add check on myj=.true.
    626. 

  626. !        IF((Q2K.GE.Q2SAT*TRESH).AND.Q2K.LT.QZ0(I,J))THEN
    627. 

  627.         IF((myj).AND.(Q2K.GE.Q2SAT*TRESH).AND.Q2K.LT.QZ0(I,J))THEN
    628. 

  628.           SATFLG=0.
    629. 

  629.           CHKLOWQ(I,J)=0.
    630. 

  630.         ELSE
    631. 

  631.           SATFLG=1.0
    632. 

  632.           CHKLOWQ(I,J)=1.
    633. 

  633.         ENDIF
    634. 

  634. 

  635.         SFCTMP=T3D(i,1,j)
    636. 

  636.         ZLVL=0.5*DZ8W(i,1,j)
    637. 

  637. 

  638. !        TH2=SFCTMP+(0.0097545*ZLVL)
    639. 

  639. ! calculate SFCTH2 via Exner function vs lapse-rate (above)
    640. 

  640.          APES=(1.E5/PSFC)**CAPA
    641. 

  641.          APELM=(1.E5/SFCPRS)**CAPA
    642. 

  642.          SFCTH2=SFCTMP*APELM
    643. 

  643.          TH2=SFCTH2/APES
    644. 

  644. !
    645. 

  645.          EMISSI = EMISS(I,J)
    646. 

  646.          LWDN=GLW(I,J)*EMISSI
    647. 

  647. ! SOLDN is total incoming solar
    648. 

  648.         SOLDN=SWDOWN(I,J)
    649. 

  649. ! GSW is net downward solar
    650. 

  650. !        SOLNET=GSW(I,J)
    651. 

  651. ! use mid-day albedo to determine net downward solar (no solar zenith angle correction)
    652. 

  652.         SOLNET=SOLDN*(1.-ALBEDO(I,J))
    653. 

  653.         PRCP=RAINBL(i,j)/DT
    654. 

  654.         VEGTYP=IVGTYP(I,J)
    655. 

  655.         SOILTYP=ISLTYP(I,J)
    656. 

  656.         SHDFAC=VEGFRA(I,J)/100.
    657. 

  657.         T1=TSK(I,J)
    658. 

  658.         CHK=CHS(I,J)
    659. 

  659.         SHMIN=SHDMIN(I,J)/100. !NEW
    660. 

  660.         SHMAX=SHDMAX(I,J)/100. !NEW
    661. 

  661. ! convert snow water equivalent from mm to meter
    662. 

  662.         SNEQV=SNOW(I,J)*0.001
    663. 

  663. ! snow depth in meters
    664. 

  664.         SNOWHK=SNOWH(I,J)
    665. 

  665.         SNCOVR=SNOWC(I,J)
    666. 

  666. 

  667. ! if "SR" present, set frac of frozen precip ("FFROZP") = snow-ratio ("SR", range:0-1)
    668. 

  668. ! SR from e.g. Ferrier microphysics
    669. 

  669. ! otherwise define from 1st atmos level temperature
    670. 

  670.        IF(FRPCPN) THEN
    671. 

  671.           FFROZP=SR(I,J)
    672. 

  672.         ELSE
    673. 

  673.           IF (SFCTMP <=  273.15) THEN
    674. 

  674.             FFROZP = 1.0
    675. 

  675. 	  ELSE
    676. 

  676. 	    FFROZP = 0.0
    677. 

  677. 	  ENDIF
    678. 

  678.         ENDIF
    679. 

  679. !***
    680. 

  680.         IF((XLAND(I,J)-1.5).GE.0.)THEN                                  ! begining of land/sea if block
    681. 

  681. ! Open water points
    682. 

  682.           TSK_RURAL(I,J)=TSK(I,J)
    683. 

  683.           HFX_RURAL(I,J)=HFX(I,J)
    684. 

  684.           QFX_RURAL(I,J)=QFX(I,J)
    685. 

  685.           LH_RURAL(I,J)=LH(I,J)
    686. 

  686.           EMISS_RURAL(I,J)=EMISS(I,J)
    687. 

  687.           GRDFLX_RURAL(I,J)=GRDFLX(I,J)
    688. 

  688.         ELSE
    689. 

  689. ! Land or sea-ice case
    690. 

  690. 

  691.           IF (XICE(I,J) >= XICE_THRESHOLD) THEN
    692. 

  692.              ! Sea-ice point
    693. 

  693.              ICE = 1
    694. 

  694.           ELSE IF ( VEGTYP == ISICE ) THEN
    695. 

  695.              ! Land-ice point
    696. 

  696.              ICE = -1
    697. 

  697.           ELSE
    698. 

  698.              ! Neither sea ice or land ice.
    699. 

  699.              ICE=0
    700. 

  700.           ENDIF
    701. 

  701.           DQSDT2=Q2SAT*A23M4/(SFCTMP-A4)**2
    702. 

  702. 

  703.           IF(SNOW(I,J).GT.0.0)THEN
    704. 

  704. ! snow on surface (use ice saturation properties)
    705. 

  705.             SFCTSNO=SFCTMP
    706. 

  706.             E2SAT=611.2*EXP(6174.*(1./273.15 - 1./SFCTSNO))
    707. 

  707.             Q2SATI=0.622*E2SAT/(SFCPRS-E2SAT)
    708. 

  708.             Q2SATI=Q2SATI/(1.0+Q2SATI)    ! spec. hum.
    709. 

  709.             IF (T1 .GT. 273.14) THEN
    710. 

  710. ! warm ground temps, weight the saturation between ice and water according to SNOWC
    711. 

  711.               Q2SAT=Q2SAT*(1.-SNOWC(I,J)) + Q2SATI*SNOWC(I,J)
    712. 

  712.               DQSDT2=DQSDT2*(1.-SNOWC(I,J)) + Q2SATI*6174./(SFCTSNO**2)*SNOWC(I,J)
    713. 

  713.             ELSE
    714. 

  714. ! cold ground temps, use ice saturation only
    715. 

  715.               Q2SAT=Q2SATI
    716. 

  716.               DQSDT2=Q2SATI*6174./(SFCTSNO**2)
    717. 

  717.             ENDIF
    718. 

  718. ! for snow cover fraction at 0 C, ground temp will not change, so DQSDT2 effectively zero
    719. 

  719.             IF(T1 .GT. 273. .AND. SNOWC(I,J) .GT. 0.)DQSDT2=DQSDT2*(1.-SNOWC(I,J))
    720. 

  720.           ENDIF
    721. 

  721. 

  722.           IF(ICE.EQ.1)THEN
    723. 

  723.              ! Sea-ice point has deep-level temperature of -2 C
    724. 

  724.              TBOT=271.16
    725. 

  725.           ELSE
    726. 

  726.              ! Land-ice or land points have the usual deep-soil temperature.
    727. 

  727.              TBOT=TMN(I,J)
    728. 

  728.           ENDIF
    729. 

  729.           IF(VEGTYP.EQ.25) SHDFAC=0.0000
    730. 

  730.           IF(VEGTYP.EQ.26) SHDFAC=0.0000
    731. 

  731.           IF(VEGTYP.EQ.27) SHDFAC=0.0000
    732. 

  732.           IF(SOILTYP.EQ.14.AND.XICE(I,J).EQ.0.)THEN
    733. 

  733. #if 0
    734. 

  734.          IF(IPRINT)PRINT*,' SOIL TYPE FOUND TO BE WATER AT A LAND-POINT'
    735. 

  735.          IF(IPRINT)PRINT*,i,j,'RESET SOIL in surfce.F'
    736. 

  736. #endif
    737. 

  737.             SOILTYP=7
    738. 

  738.           ENDIF
    739. 

  739.           SNOALB1 = SNOALB(I,J)
    740. 

  740.           CMC=CANWAT(I,J)
    741. 

  741. 

  742. !-------------------------------------------
    743. 

  743. !*** convert snow depth from mm to meter
    744. 

  744. !
    745. 

  745. !          IF(RDMAXALB) THEN
    746. 

  746. !           SNOALB=ALBMAX(I,J)*0.01
    747. 

  747. !         ELSE
    748. 

  748. !           SNOALB=MAXALB(IVGTPK)*0.01
    749. 

  749. !         ENDIF
    750. 

  750. 

  751. !        SNOALB1=0.80
    752. 

  752. !        SHMIN=0.00
    753. 

  753.         ALBBRD=ALBBCK(I,J)
    754. 

  754.         Z0BRD=Z0(I,J)
    755. 

  755.         EMBRD=EMBCK(I,J)
    756. 

  756.         SNOTIME1 = SNOTIME(I,J)
    757. 

  757.         RIBB=RIB(I,J)
    758. 

  758. !FEI: temporaray arrays above need to be changed later by using SI
    759. 

  759. 

  760.           DO NS=1,NSOIL
    761. 

  761.             SMC(NS)=SMOIS(I,NS,J)
    762. 

  762.             STC(NS)=TSLB(I,NS,J)                                          !STEMP
    763. 

  763.             SWC(NS)=SH2O(I,NS,J)
    764. 

  764.           ENDDO
    765. 

  765. !
    766. 

  766.           if ( (SNEQV.ne.0..AND.SNOWHK.eq.0.).or.(SNOWHK.le.SNEQV) )THEN
    767. 

  767.             SNOWHK= 5.*SNEQV
    768. 

  768.           endif
    769. 

  769. !
    770. 

  770. 

  771. !Fei: urban. for urban surface, if calling UCM, redefine the natural surface in cities as
    772. 

  772. ! the "NATURAL" category in the VEGPARM.TBL
    773. 

  773. 	
    774. 

  774. 	   IF(SF_URBAN_PHYSICS == 1.OR. SF_URBAN_PHYSICS==2.OR.SF_URBAN_PHYSICS==3 ) THEN
    775. 

  775.                 IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == 31 .or. &
    776. 

  776.                   IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33) THEN
    777. 

  777. 		 VEGTYP = NATURAL
    778. 

  778.                  SHDFAC = SHDTBL(NATURAL)
    779. 

  779.                  ALBEDOK =0.2         !  0.2
    780. 

  780.                  ALBBRD  =0.2         !0.2
    781. 

  781.                  EMISSI = 0.98                                 !for VEGTYP=5
    782. 

  782. 		 IF ( FRC_URB2D(I,J) < 0.99 ) THEN
    783. 

  783.                    if(sf_urban_physics.eq.1)then
    784. 

  784.            T1= ( TSK(I,J) -FRC_URB2D(I,J) * TS_URB2D (I,J) )/ (1-FRC_URB2D(I,J))
    785. 

  785.                    elseif((sf_urban_physics.eq.2).OR.(sf_urban_physics.eq.3))then
    786. 

  786.                 r1= (tsk(i,j)**4.)
    787. 

  787.                 r2= frc_urb2d(i,j)*(ts_urb2d(i,j)**4.)
    788. 

  788.                 r3= (1.-frc_urb2d(i,j))
    789. 

  789.                 t1= ((r1-r2)/r3)**.25
    790. 

  790.                    endif
    791. 

  791. 	         ELSE
    792. 

  792. 		 T1 = TSK(I,J)
    793. 

  793.                  ENDIF
    794. 

  794.                 ENDIF
    795. 

  795.            ELSE
    796. 

  796.                  IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == 31 .or. &
    797. 

  797.                   IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33) THEN
    798. 

  798.                   VEGTYP = ISURBAN
    799. 

  799.            	 ENDIF
    800. 

  800.            ENDIF
    801. 

  801. 

  802. #if 0
    803. 

  803.           IF(IPRINT) THEN
    804. 

  804. !
    805. 

  805.        print*, 'BEFORE SFLX, in Noahlsm_driver'
    806. 

  806.        print*, 'ICE', ICE, 'DT',DT, 'ZLVL',ZLVL, 'NSOIL', NSOIL,   &
    807. 

  807.        'SLDPTH', SLDPTH, 'LOCAL',LOCAL, 'LUTYPE',&
    808. 

  808.         LUTYPE, 'SLTYPE',SLTYPE, 'LWDN',LWDN, 'SOLDN',SOLDN,      &
    809. 

  809.         'SFCPRS',SFCPRS, 'PRCP',PRCP,'SFCTMP',SFCTMP,'Q2K',Q2K,   &
    810. 

  810.          'TH2',TH2,'Q2SAT',Q2SAT,'DQSDT2',DQSDT2,'VEGTYP', VEGTYP,&
    811. 

  811.          'SOILTYP',SOILTYP, 'SLOPETYP',SLOPETYP, 'SHDFAC',SHDFAC,&
    812. 

  812.          'SHMIN',SHMIN, 'ALBBRD',ALBBRD,'SNOALB1',SNOALB1,'TBOT',&
    813. 

  813.           TBOT, 'Z0BRD',Z0BRD, 'Z0K',Z0K, 'CMC',CMC, 'T1',T1,'STC',&
    814. 

  814.           STC, 'SMC',SMC, 'SWC',SWC,'SNOWHK',SNOWHK,'SNEQV',SNEQV,&
    815. 

  815.           'ALBEDOK',ALBEDOK,'CHK',CHK,'ETA',ETA,'SHEAT',SHEAT,      &
    816. 

  816.           'ETA_KINEMATIC',ETA_KINEMATIC, 'FDOWN',FDOWN,'EC',EC,   &
    817. 

  817.           'EDIR',EDIR,'ET',ET,'ETT',ETT,'ESNOW',ESNOW,'DRIP',DRIP,&
    818. 

  818.           'DEW',DEW,'BETA',BETA,'ETP',ETP,'SSOIL',SSOIL,'FLX1',FLX1,&
    819. 

  819.           'FLX2',FLX2,'FLX3',FLX3,'SNOMLT',SNOMLT,'SNCOVR',SNCOVR,&
    820. 

  820.           'RUNOFF1',RUNOFF1,'RUNOFF2',RUNOFF2,'RUNOFF3',RUNOFF3, &
    821. 

  821.           'RC',RC, 'PC',PC,'RSMIN',RSMIN,'XLAI',XLAI,'RCS',RCS,  &
    822. 

  822.           'RCT',RCT,'RCQ',RCQ,'RCSOIL',RCSOIL,'SOILW',SOILW,     &
    823. 

  823.           'SOILM',SOILM,'Q1',Q1,'SMCWLT',SMCWLT,'SMCDRY',SMCDRY,&
    824. 

  824.           'SMCREF',SMCREF,'SMCMAX',SMCMAX,'NROOT',NROOT
    825. 

  825.            endif
    826. 

  826. #endif
    827. 

  827. 

  828.           IF (rdlai2d) THEN
    829. 

  829.              xlai = lai(i,j)
    830. 

  830.           endif
    831. 

  831. 

  832.     IF ( XICE(I,J) >= XICE_THRESHOLD ) THEN
    833. 

  833. 

  834.        ! Sea-ice case
    835. 

  835. 

  836.        DO NS = 1, NSOIL
    837. 

  837.           SH2O(I,NS,J) = 1.0
    838. 

  838.        ENDDO
    839. 

  839.        LAI(I,J) = 0.01
    840. 

  840. 

  841.        CYCLE ILOOP
    842. 

  842. 

  843.     ELSE
    844. 

  844. 

  845.        ! Land and glacial land.
    846. 

  846. 

  847.        CALL SFLX (I,J,ICE,FFROZP, ISURBAN, DT,ZLVL,NSOIL,SLDPTH,  &    !C
    848. 

  848.                  LOCAL,                                           &    !L
    849. 

  849.                  LUTYPE, SLTYPE,                                  &    !CL
    850. 

  850.                  LWDN,SOLDN,SOLNET,SFCPRS,PRCP,SFCTMP,Q2K,DUMMY,         &    !F
    851. 

  851.                  DUMMY,DUMMY, DUMMY,                              &    !F PRCPRAIN not used
    852. 

  852.                  TH2,Q2SAT,DQSDT2,                                &    !I
    853. 

  853.                  VEGTYP,SOILTYP,SLOPETYP,SHDFAC,SHMIN,SHMAX,      &    !I
    854. 

  854.                  ALBBRD, SNOALB1,TBOT, Z0BRD, Z0K, EMISSI, EMBRD, &    !S
    855. 

  855.                  CMC,T1,STC,SMC,SWC,SNOWHK,SNEQV,ALBEDOK,CHK,dummy,&    !H
    856. 

  856.                  ETA,SHEAT, ETA_KINEMATIC,FDOWN,                  &    !O
    857. 

  857.                  EC,EDIR,ET,ETT,ESNOW,DRIP,DEW,                   &    !O
    858. 

  858.                  BETA,ETP,SSOIL,                                  &    !O
    859. 

  859.                  FLX1,FLX2,FLX3,                                  &    !O
    860. 

  860.                  SNOMLT,SNCOVR,                                   &    !O
    861. 

  861.                  RUNOFF1,RUNOFF2,RUNOFF3,                         &    !O
    862. 

  862.                  RC,PC,RSMIN,XLAI,RCS,RCT,RCQ,RCSOIL,             &    !O
    863. 

  863.                  SOILW,SOILM,Q1,SMAV,                             &    !D
    864. 

  864.                  RDLAI2D,USEMONALB,                               &
    865. 

  865.                  SNOTIME1,                                        &
    866. 

  866.                  RIBB,                                            &
    867. 

  867.                  SMCWLT,SMCDRY,SMCREF,SMCMAX,NROOT)
    868. 

  868.     ENDIF
    869. 

  869. 

  870.        lai(i,j) = xlai
    871. 

  871. 

  872. #if 0
    873. 

  873.           IF(IPRINT) THEN
    874. 

  874. 

  875.        print*, 'AFTER SFLX, in Noahlsm_driver'
    876. 

  876.        print*, 'ICE', ICE, 'DT',DT, 'ZLVL',ZLVL, 'NSOIL', NSOIL,   &
    877. 

  877.        'SLDPTH', SLDPTH, 'LOCAL',LOCAL, 'LUTYPE',&
    878. 

  878.         LUTYPE, 'SLTYPE',SLTYPE, 'LWDN',LWDN, 'SOLDN',SOLDN,      &
    879. 

  879.         'SFCPRS',SFCPRS, 'PRCP',PRCP,'SFCTMP',SFCTMP,'Q2K',Q2K,   &
    880. 

  880.          'TH2',TH2,'Q2SAT',Q2SAT,'DQSDT2',DQSDT2,'VEGTYP', VEGTYP,&
    881. 

  881.           'SOILTYP',SOILTYP, 'SLOPETYP',SLOPETYP, 'SHDFAC',SHDFAC,&
    882. 

  882.          'SHDMIN',SHMIN, 'ALBBRD',ALBBRD,'SNOALB',SNOALB1,'TBOT',&
    883. 

  883.           TBOT, 'Z0BRD',Z0BRD, 'Z0K',Z0K, 'CMC',CMC, 'T1',T1,'STC',&
    884. 

  884.           STC, 'SMC',SMC, 'SWc',SWC,'SNOWHK',SNOWHK,'SNEQV',SNEQV,&
    885. 

  885.           'ALBEDOK',ALBEDOK,'CHK',CHK,'ETA',ETA,'SHEAT',SHEAT,      &
    886. 

  886.           'ETA_KINEMATIC',ETA_KINEMATIC, 'FDOWN',FDOWN,'EC',EC,   &
    887. 

  887.           'EDIR',EDIR,'ET',ET,'ETT',ETT,'ESNOW',ESNOW,'DRIP',DRIP,&
    888. 

  888.           'DEW',DEW,'BETA',BETA,'ETP',ETP,'SSOIL',SSOIL,'FLX1',FLX1,&
    889. 

  889.           'FLX2',FLX2,'FLX3',FLX3,'SNOMLT',SNOMLT,'SNCOVR',SNCOVR,&
    890. 

  890.           'RUNOFF1',RUNOFF1,'RUNOFF2',RUNOFF2,'RUNOFF3',RUNOFF3, &
    891. 

  891.           'RC',RC, 'PC',PC,'RSMIN',RSMIN,'XLAI',XLAI,'RCS',RCS,  &
    892. 

  892.           'RCT',RCT,'RCQ',RCQ,'RCSOIL',RCSOIL,'SOILW',SOILW,     &
    893. 

  893.           'SOILM',SOILM,'Q1',Q1,'SMCWLT',SMCWLT,'SMCDRY',SMCDRY,&
    894. 

  894.           'SMCREF',SMCREF,'SMCMAX',SMCMAX,'NROOT',NROOT
    895. 

  895.            endif
    896. 

  896. #endif
    897. 

  897. 

  898. !***  UPDATE STATE VARIABLES
    899. 

  899.           CANWAT(I,J)=CMC
    900. 

  900.           SNOW(I,J)=SNEQV*1000.
    901. 

  901. !          SNOWH(I,J)=SNOWHK*1000.
    902. 

  902.           SNOWH(I,J)=SNOWHK                   ! SNOWHK in meters
    903. 

  903.           ALBEDO(I,J)=ALBEDOK
    904. 

  904.           ALB_RURAL(I,J)=ALBEDOK
    905. 

  905.           ALBBCK(I,J)=ALBBRD
    906. 

  906.           Z0(I,J)=Z0BRD
    907. 

  907.           EMISS(I,J) = EMISSI
    908. 

  908.           EMISS_RURAL(I,J) = EMISSI
    909. 

  909. ! Noah: activate time-varying roughness length (V3.3 Feb 2011)
    910. 

  910.           ZNT(I,J)=Z0K
    911. 

  911.           TSK(I,J)=T1
    912. 

  912.           TSK_RURAL(I,J)=T1
    913. 

  913.           HFX(I,J)=SHEAT
    914. 

  914.           HFX_RURAL(I,J)=SHEAT
    915. 

  915. ! MEk Jul07 add potential evap accum
    916. 

  916.         POTEVP(I,J)=POTEVP(I,J)+ETP*FDTW
    917. 

  917.           QFX(I,J)=ETA_KINEMATIC
    918. 

  918.           QFX_RURAL(I,J)=ETA_KINEMATIC
    919. 

  919.           LH(I,J)=ETA
    920. 

  920.           LH_RURAL(I,J)=ETA
    921. 

  921.           GRDFLX(I,J)=SSOIL
    922. 

  922.           GRDFLX_RURAL(I,J)=SSOIL
    923. 

  923.           SNOWC(I,J)=SNCOVR
    924. 

  924.           CHS2(I,J)=CQS2(I,J)
    925. 

  925.           SNOTIME(I,J) = SNOTIME1
    926. 

  926. !      prevent diagnostic ground q (q1) from being greater than qsat(tsk)
    927. 

  927. !      as happens over snow cover where the cqs2 value also becomes irrelevant
    928. 

  928. !      by setting cqs2=chs in this situation the 2m q should become just qv(k=1)
    929. 

  929.           IF (Q1 .GT. QSFC(I,J)) THEN
    930. 

  930.             CQS2(I,J) = CHS(I,J)
    931. 

  931.           ENDIF
    932. 

  932. !          QSFC(I,J)=Q1
    933. 

  933. ! Convert QSFC back to mixing ratio
    934. 

  934.            QSFC(I,J)= Q1/(1.0-Q1)
    935. 

  935. !
    936. 

  936.            QSFC_RURAL(I,J)= Q1/(1.0-Q1)
    937. 

  937. ! Calculate momentum flux from rural surface for use with multi-layer UCM (Martilli et al. 2002)
    938. 

  938. 

  939.           DO 80 NS=1,NSOIL
    940. 

  940.            SMOIS(I,NS,J)=SMC(NS)
    941. 

  941.            TSLB(I,NS,J)=STC(NS)                                        !  STEMP
    942. 

  942.            SH2O(I,NS,J)=SWC(NS)
    943. 

  943.    80     CONTINUE
    944. 

  944. !       ENDIF
    945. 

  945. 

  946.      !
    947. 

  947.      ! Residual of surface energy balance equation terms
    948. 

  948.      !
    949. 

  949.      noahres(i,j) =     ( solnet + lwdn ) - sheat + ssoil - eta - ( emissi * STBOLT * (t1**4) ) - flx1 - flx2 - flx3
    950. 

  950. 

  951. 

  952.         IF (SF_URBAN_PHYSICS == 1 ) THEN                                              ! Beginning of UCM CALL if block
    953. 

  953. !--------------------------------------
    954. 

  954. ! URBAN CANOPY MODEL START - urban
    955. 

  955. !--------------------------------------
    956. 

  956. ! Input variables lsm --> urban
    957. 

  957. 

  958. 

  959.           IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == 31 .or. &
    960. 

  960.               IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33 ) THEN
    961. 

  961. 

  962. ! Call urban
    963. 

  963. 

  964. !
    965. 

  965.             UTYPE_URB = UTYPE_URB2D(I,J) !urban type (low, high or industrial)
    966. 

  966. 

  967.             TA_URB    = SFCTMP           ! [K]
    968. 

  968.             QA_URB    = Q2K              ! [kg/kg]
    969. 

  969.             UA_URB    = SQRT(U_PHY(I,1,J)**2.+V_PHY(I,1,J)**2.)
    970. 

  970.             U1_URB    = U_PHY(I,1,J)
    971. 

  971.             V1_URB    = V_PHY(I,1,J)
    972. 

  972.             IF(UA_URB < 1.) UA_URB=1.    ! [m/s]
    973. 

  973.             SSG_URB   = SOLDN            ! [W/m/m]
    974. 

  974.             SSGD_URB  = 0.8*SOLDN        ! [W/m/m]
    975. 

  975.             SSGQ_URB  = SSG_URB-SSGD_URB ! [W/m/m]
    976. 

  976.             LLG_URB   = GLW(I,J)         ! [W/m/m]
    977. 

  977.             RAIN_URB  = RAINBL(I,J)      ! [mm]
    978. 

  978.             RHOO_URB  = SFCPRS / (287.04 * SFCTMP * (1.0+ 0.61 * Q2K)) ![kg/m/m/m]
    979. 

  979.             ZA_URB    = ZLVL             ! [m]
    980. 

  980.             DELT_URB  = DT               ! [sec]
    981. 

  981.             XLAT_URB  = XLAT_URB2D(I,J)  ! [deg]
    982. 

  982.             COSZ_URB  = COSZ_URB2D(I,J)  !
    983. 

  983.             OMG_URB   = OMG_URB2D(I,J)   !
    984. 

  984.             ZNT_URB   = ZNT(I,J)
    985. 

  985. 

  986.             LSOLAR_URB = .FALSE.
    987. 

  987. 

  988.             TR_URB = TR_URB2D(I,J)
    989. 

  989.             TB_URB = TB_URB2D(I,J)
    990. 

  990.             TG_URB = TG_URB2D(I,J)
    991. 

  991.             TC_URB = TC_URB2D(I,J)
    992. 

  992.             QC_URB = QC_URB2D(I,J)
    993. 

  993.             UC_URB = UC_URB2D(I,J)
    994. 

  994. 

  995.             DO K = 1,num_roof_layers
    996. 

  996.               TRL_URB(K) = TRL_URB3D(I,K,J)
    997. 

  997.             END DO
    998. 

  998.             DO K = 1,num_wall_layers
    999. 

  999.               TBL_URB(K) = TBL_URB3D(I,K,J)
    1000. 

  1000.             END DO
    1001. 

  1001.             DO K = 1,num_road_layers
    1002. 

  1002.               TGL_URB(K) = TGL_URB3D(I,K,J)
    1003. 

  1003.             END DO
    1004. 

  1004. 

  1005.             XXXR_URB = XXXR_URB2D(I,J)
    1006. 

  1006.             XXXB_URB = XXXB_URB2D(I,J)
    1007. 

  1007.             XXXG_URB = XXXG_URB2D(I,J)
    1008. 

  1008.             XXXC_URB = XXXC_URB2D(I,J)
    1009. 

  1009. !
    1010. 

  1010. !
    1011. 

  1011. !      Limits to avoid dividing by small number
    1012. 

  1012.             if (CHS(I,J) < 1.0E-02) then
    1013. 

  1013.                CHS(I,J)  = 1.0E-02
    1014. 

  1014.             endif
    1015. 

  1015.             if (CHS2(I,J) < 1.0E-02) then
    1016. 

  1016.                CHS2(I,J)  = 1.0E-02
    1017. 

  1017.             endif
    1018. 

  1018.             if (CQS2(I,J) < 1.0E-02) then
    1019. 

  1019.                CQS2(I,J)  = 1.0E-02
    1020. 

  1020.             endif
    1021. 

  1021. !
    1022. 

  1022.             CHS_URB  = CHS(I,J)
    1023. 

  1023.             CHS2_URB = CHS2(I,J)
    1024. 

  1024.             IF (PRESENT(CMR_SFCDIF)) THEN
    1025. 

  1025.                CMR_URB = CMR_SFCDIF(I,J)
    1026. 

  1026.                CHR_URB = CHR_SFCDIF(I,J)
    1027. 

  1027.                CMC_URB = CMC_SFCDIF(I,J)
    1028. 

  1028.                CHC_URB = CHC_SFCDIF(I,J)
    1029. 

  1029.             ENDIF
    1030. 

  1030. !
    1031. 

  1031. ! Call urban
    1032. 

  1032. 

  1033.             CALL urban(LSOLAR_URB,                                      & ! I
    1034. 

  1034.                        num_roof_layers,num_wall_layers,num_road_layers, & ! C
    1035. 

  1035.                        DZR,DZB,DZG,                                     & ! C
    1036. 

  1036.                        UTYPE_URB,TA_URB,QA_URB,UA_URB,U1_URB,V1_URB,SSG_URB, & ! I
    1037. 

  1037.                        SSGD_URB,SSGQ_URB,LLG_URB,RAIN_URB,RHOO_URB,     & ! I
    1038. 

  1038.                        ZA_URB,DECLIN_URB,COSZ_URB,OMG_URB,              & ! I
    1039. 

  1039.                        XLAT_URB,DELT_URB,ZNT_URB,                       & ! I
    1040. 

  1040.                        CHS_URB, CHS2_URB,                               & ! I
    1041. 

  1041.                        TR_URB, TB_URB, TG_URB, TC_URB, QC_URB,UC_URB,   & ! H
    1042. 

  1042.                        TRL_URB,TBL_URB,TGL_URB,                         & ! H
    1043. 

  1043.                        XXXR_URB, XXXB_URB, XXXG_URB, XXXC_URB,          & ! H
    1044. 

  1044.                        TS_URB,QS_URB,SH_URB,LH_URB,LH_KINEMATIC_URB,    & ! O
    1045. 

  1045.                        SW_URB,ALB_URB,LW_URB,G_URB,RN_URB,PSIM_URB,PSIH_URB, & ! O
    1046. 

  1046.                        GZ1OZ0_URB,                                      & !O
    1047. 

  1047.                        CMR_URB, CHR_URB, CMC_URB, CHC_URB,              &
    1048. 

  1048.                        U10_URB, V10_URB, TH2_URB, Q2_URB,               & ! O
    1049. 

  1049.                        UST_URB)                                           !O
    1050. 

  1050. 

  1051. #if 0
    1052. 

  1052.           IF(IPRINT) THEN
    1053. 

  1053. 

  1054.        print*, 'AFTER CALL URBAN'
    1055. 

  1055.        print*,'num_roof_layers',num_roof_layers, 'num_wall_layers',  &
    1056. 

  1056.         …
    1057.

Large files files are truncated, but you can click here to view the full file