source: trunk/WRF.COMMON/WRFV2/phys/module_surface_driver.F @ 3567

Last change on this file since 3567 was 11, checked in by aslmd, 14 years ago

spiga@svn-planeto:ajoute le modele meso-echelle martien

File size: 42.0 KB
Line 
1!WRF:MEDIATION_LAYER:PHYSICS
2!
3MODULE module_surface_driver
4CONTAINS
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     &          ,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(IN )::   ISLTYP
231   INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   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   LOGICAL, INTENT(IN )::   WARM_RAIN
239   REAL , INTENT(IN )::   U_FRAME
240   REAL , INTENT(IN )::   V_FRAME
241   REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT)::   SMOIS
242   REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT)::   TSLB
243   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   GLW
244   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   GSW,SWDOWN
245   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   HT
246   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   RAINCV
247   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   SST
248   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   TMN
249   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   VEGFRA
250   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   XICE
251   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   XLAND
252   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   MAVAIL
253   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   SNOALB
254   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   ACSNOW
255   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   AKHS
256   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   AKMS
257   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   ALBEDO
258   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   CANWAT
259
260
261   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   GRDFLX
262   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   HFX
263   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   RMOL
264   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   PBLH
265   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   Q2
266   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   QFX
267   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   QSFC
268   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   QZ0
269   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SFCRUNOFF
270   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SMSTAV
271   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SMSTOT
272   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SNOW
273   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SNOWC
274   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SNOWH
275   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   TH2
276   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   THZ0
277   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   TSK
278   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   UDRUNOFF
279   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   UST
280   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   UZ0
281   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   VZ0
282   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   WSPD
283   REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   ZNT
284   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   BR
285   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   CHKLOWQ
286   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   GZ1OZ0
287   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   PSHLTR
288   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   PSIH
289   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   PSIM
290   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   Q10
291   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   QSHLTR
292   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   TH10
293   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   TSHLTR
294   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   U10
295   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   V10
296   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   PSFC
297   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)::   ACSNOM
298   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)::   SFCEVP
299   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)::   SFCEXC
300   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)::   FLHC
301   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)::   FLQC
302   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) ::   CT
303   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   DZ8W
304   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   P8W
305   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   PI_PHY
306   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   P_PHY
307   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   RHO
308   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   TH_PHY
309   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   T_PHY
310   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   U_PHY
311   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   V_PHY
312   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   Z
313   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::   TKE_MYJ
314   REAL, DIMENSION(1:num_soil_layers), INTENT(IN)::   DZS
315   REAL, DIMENSION(1:num_soil_layers), INTENT(IN)::   ZS
316   REAL, INTENT(IN )::   DT
317   REAL, INTENT(IN )::   DX
318
319!  arguments for NCAR surface physics
320
321   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT )::   ALBBCK  ! INOUT needed for NMM
322   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT )::   LH
323   REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT)::   SH2O
324   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   SHDMAX
325   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   SHDMIN
326   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   Z0
327
328!
329! Optional
330!
331
332!
333!  Observation nudging
334!
335   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT)::   uratx  !Added for obs-nudging
336   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT)::   vratx  !Added for obs-nudging
337   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT)::   tratx  !Added for obs-nudging
338!
339! Flags relating to the optional tendency arrays declared above
340! Models that carry the optional tendencies will provdide the
341! optional arguments at compile time; these flags all the model
342! to determine at run-time whether a particular tracer is in
343! use or not.
344!
345   LOGICAL, INTENT(IN), OPTIONAL ::                             &
346                                                      f_qv      &
347                                                     ,f_qc      &
348                                                     ,f_qr      &
349                                                     ,f_qi      &
350                                                     ,f_qs      &
351                                                     ,f_qg
352
353   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
354         OPTIONAL, INTENT(INOUT) ::                              &
355                      ! optional moisture tracers
356                      ! 2 time levels; if only one then use CURR
357                      qv_curr, qc_curr, qr_curr                  &
358                     ,qi_curr, qs_curr, qg_curr
359
360   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   capg
361   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   emiss
362   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   hol
363   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   mol
364   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   regime
365   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN )::     rainncv
366   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   RAINBL
367   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   t2
368   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN )::     thc
369   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   qsg
370   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   qvg
371   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   qcg
372   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   soilt1
373   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   tsnav
374   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   potevp ! NMM LSM
375   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   snopcx ! NMM LSM
376   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   soiltb ! NMM LSM
377   REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   sr ! NMM and RUC LSM
378   REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), OPTIONAL, INTENT(INOUT)::   smfr3d
379   REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), OPTIONAL, INTENT(INOUT)::   keepfr3dflag
380
381!  LOCAL  VAR
382
383   REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ) ::v_phytmp
384   REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ) ::u_phytmp
385
386   REAL,       DIMENSION( ims:ime, jms:jme )          ::  ZOL
387
388   REAL,       DIMENSION( ims:ime, jms:jme )          ::          &
389                                                             QGH, &
390                                                             CHS, &
391                                                             CPM, &
392                                                            CHS2, &
393                                                            CQS2
394
395   REAL    :: DTMIN,DTBL
396!
397   INTEGER :: i,J,K,NK,jj,ij
398   LOGICAL :: radiation, myj, frpcpn
399!-------------------------------------------------
400! urban related variables are added to declaration
401!-------------------------------------------------
402     REAL, OPTIONAL, INTENT(IN) :: DECLIN_URB                                 !urban
403     REAL, OPTIONAL , DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZ_URB2D  !urban
404     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: OMG_URB2D   !urban
405     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: XLAT_URB2D  !urban
406     INTEGER,  OPTIONAL, INTENT(IN) :: num_roof_layers                         !urban
407     INTEGER,  OPTIONAL, INTENT(IN) :: num_wall_layers                         !urban
408     INTEGER,  OPTIONAL, INTENT(IN) :: num_road_layers                         !urban
409     REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZR          !urban
410     REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZB          !urban
411     REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZG          !urban
412
413     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: TR_URB2D !urban
414     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: TB_URB2D !urban
415     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: TG_URB2D !urban
416     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: TC_URB2D !urban
417     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: QC_URB2D !urban
418     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: UC_URB2D !urban
419     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXR_URB2D !urban
420     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXB_URB2D !urban
421     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXG_URB2D !urban
422     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXC_URB2D !urban
423     REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &       !urban
424           INTENT(INOUT)  :: TRL_URB3D                                 !urban
425     REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &       !urban
426           INTENT(INOUT)  :: TBL_URB3D                                 !urban
427     REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &       !urban
428           INTENT(INOUT)  :: TGL_URB3D                                 !urban
429     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: SH_URB2D !urban
430     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: LH_URB2D !urban
431     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: G_URB2D  !urban
432     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: RN_URB2D !urban
433     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: TS_URB2D !urban
434!
435     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: FRC_URB2D  !urban
436     INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: UTYPE_URB2D  !urban
437
438     REAL,  DIMENSION( ims:ime, jms:jme )  :: PSIM_URB2D  !urban local var
439     REAL,  DIMENSION( ims:ime, jms:jme )  :: PSIH_URB2D  !urban local var
440     REAL,  DIMENSION( ims:ime, jms:jme )  :: GZ1OZ0_URB2D  !urban local var
441!m     REAL, DIMENSION( ims:ime, jms:jme ) :: AKHS_URB2D  !urban local var
442     REAL,  DIMENSION( ims:ime, jms:jme )  :: AKMS_URB2D  !urban local var
443     REAL,  DIMENSION( ims:ime, jms:jme )  :: U10_URB2D   !urban local var
444     REAL,  DIMENSION( ims:ime, jms:jme )  :: V10_URB2D   !urban local var
445     REAL,  DIMENSION( ims:ime, jms:jme )  :: TH2_URB2D   !urban local var
446     REAL,  DIMENSION( ims:ime, jms:jme )  :: Q2_URB2D    !urban local var
447     REAL,  DIMENSION( ims:ime, jms:jme )  :: UST_URB2D  !urban local var
448
449!------------------------------------------------------------------
450   CHARACTER*256 :: message
451!------------------------------------------------------------------
452!
453
454  if (sf_sfclay_physics .eq. 0) return
455
456  v_phytmp = 0.
457  u_phytmp = 0.
458  ZOL = 0.
459  QGH = 0.
460  CHS = 0.
461  CPM = 0.
462  CHS2 = 0.
463  DTMIN = 0.
464  DTBL = 0.
465
466! RAINBL in mm (Accumulation between PBL calls)
467
468  IF ( PRESENT( rainncv ) .AND. PRESENT( rainbl ) ) THEN
469    !$OMP PARALLEL DO   &
470    !$OMP PRIVATE ( ij, i, j, k )
471    DO ij = 1 , num_tiles
472      DO j=j_start(ij),j_end(ij)
473      DO i=i_start(ij),i_end(ij)
474         RAINBL(i,j) = RAINBL(i,j) + RAINCV(i,j) + RAINNCV(i,j)
475         RAINBL(i,j) = MAX (RAINBL(i,j), 0.0)
476      ENDDO
477      ENDDO
478    ENDDO
479    !$OMP END PARALLEL DO
480  ELSE IF ( PRESENT( rainbl ) ) THEN
481    !$OMP PARALLEL DO   &
482    !$OMP PRIVATE ( ij, i, j, k )
483    DO ij = 1 , num_tiles
484      DO j=j_start(ij),j_end(ij)
485      DO i=i_start(ij),i_end(ij)
486         RAINBL(i,j) = RAINBL(i,j) + RAINCV(i,j)
487         RAINBL(i,j) = MAX (RAINBL(i,j), 0.0)
488      ENDDO
489      ENDDO
490    ENDDO
491    !$OMP END PARALLEL DO
492  ENDIF
493! Update SST
494  IF (sst_update .EQ. 1) THEN
495    !$OMP PARALLEL DO   &
496    !$OMP PRIVATE ( ij, i, j, k )
497    DO ij = 1 , num_tiles
498      DO j=j_start(ij),j_end(ij)
499      DO i=i_start(ij),i_end(ij)
500        IF(XLAND(i,j) .GT. 1.5)TSK(i,j)=SST(i,j)
501      ENDDO
502      ENDDO
503    ENDDO
504    !$OMP END PARALLEL DO
505  ENDIF
506
507  IF (itimestep .eq. 1 .or. mod(itimestep,STEPBL) .eq. 0) THEN
508
509  radiation = .false.
510  myj = .false.
511  frpcpn = .false.
512
513  IF (ra_lw_physics .gt. 0) radiation = .true.
514
515!----
516! CALCULATE CONSTANT
517 
518     DTMIN=DT/60.
519! Surface schemes need PBL time step for updates and accumulations
520! Assume these schemes provide no tendencies
521     DTBL=DT*STEPBL
522
523! SAVE OLD VALUES
524
525
526     !$OMP PARALLEL DO   &
527     !$OMP PRIVATE ( ij, i, j, k )
528     DO ij = 1 , num_tiles
529       DO j=j_start(ij),j_end(ij)
530       DO i=i_start(ij),i_end(ij)
531! PSFC : in Pa
532          PSFC(I,J)=p8w(I,kts,J)
533! REVERSE ORDER IN THE VERTICAL DIRECTION
534          DO k=kts,kte
535            v_phytmp(i,k,j)=v_phy(i,k,j)+v_frame
536            u_phytmp(i,k,j)=u_phy(i,k,j)+u_frame
537          ENDDO
538       ENDDO
539       ENDDO
540     ENDDO
541     !$OMP END PARALLEL DO
542
543     !$OMP PARALLEL DO   &
544     !$OMP PRIVATE ( ij, i, j, k )
545     DO ij = 1 , num_tiles
546     sfclay_select: SELECT CASE(sf_sfclay_physics)
547
548     CASE (SFCLAYSCHEME)
549#if (NMM_CORE != 1)
550! DX varies spatially in NMM, therefore, SFCLAY cannot be called
551! because it takes a scalar DX. NMM passes in a dummy value for this
552! scalar.  NEEDS FURTHER ATTENTION. JM 20050215
553       IF (PRESENT(qv_curr)                            .AND.    &
554           PRESENT(mol)        .AND.  PRESENT(regime)  .AND.    &
555                                                      .TRUE. ) THEN
556         CALL wrf_debug( 100, 'in SFCLAY' )
557         CALL SFCLAY(u_phytmp,v_phytmp,t_phy,qv_curr,&
558               p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
559               znt,ust,pblh,mavail,zol,mol,regime,psim,psih,       &
560               xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol,       &
561               uratx,vratx,tratx,                                  &
562               u10,v10,th2,t2,q2,                                  &
563               gz1oz0,wspd,br,isfflx,dx,                           &
564               svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
565               ids,ide, jds,jde, kds,kde,                          &
566               ims,ime, jms,jme, kms,kme,                          &
567               i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
568       ELSE
569         CALL wrf_error_fatal('Lacking arguments for SFCLAY in surface driver')
570       ENDIF
571
572#else
573       CALL wrf_error_fatal('SFCLAY cannot be used with NMM')
574#endif
575      CASE (MYJSFCSCHEME)
576       IF (PRESENT(qv_curr)    .AND.  PRESENT(qc_curr) .AND.    &
577                                                      .TRUE. ) THEN
578
579        myj =.true.
580
581            CALL wrf_debug(100,'in MYJSFC')
582            CALL MYJSFC(itimestep,ht,dz8w,                         &
583              p_phy,p8w,th_phy,t_phy,                              &
584              qv_curr,qc_curr,                                      &
585              u_phy,v_phy,tke_myj,                                 &
586              tsk,qsfc,thz0,qz0,uz0,vz0,                           &
587              lowlyr,                                              &
588              xland,                                               &
589              ust,znt,z0,pblh,mavail,rmol,                         &
590              akhs,akms,                                           &
591              chs,chs2,cqs2,hfx,qfx,lh,flhc,flqc,qgh,cpm,ct,       &
592              u10,v10,t2,th2,tshltr,th10,q2,qshltr,q10,pshltr,               &
593              ids,ide, jds,jde, kds,kde,                           &
594              ims,ime, jms,jme, kms,kme,                           &
595              i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
596       ELSE
597         CALL wrf_error_fatal('Lacking arguments for MYJSFC in surface driver')
598       ENDIF
599
600     CASE (GFSSFCSCHEME)
601       IF (PRESENT(qv_curr) .AND. .TRUE. ) THEN
602       CALL wrf_debug( 100, 'in GFSSFC' )
603         CALL SF_GFS(u_phytmp,v_phytmp,t_phy,qv_curr,              &
604               p_phy,CP,RCP,R_d,XLV,PSFC,CHS,CHS2,CQS2,CPM,        &
605               ZNT,UST,PSIM,PSIH,                                  &
606               XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,                     &
607               QGH,QSFC,U10,V10,                                   &
608               GZ1OZ0,WSPD,BR,ISFFLX,                              &
609               EP_1,EP_2,KARMAN,itimestep,                         &
610               ids,ide, jds,jde, kds,kde,                          &
611               ims,ime, jms,jme, kms,kme,                          &
612               i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
613        CALL wrf_debug(100,'in SFCDIAGS')
614       ELSE
615         CALL wrf_error_fatal('Lacking arguments for SF_GFS in surface driver')
616       ENDIF
617
618     CASE DEFAULT
619       
620       WRITE( message , * )                                &
621   'The sfclay option does not exist: sf_sfclay_physics = ', sf_sfclay_physics
622       CALL wrf_error_fatal ( message )
623
624     END SELECT sfclay_select
625     ENDDO
626     !$OMP END PARALLEL DO
627
628     IF (ISFFLX.EQ.0 ) GOTO 430
629     !$OMP PARALLEL DO   &
630     !$OMP PRIVATE ( ij, i, j, k )
631     DO ij = 1 , num_tiles
632
633     sfc_select: SELECT CASE(sf_surface_physics)
634
635     CASE (SLABSCHEME)
636
637       IF (PRESENT(qv_curr)                            .AND.    &
638           PRESENT(capg)        .AND.    &
639                                                      .TRUE. ) THEN
640           DO j=j_start(ij),j_end(ij)
641           DO i=i_start(ij),i_end(ij)
642!          CQS2 ACCOUNTS FOR MAVAIL FOR SFCDIAGS 2M Q
643              CQS2(I,J)= CQS2(I,J)*MAVAIL(I,J)
644           ENDDO
645           ENDDO
646
647        CALL wrf_debug(100,'in SLAB')
648          CALL SLAB(t_phy,qv_curr,p_phy,flhc,flqc,  &
649             psfc,xland,tmn,hfx,qfx,lh,tsk,qsfc,chklowq,          &
650             gsw,glw,capg,thc,snowc,emiss,mavail,                 &
651             dtbl,rcp,xlv,dtmin,ifsnow,                           &
652             svp1,svp2,svp3,svpt0,ep_2,karman,eomeg,stbolt,       &
653             tslb,zs,dzs,num_soil_layers,radiation,               &
654             ids,ide, jds,jde, kds,kde,                           &
655             ims,ime, jms,jme, kms,kme,                           &
656             i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
657
658           DO j=j_start(ij),j_end(ij)
659           DO i=i_start(ij),i_end(ij)
660              SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
661           ENDDO
662           ENDDO
663
664        CALL wrf_debug(100,'in SFCDIAGS')
665          CALL SFCDIAGS(hfx,qfx,tsk,qsfc,chs2,cqs2,t2,th2,q2,      &
666                     psfc,cp,r_d,rcp,                              &
667                     ids,ide, jds,jde, kds,kde,                    &
668                     ims,ime, jms,jme, kms,kme,                    &
669             i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
670
671       ELSE
672         CALL wrf_error_fatal('Lacking arguments for SLAB in surface driver')
673       ENDIF
674
675#if ( NMM_CORE == 1 )
676     CASE (NMMLSMSCHEME)
677       IF (PRESENT(qv_curr)    .AND.  PRESENT(rainbl)  .AND.    &
678           PRESENT(potevp)     .AND.  PRESENT(snopcx)  .AND.    &
679           PRESENT(soiltb)     .AND.  PRESENT(sr)      .AND.    &
680                                                      .TRUE. ) THEN
681           CALL wrf_debug(100,'in NMM LSM')
682           CALL nmmlsm(dz8w,qv_curr,p8w,rho,                    &
683                t_phy,th_phy,tsk,chs,                           &
684                hfx,qfx,qgh,swdown,glw,lh,rmol,                 &
685                smstav,smstot,sfcrunoff,                        &
686                udrunoff,ivgtyp,isltyp,vegfra,sfcevp,potevp,    &
687                grdflx,sfcexc,acsnow,acsnom,snopcx,             &
688                albbck,tmn,xland,xice,qz0,                      &
689                th2,q2,snowc,cqs2,qsfc,soiltb,chklowq,rainbl,   &
690                num_soil_layers,dtbl,dzs,itimestep,             &
691                smois,tslb,snow,canwat,cpm,rcp,sr,              &    !tslb
692                albedo,snoalb,sh2o,snowh,                       &
693                ids,ide, jds,jde, kds,kde,                      &
694                ims,ime, jms,jme, kms,kme,                      &
695                i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
696          CALL wrf_debug(100,'back from NMM LSM')
697       ELSE
698         CALL wrf_error_fatal('Lacking arguments for NMMLSM in surface driver')
699       ENDIF
700#endif
701
702     CASE (LSMSCHEME)
703
704       IF (PRESENT(qv_curr)    .AND.  PRESENT(rainbl)        .AND.    &
705!          PRESENT(emiss)      .AND.  PRESENT(t2)            .AND.    &
706!          PRESENT(declin_urb) .AND.  PRESENT(cosz_urb2d)    .AND.    &
707!          PRESENT(omg_urb2d)  .AND. PRESENT( xlat_urb2d)    .AND.    &       
708!          PRESENT(dzr)       .AND.    &
709!          PRESENT( dzb)            .AND. PRESENT(dzg)       .AND.    &
710!          PRESENT(tr_urb2d) .AND. PRESENT(tb_urb2d)         .AND.    &
711!          PRESENT(tg_urb2d) .AND. PRESENT(tc_urb2d) .AND.            &
712!          PRESENT(qc_urb2d) .AND. PRESENT(uc_urb2d) .AND.            &
713!          PRESENT(xxxr_urb2d) .AND. PRESENT(xxxb_urb2d) .AND.        &
714!          PRESENT(xxxg_urb2d) .AND.                                  &
715!          PRESENT(xxxc_urb2d) .AND. PRESENT(trl_urb3d) .AND.         &
716!          PRESENT(tbl_urb3d)   .AND. PRESENT(tgl_urb3d)  .AND.       &         
717!          PRESENT(sh_urb2d) .AND. PRESENT(lh_urb2d)  .AND.           &
718!          PRESENT(g_urb2d)   .AND. PRESENT(rn_urb2d) .AND.           &
719!          PRESENT(ts_urb2d)                          .AND.           &
720!          PRESENT(frc_urb2d) .AND. PRESENT(utype_urb2d)   .AND.      &         
721                                                      .TRUE. ) THEN
722!------------------------------------------------------------------
723         CALL wrf_debug(100,'in NOAH LSM')
724           CALL lsm(dz8w,qv_curr,p8w,t_phy,tsk,                 &
725                hfx,qfx,lh,grdflx,qgh,gsw,glw,smstav,smstot,    &
726                sfcrunoff,udrunoff,ivgtyp,isltyp,vegfra,        &
727                albedo,albbck,znt,z0, tmn,xland,xice, emiss,    &
728                snowc,qsfc,rainbl,                              &
729                num_soil_layers,dtbl,dzs,itimestep,             &
730                smois,tslb,snow,canwat,                         &
731                chs, chs2, cqs2, cpm,rcp,                       &   
732                sh2o,snowh,                                     & !h 
733                u_phy,v_phy,                                    & !I
734                snoalb,shdmin,shdmax,                           & !i
735                acsnom,acsnow,                                  & !o
736                ids,ide, jds,jde, kds,kde,                      &
737                ims,ime, jms,jme, kms,kme,                      &
738                i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte,    &
739                ucmcall                                         &
740!Optional urban
741                ,tr_urb2d,tb_urb2d,tg_urb2d,tc_urb2d,qc_urb2d,  & !H urban
742                uc_urb2d,                                       & !H urban
743                xxxr_urb2d,xxxb_urb2d,xxxg_urb2d,xxxc_urb2d,    & !H urban
744                trl_urb3d,tbl_urb3d,tgl_urb3d,                  & !H urban
745                sh_urb2d,lh_urb2d,g_urb2d,rn_urb2d,ts_urb2d,    & !H urban
746                psim_urb2d,psih_urb2d,u10_urb2d,v10_urb2d,      & !O urban
747                GZ1OZ0_urb2d, AKMS_URB2D,                       & !O urban
748                th2_urb2d,q2_urb2d,ust_urb2d,                   & !O urban
749                declin_urb,cosz_urb2d,omg_urb2d,                & !I urban
750                xlat_urb2d,                                     & !I urban
751                num_roof_layers, num_wall_layers,               & !I urban
752                num_road_layers, DZR, DZB, DZG,                 & !I urban
753                FRC_URB2D, UTYPE_URB2D                          & ! urban
754                )
755
756
757           DO j=j_start(ij),j_end(ij)
758           DO i=i_start(ij),i_end(ij)
759              CHKLOWQ(I,J)= 1.0
760              SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
761           ENDDO
762           ENDDO
763         
764          CALL SFCDIAGS(HFX,QFX,TSK,QSFC,CHS2,CQS2,T2,TH2,Q2,      &
765                     PSFC,CP,R_d,RCP,                              &
766                     ids,ide, jds,jde, kds,kde,                    &
767                     ims,ime, jms,jme, kms,kme,                    &
768             i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
769
770!urban
771     IF(UCMCALL.eq.1) THEN
772       DO j=j_start(ij),j_end(ij)                             !urban
773         DO i=i_start(ij),i_end(ij)                           !urban
774          IF( IVGTYP(I,J) == 1 .or. IVGTYP(I,J) == 31 .or. &  !urban
775              IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33 ) THEN !urban
776!             TH2(I,J)  = TH2_URB2D(I,J)                       !urban
777!             T2(I,J)   = TH2_URB2D(I,J)/(1.E5/PSFC(I,J))**RCP !urban
778!m             T2(I,J)   = TH2_URB2D(I,J)                       !urban
779             T2(I,J)   = FRC_URB2D(i,j)*TH2_URB2D(I,J) + (1-FRC_URB2D(i,j))*T2(I,J) !urban
780             TH2(I,J) = T2(I,J)*(1.E5/PSFC(I,J))**RCP                               !urban
781!m             Q2(I,J)   = Q2_URB2D(I,J)                                            !urban
782             Q2(I,J)   = FRC_URB2D(i,j)*Q2_URB2D(I,J) +(1-FRC_URB2D(i,j))* Q2(I,J)  !urban
783             U10(I,J)  = U10_URB2D(I,J)                       !urban
784             V10(I,J)  = V10_URB2D(I,J)                       !urban
785             PSIM(I,J) = PSIM_URB2D(I,J)                      !urban
786             PSIH(I,J) = PSIH_URB2D(I,J)                      !urban
787             GZ1OZ0(I,J) = GZ1OZ0_URB2D(I,J)                  !urban
788!m             AKHS(I,J) = AKHS_URB2D(I,J)                    !urban
789             AKHS(I,J) = CHS(I,J)                             !urban
790             AKMS(I,J) = AKMS_URB2D(I,J)                      !urban
791           END IF                                             !urban
792         ENDDO                                                !urban
793       ENDDO                                                  !urban
794     ENDIF
795!------------------------------------------------------------------
796
797       ELSE
798         CALL wrf_error_fatal('Lacking arguments for LSM in surface driver')
799       ENDIF
800
801     CASE (RUCLSMSCHEME)
802       IF (PRESENT(qv_curr)    .AND.  PRESENT(qc_curr) .AND.    &
803!           PRESENT(emiss)      .AND.  PRESENT(t2)      .AND.    &
804           PRESENT(qsg)        .AND.  PRESENT(qvg)     .AND.    &
805           PRESENT(qcg)        .AND.  PRESENT(soilt1)  .AND.    &
806           PRESENT(tsnav)      .AND.  PRESENT(smfr3d)  .AND.    &
807           PRESENT(keepfr3dflag) .AND. PRESENT(rainbl) .AND.    &
808                                                      .TRUE. ) THEN
809
810           IF( PRESENT(sr) ) THEN
811               frpcpn=.true.
812           ELSE
813               SR = 1.
814           ENDIF
815
816           CALL wrf_debug(100,'in RUC LSM')
817           CALL LSMRUC(dtbl,itimestep,num_soil_layers,          &
818                zs,rainbl,snow,snowh,snowc,sr,frpcpn,           &
819                dz8w,p8w,t_phy,qv_curr,qc_curr,rho,             & !p8w in [pa]
820                glw,gsw,emiss,chklowq,                          &
821                flqc,flhc,mavail,canwat,vegfra,albedo,znt,      &
822                qsfc,qsg,qvg,qcg,soilt1,tsnav,                  &
823                tmn,ivgtyp,isltyp,xland,xice,                   &
824                cp,g,xlv,stbolt,                                &
825                smois,smstav,smstot,tslb,tsk,hfx,qfx,lh,        &
826                sfcrunoff,udrunoff,sfcexc,                      &
827                sfcevp,grdflx,acsnow,                           &
828                smfr3d,keepfr3dflag,                            &
829                myj,                                            &
830                ids,ide, jds,jde, kds,kde,                      &
831                ims,ime, jms,jme, kms,kme,                      &
832                i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
833
834         IF(.not. MYJ) then
835
836          CALL SFCDIAGS(HFX,QFX,TSK,QVG,CHS2,CQS2,T2,TH2,Q2,      &
837                     PSFC,CP,R_d,RCP,                              &
838                     ids,ide, jds,jde, kds,kde,                    &
839                     ims,ime, jms,jme, kms,kme,                    &
840             i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
841         ENDIF
842 
843
844       ELSE
845         CALL wrf_error_fatal('Lacking arguments for RUCLSM in surface driver')
846       ENDIF
847
848     CASE DEFAULT
849
850       WRITE( message , * ) &
851        'The surface option does not exist: sf_surface_physics = ', sf_surface_physics
852       CALL wrf_error_fatal ( message )
853
854     END SELECT sfc_select
855     ENDDO
856     !$OMP END PARALLEL DO
857
858 430 CONTINUE
859
860
861! Reset RAINBL in mm (Accumulation between PBL calls)
862
863     IF ( PRESENT( rainbl ) ) THEN
864       !$OMP PARALLEL DO   &
865       !$OMP PRIVATE ( ij, i, j, k )
866       DO ij = 1 , num_tiles
867         DO j=j_start(ij),j_end(ij)
868         DO i=i_start(ij),i_end(ij)
869            RAINBL(i,j) = 0.
870         ENDDO
871         ENDDO
872       ENDDO
873       !$OMP END PARALLEL DO
874     ENDIF
875
876   ENDIF
877
878   END SUBROUTINE surface_driver
879
880END MODULE module_surface_driver
881
Note: See TracBrowser for help on using the repository browser.