wrfv2_fire/phys/module_surface_driver.F

   1 !WRF:MEDIATION_LAYER:PHYSICS
   2 !
   3 MODULE module_surface_driver
   4 CONTAINS
   5
   6    SUBROUTINE surface_driver(                                         &
   7      &           acsnom,acsnow,akhs,akms,albedo,br,canwat             &
   8      &          ,chklowq,dt,dx,dz8w,dzs,glw                           &
   9      &          ,grdflx,gsw,swdown,gz1oz0,hfx,ht,ifsnow,isfflx        &
  10      &          ,isltyp,itimestep,ivgtyp,lowlyr,mavail,rmol           &
  11      &          ,num_soil_layers,p8w,pblh,pi_phy,pshltr,psih          &
  12      &          ,psim,p_phy,q10,q2,qfx,qsfc,qshltr,qz0                &
  13      &          ,raincv,rho,sfcevp,sfcexc,sfcrunoff                   &
  14      &          ,smois,smstav,smstot,snoalb,snow,snowc,snowh,stepbl   &
  15      &          ,th10,th2,thz0,th_phy,tmn,tshltr,tsk,tslb             &
  16      &          ,t_phy,u10,udrunoff,ust,uz0,u_frame,u_phy,v10,vegfra  &
  17      &          ,vz0,v_frame,v_phy,warm_rain,wspd,xice,xland,z,znt,zs &
  18      &          ,xicem,isice,iswater,ct,tke_myj                       &
  19      &          ,albbck,embck,lh,sh2o,shdmax,shdmin,z0                &
  20      &          ,flqc,flhc,psfc,sst,sst_update,t2,emiss               &
  21      &          ,sf_sfclay_physics,sf_surface_physics,ra_lw_physics   &
  22      &          ,landusef,soilctop,soilcbot,ra,rs,nlcat,nscat,vegf_px & ! PX-LSM
  23      &          ,snowncv, anal_interval, lai, pxlsm_smois_init        & ! PX-LSM
  24      &          ,pxlsm_soil_nudge                                     & ! PX-LSM
  25             !  Optional urban
  26      &          ,declin_urb,cosz_urb2d,omg_urb2d,xlat_urb2d           & !I urban
  27      &          ,num_roof_layers, num_wall_layers                     & !I urban
  28      &          ,num_road_layers, dzr, dzb, dzg                       & !I urban
  29      &          ,tr_urb2d,tb_urb2d,tg_urb2d,tc_urb2d,qc_urb2d         & !H urban
  30      &          ,uc_urb2d                                             & !H urban
  31      &          ,xxxr_urb2d,xxxb_urb2d,xxxg_urb2d,xxxc_urb2d          & !H urban
  32      &          ,trl_urb3d,tbl_urb3d,tgl_urb3d                        & !H urban
  33      &          ,sh_urb2d,lh_urb2d,g_urb2d,rn_urb2d,ts_urb2d          & !H urban
  34      &          ,frc_urb2d, utype_urb2d                               & !H urban
  35      &          ,ucmcall                                              & ! urban
  36      &          , ids,ide,jds,jde,kds,kde                             &
  37      &          , ims,ime,jms,jme,kms,kme                             &
  38      &          , i_start,i_end,j_start,j_end,kts,kte,num_tiles       &
  39              !  Optional moisture tracers
  40      &           ,qv_curr, qc_curr, qr_curr                           &
  41      &           ,qi_curr, qs_curr, qg_curr                           &
  42              !  Optional moisture tracer flags
  43      &           ,f_qv,f_qc,f_qr                                      &
  44      &           ,f_qi,f_qs,f_qg                                      &
  45              !  Other optionals (more or less em specific)
  46      &          ,capg,hol,mol                                         &
  47      &          ,rainncv,rainbl,regime,thc                            &
  48      &          ,qsg,qvg,qcg,soilt1,tsnav                             &
  49      &          ,smfr3d,keepfr3dflag                                  &
  50              !  Other optionals (more or less nmm specific)
  51      &          ,potevp,snopcx,soiltb,sr                              &
  52              !  Optional observation PX LSM surface nudging
  53      &          ,t2_ndg_old, q2_ndg_old, t2_ndg_new, q2_ndg_new       &
  54      &          ,sn_ndg_old, sn_ndg_new                               &
  55      &          ,t2obs, q2obs                                         &
  56              !  Optional observation nudging
  57      &          ,uratx,vratx,tratx                                    &
  58              !  Optional simple oml model
  59      &          ,omlcall,oml_hml0,oml_gamma                           &
  60      &          ,tml,t0ml,hml,h0ml,huml,hvml,f                        &
  61      &          ,ustm,ck,cka,cd,cda,isftcflx                          &
  62              !  Optional adaptive time step
  63      &          ,bldt,curr_secs,adapt_step_flag                       &
  64                                                                       )
  65
  66 #if ( ! NMM_CORE == 1 )
  67    USE module_state_description, ONLY : SFCLAYSCHEME              &
  68                                        ,MYJSFCSCHEME              &
  69                                        ,GFSSFCSCHEME              &
  70                                        ,PXSFCSCHEME               &
  71                                        ,SLABSCHEME                &
  72                                        ,LSMSCHEME                 &
  73                                        ,RUCLSMSCHEME              &
  74                                        ,PXLSMSCHEME
  75 #else
  76    USE module_state_description, ONLY : SFCLAYSCHEME              &
  77                                        ,MYJSFCSCHEME              &
  78                                        ,GFSSFCSCHEME              &
  79                                        ,PXSFCSCHEME               &
  80                                        ,SLABSCHEME                &
  81                                        ,NMMLSMSCHEME              &
  82                                        ,LSMSCHEME                 &
  83                                        ,RUCLSMSCHEME              &
  84                                        ,PXLSMSCHEME
  85 #endif
  86    USE module_model_constants
  87 ! *** add new modules of schemes here
  88
  89    USE module_sf_sfclay
  90    USE module_sf_myjsfc
  91    USE module_sf_gfs
  92    USE module_sf_noahdrv
  93    USE module_sf_ruclsm
  94    USE module_sf_pxsfclay
  95    USE module_sf_pxlsm
  96 #if ( NMM_CORE == 1 )
  97    USE module_sf_lsm_nmm
  98 #endif
  99
 100    USE module_sf_slab
 101 !
 102    USE module_sf_sfcdiags
 103 !
 104
 105    !  This driver calls subroutines for the surface parameterizations.
 106    !
 107    !  surface layer: (between surface and pbl)
 108    !      1. sfclay
 109    !      2. myjsfc
 110    !      7. Pleim surface layer
 111    !  surface: ground temp/lsm scheme:
 112    !      1. slab
 113    !      2. Noah LSM
 114    !      7. Pleim-Xiu LSM
 115    !      99. NMM LSM (NMM core only)
 116 !------------------------------------------------------------------
 117    IMPLICIT NONE
 118 !======================================================================
 119 ! Grid structure in physics part of WRF
 120 !----------------------------------------------------------------------
 121 ! The horizontal velocities used in the physics are unstaggered
 122 ! relative to temperature/moisture variables. All predicted
 123 ! variables are carried at half levels except w, which is at full
 124 ! levels. Some arrays with names (*8w) are at w (full) levels.
 125 !
 126 !----------------------------------------------------------------------
 127 ! In WRF, kms (smallest number) is the bottom level and kme (largest
 128 ! number) is the top level.  In your scheme, if 1 is at the top level,
 129 ! then you have to reverse the order in the k direction.
 130 !
 131 !         kme      -   half level (no data at this level)
 132 !         kme    ----- full level
 133 !         kme-1    -   half level
 134 !         kme-1  ----- full level
 135 !         .
 136 !         kms+2    -   half level
 137 !         kms+2  ----- full level
 138 !         kms+1    -   half level
 139 !         kms+1  ----- full level
 140 !         kms      -   half level
 141 !         kms    ----- full level
 142 !
 143 !======================================================================
 144 ! Definitions
 145 !-----------
 146 ! Theta      potential temperature (K)
 147 ! Qv         water vapor mixing ratio (kg/kg)
 148 ! Qc         cloud water mixing ratio (kg/kg)
 149 ! Qr         rain water mixing ratio (kg/kg)
 150 ! Qi         cloud ice mixing ratio (kg/kg)
 151 ! Qs         snow mixing ratio (kg/kg)
 152 !-----------------------------------------------------------------
 153 !-- itimestep     number of time steps
 154 !-- GLW           downward long wave flux at ground surface (W/m^2)
 155 !-- GSW           net short wave flux at ground surface (W/m^2)
 156 !-- SWDOWN        downward short wave flux at ground surface (W/m^2)
 157 !-- EMISS         surface emissivity (between 0 and 1)
 158 !-- TSK           surface temperature (K)
 159 !-- TMN           soil temperature at lower boundary (K)
 160 !-- XLAND         land mask (1 for land, 2 for water)
 161 !-- ZNT           time-varying roughness length (m)
 162 !-- Z0            background roughness length (m)
 163 !-- MAVAIL        surface moisture availability (between 0 and 1)
 164 !-- UST           u* in similarity theory (m/s)
 165 !-- MOL           T* (similarity theory) (K)
 166 !-- HOL           PBL height over Monin-Obukhov length
 167 !-- PBLH          PBL height (m)
 168 !-- CAPG          heat capacity for soil (J/K/m^3)
 169 !-- THC           thermal inertia (Cal/cm/K/s^0.5)
 170 !-- SNOWC         flag indicating snow coverage (1 for snow cover)
 171 !-- HFX           net upward heat flux at the surface (W/m^2)
 172 !-- QFX           net upward moisture flux at the surface (kg/m^2/s)
 173 !-- LH            net upward latent heat flux at surface (W/m^2)
 174 !-- REGIME        flag indicating PBL regime (stable, unstable, etc.)
 175 !-- tke_myj       turbulence kinetic energy from Mellor-Yamada-Janjic (MYJ) (m^2/s^2)
 176 !-- akhs          sfc exchange coefficient of heat/moisture from MYJ
 177 !-- akms          sfc exchange coefficient of momentum from MYJ
 178 !-- thz0          potential temperature at roughness length (K)
 179 !-- uz0           u wind component at roughness length (m/s)
 180 !-- vz0           v wind component at roughness length (m/s)
 181 !-- qsfc          specific humidity at lower boundary (kg/kg)
 182 !-- uratx         ratio of u over u10 (Added for obs-nudging)
 183 !-- vratx         ratio of v over v10 (Added for obs-nudging)
 184 !-- tratx         ratio of t over th2 (Added for obs-nudging)
 185 !-- u10           diagnostic 10-m u component from surface layer
 186 !-- v10           diagnostic 10-m v component from surface layer
 187 !-- th2           diagnostic 2-m theta from surface layer and lsm
 188 !-- t2            diagnostic 2-m temperature from surface layer and lsm
 189 !-- q2            diagnostic 2-m mixing ratio from surface layer and lsm
 190 !-- tshltr        diagnostic 2-m theta from MYJ
 191 !-- th10          diagnostic 10-m theta from MYJ
 192 !-- qshltr        diagnostic 2-m specific humidity from MYJ
 193 !-- q10           diagnostic 10-m specific humidity from MYJ
 194 !-- lowlyr        index of lowest model layer above ground
 195 !-- rr            dry air density (kg/m^3)
 196 !-- u_phy         u-velocity interpolated to theta points (m/s)
 197 !-- v_phy         v-velocity interpolated to theta points (m/s)
 198 !-- th_phy        potential temperature (K)
 199 !-- moist         moisture array (4D - last index is species) (kg/kg)
 200 !-- p_phy         pressure (Pa)
 201 !-- pi_phy        exner function (dimensionless)
 202 !-- pshltr        diagnostic shelter (2m) pressure from MYJ (Pa)
 203 !-- p8w           pressure at full levels (Pa)
 204 !-- t_phy         temperature (K)
 205 !-- dz8w          dz between full levels (m)
 206 !-- z             height above sea level (m)
 207 !-- DX            horizontal space interval (m)
 208 !-- DT            time step (second)
 209 !-- PSFC          pressure at the surface (Pa)
 210 !-- SST           sea-surface temperature (K)
 211 !-- TSLB
 212 !-- ZS
 213 !-- DZS
 214 !-- num_soil_layers number of soil layer
 215 !-- IFSNOW      ifsnow=1 for snow-cover effects
 216 !-- omlcall       whether to call simple ocean mixed layer model from slab (1 = use oml)
 217 !-- oml_hml0      initial mixed layer depth (if real-data not available, default 50 m)
 218 !-- oml_gamma     lapse rate below mixed layer in ocean (default 0.14 K m-1)
 219 !-- ck            enthalpy exchange coeff at 10 meters
 220 !-- cd            momentum exchange coeff at 10 meters
 221 !-- cka           enthalpy exchange coeff at the lowest model level
 222 !-- cda           momentum exchange coeff at the lowest model level
 223 !
 224 !-- LANDUSEF     Landuse fraction                      ! P-X LSM
 225 !-- SOILCTOP     Top soil fraction                     ! P-X LSM
 226 !-- SOILCBOT     Bottom soil fraction                  ! P-X LSM
 227 !-- RA           Aerodynamic resistence                        ! P-X LSM
 228 !-- RS           Stomatal resistence                   ! P-X LSM
 229 !-- NLCAT        Number of landuse categories          ! P-X LSM
 230 !-- NSCAT        Number of soil categories             ! P-X LSM
 231 !
 232 !-- ids           start index for i in domain
 233 !-- ide           end index for i in domain
 234 !-- jds           start index for j in domain
 235 !-- jde           end index for j in domain
 236 !-- kds           start index for k in domain
 237 !-- kde           end index for k in domain
 238 !-- ims           start index for i in memory
 239 !-- ime           end index for i in memory
 240 !-- jms           start index for j in memory
 241 !-- jme           end index for j in memory
 242 !-- kms           start index for k in memory
 243 !-- kme           end index for k in memory
 244 !-- its           start index for i in tile
 245 !-- ite           end index for i in tile
 246 !-- jts           start index for j in tile
 247 !-- jte           end index for j in tile
 248 !-- kts           start index for k in tile
 249 !-- kte           end index for k in tile
 250 !
 251 !******************************************************************
 252 !------------------------------------------------------------------
 253
 254    INTEGER, INTENT(IN) ::                                             &
 255      &           ids,ide,jds,jde,kds,kde                              &
 256      &          ,ims,ime,jms,jme,kms,kme                              &
 257      &          ,kts,kte,num_tiles
 258
 259    INTEGER, INTENT(IN)::   NLCAT
 260    INTEGER, INTENT(IN)::   NSCAT
 261
 262    INTEGER, INTENT(IN) :: sf_sfclay_physics, sf_surface_physics,      &
 263                           ra_lw_physics, sst_update
 264
 265    INTEGER, INTENT(IN) :: ucmcall                                     !urban
 266
 267    INTEGER, DIMENSION(num_tiles), INTENT(IN) ::                       &
 268      &           i_start,i_end,j_start,j_end
 269
 270    INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT )::  ISLTYP
 271    INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   IVGTYP
 272    INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   LOWLYR
 273    INTEGER, INTENT(IN )::   IFSNOW
 274    INTEGER, INTENT(IN )::   ISFFLX
 275    INTEGER, INTENT(IN )::   ITIMESTEP
 276    INTEGER, INTENT(IN )::   NUM_SOIL_LAYERS
 277    INTEGER, INTENT(IN )::   STEPBL
 278    INTEGER, INTENT(IN )::   ISICE
 279    INTEGER, INTENT(IN )::   ISWATER
 280    LOGICAL, INTENT(IN )::   WARM_RAIN
 281    REAL , INTENT(IN )::   U_FRAME
 282    REAL , INTENT(IN )::   V_FRAME
 283    REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT)::   SMOIS
 284    REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT)::   TSLB
 285    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   GLW
 286    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   GSW,SWDOWN
 287    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   HT
 288    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   RAINCV
 289    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   SST
 290    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   TMN
 291    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   VEGFRA
 292    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   XICE
 293    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   XLAND
 294    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   XICEM
 295    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   MAVAIL
 296    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   SNOALB
 297    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   ACSNOW
 298    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   AKHS
 299    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   AKMS
 300    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   ALBEDO
 301    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   CANWAT
 302
 303    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   GRDFLX
 304    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   HFX
 305    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   RMOL
 306    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   PBLH
 307    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   Q2
 308    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   QFX
 309    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   QSFC
 310    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   QZ0
 311    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SFCRUNOFF
 312    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SMSTAV
 313    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SMSTOT
 314    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SNOW
 315    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SNOWC
 316    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SNOWH
 317    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   TH2
 318    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   THZ0
 319    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   TSK
 320    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   UDRUNOFF
 321    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   UST
 322    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   UZ0
 323    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   VZ0
 324    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   WSPD
 325    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   ZNT
 326    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   BR
 327    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   CHKLOWQ
 328    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   GZ1OZ0
 329    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   PSHLTR
 330    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   PSIH
 331    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   PSIM
 332    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   Q10
 333    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   QSHLTR
 334    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   TH10
 335    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   TSHLTR
 336    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   U10
 337    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   V10
 338    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   PSFC
 339    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)::   ACSNOM
 340    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)::   SFCEVP
 341    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)::   SFCEXC
 342    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)::   FLHC
 343    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)::   FLQC
 344    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) ::   CT
 345    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   DZ8W
 346    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   P8W
 347    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   PI_PHY
 348    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   P_PHY
 349    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   RHO
 350    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   TH_PHY
 351    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   T_PHY
 352    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   U_PHY
 353    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   V_PHY
 354    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   Z
 355    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::   TKE_MYJ
 356    REAL, DIMENSION(1:num_soil_layers), INTENT(IN)::   DZS
 357    REAL, DIMENSION(1:num_soil_layers), INTENT(IN)::   ZS
 358    REAL, INTENT(IN )::   DT
 359    REAL, INTENT(IN )::   DX
 360    REAL,       INTENT(IN   ),OPTIONAL    ::     bldt
 361    REAL,       INTENT(IN   ),OPTIONAL    ::     curr_secs
 362    LOGICAL,    INTENT(IN   ),OPTIONAL    ::     adapt_step_flag
 363
 364 !  arguments for NCAR surface physics
 365
 366    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT )::   ALBBCK  ! INOUT needed for NMM
 367    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT )::   EMBCK
 368    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT )::   LH
 369    REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT)::   SH2O
 370    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   SHDMAX
 371    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   SHDMIN
 372    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   Z0
 373
 374 !
 375 ! Optional
 376 !
 377 !  arguments for Ocean Mixed Layer Model
 378    REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(INOUT )::   TML, T0ML, HML, H0ML, HUML, HVML
 379    REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(IN    )::   F
 380    REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(OUT   )::   CK, CKA, CD, CDA, USTM
 381
 382    INTEGER, OPTIONAL, INTENT(IN )::   ISFTCFLX
 383    INTEGER, OPTIONAL, INTENT(IN )::   OMLCALL
 384    REAL   , OPTIONAL, INTENT(IN )::   OML_HML0
 385    REAL   , OPTIONAL, INTENT(IN )::   OML_GAMMA
 386 !
 387 !  Observation nudging
 388 !
 389    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT)::   uratx  !Added for obs-nudging
 390    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT)::   vratx  !Added for obs-nudging
 391    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT)::   tratx  !Added for obs-nudging
 392 !
 393 !  PX LSM Surface Grid Analysis nudging
 394 !
 395    INTEGER, OPTIONAL, INTENT(IN)    :: pxlsm_smois_init, pxlsm_soil_nudge, ANAL_INTERVAL
 396    REAL, DIMENSION( ims:ime, NLCAT, jms:jme ) , OPTIONAL, INTENT(INOUT)::   LANDUSEF
 397    REAL, DIMENSION( ims:ime, NSCAT, jms:jme ) , OPTIONAL, INTENT(INOUT)::   SOILCTOP, SOILCBOT
 398    REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(INOUT)::   VEGF_PX
 399    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   RA
 400    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   RS
 401    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   LAI
 402    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT)::   T2OBS
 403    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT)::   Q2OBS
 404
 405    REAL,       DIMENSION( ims:ime,  jms:jme ),                           &
 406                OPTIONAL, INTENT(INOUT)    ::      t2_ndg_old,            &
 407                                                   q2_ndg_old,            &
 408                                                   t2_ndg_new,            &
 409                                                   q2_ndg_new,            &
 410                                                   sn_ndg_old,            &
 411                                                   sn_ndg_new
 412 !
 413 !
 414 ! Flags relating to the optional tendency arrays declared above
 415 ! Models that carry the optional tendencies will provdide the
 416 ! optional arguments at compile time; these flags all the model
 417 ! to determine at run-time whether a particular tracer is in
 418 ! use or not.
 419 !
 420    LOGICAL, INTENT(IN), OPTIONAL ::                             &
 421                                                       f_qv      &
 422                                                      ,f_qc      &
 423                                                      ,f_qr      &
 424                                                      ,f_qi      &
 425                                                      ,f_qs      &
 426                                                      ,f_qg
 427
 428    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
 429          OPTIONAL, INTENT(INOUT) ::                              &
 430                       ! optional moisture tracers
 431                       ! 2 time levels; if only one then use CURR
 432                       qv_curr, qc_curr, qr_curr                  &
 433                      ,qi_curr, qs_curr, qg_curr
 434    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN)   ::   snowncv
 435    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   capg
 436    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   emiss
 437    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   hol
 438    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   mol
 439    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   regime
 440    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN )::     rainncv
 441    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   RAINBL
 442    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   t2
 443    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN )::     thc
 444    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   qsg
 445    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   qvg
 446    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   qcg
 447    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   soilt1
 448    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   tsnav
 449    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   potevp ! NMM LSM
 450    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   snopcx ! NMM LSM
 451    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   soiltb ! NMM LSM
 452    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   sr ! NMM and RUC LSM
 453    REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), OPTIONAL, INTENT(INOUT)::   smfr3d
 454    REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), OPTIONAL, INTENT(INOUT)::   keepfr3dflag
 455
 456 !  LOCAL  VAR
 457
 458    REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ) ::v_phytmp
 459    REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ) ::u_phytmp
 460
 461    REAL,       DIMENSION( ims:ime, jms:jme )          ::  ZOL
 462
 463    REAL,       DIMENSION( ims:ime, jms:jme )          ::          &
 464                                                              QGH, &
 465                                                              CHS, &
 466                                                              CPM, &
 467                                                             CHS2, &
 468                                                             CQS2
 469
 470    REAL    :: DTMIN,DTBL
 471 !
 472    INTEGER :: i,J,K,NK,jj,ij
 473    LOGICAL :: radiation, myj, frpcpn
 474 !-------------------------------------------------
 475 ! urban related variables are added to declaration
 476 !-------------------------------------------------
 477      REAL, OPTIONAL, INTENT(IN) :: DECLIN_URB                                 !urban
 478      REAL, OPTIONAL , DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZ_URB2D  !urban
 479      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: OMG_URB2D   !urban
 480      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: XLAT_URB2D  !urban
 481      INTEGER,  OPTIONAL, INTENT(IN) :: num_roof_layers                         !urban
 482      INTEGER,  OPTIONAL, INTENT(IN) :: num_wall_layers                         !urban
 483      INTEGER,  OPTIONAL, INTENT(IN) :: num_road_layers                         !urban
 484      REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZR          !urban
 485      REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZB          !urban
 486      REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZG          !urban
 487
 488      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: TR_URB2D !urban
 489      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: TB_URB2D !urban
 490      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: TG_URB2D !urban
 491      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: TC_URB2D !urban
 492      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: QC_URB2D !urban
 493      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: UC_URB2D !urban
 494      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXR_URB2D !urban
 495      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXB_URB2D !urban
 496      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXG_URB2D !urban
 497      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXC_URB2D !urban
 498      REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &       !urban
 499            INTENT(INOUT)  :: TRL_URB3D                                 !urban
 500      REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &       !urban
 501            INTENT(INOUT)  :: TBL_URB3D                                 !urban
 502      REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &       !urban
 503            INTENT(INOUT)  :: TGL_URB3D                                 !urban
 504      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: SH_URB2D !urban
 505      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: LH_URB2D !urban
 506      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: G_URB2D  !urban
 507      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: RN_URB2D !urban
 508      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: TS_URB2D !urban
 509 !
 510      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: FRC_URB2D  !urban
 511      INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: UTYPE_URB2D  !urban
 512
 513      REAL,  DIMENSION( ims:ime, jms:jme )  :: PSIM_URB2D  !urban local var
 514      REAL,  DIMENSION( ims:ime, jms:jme )  :: PSIH_URB2D  !urban local var
 515      REAL,  DIMENSION( ims:ime, jms:jme )  :: GZ1OZ0_URB2D  !urban local var
 516 !m     REAL, DIMENSION( ims:ime, jms:jme ) :: AKHS_URB2D  !urban local var
 517      REAL,  DIMENSION( ims:ime, jms:jme )  :: AKMS_URB2D  !urban local var
 518      REAL,  DIMENSION( ims:ime, jms:jme )  :: U10_URB2D   !urban local var
 519      REAL,  DIMENSION( ims:ime, jms:jme )  :: V10_URB2D   !urban local var
 520      REAL,  DIMENSION( ims:ime, jms:jme )  :: TH2_URB2D   !urban local var
 521      REAL,  DIMENSION( ims:ime, jms:jme )  :: Q2_URB2D    !urban local var
 522      REAL,  DIMENSION( ims:ime, jms:jme )  :: UST_URB2D  !urban local var
 523
 524 !------------------------------------------------------------------
 525    CHARACTER*256 :: message
 526    REAL    :: next_bl_time
 527    LOGICAL :: run_param
 528    LOGICAL :: do_adapt
 529 !
 530 !
 531 !------------------------------------------------------------------
 532 !
 533
 534   if (sf_sfclay_physics .eq. 0) return
 535 ! if (sf_sfclay_physics .eq. 0 .or. sf_surface_physics.eq.0) return
 536
 537   v_phytmp = 0.
 538   u_phytmp = 0.
 539   ZOL = 0.
 540   QGH = 0.
 541   CHS = 0.
 542   CPM = 0.
 543   CHS2 = 0.
 544   DTMIN = 0.
 545   DTBL = 0.
 546
 547 ! RAINBL in mm (Accumulation between PBL calls)
 548
 549   IF ( PRESENT( rainncv ) .AND. PRESENT( rainbl ) ) THEN
 550     !$OMP PARALLEL DO   &
 551     !$OMP PRIVATE ( ij, i, j, k )
 552     DO ij = 1 , num_tiles
 553       DO j=j_start(ij),j_end(ij)
 554       DO i=i_start(ij),i_end(ij)
 555          RAINBL(i,j) = RAINBL(i,j) + RAINCV(i,j) + RAINNCV(i,j)
 556          RAINBL(i,j) = MAX (RAINBL(i,j), 0.0)
 557       ENDDO
 558       ENDDO
 559     ENDDO
 560     !$OMP END PARALLEL DO
 561   ELSE IF ( PRESENT( rainbl ) ) THEN
 562     !$OMP PARALLEL DO   &
 563     !$OMP PRIVATE ( ij, i, j, k )
 564     DO ij = 1 , num_tiles
 565       DO j=j_start(ij),j_end(ij)
 566       DO i=i_start(ij),i_end(ij)
 567          RAINBL(i,j) = RAINBL(i,j) + RAINCV(i,j)
 568          RAINBL(i,j) = MAX (RAINBL(i,j), 0.0)
 569       ENDDO
 570       ENDDO
 571     ENDDO
 572     !$OMP END PARALLEL DO
 573   ENDIF
 574 ! Update SST
 575   IF (sst_update .EQ. 1) THEN
 576     !$OMP PARALLEL DO   &
 577     !$OMP PRIVATE ( ij, i, j, k )
 578     DO ij = 1 , num_tiles
 579       DO j=j_start(ij),j_end(ij)
 580       DO i=i_start(ij),i_end(ij)
 581         IF(XLAND(i,j) .GT. 1.5 .AND. XICE(I,J) .GT. 0.5 .AND. XICEM(I,J) .LT. 0.5)THEN
 582 ! water point turns to sea-ice point
 583           XICEM(I,J) = XICE(I,J)
 584           XLAND(I,J) = 1.
 585           IVGTYP(I,J) = ISICE
 586           ISLTYP(I,J) = 16
 587           VEGFRA(I,J) = 0.
 588           TMN(I,J) = 271.4
 589           DO nk = 1, num_soil_layers
 590             TSLB(I,NK,J) = TSK(I,J)
 591             SMOIS(I,NK,J) = 1.0
 592             SH2O(I,NK,J) = 0.0
 593           ENDDO
 594         ENDIF
 595         IF(XLAND(i,j) .GT. 1.5) THEN
 596           TSK(i,j)   =SST(i,j)
 597           TSLB(i,1,j)=SST(i,j)
 598         ENDIF
 599         IF(XLAND(i,j) .LT. 1.5 .AND. XICEM(I,J) .GT. 0.5 .AND. XICE(I,J) .LT. 0.5)THEN
 600 ! sea-ice point turns to water point
 601           XICEM(I,J) = XICE(I,J)
 602           XLAND(I,J) = 2.
 603           IVGTYP(I,J) = ISWATER
 604           ISLTYP(I,J) = 14
 605           VEGFRA(I,J) = 0.
 606           TMN(I,J) = SST(I,J)
 607           DO nk = 1, num_soil_layers
 608             TSLB(I,NK,J) = SST(I,J)
 609             SMOIS(I,NK,J) = 1.0
 610             SH2O(I,NK,J) = 1.0
 611           ENDDO
 612         ENDIF
 613       ENDDO
 614       ENDDO
 615     ENDDO
 616     !$OMP END PARALLEL DO
 617   ENDIF
 618
 619
 620 !
 621 ! Modified for adaptive time step
 622 !
 623
 624   IF ( (itimestep .EQ. 1) .OR. (MOD(itimestep,STEPBL) .EQ. 0) ) THEN
 625     run_param = .TRUE.
 626   ELSE
 627     run_param = .FALSE.
 628   ENDIF
 629   IF (PRESENT(adapt_step_flag)) THEN
 630     IF ((adapt_step_flag)) THEN
 631       IF ( (itimestep .EQ. 1) .OR. (bldt .EQ. 0) .OR. &
 632            ( CURR_SECS + dt >= ( INT( CURR_SECS / ( bldt * 60 ) + 1 ) * bldt * 60) ) ) THEN
 633         run_param = .TRUE.
 634       ELSE
 635         run_param = .FALSE.
 636       ENDIF
 637     ENDIF
 638   ENDIF
 639
 640   IF ( run_param ) then
 641
 642 ! IF (itimestep .eq. 1 .or. mod(itimestep,STEPBL) .eq. 0) THEN
 643
 644   radiation = .false.
 645   myj = .false.
 646   frpcpn = .false.
 647
 648   IF (ra_lw_physics .gt. 0) radiation = .true.
 649
 650 !----
 651 ! CALCULATE CONSTANT
 652
 653      DTMIN=DT/60.
 654 ! Surface schemes need PBL time step for updates and accumulations
 655 ! Assume these schemes provide no tendencies
 656
 657     if (PRESENT(adapt_step_flag)) then
 658        if (adapt_step_flag) then
 659           do_adapt = .TRUE.
 660        else
 661           do_adapt = .FALSE.
 662        endif
 663     else
 664        do_adapt = .FALSE.
 665     endif
 666
 667     if (PRESENT(BLDT)) then
 668        if (bldt .eq. 0) then
 669           DTBL = dt
 670        ELSE
 671           if (do_adapt) then
 672              call wrf_message("WARNING: When using an adaptive time-step the boundary layer"// &
 673                               " time-step should be 0 (i.e., equivalent to model time-step).  "// &
 674                               "In order to proceed, for boundary layer calculations, the "// &
 675                               "boundary layer time-step"// &
 676                               " will be rounded to the nearest minute, possibly resulting in"// &
 677                               " innacurate results.")
 678              DTBL=bldt*60
 679           else
 680              DTBL=DT*STEPBL
 681           endif
 682        endif
 683     else
 684        DTBL=DT*STEPBL
 685     endif
 686
 687 ! SAVE OLD VALUES
 688
 689
 690      !$OMP PARALLEL DO   &
 691      !$OMP PRIVATE ( ij, i, j, k )
 692      DO ij = 1 , num_tiles
 693        DO j=j_start(ij),j_end(ij)
 694        DO i=i_start(ij),i_end(ij)
 695 ! PSFC : in Pa
 696           PSFC(I,J)=p8w(I,kts,J)
 697 ! REVERSE ORDER IN THE VERTICAL DIRECTION
 698           DO k=kts,kte
 699             v_phytmp(i,k,j)=v_phy(i,k,j)+v_frame
 700             u_phytmp(i,k,j)=u_phy(i,k,j)+u_frame
 701           ENDDO
 702        ENDDO
 703        ENDDO
 704      ENDDO
 705      !$OMP END PARALLEL DO
 706
 707      !$OMP PARALLEL DO   &
 708      !$OMP PRIVATE ( ij, i, j, k )
 709      DO ij = 1 , num_tiles
 710      sfclay_select: SELECT CASE(sf_sfclay_physics)
 711
 712      CASE (SFCLAYSCHEME)
 713 ! DX varies spatially in NMM, therefore, SFCLAY cannot be called
 714 ! because it takes a scalar DX. NMM passes in a dummy value for this
 715 ! scalar.  NEEDS FURTHER ATTENTION. JM 20050215
 716        IF (PRESENT(qv_curr)                            .AND.    &
 717            PRESENT(mol)        .AND.  PRESENT(regime)  .AND.    &
 718                                                       .TRUE. ) THEN
 719          CALL wrf_debug( 100, 'in SFCLAY' )
 720          CALL SFCLAY(u_phytmp,v_phytmp,t_phy,qv_curr,&
 721                p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
 722                znt,ust,pblh,mavail,zol,mol,regime,psim,psih,       &
 723                xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol,       &
 724                u10,v10,th2,t2,q2,                                  &
 725                gz1oz0,wspd,br,isfflx,dx,                           &
 726                svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
 727                P1000mb,                                            &
 728                ids,ide, jds,jde, kds,kde,                          &
 729                ims,ime, jms,jme, kms,kme,                          &
 730                i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte,    &
 731                uratx,vratx,tratx,                                  &
 732                ustm,ck,cka,cd,cda,isftcflx                         )
 733        ELSE
 734          CALL wrf_error_fatal('Lacking arguments for SFCLAY in surface driver')
 735        ENDIF
 736
 737
 738      CASE (PXSFCSCHEME)
 739 #if (NMM_CORE != 1)
 740        IF (PRESENT(qv_curr)                            .AND.    &
 741            PRESENT(mol)        .AND.  PRESENT(regime)  .AND.    &
 742                                                       .TRUE. ) THEN
 743          CALL wrf_debug( 100, 'in PX Surface Layer scheme' )
 744          CALL PXSFCLAY(u_phytmp,v_phytmp,t_phy,th_phy,qv_curr,&
 745                p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
 746                znt,ust,pblh,mavail,zol,mol,regime,psim,psih,       &
 747                xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol,       &
 748                u10,v10,                                            &
 749                gz1oz0,wspd,br,isfflx,dx,                           &
 750                svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,              &
 751                ids,ide, jds,jde, kds,kde,                          &
 752                ims,ime, jms,jme, kms,kme,                          &
 753                i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
 754        ELSE
 755          CALL wrf_error_fatal('Lacking arguments for PX Surface Layer in surface driver')
 756        ENDIF
 757 #else
 758        CALL wrf_error_fatal('PX Surface Layer scheme cannot be used with NMM')
 759 #endif
 760
 761       CASE (MYJSFCSCHEME)
 762        IF (PRESENT(qv_curr)    .AND.  PRESENT(qc_curr) .AND.    &
 763                                                       .TRUE. ) THEN
 764
 765         myj =.true.
 766
 767             CALL wrf_debug(100,'in MYJSFC')
 768             CALL MYJSFC(itimestep,ht,dz8w,                         &
 769               p_phy,p8w,th_phy,t_phy,                              &
 770               qv_curr,qc_curr,                                      &
 771               u_phy,v_phy,tke_myj,                                 &
 772               tsk,qsfc,thz0,qz0,uz0,vz0,                           &
 773               lowlyr,                                              &
 774               xland,                                               &
 775               ust,znt,z0,pblh,mavail,rmol,                         &
 776               akhs,akms,                                           &
 777               chs,chs2,cqs2,hfx,qfx,lh,flhc,flqc,qgh,cpm,ct,       &
 778               u10,v10,t2,th2,tshltr,th10,q2,qshltr,q10,pshltr,               &
 779               p1000mb,                                             &
 780               ids,ide, jds,jde, kds,kde,                           &
 781               ims,ime, jms,jme, kms,kme,                           &
 782               i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
 783        ELSE
 784          CALL wrf_error_fatal('Lacking arguments for MYJSFC in surface driver')
 785        ENDIF
 786
 787      CASE (GFSSFCSCHEME)
 788        IF (PRESENT(qv_curr) .AND. .TRUE. ) THEN
 789        CALL wrf_debug( 100, 'in GFSSFC' )
 790          CALL SF_GFS(u_phytmp,v_phytmp,t_phy,qv_curr,              &
 791                p_phy,CP,RCP,R_d,XLV,PSFC,CHS,CHS2,CQS2,CPM,        &
 792                ZNT,UST,PSIM,PSIH,                                  &
 793                XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,                     &
 794                QGH,QSFC,U10,V10,                                   &
 795                GZ1OZ0,WSPD,BR,ISFFLX,                              &
 796                EP_1,EP_2,KARMAN,itimestep,                         &
 797                ids,ide, jds,jde, kds,kde,                          &
 798                ims,ime, jms,jme, kms,kme,                          &
 799                i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
 800         CALL wrf_debug(100,'in SFCDIAGS')
 801        ELSE
 802          CALL wrf_error_fatal('Lacking arguments for SF_GFS in surface driver')
 803        ENDIF
 804
 805      CASE DEFAULT
 806
 807        WRITE( message , * )                                &
 808    'The sfclay option does not exist: sf_sfclay_physics = ', sf_sfclay_physics
 809        CALL wrf_error_fatal ( message )
 810
 811      END SELECT sfclay_select
 812      ENDDO
 813      !$OMP END PARALLEL DO
 814
 815      IF (ISFFLX.EQ.0 ) GOTO 430
 816      !$OMP PARALLEL DO   &
 817      !$OMP PRIVATE ( ij, i, j, k )
 818      DO ij = 1 , num_tiles
 819
 820      sfc_select: SELECT CASE(sf_surface_physics)
 821
 822      CASE (SLABSCHEME)
 823
 824        IF (PRESENT(qv_curr)                            .AND.    &
 825            PRESENT(capg)        .AND.    &
 826                                                       .TRUE. ) THEN
 827            DO j=j_start(ij),j_end(ij)
 828            DO i=i_start(ij),i_end(ij)
 829 !          CQS2 ACCOUNTS FOR MAVAIL FOR SFCDIAGS 2M Q
 830               CQS2(I,J)= CQS2(I,J)*MAVAIL(I,J)
 831            ENDDO
 832            ENDDO
 833
 834         CALL wrf_debug(100,'in SLAB')
 835           CALL SLAB(t_phy,qv_curr,p_phy,flhc,flqc,  &
 836              psfc,xland,tmn,hfx,qfx,lh,tsk,qsfc,chklowq,          &
 837              gsw,glw,capg,thc,snowc,emiss,mavail,                 &
 838              dtbl,rcp,xlv,dtmin,ifsnow,                           &
 839              svp1,svp2,svp3,svpt0,ep_2,karman,eomeg,stbolt,       &
 840              tslb,zs,dzs,num_soil_layers,radiation,               &
 841              p1000mb,                                             &
 842              ids,ide, jds,jde, kds,kde,                           &
 843              ims,ime, jms,jme, kms,kme,                           &
 844              i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte,&
 845              tml,t0ml,hml,h0ml,huml,hvml,ust,u_phy,v_phy,f,g,     &
 846              omlcall,oml_gamma                                    )
 847
 848            DO j=j_start(ij),j_end(ij)
 849            DO i=i_start(ij),i_end(ij)
 850               SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
 851            ENDDO
 852            ENDDO
 853
 854         CALL wrf_debug(100,'in SFCDIAGS')
 855           CALL SFCDIAGS(hfx,qfx,tsk,qsfc,chs2,cqs2,t2,th2,q2,      &
 856                      psfc,cp,r_d,rcp,                              &
 857                      ids,ide, jds,jde, kds,kde,                    &
 858                      ims,ime, jms,jme, kms,kme,                    &
 859              i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
 860
 861        ENDIF
 862
 863 #if ( NMM_CORE == 1 )
 864      CASE (NMMLSMSCHEME)
 865        IF (PRESENT(qv_curr)    .AND.  PRESENT(rainbl)  .AND.    &
 866            PRESENT(potevp)     .AND.  PRESENT(snopcx)  .AND.    &
 867            PRESENT(soiltb)     .AND.  PRESENT(sr)      .AND.    &
 868                                                       .TRUE. ) THEN
 869            CALL wrf_debug(100,'in NMM LSM')
 870            CALL nmmlsm(dz8w,qv_curr,p8w,rho,                    &
 871                 t_phy,th_phy,tsk,chs,                           &
 872                 hfx,qfx,qgh,swdown,glw,lh,rmol,                 &
 873                 smstav,smstot,sfcrunoff,                        &
 874                 udrunoff,ivgtyp,isltyp,vegfra,sfcevp,potevp,    &
 875                 grdflx,sfcexc,acsnow,acsnom,snopcx,             &
 876                 albbck,tmn,xland,xice,qz0,                      &
 877                 th2,q2,snowc,cqs2,qsfc,soiltb,chklowq,rainbl,   &
 878                 num_soil_layers,dtbl,dzs,itimestep,             &
 879                 smois,tslb,snow,canwat,cpm,rcp,sr,              &    !tslb
 880                 albedo,snoalb,sh2o,snowh,                       &
 881                 ids,ide, jds,jde, kds,kde,                      &
 882                 ims,ime, jms,jme, kms,kme,                      &
 883                 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
 884           CALL wrf_debug(100,'back from NMM LSM')
 885        ELSE
 886          CALL wrf_error_fatal('Lacking arguments for NMMLSM in surface driver')
 887        ENDIF
 888 #endif
 889
 890      CASE (LSMSCHEME)
 891
 892        IF (PRESENT(qv_curr)    .AND.  PRESENT(rainbl)        .AND.    &
 893 !          PRESENT(emiss)      .AND.  PRESENT(t2)            .AND.    &
 894 !          PRESENT(declin_urb) .AND.  PRESENT(cosz_urb2d)    .AND.    &
 895 !          PRESENT(omg_urb2d)  .AND. PRESENT( xlat_urb2d)    .AND.    &
 896 !          PRESENT(dzr)       .AND.    &
 897 !          PRESENT( dzb)            .AND. PRESENT(dzg)       .AND.    &
 898 !          PRESENT(tr_urb2d) .AND. PRESENT(tb_urb2d)         .AND.    &
 899 !          PRESENT(tg_urb2d) .AND. PRESENT(tc_urb2d) .AND.            &
 900 !          PRESENT(qc_urb2d) .AND. PRESENT(uc_urb2d) .AND.            &
 901 !          PRESENT(xxxr_urb2d) .AND. PRESENT(xxxb_urb2d) .AND.        &
 902 !          PRESENT(xxxg_urb2d) .AND.                                  &
 903 !          PRESENT(xxxc_urb2d) .AND. PRESENT(trl_urb3d) .AND.         &
 904 !          PRESENT(tbl_urb3d)   .AND. PRESENT(tgl_urb3d)  .AND.       &
 905 !          PRESENT(sh_urb2d) .AND. PRESENT(lh_urb2d)  .AND.           &
 906 !          PRESENT(g_urb2d)   .AND. PRESENT(rn_urb2d) .AND.           &
 907 !          PRESENT(ts_urb2d)                          .AND.           &
 908 !          PRESENT(frc_urb2d) .AND. PRESENT(utype_urb2d)   .AND.      &
 909                                                       .TRUE. ) THEN
 910 !------------------------------------------------------------------
 911          IF( PRESENT(sr) ) THEN
 912            frpcpn=.true.
 913          ENDIF
 914
 915          CALL wrf_debug(100,'in NOAH DRV')
 916            CALL lsm(dz8w,qv_curr,p8w,t_phy,tsk,                 &
 917                 hfx,qfx,lh,grdflx,qgh,gsw,swdown,glw,smstav,smstot,    &
 918                 sfcrunoff,udrunoff,ivgtyp,isltyp,vegfra,        &
 919                 albedo,albbck,znt,z0, tmn,xland,xice, emiss, embck,    &
 920                 snowc,qsfc,rainbl,                              &
 921                 num_soil_layers,dtbl,dzs,itimestep,             &
 922                 smois,tslb,snow,canwat,                         &
 923                 chs, chs2, cqs2, cpm,rcp,SR,chklowq,qz0,        &
 924 !MEk June07
 925                 myj,frpcpn,                                     &
 926                 sh2o,snowh,                                     & !h
 927                 u_phy,v_phy,                                    & !I
 928                 snoalb,shdmin,shdmax,                           & !i
 929                 acsnom,acsnow,                                  & !o
 930 ! MEK MAY 2007
 931                 snopcx,                                         & !o
 932 ! MEK JUL2007
 933                 potevp,                                         & !o
 934                 ids,ide, jds,jde, kds,kde,                      &
 935                 ims,ime, jms,jme, kms,kme,                      &
 936                 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte,    &
 937                 ucmcall                                         &
 938 !Optional urban
 939                 ,tr_urb2d,tb_urb2d,tg_urb2d,tc_urb2d,qc_urb2d,  & !H urban
 940                 uc_urb2d,                                       & !H urban
 941                 xxxr_urb2d,xxxb_urb2d,xxxg_urb2d,xxxc_urb2d,    & !H urban
 942                 trl_urb3d,tbl_urb3d,tgl_urb3d,                  & !H urban
 943                 sh_urb2d,lh_urb2d,g_urb2d,rn_urb2d,ts_urb2d,    & !H urban
 944                 psim_urb2d,psih_urb2d,u10_urb2d,v10_urb2d,      & !O urban
 945                 GZ1OZ0_urb2d, AKMS_URB2D,                       & !O urban
 946                 th2_urb2d,q2_urb2d,ust_urb2d,                   & !O urban
 947                 declin_urb,cosz_urb2d,omg_urb2d,                & !I urban
 948                 xlat_urb2d,                                     & !I urban
 949                 num_roof_layers, num_wall_layers,               & !I urban
 950                 num_road_layers, DZR, DZB, DZG,                 & !I urban
 951                 FRC_URB2D, UTYPE_URB2D                          & ! urban
 952                 )
 953
 954
 955            DO j=j_start(ij),j_end(ij)
 956            DO i=i_start(ij),i_end(ij)
 957 !              CHKLOWQ(I,J)= 1.0
 958                SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
 959                SFCEXC(I,J)= CHS(I,J)
 960            ENDDO
 961            ENDDO
 962
 963           CALL SFCDIAGS(HFX,QFX,TSK,QSFC,CHS2,CQS2,T2,TH2,Q2,      &
 964                      PSFC,CP,R_d,RCP,                              &
 965                      ids,ide, jds,jde, kds,kde,                    &
 966                      ims,ime, jms,jme, kms,kme,                    &
 967              i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
 968
 969 !urban
 970      IF(UCMCALL.eq.1) THEN
 971        DO j=j_start(ij),j_end(ij)                             !urban
 972          DO i=i_start(ij),i_end(ij)                           !urban
 973           IF( IVGTYP(I,J) == 1 .or. IVGTYP(I,J) == 31 .or. &  !urban
 974               IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33 ) THEN !urban
 975 !             TH2(I,J)  = TH2_URB2D(I,J)                       !urban
 976 !             T2(I,J)   = TH2_URB2D(I,J)/(1.E5/PSFC(I,J))**RCP !urban
 977 !m             T2(I,J)   = TH2_URB2D(I,J)                       !urban
 978              T2(I,J)   = FRC_URB2D(i,j)*TH2_URB2D(I,J) + (1-FRC_URB2D(i,j))*T2(I,J) !urban
 979              TH2(I,J) = T2(I,J)*(1.E5/PSFC(I,J))**RCP                               !urban
 980 !m             Q2(I,J)   = Q2_URB2D(I,J)                                            !urban
 981              Q2(I,J)   = FRC_URB2D(i,j)*Q2_URB2D(I,J) +(1-FRC_URB2D(i,j))* Q2(I,J)  !urban
 982              U10(I,J)  = U10_URB2D(I,J)                       !urban
 983              V10(I,J)  = V10_URB2D(I,J)                       !urban
 984              PSIM(I,J) = PSIM_URB2D(I,J)                      !urban
 985              PSIH(I,J) = PSIH_URB2D(I,J)                      !urban
 986              GZ1OZ0(I,J) = GZ1OZ0_URB2D(I,J)                  !urban
 987 !m             AKHS(I,J) = AKHS_URB2D(I,J)                    !urban
 988              AKHS(I,J) = CHS(I,J)                             !urban
 989              AKMS(I,J) = AKMS_URB2D(I,J)                      !urban
 990            END IF                                             !urban
 991          ENDDO                                                !urban
 992        ENDDO                                                  !urban
 993      ENDIF
 994 !------------------------------------------------------------------
 995
 996        ELSE
 997          CALL wrf_error_fatal('Lacking arguments for LSM in surface driver')
 998        ENDIF
 999
1000      CASE (RUCLSMSCHEME)
1001        IF (PRESENT(qv_curr)    .AND.  PRESENT(qc_curr) .AND.    &
1002 !           PRESENT(emiss)      .AND.  PRESENT(t2)      .AND.    &
1003            PRESENT(qsg)        .AND.  PRESENT(qvg)     .AND.    &
1004            PRESENT(qcg)        .AND.  PRESENT(soilt1)  .AND.    &
1005            PRESENT(tsnav)      .AND.  PRESENT(smfr3d)  .AND.    &
1006            PRESENT(keepfr3dflag) .AND. PRESENT(rainbl) .AND.    &
1007                                                       .TRUE. ) THEN
1008
1009            IF( PRESENT(sr) ) THEN
1010                frpcpn=.true.
1011            ELSE
1012                SR = 1.
1013            ENDIF
1014
1015            CALL wrf_debug(100,'in RUC LSM')
1016            CALL LSMRUC(dtbl,itimestep,num_soil_layers,          &
1017                 zs,rainbl,snow,snowh,snowc,sr,frpcpn,           &
1018                 dz8w,p8w,t_phy,qv_curr,qc_curr,rho,             & !p8w in [pa]
1019                 glw,gsw,emiss,chklowq,                          &
1020                 chs,flqc,flhc,mavail,canwat,vegfra,albedo,znt,  &
1021                 snoalb, albbck,                                 &   !new
1022                 qsfc,qsg,qvg,qcg,soilt1,tsnav,                  &
1023                 tmn,ivgtyp,isltyp,xland,xice,                   &
1024                 cp,g,xlv,stbolt,                                &
1025                 smois,sh2o,smstav,smstot,tslb,tsk,hfx,qfx,lh,   &
1026                 sfcrunoff,udrunoff,sfcexc,                      &
1027                 sfcevp,grdflx,acsnow,                           &
1028                 smfr3d,keepfr3dflag,                            &
1029                 myj,                                            &
1030                 ids,ide, jds,jde, kds,kde,                      &
1031                 ims,ime, jms,jme, kms,kme,                      &
1032                 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
1033
1034 !tgs     IF(.not. MYJ) then
1035
1036           CALL SFCDIAGS(HFX,QFX,TSK,QVG,CHS2,CQS2,T2,TH2,Q2,      &
1037                      PSFC,CP,R_d,RCP,                              &
1038                      ids,ide, jds,jde, kds,kde,                    &
1039                      ims,ime, jms,jme, kms,kme,                    &
1040              i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
1041 !tgs     ENDIF
1042
1043
1044        ELSE
1045          CALL wrf_error_fatal('Lacking arguments for RUCLSM in surface driver')
1046        ENDIF
1047
1048      CASE (PXLSMSCHEME)
1049        IF (PRESENT(qv_curr)    .AND.  PRESENT(qc_curr) .AND.    &
1050            PRESENT(emiss)      .AND.  PRESENT(t2)      .AND.    &
1051            PRESENT(qsg)        .AND.  PRESENT(qvg)     .AND.    &
1052            PRESENT(qcg)        .AND.  PRESENT(soilt1)  .AND.    &
1053            PRESENT(tsnav)      .AND.  PRESENT(smfr3d)  .AND.    &
1054            PRESENT(keepfr3dflag) .AND. PRESENT(rainbl) .AND.    &
1055                                                       .TRUE. ) THEN
1056            CALL wrf_debug(100,'in P-X LSM')
1057            CALL PXLSM(u_phy, v_phy, dz8w, qv_curr, t_phy, th_phy, rho,    &
1058                       psfc, gsw, glw, rainbl, emiss,                  &
1059                       ITIMESTEP, num_soil_layers, DT, anal_interval,  &
1060                       xland, albbck, albedo, snoalb, smois, tslb,     &
1061                       mavail,T2, Q2,                                  &
1062                       zs, dzs, psih,                                  &
1063                       landusef,soilctop,soilcbot,vegfra, vegf_px,     &
1064                       isltyp,ra,rs,lai,nlcat,nscat,                   &
1065                       hfx,qfx,lh,tsk,znt,canwat,                      &
1066                       grdflx,shdmin,shdmax,                           &
1067                       snowc,pblh,rmol,ust,capg,dtbl,                  &
1068                       t2_ndg_old,t2_ndg_new,q2_ndg_old,q2_ndg_new,    &
1069                       sn_ndg_old, sn_ndg_new, snow, snowh,snowncv,    &
1070                       t2obs, q2obs, pxlsm_smois_init, pxlsm_soil_nudge, &
1071                       ids,ide, jds,jde, kds,kde,                      &
1072                       ims,ime, jms,jme, kms,kme,                      &
1073                       i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte)
1074
1075            DO j=j_start(ij),j_end(ij)
1076            DO i=i_start(ij),i_end(ij)
1077               CHKLOWQ(I,J)= 1.0
1078               TH2(I,J) = T2(I,J)*(1.E5/PSFC(I,J))**RCP
1079               SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
1080            ENDDO
1081            ENDDO
1082
1083        ELSE
1084          CALL wrf_error_fatal('Lacking arguments for P-X LSM in surface driver')
1085        ENDIF
1086
1087      CASE DEFAULT
1088
1089        IF ( itimestep .eq. 1 ) THEN
1090        WRITE( message , * ) &
1091         'No land surface physics option is used: sf_surface_physics = ', sf_surface_physics
1092         CALL wrf_message ( message )
1093        ENDIF
1094
1095      END SELECT sfc_select
1096      ENDDO
1097      !$OMP END PARALLEL DO
1098
1099  430 CONTINUE
1100
1101
1102 ! Reset RAINBL in mm (Accumulation between PBL calls)
1103
1104      IF ( PRESENT( rainbl ) ) THEN
1105        !$OMP PARALLEL DO   &
1106        !$OMP PRIVATE ( ij, i, j, k )
1107        DO ij = 1 , num_tiles
1108          DO j=j_start(ij),j_end(ij)
1109          DO i=i_start(ij),i_end(ij)
1110             RAINBL(i,j) = 0.
1111          ENDDO
1112          ENDDO
1113        ENDDO
1114        !$OMP END PARALLEL DO
1115      ENDIF
1116
1117    ENDIF
1118
1119    END SUBROUTINE surface_driver
1120
1121 END MODULE module_surface_driver
1122