PageRenderTime 849ms CodeModel.GetById 27ms RepoModel.GetById 1ms app.codeStats 1ms

/wrfv2_fire/phys/module_sf_ruclsm.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 6031 lines | 3585 code | 793 blank | 1653 comment | 96 complexity | 926e2faf7df8889ef7fefb2ef52fc9ed 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. #define LSMRUC_DBG_LVL 3000
    2. 

  2. !WRF:MODEL_LAYER:PHYSICS
    3. 

  3. !
    4. 

  4. MODULE module_sf_ruclsm
    5. 

  5. 

  6.   USE module_model_constants
    7. 

  7.   USE module_wrf_error
    8. 

  8. 

  9. ! VEGETATION PARAMETERS
    10. 

  10.         INTEGER :: LUCATS , BARE, NATURAL
    11. 

  11.         integer, PARAMETER :: NLUS=50
    12. 

  12.         CHARACTER*8 LUTYPE
    13. 

  13.         INTEGER, DIMENSION(1:NLUS) :: IFORTBL
    14. 

  14.         real, dimension(1:NLUS) ::  SNUPTBL, RSTBL, RGLTBL, HSTBL, LAITBL,         &
    15. 

  15.                                     ALBTBL, Z0TBL, LEMITBL, PCTBL, SHDTBL, MAXALB
    16. 

  16.         REAL ::   TOPT_DATA,CMCMAX_DATA,CFACTR_DATA,RSMAX_DATA
    17. 

  17. 

  18. ! SOIL PARAMETERS
    19. 

  19.         INTEGER :: SLCATS
    20. 

  20.         INTEGER, PARAMETER :: NSLTYPE=30
    21. 

  21.         CHARACTER*8 SLTYPE
    22. 

  22.         REAL, DIMENSION (1:NSLTYPE) :: BB,DRYSMC,HC,                           &
    23. 

  23.         MAXSMC, REFSMC,SATPSI,SATDK,SATDW, WLTSMC,QTZ
    24. 

  24. 

  25. ! LSM GENERAL PARAMETERS
    26. 

  26.         INTEGER :: SLPCATS
    27. 

  27.         INTEGER, PARAMETER :: NSLOPE=30
    28. 

  28.         REAL, DIMENSION (1:NSLOPE) :: SLOPE_DATA
    29. 

  29.         REAL ::  SBETA_DATA,FXEXP_DATA,CSOIL_DATA,SALP_DATA,REFDK_DATA,           &
    30. 

  30.                  REFKDT_DATA,FRZK_DATA,ZBOT_DATA,  SMLOW_DATA,SMHIGH_DATA,        &
    31. 

  31.                         CZIL_DATA
    32. 

  32. 

  33.         CHARACTER*256  :: err_message
    34. 

  34. 

  35. 

  36. CONTAINS
    37. 

  37. 

  38. !-----------------------------------------------------------------
    39. 

  39.     SUBROUTINE LSMRUC(                                           &
    40. 

  40.                    DT,KTAU,NSL,ZS,                               &
    41. 

  41.                    RAINBL,SNOW,SNOWH,SNOWC,FRZFRAC,frpcpn,       &
    42. 

  42.                    Z3D,P8W,T3D,QV3D,QC3D,RHO3D,                  & !p8W in [PA]
    43. 

  43.                    GLW,GSW,EMISS,CHKLOWQ, CHS,                   & 
    44. 

  44.                    FLQC,FLHC,MAVAIL,CANWAT,VEGFRA,ALB,ZNT,       &
    45. 

  45.                    Z0,SNOALB,ALBBCK,LAI,                         &  !new
    46. 

  46.                    mminlu, landusef, nlcat, mosaic_lu,           &
    47. 

  47.                    mosaic_soil, soilctop, nscat,                 &  !new
    48. 

  48.                    QSFC,QSG,QVG,QCG,DEW,SOILT1,TSNAV,            &
    49. 

  49.                    TBOT,IVGTYP,ISLTYP,XLAND,                     &
    50. 

  50.                    ISWATER,ISICE,XICE,XICE_THRESHOLD,            &
    51. 

  51.                    CP,ROVCP,G0,LV,STBOLT,                        &
    52. 

  52.                    SOILMOIS,SH2O,SMAVAIL,SMMAX,                  &
    53. 

  53.                    TSO,SOILT,HFX,QFX,LH,                         &
    54. 

  54.                    SFCRUNOFF,UDRUNOFF,SFCEXC,                    &
    55. 

  55.                    SFCEVP,GRDFLX,ACSNOW,SNOM,                    &
    56. 

  56.                    SMFR3D,KEEPFR3DFLAG,                          &
    57. 

  57.                    myj,                                          &
    58. 

  58.                    ids,ide, jds,jde, kds,kde,                    &
    59. 

  59.                    ims,ime, jms,jme, kms,kme,                    &
    60. 

  60.                    its,ite, jts,jte, kts,kte                     )
    61. 

  61. !-----------------------------------------------------------------
    62. 

  62.    IMPLICIT NONE
    63. 

  63. !-----------------------------------------------------------------
    64. 

  64. !
    65. 

  65. ! The RUC LSM model is described in:
    66. 

  66. !  Smirnova, T.G., J.M. Brown, and S.G. Benjamin, 1997: 
    67. 

  67. !     Performance of different soil model configurations in simulating 
    68. 

  68. !     ground surface temperature and surface fluxes. 
    69. 

  69. !     Mon. Wea. Rev. 125, 1870-1884.
    70. 

  70. !  Smirnova, T.G., J.M. Brown, and D. Kim, 2000: Parameterization of 
    71. 

  71. !     cold-season processes in the MAPS land-surface scheme. 
    72. 

  72. !     J. Geophys. Res. 105, 4077-4086.
    73. 

  73. !-----------------------------------------------------------------
    74. 

  74. !-- DT            time step (second)
    75. 

  75. !        ktau - number of time step
    76. 

  76. !        NSL  - number of soil layers
    77. 

  77. !        NZS  - number of levels in soil
    78. 

  78. !        ZS   - depth of soil levels (m)
    79. 

  79. !-- RAINBL    - accumulated rain in [mm] between the PBL calls
    80. 

  80. !-- RAINNCV         one time step grid scale precipitation (mm/step)
    81. 

  81. !        SNOW - snow water equivalent [mm]
    82. 

  82. !        FRAZFRAC - fraction of frozen precipitation
    83. 

  83. !-- SNOWC       flag indicating snow coverage (1 for snow cover)
    84. 

  84. !-- Z3D         heights (m)
    85. 

  85. !-- P8W         3D pressure (Pa)
    86. 

  86. !-- T3D         temperature (K)
    87. 

  87. !-- QV3D        3D water vapor mixing ratio (Kg/Kg)
    88. 

  88. !        QC3D - 3D cloud water mixing ratio (Kg/Kg)
    89. 

  89. !       RHO3D - 3D air density (kg/m^3)
    90. 

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

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

  92. !-- EMISS       surface emissivity (between 0 and 1)
    93. 

  93. !        FLQC - surface exchange coefficient for moisture (kg/m^2/s)
    94. 

  94. !        FLHC - surface exchange coefficient for heat [W/m^2/s/degreeK]     
    95. 

  95. !      SFCEXC - surface exchange coefficient for heat [m/s]
    96. 

  96. !      CANWAT - CANOPY MOISTURE CONTENT (mm)
    97. 

  97. !      VEGFRA - vegetation fraction (between 0 and 1)
    98. 

  98. !         ALB - surface albedo (between 0 and 1)
    99. 

  99. !      SNOALB - maximum snow albedo (between 0 and 1)
    100. 

  100. !      ALBBCK - snow-free albedo (between 0 and 1)
    101. 

  101. !         ZNT - roughness length [m]
    102. 

  102. !-- TBOT        soil temperature at lower boundary (K)
    103. 

  103. !      IVGTYP - USGS vegetation type (24 classes)
    104. 

  104. !      ISLTYP - STASGO soil type (16 classes)
    105. 

  105. !-- XLAND       land mask (1 for land, 2 for water)
    106. 

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

  107. !-- G0          acceleration due to gravity (m/s^2)
    108. 

  108. !-- LV          latent heat of melting (J/kg)
    109. 

  109. !-- STBOLT      Stefan-Boltzmann constant (W/m^2/K^4)
    110. 

  110. !    SOILMOIS - soil moisture content (volumetric fraction)
    111. 

  111. !         TSO - soil temp (K)
    112. 

  112. !-- SOILT       surface temperature (K)
    113. 

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

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

  115. !-- LH          upward latent heat flux (W/m^2)
    116. 

  116. !   SFCRUNOFF - ground surface runoff [mm]
    117. 

  117. !    UDRUNOFF - underground runoff [mm]
    118. 

  118. !      SFCEVP - total evaporation in [kg/m^2]
    119. 

  119. !      GRDFLX - soil heat flux (W/m^2: negative, if downward from surface)
    120. 

  120. !      ACSNOW - accumulation of snow water [m]   
    121. 

  121. !-- CHKLOWQ - is either 0 or 1 (so far set equal to 1).
    122. 

  122. !--           used only in MYJPBL. 
    123. 

  123. !-- tice - sea ice temperture (C)
    124. 

  124. !-- rhosice - sea ice density (kg m^-3)
    125. 

  125. !-- capice - sea ice volumetric heat capacity (J/m^3/K)
    126. 

  126. !-- thdifice - sea ice thermal diffusivity (m^2/s)
    127. 

  127. !--
    128. 

  128. !-- ims           start index for i in memory
    129. 

  129. !-- ime           end index for i in memory
    130. 

  130. !-- jms           start index for j in memory
    131. 

  131. !-- jme           end index for j in memory
    132. 

  132. !-- kms           start index for k in memory
    133. 

  133. !-- kme           end index for k in memory
    134. 

  134. !-------------------------------------------------------------------------
    135. 

  135. !   INTEGER,     PARAMETER            ::     nzss=5
    136. 

  136. !   INTEGER,     PARAMETER            ::     nddzs=2*(nzss-2)
    137. 

  137. 

  138.    INTEGER,     PARAMETER            ::     nvegclas=24+3
    139. 

  139. 

  140.    REAL,       INTENT(IN   )    ::     DT
    141. 

  141.    LOGICAL,    INTENT(IN   )    ::     myj,frpcpn
    142. 

  142.    INTEGER,    INTENT(IN   )    ::     NLCAT, NSCAT, mosaic_lu, mosaic_soil
    143. 

  143.    INTEGER,    INTENT(IN   )    ::     ktau, nsl, isice, iswater, &
    144. 

  144.                                        ims,ime, jms,jme, kms,kme, &
    145. 

  145.                                        ids,ide, jds,jde, kds,kde, &
    146. 

  146.                                        its,ite, jts,jte, kts,kte
    147. 

  147. 

  148.    REAL,    DIMENSION( ims:ime, kms:kme, jms:jme )            , &
    149. 

  149.             INTENT(IN   )    ::                           QV3D, &
    150. 

  150.                                                           QC3D, &
    151. 

  151.                                                            p8w, &
    152. 

  152.                                                          rho3D, &
    153. 

  153.                                                            T3D, &
    154. 

  154.                                                            z3D
    155. 

  155. 

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

  157.                INTENT(IN   )    ::                       RAINBL, &
    158. 

  158.                                                             GLW, &
    159. 

  159.                                                             GSW, &
    160. 

  160.                                                            FLHC, &
    161. 

  161.                                                            FLQC, &
    162. 

  162.                                                            CHS , &
    163. 

  163.                                                           EMISS, &
    164. 

  164.                                                            XICE, &
    165. 

  165.                                                           XLAND, &
    166. 

  166.                                                          ALBBCK, &
    167. 

  167.                                                          VEGFRA, &
    168. 

  168.                                                            TBOT
    169. 

  169. 

  170.    REAL,       DIMENSION( 1:nsl), INTENT(IN   )      ::      ZS
    171. 

  171. 

  172.    REAL,       DIMENSION( ims:ime , jms:jme ),                   &
    173. 

  173.                INTENT(INOUT)    ::                               &
    174. 

  174.                                                            SNOW, & !new
    175. 

  175.                                                           SNOWH, &
    176. 

  176.                                                           SNOWC, &
    177. 

  177.                                                          CANWAT, & ! new
    178. 

  178.                                                          SNOALB, &
    179. 

  179.                                                             ALB, &
    180. 

  180.                                                             LAI, &
    181. 

  181.                                                          MAVAIL, & 
    182. 

  182.                                                          SFCEXC, &
    183. 

  183.                                                             Z0 , &
    184. 

  184.                                                             ZNT
    185. 

  185. 

  186.    REAL,       DIMENSION( ims:ime , jms:jme ),                   &
    187. 

  187.                INTENT(IN   )    ::                               &
    188. 

  188.                                                         FRZFRAC
    189. 

  189. 

  190.    INTEGER,    DIMENSION( ims:ime , jms:jme ),                   &
    191. 

  191.                INTENT(IN   )    ::                       IVGTYP, &
    192. 

  192.                                                          ISLTYP
    193. 

  193.    CHARACTER(LEN=*), INTENT(IN   )    ::                 MMINLU
    194. 

  194.    REAL,     DIMENSION( ims:ime , 1:nlcat, jms:jme ), INTENT(IN):: LANDUSEF
    195. 

  195.    REAL,     DIMENSION( ims:ime , 1:nscat, jms:jme ), INTENT(IN):: SOILCTOP
    196. 

  196. 

  197.    REAL, INTENT(IN   )          ::         CP,ROVCP,G0,LV,STBOLT,XICE_threshold
    198. 

  198.  
    199. 

  199.    REAL,       DIMENSION( ims:ime , 1:nsl, jms:jme )           , &
    200. 

  200.                INTENT(INOUT)    ::                 SOILMOIS,SH2O,TSO
    201. 

  201. 

  202.    REAL,       DIMENSION( ims:ime, jms:jme )                   , &
    203. 

  203.                INTENT(INOUT)    ::                        SOILT, &
    204. 

  204.                                                             HFX, &
    205. 

  205.                                                             QFX, &
    206. 

  206.                                                              LH, &
    207. 

  207.                                                          SFCEVP, &
    208. 

  208.                                                       SFCRUNOFF, &
    209. 

  209.                                                        UDRUNOFF, &
    210. 

  210.                                                          GRDFLX, &
    211. 

  211.                                                          ACSNOW, &
    212. 

  212.                                                            SNOM, &
    213. 

  213.                                                             QVG, &
    214. 

  214.                                                             QCG, &
    215. 

  215.                                                             DEW, &
    216. 

  216.                                                            QSFC, &
    217. 

  217.                                                             QSG, &
    218. 

  218.                                                         CHKLOWQ, &
    219. 

  219.                                                          SOILT1, &
    220. 

  220.                                                           TSNAV
    221. 

  221. 

  222.    REAL,       DIMENSION( ims:ime, jms:jme )                   , & 
    223. 

  223.                INTENT(INOUT)    ::                      SMAVAIL, &
    224. 

  224.                                                           SMMAX
    225. 

  225. 

  226.    REAL,       DIMENSION( its:ite, jts:jte )    ::               &
    227. 

  227.                                                              PC, &
    228. 

  228.                                                         RUNOFF1, &
    229. 

  229.                                                         RUNOFF2, &
    230. 

  230.                                                          EMISSL, &
    231. 

  231.                                                            ZNTL, &
    232. 

  232.                                                         LMAVAIL, &
    233. 

  233.                                                           SMELT, &
    234. 

  234.                                                            SNOH, &
    235. 

  235.                                                           SNFLX, &
    236. 

  236.                                                            EDIR, &
    237. 

  237.                                                              EC, &
    238. 

  238.                                                             ETT, &
    239. 

  239.                                                          SUBLIM, &
    240. 

  240.                                                            sflx, &
    241. 

  241.                                                           EVAPL, &
    242. 

  242.                                                           PRCPL, &
    243. 

  243.                                                          SEAICE, &
    244. 

  244.                                                         INFILTR
    245. 

  245. 

  246. !--- soil/snow properties
    247. 

  247.    REAL,       DIMENSION( ims:ime, 1:nsl, jms:jme)               &
    248. 

  248.                                              ::    KEEPFR3DFLAG, &
    249. 

  249.                                                          SMFR3D
    250. 

  250. 

  251.    REAL                                                          &
    252. 

  252.                              ::                           RHOCS, &
    253. 

  253.                                                           RHOSN, &
    254. 

  254.                                                        RHONEWSN, &
    255. 

  255.                                                            BCLH, &
    256. 

  256.                                                             DQM, &
    257. 

  257.                                                            KSAT, &
    258. 

  258.                                                            PSIS, &
    259. 

  259.                                                            QMIN, &
    260. 

  260.                                                           QWRTZ, &
    261. 

  261.                                                             REF, &
    262. 

  262.                                                            WILT, &
    263. 

  263.                                                         CANWATR, &
    264. 

  264.                                                        SNOWFRAC, &
    265. 

  265.                                                           SNHEI, &
    266. 

  266.                                                            SNWE
    267. 

  267. 

  268.    REAL                                      ::              CN, &
    269. 

  269.                                                          SAT,CW, &
    270. 

  270.                                                            C1SN, &
    271. 

  271.                                                            C2SN, &
    272. 

  272.                                                          KQWRTZ, &
    273. 

  273.                                                            KICE, &
    274. 

  274.                                                             KWT
    275. 

  275. 

  276. 

  277.    REAL,     DIMENSION(1:NSL)                ::          ZSMAIN, &
    278. 

  278.                                                          ZSHALF, &
    279. 

  279.                                                          DTDZS2
    280. 

  280. 

  281.    REAL,     DIMENSION(1:2*(nsl-2))          ::           DTDZS
    282. 

  282. 

  283.    REAL,     DIMENSION(1:4001)               ::             TBQ
    284. 

  284. 

  285. 

  286.    REAL,     DIMENSION( 1:nsl )              ::         SOILM1D, & 
    287. 

  287.                                                           TSO1D, &
    288. 

  288.                                                         SOILICE, &
    289. 

  289.                                                         SOILIQW, &
    290. 

  290.                                                        SMFRKEEP
    291. 

  291. 

  292.    REAL,     DIMENSION( 1:nsl )              ::          KEEPFR
    293. 

  293.                                                 
    294. 

  294.    REAL,     DIMENSION( 1:nlcat )            ::          lufrac
    295. 

  295.    REAL,     DIMENSION( 1:nscat )            ::          soilfrac
    296. 

  296. 

  297.    REAL                           ::                        RSM, &
    298. 

  298.                                                       SNWEPRINT, &
    299. 

  299.                                                      SNHEIPRINT
    300. 

  300. 

  301.    REAL                           ::                     PRCPMS, &
    302. 

  302.                                                         NEWSNMS, &
    303. 

  303.                                                            PATM, &
    304. 

  304.                                                           PATMB, &
    305. 

  305.                                                            TABS, &
    306. 

  306.                                                           QVATM, &
    307. 

  307.                                                           QCATM, &
    308. 

  308.                                                           Q2SAT, &
    309. 

  309.                                                          CONFLX, &
    310. 

  310.                                                             RHO, &
    311. 

  311.                                                            QKMS, &
    312. 

  312.                                                            TKMS, &
    313. 

  313.                                                        INFILTRP
    314. 

  314.    REAL      ::  cq,r61,r273,arp,brp,x,evs,eis
    315. 

  315. 

  316.    REAL      ::  meltfactor
    317. 

  317.    INTEGER   ::  NROOT
    318. 

  318.    INTEGER   ::  ILAND,ISOIL,IFOREST
    319. 

  319.  
    320. 

  320.    INTEGER   ::  I,J,K,NZS,NZS1,NDDZS
    321. 

  321.    INTEGER   ::  k1,l,k2,kp,km
    322. 

  322.    CHARACTER (LEN=132) :: message
    323. 

  323. 

  324. !-----------------------------------------------------------------
    325. 

  325. 

  326.          NZS=NSL
    327. 

  327.          NDDZS=2*(nzs-2)
    328. 

  328. 

  329. !---- table TBQ is for resolution of balance equation in VILKA
    330. 

  330.         CQ=173.15-.05
    331. 

  331.         R273=1./273.15
    332. 

  332.         R61=6.1153*0.62198
    333. 

  333.         ARP=77455.*41.9/461.525
    334. 

  334.         BRP=64.*41.9/461.525
    335. 

  335. 

  336.         DO K=1,4001
    337. 

  337.           CQ=CQ+.05
    338. 

  338. !          TBQ(K)=R61*EXP(ARP*(R273-1./CQ)-BRP*LOG(CQ*R273))
    339. 

  339.         EVS=EXP(17.67*(CQ-273.15)/(CQ-29.65))
    340. 

  340.         EIS=EXP(22.514-6.15E3/CQ)
    341. 

  341.         if(CQ.ge.273.15) then
    342. 

  342. ! tbq is in mb
    343. 

  343.         tbq(k) = R61*evs
    344. 

  344.         else
    345. 

  345.         tbq(k) = R61*eis
    346. 

  346.         endif
    347. 

  347. 

  348.         END DO
    349. 

  349. 

  350. !--- Initialize soil/vegetation parameters
    351. 

  351. !--- This is temporary until SI is added to mass coordinate ---!!!!!
    352. 

  352. 

  353. #if ( NMM_CORE == 1 )
    354. 

  354.      if(ktau+1.eq.1) then
    355. 

  355. #else
    356. 

  356.      if(ktau.eq.1) then
    357. 

  357. #endif
    358. 

  358.      DO J=jts,jte
    359. 

  359.          DO i=its,ite
    360. 

  360.             do k=1,nsl
    361. 

  361. !       smfr3d  (i,k,j)=soilmois(i,k,j)/900.*1.e3
    362. 

  362. !       sh2o    (i,k,j)=soilmois(i,k,j)-smfr3d(i,k,j)/1.e3*900.
    363. 

  363.        keepfr3dflag(i,k,j)=0.
    364. 

  364.             enddo
    365. 

  365. !--- initializing to zero snow fraction
    366. 

  366.            snowc(i,j) = min(1.,snowh(i,j)/0.05)
    367. 

  367. !--- initializing inside snow temp if it is not defined
    368. 

  368.         IF((soilt1(i,j) .LT. 170.) .or. (soilt1(i,j) .GT.400.)) THEN
    369. 

  369.             IF(snowc(i,j).gt.0.1) THEN
    370. 

  370.            soilt1(i,j)=0.5*(soilt(i,j)+tso(i,1,j))
    371. 

  371.     IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
    372. 

  372.         WRITE ( message , FMT='(A,F8.3,2I6)' ) &
    373. 

  373.        'Temperature inside snow is initialized in RUCLSM ', soilt1(i,j),i,j
    374. 

  374.         CALL wrf_debug ( 0 , message )
    375. 

  375.     ENDIF
    376. 

  376.             ELSE
    377. 

  377.            soilt1(i,j) = soilt(i,j)
    378. 

  378.             ENDIF
    379. 

  379.         ENDIF
    380. 

  380.            tsnav(i,j) =0.5*(soilt(i,j)+tso(i,1,j))-273.
    381. 

  381.            qcg  (i,j) =0.
    382. 

  382.            patmb=P8w(i,kms,j)*1.e-2
    383. 

  383.            QSG  (i,j) = QSN(SOILT(i,j),TBQ)/PATMB
    384. 

  384.         IF((qvg(i,j) .LE. 0.) .or. (qvg(i,j) .GT.0.1)) THEN
    385. 

  385.            qvg  (i,j) = QSG(i,j)*mavail(i,j)
    386. 

  386.           IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
    387. 

  387.            WRITE ( message , FMT='(A,F8.3,2I6)' ) &
    388. 

  388.           'QVG is initialized in RUCLSM ', qvg(i,j),mavail(i,j),qsg(i,j),i,j
    389. 

  389.            CALL wrf_debug ( 0 , message )
    390. 

  390.           ENDIF
    391. 

  391.         ENDIF
    392. 

  392. !           qvg  (i,j) =qv3d(i,1,j)
    393. 

  393. !           qsfc(i,j) = qsg(i,j)/(1.+qsg(i,j))
    394. 

  394.            qsfc(i,j) = qvg(i,j)/(1.+qvg(i,j))
    395. 

  395.            SMELT(i,j) = 0.
    396. 

  396.            SNOM (i,j) = 0.
    397. 

  397.            SNFLX(i,j) = 0.
    398. 

  398.            DEW  (i,j) = 0.
    399. 

  399.            PC   (i,j) = 0.
    400. 

  400.            zntl (i,j) = 0.
    401. 

  401.            RUNOFF1(i,j) = 0.
    402. 

  402.            RUNOFF2(i,j) = 0.
    403. 

  403.            SFCRUNOFF(i,j) = 0.
    404. 

  404.            UDRUNOFF(i,j) = 0.
    405. 

  405.            emissl (i,j) = 0.
    406. 

  406. ! Temporarily!!!
    407. 

  407.            canwat(i,j)=0.
    408. 

  408. 

  409. ! For RUC LSM CHKLOWQ needed for MYJPBL should 
    410. 

  410. ! 1 because is actual specific humidity at the surface, and
    411. 

  411. ! not the saturation value
    412. 

  412.            chklowq(i,j) = 1.
    413. 

  413.            infiltr(i,j) = 0.
    414. 

  414.            snoh  (i,j) = 0.
    415. 

  415.            edir  (i,j) = 0.
    416. 

  416.            ec    (i,j) = 0.
    417. 

  417.            ett   (i,j) = 0.
    418. 

  418.            sublim(i,j) = 0.
    419. 

  419.            sflx  (i,j) = 0.
    420. 

  420.            evapl (i,j) = 0.
    421. 

  421.            prcpl (i,j) = 0.
    422. 

  422.          ENDDO
    423. 

  423.      ENDDO
    424. 

  424. 

  425.         do k=1,nsl
    426. 

  426.            soilice(k)=0.
    427. 

  427.            soiliqw(k)=0.
    428. 

  428.         enddo
    429. 

  429.      endif
    430. 

  430. 

  431. !-----------------------------------------------------------------
    432. 

  432. 

  433.         PRCPMS = 0.
    434. 

  434. 

  435. 

  436.    DO J=jts,jte
    437. 

  437. 

  438.       DO i=its,ite
    439. 

  439. 

  440.     IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
    441. 

  441.       print *,' IN LSMRUC ','ims,ime,jms,jme,its,ite,jts,jte,nzs', &
    442. 

  442.                 ims,ime,jms,jme,its,ite,jts,jte,nzs
    443. 

  443.       print *,' IVGTYP, ISLTYP ', ivgtyp(i,j),isltyp(i,j)
    444. 

  444.       print *,' MAVAIL ', mavail(i,j)
    445. 

  445.       print *,' SOILT,QVG,P8w',soilt(i,j),qvg(i,j),p8w(i,1,j)
    446. 

  446.       print *, 'LSMRUC, I,J,xland, QFX,HFX from SFCLAY',i,j,xland(i,j), &
    447. 

  447.                   qfx(i,j),hfx(i,j)
    448. 

  448.       print *, ' GSW, GLW =',gsw(i,j),glw(i,j)
    449. 

  449.       print *, 'SOILT, TSO start of time step =',soilt(i,j),(tso(i,k,j),k=1,nsl)
    450. 

  450.       print *, 'SOILMOIS start of time step =',(soilmois(i,k,j),k=1,nsl)
    451. 

  451.       print *, 'SMFROZEN start of time step =',(smfr3d(i,k,j),k=1,nsl)
    452. 

  452.       print *, ' I,J=, after SFCLAY CHS,FLHC ',i,j,chs(i,j),flhc(i,j)
    453. 

  453.       print *, 'LSMRUC, IVGTYP,ISLTYP,ALB = ', ivgtyp(i,j),isltyp(i,j),alb(i,j),i,j
    454. 

  454.       print *, 'LSMRUC  I,J,DT,RAINBL =',I,J,dt,RAINBL(i,j)
    455. 

  455.       print *, 'XLAND ---->, ivgtype,isoiltyp,i,j',xland(i,j),ivgtyp(i,j),isltyp(i,j),i,j
    456. 

  456.     ENDIF
    457. 

  457. 

  458. 

  459.          ILAND     = IVGTYP(i,j)
    460. 

  460.          ISOIL     = ISLTYP(I,J)
    461. 

  461.          TABS      = T3D(i,kms,j)
    462. 

  462.          QVATM     = QV3D(i,kms,j)
    463. 

  463.          QCATM     = QC3D(i,kms,j)
    464. 

  464.          PATM      = P8w(i,kms,j)*1.e-5
    465. 

  465. !-- Z3D(1) is thickness between first full sigma level and the surface, 
    466. 

  466. !-- but first mass level is at the half of the first sigma level 
    467. 

  467. !-- (u and v are also at the half of first sigma level)
    468. 

  468.          CONFLX    = Z3D(i,kms,j)*0.5
    469. 

  469.          RHO       = RHO3D(I,kms,J)
    470. 

  470. !--- 1*e-3 is to convert from mm/s to m/s
    471. 

  471.        IF(FRPCPN) THEN
    472. 

  472.          PRCPMS    = (RAINBL(i,j)/DT*1.e-3)*(1-FRZFRAC(I,J))
    473. 

  473.          NEWSNMS  = (RAINBL(i,j)/DT*1.e-3)*FRZFRAC(I,J)
    474. 

  474.        ELSE
    475. 

  475.           if (tabs.le.273.15) then
    476. 

  476.          PRCPMS    = 0.
    477. 

  477.          NEWSNMS   = RAINBL(i,j)/DT*1.e-3
    478. 

  478.           else
    479. 

  479.          PRCPMS    = RAINBL(i,j)/DT*1.e-3
    480. 

  480.          NEWSNMS   = 0.
    481. 

  481.           endif
    482. 

  482.        ENDIF
    483. 

  483. !        if   (myj)   then
    484. 

  484.          QKMS=CHS(i,j)
    485. 

  485.          TKMS=CHS(i,j)
    486. 

  486. !        else
    487. 

  487. !--- convert exchange coeff QKMS to [m/s]
    488. 

  488. !         QKMS=FLQC(I,J)/RHO/MAVAIL(I,J)
    489. 

  489. !         TKMS=FLHC(I,J)/RHO/CP
    490. 

  490. !        endif
    491. 

  491. !--- convert incoming snow and canwat from mm to m
    492. 

  492.          SNWE=SNOW(I,J)*1.E-3
    493. 

  493.          SNHEI=SNOWH(I,J)
    494. 

  494.          CANWATR=CANWAT(I,J)*1.E-3
    495. 

  495.          SNOWFRAC=SNOWC(I,J)
    496. 

  496. 

  497. !-----
    498. 

  498.              zsmain(1)=0.
    499. 

  499.              zshalf(1)=0.
    500. 

  500.           do k=2,nzs
    501. 

  501.              zsmain(k)= zs(k)
    502. 

  502.              zshalf(k)=0.5*(zsmain(k-1) + zsmain(k))
    503. 

  503.           enddo
    504. 

  504. 

  505.           do k=1,nlcat
    506. 

  506.              lufrac(k) = landusef(i,k,j)
    507. 

  507.           enddo
    508. 

  508.           do k=1,nscat
    509. 

  509.              soilfrac(k) = soilctop(i,k,j)
    510. 

  510.           enddo
    511. 

  511. 

  512. !------------------------------------------------------------
    513. 

  513. !-----  DDZS and DSDZ1 are for implicit solution of soil eqns.
    514. 

  514. !-------------------------------------------------------------
    515. 

  515.         NZS1=NZS-1
    516. 

  516. !-----
    517. 

  517.     IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
    518. 

  518.          print *,' DT,NZS1, ZSMAIN, ZSHALF --->', dt,nzs1,zsmain,zshalf
    519. 

  519.     ENDIF
    520. 

  520. 

  521.         DO  K=2,NZS1
    522. 

  522.           K1=2*K-3
    523. 

  523.           K2=K1+1
    524. 

  524.           X=DT/2./(ZSHALF(K+1)-ZSHALF(K))
    525. 

  525.           DTDZS(K1)=X/(ZSMAIN(K)-ZSMAIN(K-1))
    526. 

  526.           DTDZS2(K-1)=X
    527. 

  527.           DTDZS(K2)=X/(ZSMAIN(K+1)-ZSMAIN(K))
    528. 

  528.         END DO
    529. 

  529. 

  530. !27jul2011 - CN and SAT are defined in VEGPARM.TBL
    531. 

  531. !        CN=0.5     ! exponent
    532. 

  532. !        SAT=0.0004   ! canopy water saturated
    533. 

  533.   
    534. 

  534.         CW =4.183E6
    535. 

  535. 

  536. 

  537. !--- Constants used in Johansen soil thermal
    538. 

  538. !--- conductivity method
    539. 

  539. 

  540.         KQWRTZ=7.7
    541. 

  541.         KICE=2.2
    542. 

  542.         KWT=0.57
    543. 

  543. 

  544. !***********************************************************************
    545. 

  545. !--- Constants for snow density calculations C1SN and C2SN
    546. 

  546. 

  547.         c1sn=0.026
    548. 

  548. !        c1sn=0.01
    549. 

  549.         c2sn=21.
    550. 

  550. 

  551. !***********************************************************************
    552. 

  552. 

  553.         NROOT= 4
    554. 

  554. !           ! rooting depth
    555. 

  555. 

  556.         RHONEWSN = 200.
    557. 

  557.        if(SNOW(i,j).gt.0. .and. SNOWH(i,j).gt.0.) then
    558. 

  558.         RHOSN = SNOW(i,j)/SNOWH(i,j)
    559. 

  559.        else
    560. 

  560.         RHOSN = 300.
    561. 

  561.        endif
    562. 

  562. 

  563.     IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
    564. 

  564.        if(ktau.eq.1 .and.(i.eq.195.and.j.eq.254)) &
    565. 

  565.            print *,'before SOILVEGIN - z0,znt(195,254)',z0(i,j),znt(i,j)
    566. 

  566.     ENDIF
    567. 

  567. !--- initializing soil and surface properties
    568. 

  568.      CALL SOILVEGIN  ( mosaic_lu, mosaic_soil,soilfrac,nscat,            &
    569. 

  569.                        NLCAT,ILAND,ISOIL,iswater,MYJ,IFOREST,lufrac,     &
    570. 

  570.                        EMISSL(I,J),PC(I,J),ZNT(I,J),LAI(I,J),            &
    571. 

  571.                        QWRTZ,RHOCS,BCLH,DQM,KSAT,PSIS,QMIN,REF,WILT,i,j )
    572. 

  572.     IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
    573. 

  573.       if(ktau.eq.1 .and.(i.eq.195.and.j.eq.254)) &
    574. 

  574.          print *,'after SOILVEGIN - z0,znt(195,254)',z0(i,j),znt(i,j)
    575. 

  575. 

  576.       if(ktau.eq.1 .and. (i.eq.195.and.j.eq.254)) then
    577. 

  577.          print *,'NLCAT,iland,lufrac,EMISSL(I,J),PC(I,J),ZNT(I,J),LAI(I,J)', &
    578. 

  578.                   NLCAT,iland,lufrac,EMISSL(I,J),PC(I,J),ZNT(I,J),LAI(I,J),i,j
    579. 

  579.          print *,'NSCAT,soilfrac,QWRTZ,RHOCS,BCLH,DQM,KSAT,PSIS,QMIN,REF,WILT',&
    580. 

  580.                  NSCAT,soilfrac,QWRTZ,RHOCS,BCLH,DQM,KSAT,PSIS,QMIN,REF,WILT,i,j
    581. 

  581.       endif
    582. 

  582.     ENDIF
    583. 

  583. 

  584.         CN=CFACTR_DATA   ! exponent
    585. 

  585.         SAT=max(1.e-4,CMCMAX_DATA * LAI(I,J) * 0.01*VEGFRA(I,J)) ! canopy water saturated
    586. 

  586. 

  587. !-- definition of number of soil levels in the rooting zone
    588. 

  588. !     IF(iforest(ivgtyp(i,j)).ne.1) THEN
    589. 

  589.      IF(iforest.ne.1) THEN
    590. 

  590. !---- all vegetation types except evergreen and mixed forests
    591. 

  591. !18apr08 - define meltfactor for Egglston melting limit:
    592. 

  592. ! for open areas factor is 2, and for forests - factor is 1.5
    593. 

  593. ! This will make limit on snow melting smaller and let snow stay 
    594. 

  594. ! longer in the forests.
    595. 

  595.          meltfactor = 2.0
    596. 

  596. 

  597.          do k=2,nzs
    598. 

  598.          if(zsmain(k).ge.0.4) then
    599. 

  599.             NROOT=K
    600. 

  600.             goto  111
    601. 

  601.          endif
    602. 

  602.          enddo
    603. 

  603.      ELSE
    604. 

  604. !---- evergreen and mixed forests
    605. 

  605. !18apr08 - define meltfactor
    606. 

  606. !         meltfactor = 1.5
    607. 

  607. ! 28 March 11 - Previously used value of metfactor= 1.5 needs to be further reduced 
    608. 

  608. ! to compensate for low snow albedos in the forested areas. 
    609. 

  609. ! Melting rate in forests will reduce.
    610. 

  610.          meltfactor = 0.85
    611. 

  611. 

  612.          do k=2,nzs
    613. 

  613.          if(zsmain(k).ge.1.1) then
    614. 

  614.             NROOT=K
    615. 

  615.             goto  111
    616. 

  616.          endif
    617. 

  617.          enddo
    618. 

  618.      ENDIF
    619. 

  619.  111   continue
    620. 

  620. 

  621. !-----
    622. 

  622.     IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
    623. 

  623.          print *,' ZNT, LAI, VEGFRA, SAT, EMIS, PC --->',                &
    624. 

  624.                    ZNT(I,J),LAI(I,J),VEGFRA(I,J),SAT,EMISSL(I,J),PC(I,J)
    625. 

  625.          print *,' ZS, ZSMAIN, ZSHALF, CONFLX, CN, SAT, --->', zs,zsmain,zshalf,conflx,cn,sat
    626. 

  626.          print *,'NROOT, meltfactor, iforest, ivgtyp, i,j ', nroot,meltfactor,iforest,ivgtyp(I,J),I,J
    627. 

  627. !         print *,'NROOT, iforest, ivgtyp, i,j ', nroot,iforest(ivgtyp(i,j)),ivgtyp(I,J),I,J
    628. 

  628.     ENDIF
    629. 

  629. 

  630. !*** SET ZERO-VALUE FOR SOME OUTPUT DIAGNOSTIC ARRAYS
    631. 

  631. 

  632.         IF((XLAND(I,J)-1.5).GE.0.)THEN
    633. 

  633. !-- Water 
    634. 

  634.            SMAVAIL(I,J)=1.0
    635. 

  635.              SMMAX(I,J)=1.0
    636. 

  636.              SNOW(I,J)=0.0
    637. 

  637.              SNOWH(I,J)=0.0
    638. 

  638.              SNOWC(I,J)=0.0
    639. 

  639.            LMAVAIL(I,J)=1.0
    640. 

  640. 

  641.            ILAND=iswater
    642. 

  642. !           ILAND=16
    643. 

  643.            ISOIL=14
    644. 

  644. 

  645.            patmb=P8w(i,1,j)*1.e-2
    646. 

  646.            qvg  (i,j) = QSN(SOILT(i,j),TBQ)/PATMB
    647. 

  647.            qsfc(i,j) = qvg(i,j)/(1.+qvg(i,j))
    648. 

  648.            CHKLOWQ(I,J)=1.
    649. 

  649.            Q2SAT=QSN(TABS,TBQ)/PATMB
    650. 

  650. 

  651.             DO K=1,NZS
    652. 

  652.               SOILMOIS(I,K,J)=1.0
    653. 

  653.               SH2O    (I,K,J)=1.0 
    654. 

  654.               TSO(I,K,J)= SOILT(I,J)
    655. 

  655.             ENDDO
    656. 

  656. 

  657.     IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
    658. 

  658.               PRINT*,'  water point, I=',I,                      &
    659. 

  659.               'J=',J, 'SOILT=', SOILT(i,j)
    660. 

  660.     ENDIF
    661. 

  661. 

  662.            ELSE
    663. 

  663. 

  664. ! LAND POINT OR SEA ICE
    665. 

  665.        if(xice(i,j).ge.xice_threshold) then
    666. 

  666. !       if(IVGTYP(i,j).eq.isice) then
    667. 

  667.            SEAICE(i,j)=1.
    668. 

  668.        else
    669. 

  669.            SEAICE(i,j)=0.
    670. 

  670.        endif
    671. 

  671. 

  672.          IF(SEAICE(I,J).GT.0.5)THEN
    673. 

  673. !-- Sea-ice case
    674. 

  674.     IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
    675. 

  675.               PRINT*,' sea-ice at water point, I=',I,            &
    676. 

  676.               'J=',J
    677. 

  677.     ENDIF
    678. 

  678. !            ILAND = 24
    679. 

  679.             ILAND = isice
    680. 

  680.             ISOIL = 16
    681. 

  681.             ZNT(I,J) = 0.011
    682. 

  682.             snoalb(i,j) = 0.75
    683. 

  683.             dqm = 1.
    684. 

  684.             ref = 1.
    685. 

  685.             qmin = 0.
    686. 

  686.             wilt = 0.
    687. 

  687.             emissl(i,j) = 1.0 
    688. 

  688. 

  689.             DO K=1,NZS
    690. 

  690.                soilmois(i,k,j) = 1.
    691. 

  691.                smfr3d(i,k,j)   = 1.
    692. 

  692.                sh2o(i,k,j)     = 0.
    693. 

  693.                keepfr3dflag(i,k,j) = 0.
    694. 

  694.             ENDDO
    695. 

  695.           ENDIF
    696. 

  696. 

  697. !  Attention!!!!  RUC LSM uses soil moisture content minus residual (minimum
    698. 

  698. !  or dry soil moisture content for a given soil type) as a state variable.
    699. 

  699. 

  700.            DO k=1,nzs
    701. 

  701. ! soilm1d - soil moisture content minus residual [m**3/m**3]
    702. 

  702.               soilm1d (k) = min(max(0.,soilmois(i,k,j)-qmin),dqm)
    703. 

  703. !              soilm1d (k) = min(max(0.,soilmois(i,k,j)),dqm)
    704. 

  704.               tso1d   (k) = tso(i,k,j)
    705. 

  705.               soiliqw (k) = min(max(0.,sh2o(i,k,j)-qmin),soilm1d(k))
    706. 

  706.            ENDDO 
    707. 

  707. 

  708.            do k=1,nzs
    709. 

  709.               smfrkeep(k) = smfr3d(i,k,j)
    710. 

  710.               keepfr  (k) = keepfr3dflag(i,k,j)
    711. 

  711.            enddo
    712. 

  712. 

  713. !              LMAVAIL(I,J)=max(0.00001,min(1.,soilmois(i,1,j)/(REF-QMIN)))
    714. 

  714. !              LMAVAIL(I,J)=max(0.00001,min(1.,soilmois(i,1,j)/dqm))
    715. 

  715.               LMAVAIL(I,J)=max(0.00001,min(1.,soilm1d(1)/dqm))
    716. 

  716. 

  717. #if ( NMM_CORE == 1 )
    718. 

  718.      if(ktau+1.gt.1) then
    719. 

  719. #else
    720. 

  720.      if(ktau.gt.1) then
    721. 

  721. #endif
    722. 

  722. 

  723. ! extract dew from the cloud water at the surface
    724. 

  724.               QCG(I,J)=QCG(I,J)-DEW(I,J)
    725. 

  725.      endif
    726. 

  726. 

  727.     IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
    728. 

  728.    print *,'LAND, i,j,tso1d,soilm1d,PATM,TABS,QVATM,QCATM,RHO',  &
    729. 

  729.                   i,j,tso1d,soilm1d,PATM,TABS,QVATM,QCATM,RHO
    730. 

  730.    print *,'CONFLX =',CONFLX 
    731. 

  731.    print *,'SMFRKEEP,KEEPFR   ',SMFRKEEP,KEEPFR
    732. 

  732.     ENDIF
    733. 

  733. 

  734. !-----------------------------------------------------------------
    735. 

  735.          CALL SFCTMP (dt,ktau,conflx,i,j,                        &
    736. 

  736. !--- input variables
    737. 

  737.                 nzs,nddzs,nroot,meltfactor,                      &   !added meltfactor
    738. 

  738.                 iland,isoil,xland(i,j),ivgtyp(i,j),PRCPMS,       &
    739. 

  739.                 NEWSNMS,SNWE,SNHEI,SNOWFRAC,RHOSN,RHONEWSN,      &
    740. 

  740.                 PATM,TABS,QVATM,QCATM,RHO,                       &
    741. 

  741.                 GLW(I,J),GSW(I,J),EMISSL(I,J),                   &
    742. 

  742.                 QKMS,TKMS,PC(I,J),LMAVAIL(I,J),                  &
    743. 

  743.                 canwatr,vegfra(I,J),alb(I,J),znt(I,J),           &
    744. 

  744.                 snoalb(i,j),albbck(i,j),                         &   !new
    745. 

  745.                 myj,seaice(i,j),isice,                           &
    746. 

  746. !--- soil fixed fields
    747. 

  747.                 QWRTZ,                                           &
    748. 

  748.                 rhocs,dqm,qmin,ref,                              &
    749. 

  749.                 wilt,psis,bclh,ksat,                             &
    750. 

  750.                 sat,cn,zsmain,zshalf,DTDZS,DTDZS2,tbq,           &
    751. 

  751. !--- constants
    752. 

  752.                 cp,rovcp,g0,lv,stbolt,cw,c1sn,c2sn,              &
    753. 

  753.                 KQWRTZ,KICE,KWT,                                 &
    754. 

  754. !--- output variables
    755. 

  755.                 snweprint,snheiprint,rsm,                        &
    756. 

  756.                 soilm1d,tso1d,smfrkeep,keepfr,                   &
    757. 

  757.                 soilt(I,J),soilt1(i,j),tsnav(i,j),dew(I,J),      &
    758. 

  758.                 qvg(I,J),qsg(I,J),qcg(I,J),SMELT(I,J),           &
    759. 

  759.                 SNOH(I,J),SNFLX(I,J),SNOM(I,J),ACSNOW(I,J),      &
    760. 

  760.                 edir(I,J),ec(I,J),ett(I,J),qfx(I,J),          &
    761. 

  761.                 lh(I,J),hfx(I,J),sflx(I,J),sublim(I,J),          &
    762. 

  762.                 evapl(I,J),prcpl(I,J),runoff1(I,J),              &
    763. 

  763.                 runoff2(I,J),soilice,soiliqw,infiltrp)
    764. 

  764. !-----------------------------------------------------------------
    765. 

  765. 

  766. !***  DIAGNOSTICS
    767. 

  767. !--- available and maximum soil moisture content in the soil
    768. 

  768. !--- domain
    769. 

  769. 

  770.         smavail(i,j) = 0.
    771. 

  771.         smmax (i,j)  = 0.  
    772. 

  772. 

  773.       do k=1,nzs-1
    774. 

  774.         smavail(i,j)=smavail(i,j)+(qmin+soilm1d(k))*             &
    775. 

  775.                     (zshalf(k+1)-zshalf(k))
    776. 

  776.         smmax (i,j) =smmax (i,j)+(qmin+dqm)*                     &
    777. 

  777.                     (zshalf(k+1)-zshalf(k))
    778. 

  778.       enddo
    779. 

  779. 

  780.         smavail(i,j)=smavail(i,j)+(qmin+soilm1d(nzs))*           &
    781. 

  781.                     (zsmain(nzs)-zshalf(nzs))
    782. 

  782.         smmax (i,j) =smmax (i,j)+(qmin+dqm)*                     &
    783. 

  783.                     (zsmain(nzs)-zshalf(nzs))
    784. 

  784. 

  785. !--- Convert the water unit into mm
    786. 

  786.         SFCRUNOFF(I,J) = SFCRUNOFF(I,J)+RUNOFF1(I,J)*DT*1000.0
    787. 

  787.         UDRUNOFF (I,J) = UDRUNOFF(I,J)+RUNOFF2(I,J)*1000.0
    788. 

  788.         SMAVAIL  (I,J) = SMAVAIL(I,J) * 1000.
    789. 

  789.         SMMAX    (I,J) = SMMAX(I,J) * 1000.
    790. 

  790. 

  791.         do k=1,nzs
    792. 

  792. 

  793. !             soilmois(i,k,j) = soilm1d(k)
    794. 

  794.              soilmois(i,k,j) = soilm1d(k) + qmin
    795. 

  795.              sh2o    (i,k,j) = min(soiliqw(k) + qmin,soilmois(i,k,j))
    796. 

  796.                   tso(i,k,j) = tso1d(k)
    797. 

  797.         enddo
    798. 

  798. 

  799.         tso(i,nzs,j) = tbot(i,j)
    800. 

  800. 

  801.         do k=1,nzs
    802. 

  802.              smfr3d(i,k,j) = smfrkeep(k)
    803. 

  803.            keepfr3dflag(i,k,j) = keepfr (k)
    804. 

  804.         enddo
    805. 

  805. 

  806. !tgs add together dew and cloud at the ground surface
    807. 

  807.         qcg(i,j)=qcg(i,j)+dew(i,j)
    808. 

  808. 

  809.         Z0       (I,J) = ZNT (I,J)
    810. 

  810.         SFCEXC   (I,J) = TKMS
    811. 

  811.         patmb=P8w(i,1,j)*1.e-2
    812. 

  812.         Q2SAT=QSN(TABS,TBQ)/PATMB
    813. 

  813.         QSFC(I,J) = QVG(I,J)/(1.+QVG(I,J))
    814. 

  814. ! for MYJ surface and PBL scheme
    815. 

  815. !      if (myj) then
    816. 

  816. ! MYJSFC expects QSFC as actual specific humidity at the surface
    817. 

  817.         IF((QVATM.GE.Q2SAT*0.95).AND.QVATM.LT.qvg(I,J))THEN
    818. 

  818.           CHKLOWQ(I,J)=0.
    819. 

  819.         ELSE
    820. 

  820.           CHKLOWQ(I,J)=1.
    821. 

  821.         ENDIF
    822. 

  822. !      else
    823. 

  823. !          CHKLOWQ(I,J)=1.
    824. 

  824. !      endif
    825. 

  825. 

  826.     IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
    827. 

  827.       if(CHKLOWQ(I,J).eq.0.) then
    828. 

  828.    print *,'i,j,CHKLOWQ',  &
    829. 

  829.                   i,j,CHKLOWQ(I,J)
    830. 

  830.       endif
    831. 

  831.     ENDIF
    832. 

  832. 

  833. ! SNOW is in [mm], SNWE is in [m]; CANWAT is in mm, CANWATR is in m
    834. 

  834.         SNOW   (i,j) = SNWE*1000.
    835. 

  835.         SNOWH  (I,J) = SNHEI 
    836. 

  836.         CANWAT (I,J) = CANWATR*1000.
    837. 

  837.         INFILTR(I,J) = INFILTRP
    838. 

  838. 

  839.         MAVAIL (i,j) = LMAVAIL(I,J)  
    840. 

  840.     IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
    841. 

  841.        print *,' LAND, I=,J=, QFX, HFX after SFCTMP', i,j,lh(i,j),hfx(i,j)
    842. 

  842.     ENDIF
    843. 

  843. !!!        QFX    (I,J) = LH(I,J)/LV
    844. 

  844.         SFCEVP (I,J) = SFCEVP (I,J) + QFX (I,J) * DT
    845. 

  845.         GRDFLX (I,J) = -1. * sflx(I,J)
    846. 

  846. 

  847.     IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
    848. 

  848.        print *,' QFX after change, LH ', i,j, QFX(i,j),LH(I,J)
    849. 

  849.     ENDIF
    850. 

  850. !--- SNOWC snow cover flag
    851. 

  851.        if(snowfrac > 0. .and. xice(i,j).ge.xice_threshold ) then
    852. 

  852.            SNOWFRAC = SNOWFRAC*XICE(I,J)
    853. 

  853.        endif
    854. 

  854. 

  855.        SNOWC(I,J)=SNOWFRAC
    856. 

  856. 

  857. 

  858. !--- get 3d soil fields
    859. 

  859.     IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
    860. 

  860.    print *,'LAND, i,j,tso1d,soilm1d - end of time step',         &
    861. 

  861.                   i,j,tso1d,soilm1d
    862. 

  862.     ENDIF
    863. 

  863. 

  864. !--- end of a land or sea ice point
    865. 

  865.         ENDIF
    866. 

  866. 

  867.       ENDDO
    868. 

  868. 

  869.    ENDDO
    870. 

  870. 

  871. !-----------------------------------------------------------------
    872. 

  872.    END SUBROUTINE LSMRUC
    873. 

  873. !-----------------------------------------------------------------
    874. 

  874. 

  875. 

  876. 

  877.    SUBROUTINE SFCTMP (delt,ktau,conflx,i,j,                      &
    878. 

  878. !--- input variables
    879. 

  879.                 nzs,nddzs,nroot,meltfactor,                      &
    880. 

  880.                 ILAND,ISOIL,XLAND,IVGTYP,PRCPMS,                 &
    881. 

  881.                 NEWSNMS,SNWE,SNHEI,SNOWFRAC,RHOSN,RHONEWSN,      &
    882. 

  882.                 PATM,TABS,QVATM,QCATM,rho,                       &
    883. 

  883.                 GLW,GSW,EMISS,QKMS,TKMS,PC,                      &
    884. 

  884.                 MAVAIL,CST,VEGFRA,ALB,ZNT,                       &
    885. 

  885.                 ALB_SNOW,ALB_SNOW_FREE,                          &
    886. 

  886.                 MYJ,SEAICE,ISICE,                                &
    887. 

  887. !--- soil fixed fields
    888. 

  888.                 QWRTZ,rhocs,dqm,qmin,ref,wilt,psis,bclh,ksat,    &
    889. 

  889.                 sat,cn,zsmain,zshalf,DTDZS,DTDZS2,tbq,           &
    890. 

  890. !--- constants
    891. 

  891.                 cp,rovcp,g0,lv,stbolt,cw,c1sn,c2sn,              &
    892. 

  892.                 KQWRTZ,KICE,KWT,                                 &
    893. 

  893. !--- output variables
    894. 

  894.                 snweprint,snheiprint,rsm,                        &
    895. 

  895.                 soilm1d,ts1d,smfrkeep,keepfr,soilt,soilt1,       &
    896. 

  896.                 tsnav,dew,qvg,qsg,qcg,                           &
    897. 

  897.                 SMELT,SNOH,SNFLX,SNOM,ACSNOW,                    &
    898. 

  898.                 edir1,ec1,ett1,eeta,qfx,hfx,s,sublim,            &
    899. 

  899.                 evapl,prcpl,runoff1,runoff2,soilice,             &
    900. 

  900.                 soiliqw,infiltr)
    901. 

  901. !-----------------------------------------------------------------
    902. 

  902.        IMPLICIT NONE
    903. 

  903. !-----------------------------------------------------------------
    904. 

  904. 

  905. !--- input variables
    906. 

  906. 

  907.    INTEGER,  INTENT(IN   )   ::  isice,i,j,nroot,ktau,nzs ,      &
    908. 

  908.                                  nddzs                             !nddzs=2*(nzs-2)
    909. 

  909. 

  910.    REAL,     INTENT(IN   )   ::  DELT,CONFLX,meltfactor
    911. 

  911.    REAL,     INTENT(IN   )   ::  C1SN,C2SN
    912. 

  912.    LOGICAL,    INTENT(IN   )    ::     myj
    913. 

  913. !--- 3-D Atmospheric variables
    914. 

  914.    REAL                                                        , &
    915. 

  915.             INTENT(IN   )    ::                            PATM, &
    916. 

  916.                                                            TABS, &
    917. 

  917.                                                           QVATM, &
    918. 

  918.                                                           QCATM
    919. 

  919.    REAL                                                        , &
    920. 

  920.             INTENT(IN   )    ::                             GLW, &
    921. 

  921.                                                             GSW, &
    922. 

  922.                                                              PC, &
    923. 

  923.                                                          VEGFRA, &
    924. 

  924.                                                   ALB_SNOW_FREE, &
    925. 

  925.                                                          SEAICE, &
    926. 

  926.                                                           XLAND, &
    927. 

  927.                                                             RHO, &
    928. 

  928.                                                            QKMS, &
    929. 

  929.                                                            TKMS
    930. 

  930.                                                              
    931. 

  931.    INTEGER,   INTENT(IN   )  ::                          IVGTYP
    932. 

  932. !--- 2-D variables
    933. 

  933.    REAL                                                        , &
    934. 

  934.             INTENT(INOUT)    ::                           EMISS, &
    935. 

  935.                                                          MAVAIL, &
    936. 

  936.                                                        SNOWFRAC, &
    937. 

  937.                                                        ALB_SNOW, &
    938. 

  938.                                                             ALB, &
    939. 

  939.                                                             CST
    940. 

  940. 

  941. !--- soil properties
    942. 

  942.    REAL                      ::                                  &
    943. 

  943.                                                           RHOCS, &
    944. 

  944.                                                            BCLH, &
    945. 

  945.                                                             DQM, &
    946. 

  946.                                                            KSAT, &
    947. 

  947.                                                            PSIS, &
    948. 

  948.                                                            QMIN, &
    949. 

  949.                                                           QWRTZ, &
    950. 

  950.                                                             REF, &
    951. 

  951.                                                             SAT, &
    952. 

  952.                                                            WILT
    953. 

  953. 

  954.    REAL,     INTENT(IN   )   ::                              CN, &
    955. 

  955.                                                              CW, &
    956. 

  956.                                                              CP, &
    957. 

  957.                                                           ROVCP, &
    958. 

  958.                                                              G0, &
    959. 

  959.                                                              LV, &
    960. 

  960.                                                          STBOLT, &
    961. 

  961.                                                          KQWRTZ, &
    962. 

  962.                                                            KICE, &
    963. 

  963.                                                             KWT
    964. 

  964. 

  965.    REAL,     DIMENSION(1:NZS), INTENT(IN)  ::            ZSMAIN, &
    966. 

  966.                                                          ZSHALF, &
    967. 

  967.                                                          DTDZS2 
    968. 

  968. 

  969. 

  970.    REAL,     DIMENSION(1:NDDZS), INTENT(IN)  ::           DTDZS
    971. 

  971. 

  972.    REAL,     DIMENSION(1:4001), INTENT(IN)  ::              TBQ
    973. 

  973. 

  974. 

  975. !--- input/output variables
    976. 

  976. !-------- 3-d soil moisture and temperature
    977. 

  977.    REAL,     DIMENSION( 1:nzs )                                , &
    978. 

  978.              INTENT(INOUT)   ::                            TS1D, & 
    979. 

  979.                                                         SOILM1D, &
    980. 

  980.                                                        SMFRKEEP
    981. 

  981.    REAL,  DIMENSION( 1:nzs )                                   , &
    982. 

  982.              INTENT(INOUT)   ::                          KEEPFR
    983. 

  983.           
    984. 

  984. 

  985.    INTEGER, INTENT(INOUT)    ::                     ILAND,ISOIL
    986. 

  986. 

  987. !-------- 2-d variables
    988. 

  988.    REAL                                                        , &
    989. 

  989.              INTENT(INOUT)   ::                             DEW, &
    990. 

  990.                                                           EDIR1, &
    991. 

  991.                                                             EC1, &
    992. 

  992.                                                            ETT1, &
    993. 

  993.                                                            EETA, &
    994. 

  994.                                                           EVAPL, &
    995. 

  995.                                                         INFILTR, &
    996. 

  996.                                                           RHOSN, & 
    997. 

  997.                                                        RHONEWSN, &
    998. 

  998.                                                          SUBLIM, &
    999. 

  999.                                                           PRCPL, &
    1000. 

  1000.                                                             QVG, &
    1001. 

  1001.                                                             QSG, &
    1002. 

  1002.                                                             QCG, &
    1003. 

  1003.                                                             QFX, &
    1004. 

  1004.                                                             HFX, &
    1005. 

  1005.                                                               S, &  
    1006. 

  1006.                                                         RUNOFF1, &
    1007. 

  1007.                                                         RUNOFF2, &
    1008. 

  1008.                                                          ACSNOW, &
    1009. 

  1009.                                                            SNWE, &
    1010. 

  1010.                                                           SNHEI, &
    1011. 

  1011.                                                           SMELT, &
    1012. 

  1012.                                                            SNOM, &
    1013. 

  1013.                                                            SNOH, &
    1014. 

  1014.                                                           SNFLX, &
    1015. 

  1015.                                                           SOILT, &
    1016. 

  1016.                                                          SOILT1, &
    1017. 

  1017.                                                           TSNAV, &
    1018. 

  1018.                                                             ZNT
    1019. 

  1019. 

  1020.    REAL,     DIMENSION(1:NZS)              ::                    &
    1021. 

  1021.                                                            tice, &
    1022. 

  1022.                                                         rhosice, &
    1023. 

  1023.                                                          capice, &
    1024. 

  1024.                                                        thdifice
    1025. 

  1025. !-------- 1-d variables
    1026. 

  1026.    REAL,     DIMENSION(1:NZS), INTENT(OUT)  ::          SOILICE, &
    1027. 

  1027.                                                         SOILIQW
    1028. 

  1028.             
    1029. 

  1029.                      
    1030. 

  1030. 

  1031.    REAL,     INTENT(OUT)                    ::              RSM, &  
    1032. 

  1032.                                                       SNWEPRINT, &
    1033. 

  1033.                                                      SNHEIPRINT
    1034. 

  1034. !--- Local variables
    1035. 

  1035. 

  1036.    INTEGER ::  K,ILNB
    1037. 

  1037. 

  1038.    REAL    ::  BSN, XSN                                        , &
    1039. 

  1039.                RAINF, SNTH, NEWSN, PRCPMS, NEWSNMS             , &
    1040. 

  1040.                T3, UPFLUX, XINET
    1041. 

  1041.    REAL    ::  snhei_crit, keep_snow_albedo
    1042. 

  1042. 

  1043.    REAL    ::  RNET,GSWNEW,EMISSN,ZNTSN
    1044. 

  1044.    REAL    ::  VEGFRAC
    1045. 

  1045.    real    ::  cice, albice, albsn
    1046. 

  1046. 

  1047. !-----------------------------------------------------------------
    1048. 

  1048.         integer,   parameter      ::      ilsnow=99 
    1049. 

  1049.         
    1050. 

  1050.     IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
    1051. 

  1051.         print *,' in SFCTMP',i,j,nzs,nddzs,nroot,                 &
    1052. 

  1052.                  SNWE,RHOSN,SNOM,SMELT,TS1D
    1053. 

  1053.     ENDIF
    1054. 

  1054. 

  1055.         NEWSN=0.
    1056. 

  1056.         RAINF = 0.
    1057. 

  1057.         RSM=0.
    1058. 

  1058.         INFILTR=0.
    1059. 

  1059.         VEGFRAC=0.01*VEGFRA
    1060. 

  1060. !       if(VEGFRAC.le.0.01) VEGFRAC=0.
    1061. 

  1061. 

  1062. !---initialize local arrays for sea ice
    1063. 

  1063.           do k=1,nzs
    1064. 

  1064.             tice(k) = 0.
    1065. 

  1065.             rhosice(k) = 0. 
    1066. 

  1066.             cice = 0.
    1067. 

  1067.             capice(k) = 0.
    1068. 

  1068.             thdifice(k) = 0.
    1069. 

  1069.           enddo
    1070. 

  1070. 

  1071.         GSWnew=GSW
    1072. 

  1072.         ALBice=ALB_SNOW_FREE
    1073. 

  1073. !--- sea ice properties
    1074. 

  1074. !--- N.N Zubov "Arctic Ice"
    1075. 

  1075. !--- no salinity dependence because we consider the ice pack
    1076. 

  1076. !--- to be old and to have low salinity (0.0002)
    1077. 

  1077.        if(SEAICE.ge.0.5) then
    1078. 

  1078.           do k=1,nzs
    1079. 

  1079.             tice(k) = ts1d(k) - 273.15
    1080. 

  1080.             rhosice(k) = 917.6/(1-0.000165*tice(k))
    1081. 

  1081.             cice = 2115.85 +7.7948*tice(k)
    1082. 

  1082.             capice(k) = cice*rhosice(k)
    1083. 

  1083.             thdifice(k) = 2.260872/capice(k)
    1084. 

  1084.            enddo
    1085. 

  1085. !-- SEA ICE ALB dependence on ice temperature. When ice temperature is
    1086. 

  1086. !-- below critical value of -10C - no change to albedo.
    1087. 

  1087. !-- If temperature is higher that -10C then albedo is decreasing.
    1088. 

  1088. !-- The minimum albedo at t=0C for ice is 0.1 less.
    1089. 

  1089.          GSWNEW=GSW/(1.-ALB)
    1090. 

  1090.        ALBice = MIN(ALB_SNOW_FREE,MAX(ALB_SNOW_FREE - 0.05,   &
    1091. 

  1091.                ALB_SNOW_FREE - 0.1*(tice(1)+10.)/10. ))
    1092. 

  1092.          GSWNEW=GSW*(1.-ALBice)
    1093. 

  1093.        endif
    1094. 

  1094. 

  1095.     IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
    1096. 

  1096.         print *,'I,J,KTAU,QKMS,TKMS', i,j,ktau,qkms,tkms
    1097. 

  1097.         print *,'GSW,GSWnew,GLW,SOILT,EMISS,ALB,ALBice,SNWE',&
    1098. 

  1098.                  GSW,GSWnew,GLW,SOILT,EMISS,ALB,ALBice,SNWE
    1099. 

  1099.     ENDIF
    1100. 

  1100. 

  1101.          SNHEI   = SNWE * 1000. / RHOSN
    1102. 

  1102. !--------------
    1103. 

  1103.          T3      = STBOLT*SOILT*SOILT*SOILT
    1104. 

  1104.          UPFLUX  = T3 *SOILT
    1105. 

  1105.          XINET   = EMISS*(GLW-UPFLUX)
    1106. 

  1106.          RNET    = GSWnew + XINET
    1107. 

  1107. 

  1108. !Calculate the amount (m) of fresh snow
    1109. 

  1109. 

  1110. 	if(snhei.gt.0.0081*1.e3/rhosn) then
    1111. 

  1111. !*** Correct snow density for current temperature (Koren et al. 1999)
    1112. 

  1112.         BSN=delt/3600.*c1sn*exp(0.08*tsnav-c2sn*rhosn*1.e-3)
    1113. 

  1113.        if(bsn*snwe*100..lt.1.e-4) goto 777
    1114. 

  1114.         XSN=rhosn*(exp(bsn*snwe*100.)-1.)/(bsn*snwe*100.)
    1115. 

  1115.         rhosn=MIN(MAX(100.,XSN),400.)
    1116. 

  1116. !        rhosn=MIN(MAX(50.,XSN),400.)
    1117. 

  1117.  777   continue
    1118. 

  1118. 

  1119. !      else
    1120. 

  1120. !        rhosn     =200.
    1121. 

  1121. !        rhonewsn  =200.
    1122. 

  1122.       endif
    1123. 

  1123. 

  1124.            newsn=newsnms*delt
    1125. 

  1125. !---- ACSNOW - accumulated snow water [kg m-2]
    1126. 

  1126.            acsnow=acsnow+newsn*1.e3
    1127. 

  1127. 

  1128.        IF(NEWSN.GT.0.) THEN
    1129. 

  1129. !       IF(NEWSN.GE.1.E-8) THEN
    1130. 

  1130. !*** Calculate fresh snow density (t > -15C, else MIN value)
    1131. 

  1131. !*** Eq. 10 from Koren et al. (1999)
    1132. 

  1132. 

  1133.     IF ( wrf_at_debug_level(LSMRUC_DBG_LVL) ) THEN
    1134. 

  1134.       print *, 'THERE IS NEW SNOW, newsn', newsn
    1135. 

  1135.     ENDIF
    1136. 

  1136.         if(tabs.lt.258.15) then
    1137. 

  1137. !          rhonewsn=50.
    1138. 

  1138.           rhonewsn=100.
    1139. 

  1139. 

  1140.         else
    1141. 

  1141.           rhonewsn=1.e3*max((0.10+0.0017*(Tabs-273.15+15.)**1.5) &
    1142. 

  1142.                                  , 0.10)
    1143. 

  1143. !          rhonewsn=1.e3*max((0.05+0.0017*(Tabs-273.15+15.)**1.5) &
    1144. 

  1144. !                                 , 0.05)
    1145. 

  1145.           rhonewsn=MIN(rhonewsn,400.)
    1146. 

  1146. !          rhonewsn=100.
    1147. 

  1147.         endif
    1148. 

  1148. 

  1149. 

  1150. !*** Define average snow density of the snow pack considering
    1151. 

  1151. !*** the amount of fresh snow (eq. 9 in Koren et al.(1999) 
    1152. 

  1152. !*** without snow melt )
    1153. 

  1153.          xsn=(rhosn*snwe+rhonewsn*newsn)/                         &
    1154. 

  1154.              (snwe+newsn)
    1155. 

  1155.          rhosn=MIN(MAX(100.,XSN),400.)
    1156. 

  1156. !         rhosn=MIN(MAX(50.,XSN),400.)
    1157. 

  1157. 

  1158.          snwe=snwe+newsn
    1159. 

  1159.          snhei=snwe*1.E3/rhosn
    1160. 

  1160.          NEWSN=NEWSN*1.E3/rhonewsn
    1161. 

  1161.        ENDIF
    1162. 

  1162. 

  1163.        IF(PRCPMS.NE.0.) THEN
    1164. 

  1164. 

  1165. ! PRCPMS is liquid precipitation rate
    1166. 

  1166. ! RAINF is a flag used for calculation of rain water
    1167. 

  1167. ! heat content contribution into heat budget equation. Rain's temperature
    1168. 

  1168. ! is set equal to air temperature at the first atmospheric
    1169. 

  1169. ! level.  
    1170. 

  1170. 

  1171.            RAINF=1.
    1172. 

  1172.        ENDIF
    1173. 

  1173. 

  1174.         IF(SNHEI.GT.0.0) THEN
    1175. 

  1175. !--- Set of surface parameters should be changed to snow values for grid
    1176. 

  1176. !--- points where the snow cover exceeds snow threshold of 2 cm
    1177. 

  1177.          ILAND=ISICE
    1178. 

  1178. 

  1179.          SNHEI_CRIT=0.01601*1.e3/rhosn
    1180. 

  1180. !         SNOWFRAC=MIN(1.,SNHEI/SNHEI_CRIT)
    1181. 

  1181.          SNOWFRAC=MIN(1.,SNHEI/(2.*SNHEI_CRIT))
    1182. 

  1182. !tgs - low limit on snow fraction
    1183. 

  1183. !       if(SNOWFRAC.lt.0.01) snowfrac=0.
    1184. 

  1184. !---        EMISS = 0.98 for snow
    1185. 

  1185.          EMISS = EMISS*(1.-snowfrac)+0.98*snowfrac
    1186. 

  1186. 

  1187. !-- Set znt for snow from VEGPARM table (snow/ice landuse), except for
    1188. 

  1188. !-- land-use types with higher roughness (forests, urban).
    1189. 

  1189.       IF(znt.lt.0.2 .and. snowfrac.gt.0.99) znt=z0tbl(iland)
    1190. 

  1190. 

  1191.          KEEP_SNOW_ALBEDO = 0.
    1192. 

  1192.       IF (NEWSN.GT.0.) KEEP_SNOW_ALBEDO = 1.
    1193. 

  1193. 

  1194. !---  GSW in-coming solar
    1195. 

  1195.          GSWNEW=GSW/(1.-ALB)
    1196. 

  1196. 

  1197.     IF(SEAICE .LT. 0.5) THEN
    1198. 

  1198. !----- SNOW on soil
    1199. 

  1199. !-- ALB dependence on snow depth
    1200. 

  1200.        ALBsn   = MAX(keep_snow_albedo*alb_snow,                 &
    1201. 

  1201.             MIN((alb_snow_free +                                &
    1202. 

  1202.            (alb_snow - alb_snow_free) * snowfrac), alb_snow))
    1203. 

  1203. !28mar11  if canopy is covered with snow to its capacity and snow depth is
    1204. 

  1204. ! higher than patchy snow treshold - then snow albedo is not less than 0.7
    1205. 

  1205.       if(cst.ge.sat .and. snowfrac .eq.1.) albsn=max(alb_snow,0.7)
    1206. 

  1206. 

  1207. !-- ALB dependence on snow temperature. When snow temperature is
    1208. 

  1208. !-- below critical value of -10C - no change to albedo.
    1209. 

  1209. !-- If temperature is higher that -10C then albedo is decreasing.
    1210. 

  1210. !-- The minimum albedo at t=0C for snow on land is 15% less than
    1211. 

  1211. !-- albedo of temperatures below -10C.
    1212. 

  1212.      if(albsn.lt.0.5) then
    1213. 

  1213.         ALB=ALBsn
    1214. 

  1214.       else
    1215. 

  1215. !-- change albedo when no fresh snow and snow albedo is higher than 0.5
    1216. 

  1216.         ALB = MIN(ALBSN,MAX(ALBSN - 0.1*(soilt - 263.15)/       &
    1217. 

  1217.                 (273.15-263.15)*ALBSN, ALBSN - 0.05))
    1218. 

  1218.       endif
    1219. 

  1219.     ELSE
    1220. 

  1220. !----- S…
    1221.

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