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

Last change on this file since 3567 was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size

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