source: trunk/WRF.COMMON/WRFV2/phys/module_fddagd_driver.F @ 3547

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

spiga@svn-planeto:ajoute le modele meso-echelle martien
File size: 10.4 KB
Line 
1!WRF:MEDIATION_LAYER:PHYSICS
2!
3
4MODULE module_fddagd_driver
5CONTAINS
6
7!------------------------------------------------------------------
8   SUBROUTINE fddagd_driver(itimestep,dt,xtime,                   &
9                  id,  &
10                  RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,                 &
11                  RQVNDGDTEN,RMUNDGDTEN,                          &
12                  u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,mu_ndg_old,       &
13                  u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,mu_ndg_new,       &
14                  u3d,v3d,th_phy,rho,moist,                       &
15                  p_phy,pi_phy,p8w,t_phy,dz8w,z,z_at_w,           &
16                  config_flags,DX,n_moist,                        &
17                  STEPFG,                                         &
18                  pblh,ht,                                        &
19                  ids,ide, jds,jde, kds,kde,                      &
20                  ims,ime, jms,jme, kms,kme,                      &
21                  i_start,i_end, j_start,j_end, kts,kte, num_tiles)
22!------------------------------------------------------------------
23   USE module_configure
24   USE module_state_description
25   USE module_model_constants
26
27! *** add new modules of schemes here
28
29   USE module_fdda_psufddagd
30!------------------------------------------------------------------
31   IMPLICIT NONE
32!======================================================================
33! Grid structure in physics part of WRF
34!----------------------------------------------------------------------
35! The horizontal velocities used in the physics are unstaggered
36! relative to temperature/moisture variables. All predicted
37! variables are carried at half levels except w, which is at full
38! levels. Some arrays with names (*8w) are at w (full) levels.
39!
40!----------------------------------------------------------------------
41! In WRF, kms (smallest number) is the bottom level and kme (largest
42! number) is the top level.  In your scheme, if 1 is at the top level,
43! then you have to reverse the order in the k direction.
44!
45!         kme      -   half level (no data at this level)
46!         kme    ----- full level
47!         kme-1    -   half level
48!         kme-1  ----- full level
49!         .
50!         .
51!         .
52!         kms+2    -   half level
53!         kms+2  ----- full level
54!         kms+1    -   half level
55!         kms+1  ----- full level
56!         kms      -   half level
57!         kms    ----- full level
58!
59!======================================================================
60!-- RUNDGDTEN       U tendency due to
61!                 FDDA analysis nudging (m/s^2)
62!-- RVNDGDTEN       V tendency due to
63!                 FDDA analysis nudging (m/s^2)
64!-- RTHNDGDTEN      Theta tendency due to
65!                 FDDA analysis nudging (K/s)
66!-- RQVNDGDTEN      Qv tendency due to
67!                 FDDA analysis nudging (kg/kg/s)
68!-- RMUNDGDTEN      mu tendency due to
69!                 FDDA analysis nudging (Pa/s)
70!-- itimestep     number of time steps
71!-- u3d           u-velocity staggered on u points (m/s)
72!-- v3d           v-velocity staggered on v points (m/s)
73!-- th_phy        potential temperature (K)
74!-- moist         moisture array (4D - last index is species) (kg/kg)
75!-- p_phy         pressure (Pa)
76!-- pi_phy        exner function (dimensionless)
77!-- p8w           pressure at full levels (Pa)
78!-- t_phy         temperature (K)
79!-- dz8w          dz between full levels (m)
80!-- z             height above sea level (m)
81!-- config_flags
82!-- DX            horizontal space interval (m)
83!-- DT            time step (second)
84!-- n_moist       number of moisture species
85!-- STEPFG        number of timesteps per FDDA re-calculation
86!-- KPBL          k-index of PBL top
87!-- ids           start index for i in domain
88!-- ide           end index for i in domain
89!-- jds           start index for j in domain
90!-- jde           end index for j in domain
91!-- kds           start index for k in domain
92!-- kde           end index for k in domain
93!-- ims           start index for i in memory
94!-- ime           end index for i in memory
95!-- jms           start index for j in memory
96!-- jme           end index for j in memory
97!-- kms           start index for k in memory
98!-- kme           end index for k in memory
99!-- jts           start index for j in tile
100!-- jte           end index for j in tile
101!-- kts           start index for k in tile
102!-- kte           end index for k in tile
103!
104!******************************************************************
105!------------------------------------------------------------------
106   TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
107!
108
109   INTEGER , INTENT(IN)         ::     id
110
111   INTEGER,    INTENT(IN   )    ::     ids,ide, jds,jde, kds,kde, &
112                                       ims,ime, jms,jme, kms,kme, &
113                                       kts,kte, num_tiles,        &
114                                       n_moist           
115
116   INTEGER, DIMENSION(num_tiles), INTENT(IN) ::                   &
117  &                                    i_start,i_end,j_start,j_end
118
119   INTEGER,    INTENT(IN   )    ::     itimestep,STEPFG
120!
121   REAL,       INTENT(IN   )    ::     DT,DX,XTIME
122
123
124!
125   REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ),            &
126               INTENT(IN   )    ::                         p_phy, &
127                                                          pi_phy, &
128                                                             p8w, &
129                                                             rho, &
130                                                           t_phy, &
131                                                             u3d, &
132                                                             v3d, &
133                                                            dz8w, &
134                                                               z, &
135                                                          z_at_w, &
136                                                          th_phy
137!
138   REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ),         &
139         INTENT(IN ) ::                                    moist
140!
141!
142!
143   REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ),            &
144               INTENT(INOUT)    ::                       RUNDGDTEN, &
145                                                         RVNDGDTEN, &
146                                                        RTHNDGDTEN, &
147                                                        RQVNDGDTEN
148
149   REAL,       DIMENSION( ims:ime,  jms:jme ),            &
150               INTENT(INOUT)    ::                      RMUNDGDTEN
151
152   REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ),            &
153               INTENT(INOUT)    ::                       u_ndg_old, &
154                                                         v_ndg_old, &
155                                                         t_ndg_old, &
156                                                         q_ndg_old, &
157                                                         u_ndg_new, &
158                                                         v_ndg_new, &
159                                                         t_ndg_new, &
160                                                         q_ndg_new
161   REAL,       DIMENSION( ims:ime,  jms:jme ),            &
162               INTENT(INOUT)    ::                       mu_ndg_old, &
163                                                         mu_ndg_new
164
165!
166   REAL,    DIMENSION( ims:ime , jms:jme ),     &
167               INTENT(IN   ) ::           pblh, &
168                                            ht
169
170!  LOCAL  VAR
171
172!
173   INTEGER :: i,J,K,NK,jj,ij
174
175!------------------------------------------------------------------
176!
177#if  ! ( NMM_CORE == 1 )
178  if (config_flags%grid_fdda .eq. 0) return
179
180  IF (itimestep == 1) THEN
181
182   !$OMP PARALLEL DO   &
183   !$OMP PRIVATE ( ij,i,j,k )
184   DO ij = 1 , num_tiles
185      DO j=j_start(ij),j_end(ij)
186      DO i=i_start(ij),i_end(ij)
187
188         DO k=kts,min(kte+1,kde)
189            u_ndg_old(i,k,j) = u3d(i,k,j)
190            v_ndg_old(i,k,j) = v3d(i,k,j)
191            t_ndg_old(i,k,j) = th_phy(i,k,j) - 300.0
192            q_ndg_old(i,k,j) = moist(i,k,j,P_QV)
193         ENDDO
194         mu_ndg_old(i,j) = 0.0
195
196      ENDDO
197      ENDDO
198
199   ENDDO
200   !$OMP END PARALLEL DO
201
202  ENDIF
203
204  IF (itimestep .eq. 1 .or. mod(itimestep,STEPFG) .eq. 0) THEN
205
206   !$OMP PARALLEL DO   &
207   !$OMP PRIVATE ( ij,i,j,k )
208   DO ij = 1 , num_tiles
209      DO j=j_start(ij),j_end(ij)
210      DO i=i_start(ij),i_end(ij)
211
212         DO k=kts,min(kte+1,kde)
213            RTHNDGDTEN(I,K,J)=0.
214            RUNDGDTEN(I,K,J)=0.
215            RVNDGDTEN(I,K,J)=0.
216            RQVNDGDTEN(I,K,J)=0.
217         ENDDO
218
219         RMUNDGDTEN(I,J)=0.
220
221      ENDDO
222      ENDDO
223
224   ENDDO
225   !$OMP END PARALLEL DO
226!
227  !$OMP PARALLEL DO   &
228  !$OMP PRIVATE ( ij, i,j,k )
229  DO ij = 1 , num_tiles
230   fdda_select: SELECT CASE(config_flags%grid_fdda)
231
232      CASE (PSUFDDAGD)
233        CALL wrf_debug(100,'in PSU FDDA scheme')
234           CALL FDDAGD(itimestep,dt,xtime, &
235               id, &
236               config_flags%gfdda_interval_m, &
237               config_flags%gfdda_end_h, &
238               config_flags%if_no_pbl_nudging_uv, &
239               config_flags%if_no_pbl_nudging_t, &
240               config_flags%if_no_pbl_nudging_q, &
241               config_flags%if_zfac_uv, &
242               config_flags%k_zfac_uv, &
243               config_flags%if_zfac_t, &
244               config_flags%k_zfac_t, &
245               config_flags%if_zfac_q, &
246               config_flags%k_zfac_q, &
247               config_flags%guv, &
248               config_flags%gt, config_flags%gq, &
249               config_flags%if_ramping, config_flags%dtramp_min, &
250               u3d,v3d,th_phy,t_phy,                 &
251               moist(ims,kms,jms,P_QV),     &
252               p_phy,pi_phy,                &
253               u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,mu_ndg_old,       &
254               u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,mu_ndg_new,       &
255               RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN,&
256               pblh, ht, z, z_at_w,                             &
257               ids,ide, jds,jde, kds,kde,                           &
258               ims,ime, jms,jme, kms,kme,                           &
259               i_start(ij),i_end(ij),j_start(ij),j_end(ij),kts,kte  )
260
261
262     CASE DEFAULT
263
264       WRITE( wrf_err_message , * ) 'The fdda option does not exist: grid_fdda = ', config_flags%grid_fdda
265       CALL wrf_error_fatal ( wrf_err_message )
266
267   END SELECT fdda_select
268
269   ENDDO
270   !$OMP END PARALLEL DO
271
272   ENDIF
273
274#endif
275!
276   END SUBROUTINE fddagd_driver
277END MODULE module_fddagd_driver
Note: See TracBrowser for help on using the repository browser.