module_surface_driver.F

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