Context Navigation

module_first_rk_step_part2.F

Last change on this file was 1, checked in by lfita, 11 years ago

-- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 44.5 KB

Line
1	!WRF:MEDIATION_LAYER:SOLVER
2
3	#define BENCH_START(A)
4	#define BENCH_END(A)
5
6	MODULE module_first_rk_step_part2
7
8	CONTAINS
9
10	SUBROUTINE first_rk_step_part2 ( grid , config_flags &
11	, moist , moist_tend &
12	, chem , chem_tend &
13	, tracer, tracer_tend &
14	, scalar , scalar_tend &
15	, fdda3d, fdda2d &
16	, ru_tendf, rv_tendf &
17	, rw_tendf, t_tendf &
18	, ph_tendf, mu_tendf &
19	, tke_tend &
20	, adapt_step_flag , curr_secs &
21	, psim , psih , wspd , gz1oz0 , br , chklowq &
22	, cu_act_flag , hol , th_phy &
23	, pi_phy , p_phy , t_phy , u_phy , v_phy &
24	, dz8w , p8w , t8w , rho_phy , rho &
25	, nba_mij, n_nba_mij & !JDM
26	, nba_rij, n_nba_rij & !JDM
27	, ids, ide, jds, jde, kds, kde &
28	, ims, ime, jms, jme, kms, kme &
29	, ips, ipe, jps, jpe, kps, kpe &
30	, imsx,imex,jmsx,jmex,kmsx,kmex &
31	, ipsx,ipex,jpsx,jpex,kpsx,kpex &
32	, imsy,imey,jmsy,jmey,kmsy,kmey &
33	, ipsy,ipey,jpsy,jpey,kpsy,kpey &
34	, k_start , k_end &
35	)
36	USE module_state_description
37	USE module_model_constants
38	USE module_domain, ONLY : domain
39	USE module_configure, ONLY : grid_config_rec_type, model_config_rec
40	#ifdef DM_PARALLEL
41	USE module_dm, ONLY : local_communicator, mytask, ntasks, ntasks_x, ntasks_y, local_communicator_periodic, wrf_dm_maxval, wrf_err_message, local_communicator_x, local_communicator_y
42	USE module_comm_dm, ONLY : halo_em_tke_c_sub,halo_em_tke_d_sub,halo_em_tke_e_sub &
43	,halo_em_phys_pbl_sub,halo_em_phys_shcu_sub &
44	,halo_em_fdda_sub,halo_em_phys_diffusion_sub,halo_em_tke_3_sub &
45	,halo_em_tke_5_sub,halo_obs_nudge_sub,period_bdy_em_a1_sub,period_bdy_em_phy_bc_sub &
46	,period_bdy_em_fdda_bc_sub,period_bdy_em_chem_sub,halo_em_phys_cu_sub
47	#endif
48
49	USE module_driver_constants
50	USE module_diffusion_em, ONLY : phy_bc, cal_deform_and_div, compute_diff_metrics, &
51	vertical_diffusion_2, horizontal_diffusion_2, calculate_km_kh, &
52	tke_rhs
53	USE module_em, ONLY : calculate_phy_tend
54	USE module_fddaobs_driver, ONLY : fddaobs_driver
55	USE module_bc, ONLY : set_physical_bc3d, set_physical_bc2d
56	USE module_physics_addtendc, ONLY : update_phy_ten
57
58	USE module_sfs_driver !JDM
59	USE module_stoch, ONLY : update_stoch_ten, update_stoch , update_stoch_ten_subdomains, &
60	do_fftback_along_x,do_fftback_along_y,sp2gp_prep
61
62
63	IMPLICIT NONE
64
65	TYPE ( domain ), INTENT(INOUT) :: grid
66	TYPE ( grid_config_rec_type ), INTENT(IN) :: config_flags
67
68	INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
69	ims, ime, jms, jme, kms, kme, &
70	ips, ipe, jps, jpe, kps, kpe, &
71	imsx,imex,jmsx,jmex,kmsx,kmex, &
72	ipsx,ipex,jpsx,jpex,kpsx,kpex, &
73	imsy,imey,jmsy,jmey,kmsy,kmey, &
74	ipsy,ipey,jpsy,jpey,kpsy,kpey
75
76
77
78	LOGICAL ,INTENT(IN) :: adapt_step_flag
79	REAL, INTENT(IN) :: curr_secs
80
81	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: moist
82	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: moist_tend
83	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_chem),INTENT(INOUT) :: chem
84	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_chem),INTENT(INOUT) :: chem_tend
85	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_tracer),INTENT(INOUT) :: tracer
86	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_tracer),INTENT(INOUT) :: tracer_tend
87	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_scalar),INTENT(INOUT) :: scalar
88	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_scalar),INTENT(INOUT) :: scalar_tend
89	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_fdda3d),INTENT(INOUT) :: fdda3d
90	REAL ,DIMENSION(ims:ime,1:1,jms:jme,num_fdda2d),INTENT(INOUT) :: fdda2d
91	REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: psim
92	REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: psih
93	REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: wspd
94	REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: gz1oz0
95	REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: br
96	REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: chklowq
97	LOGICAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: cu_act_flag
98	REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: hol
99
100	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: th_phy
101	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: pi_phy
102	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: p_phy
103	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t_phy
104	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: u_phy
105	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: v_phy
106	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: dz8w
107	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: p8w
108	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t8w
109	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rho_phy
110	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rho
111
112	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: ru_tendf
113	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rv_tendf
114	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rw_tendf
115	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: ph_tendf
116	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t_tendf
117	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: tke_tend
118
119	REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: mu_tendf
120
121	INTEGER , INTENT(IN) :: k_start, k_end
122
123	!JDM
124	INTEGER, INTENT( IN ) :: n_nba_mij, n_nba_rij
125
126	REAL ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,n_nba_mij) &
127	:: nba_mij
128
129	REAL ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,n_nba_rij) &
130	:: nba_rij
131
132	! Local
133
134	REAL, DIMENSION( ims:ime, jms:jme ) :: ht_loc
135	REAL :: scale_factor
136	INTEGER, DIMENSION( ims:ime, jms:jme ) :: shadowmask
137	INTEGER :: ij
138	INTEGER num_roof_layers
139	INTEGER num_wall_layers
140	INTEGER num_road_layers
141	INTEGER iswater
142	INTEGER rk_step
143	#if ( WRF_DFI_RADAR == 1 )
144	INTEGER i_start,i_end,j_start,j_end,i,j,k
145	#endif
146	#ifdef LMDZ1
147	INTEGER :: iz,im2,km2,jm2
148
149	im2=24
150	jm2=21
151	km2=38
152
153	PRINT *,' module_first_rk_step_part2: ',im2,km2,jm2
154	PRINT *,' al: ',grid%al(im2,km2,jm2), ' p: ', grid%p(im2,km2,jm2), &
155	' ph: ',grid%ph_2(im2,km2,jm2), ' p8w: ', p8w(im2,km2,jm2)
156	PRINT *,' Lluis checking variables k t u v p ph alt inside rk_step2 ________'
157	DO iz=kms,kme
158	PRINT *,'in0_rk_step2 ', iz, grid%t_2(im2,iz,jm2), grid%u_2(im2,iz,jm2), grid%v_2(im2,iz,jm2), &
159	grid%p(im2,iz,jm2), grid%ph_2(im2,iz,jm2), grid%alt(im2,iz,jm2), p8w(im2,iz,jm2)
160	END DO
161	#endif
162
163	! initialize all tendencies to zero in order to update physics
164	! tendencies first (separate from dry dynamics).
165
166	rk_step = 1
167
168	stoch_force_select: SELECT CASE(config_flags%stoch_force_opt)
169
170	CASE (STOCH_BACKSCATTER)
171
172	IF ( grid%id .EQ. 1 ) THEN
173
174	!$OMP PARALLEL DO &
175	!$OMP PRIVATE ( ij )
176	DO ij = 1 , grid%num_tiles
177
178	CALL UPDATE_STOCH(grid%SPSTREAMFORCS,grid%SPSTREAMFORCC, &
179	grid%SPTFORCS,grid%SPTFORCC, &
180	grid%SPT_AMP,grid%SPSTREAM_AMP, &
181	ids, ide, jds, jde, kds, kde, &
182	ims, ime, jms, jme, kms, kme, &
183	grid%i_start(ij), grid%i_end(ij), grid%j_start(ij), &
184	grid%j_end(ij), k_start, k_end )
185
186	call sp2gp_prep( &
187	grid%SPSTREAMFORCS,grid%SPSTREAMFORCC, &
188	grid%SPTFORCS,grid%SPTFORCC, &
189	grid%VERTSTRUCC,grid%VERTSTRUCS, &
190	grid%RU_REAL,grid%RV_REAL,grid%RT_REAL, &
191	grid%RU_IMAG,grid%RV_IMAG,grid%RT_IMAG, &
192	grid%DX,grid%DY,grid%stoch_vertstruc_opt, &
193	ids, ide, jds, jde, kds, kde, &
194	ims, ime, jms, jme, kms, kme, &
195	grid%i_start(ij), grid%i_end(ij), grid%j_start(ij), &
196	grid%j_end(ij), k_start, k_end)
197	ENDDO
198	!$OMP END PARALLEL DO
199
200	! Roll out into latitude bands and perform FFT along latitude bands
201	#ifdef DM_PARALLEL
202	#include "XPOSE_STOCH_BACK_U_REAL_z2x.inc"
203	#include "XPOSE_STOCH_BACK_U_IMAG_z2x.inc"
204	#include "XPOSE_STOCH_BACK_V_REAL_z2x.inc"
205	#include "XPOSE_STOCH_BACK_V_IMAG_z2x.inc"
206	#include "XPOSE_STOCH_BACK_T_REAL_z2x.inc"
207	#include "XPOSE_STOCH_BACK_T_IMAG_z2x.inc"
208
209	call do_fftback_along_x( &
210	grid%RU_REAL_xxx,grid%RU_IMAG_xxx,&
211	grid%RV_REAL_xxx,grid%RV_IMAG_xxx,&
212	grid%RT_REAL_xxx,grid%RT_IMAG_xxx,&
213	ids, ide, jds, jde, kds, kde, &
214	ims, ime, jms, jme, kms, kme, &
215	ips, ipe, jps, jpe, kps, kpe, &
216	imsx,imex,jmsx,jmex,kmsx,kmex, &
217	ipsx,ipex,jpsx,jpex,kpsx,kpex, &
218	imsy,imey,jmsy,jmey,kmsy,kmey, &
219	ipsy,ipey,jpsy,jpey,kpsy,kpey, &
220	k_start , k_end &
221	)
222
223	! Reassemble fields from latitude bands into 3D arrays
224	! reassemble field X_REAL and X_IMAG
225	#include "XPOSE_STOCH_BACK_U_REAL_x2z.inc"
226	#include "XPOSE_STOCH_BACK_U_IMAG_x2z.inc"
227	#include "XPOSE_STOCH_BACK_V_REAL_x2z.inc"
228	#include "XPOSE_STOCH_BACK_V_IMAG_x2z.inc"
229	#include "XPOSE_STOCH_BACK_T_REAL_x2z.inc"
230	#include "XPOSE_STOCH_BACK_T_IMAG_x2z.inc"
231
232	! Roll out into longitude bands and perform FFT along longitude bands
233	#include "XPOSE_STOCH_BACK_U_REAL_z2y.inc"
234	#include "XPOSE_STOCH_BACK_U_IMAG_z2y.inc"
235	#include "XPOSE_STOCH_BACK_V_REAL_z2y.inc"
236	#include "XPOSE_STOCH_BACK_V_IMAG_z2y.inc"
237	#include "XPOSE_STOCH_BACK_T_REAL_z2y.inc"
238	#include "XPOSE_STOCH_BACK_T_IMAG_z2y.inc"
239
240	call do_fftback_along_y( &
241	grid%RU_REAL_yyy,grid%RU_IMAG_yyy,&
242	grid%RV_REAL_yyy,grid%RV_IMAG_yyy,&
243	grid%RT_REAL_yyy,grid%RT_IMAG_yyy,&
244	ids, ide, jds, jde, kds, kde, &
245	ims, ime, jms, jme, kms, kme, &
246	ips, ipe, jps, jpe, kps, kpe, &
247	imsx,imex,jmsx,jmex,kmsx,kmex, &
248	ipsx,ipex,jpsx,jpex,kpsx,kpex, &
249	imsy,imey,jmsy,jmey,kmsy,kmey, &
250	ipsy,ipey,jpsy,jpey,kpsy,kpey, &
251	k_start , k_end &
252	)
253
254	! Reassemble fields from longitude bands into 3D arrays
255	#include "XPOSE_STOCH_BACK_U_REAL_y2z.inc"
256	#include "XPOSE_STOCH_BACK_U_IMAG_y2z.inc"
257	#include "XPOSE_STOCH_BACK_V_REAL_y2z.inc"
258	#include "XPOSE_STOCH_BACK_V_IMAG_y2z.inc"
259	#include "XPOSE_STOCH_BACK_T_REAL_y2z.inc"
260	#include "XPOSE_STOCH_BACK_T_IMAG_y2z.inc"
261
262	#else
263	call do_fftback_along_x( &
264	grid%RU_REAL,grid%RU_IMAG,&
265	grid%RV_REAL,grid%RV_IMAG,&
266	grid%RT_REAL,grid%RT_IMAG,&
267	ids, ide, jds, jde, kds, kde, &
268	ims, ime, jms, jme, kms, kme, &
269	ips, ipe, jps, jpe, kps, kpe, &
270	imsx,imex,jmsx,jmex,kmsx,kmex, &
271	ipsx,ipex,jpsx,jpex,kpsx,kpex, &
272	imsy,imey,jmsy,jmey,kmsy,kmey, &
273	ipsy,ipey,jpsy,jpey,kpsy,kpey, &
274	k_start , k_end &
275	)
276	call do_fftback_along_y( &
277	grid%RU_REAL,grid%RU_IMAG,&
278	grid%RV_REAL,grid%RV_IMAG,&
279	grid%RT_REAL,grid%RT_IMAG,&
280	ids, ide, jds, jde, kds, kde, &
281	ims, ime, jms, jme, kms, kme, &
282	ips, ipe, jps, jpe, kps, kpe, &
283	imsx,imex,jmsx,jmex,kmsx,kmex, &
284	ipsx,ipex,jpsx,jpex,kpsx,kpex, &
285	imsy,imey,jmsy,jmey,kmsy,kmey, &
286	ipsy,ipey,jpsy,jpey,kpsy,kpey, &
287	k_start , k_end &
288	)
289	#endif
290
291	!$OMP PARALLEL DO &
292	!$OMP PRIVATE ( ij )
293	DO ij = 1 , grid%num_tiles
294	CALL wrf_debug ( 200 , ' call update_stoch_ten' )
295	CALL update_stoch_ten(ru_tendf, rv_tendf, t_tendf, &
296	grid%ru_tendf_stoch, &
297	grid%rv_tendf_stoch, &
298	grid%rt_tendf_stoch, &
299	grid%RU_REAL,grid%RV_REAL,grid%RT_REAL, &
300	ids, ide, jds, jde, kds, kde, &
301	ims, ime, jms, jme, kms, kme, &
302	grid%i_start(ij), grid%i_end(ij), &
303	grid%j_start(ij), grid%j_end(ij), &
304	k_start, k_end, &
305	grid%dt)
306
307	ENDDO
308	!$OMP END PARALLEL DO
309	ELSE ! (grid%id .NE> 1)
310
311	!$OMP PARALLEL DO &
312	!$OMP PRIVATE ( ij )
313	DO ij = 1 , grid%num_tiles
314	CALL wrf_debug ( 200 , ' call update_stoch_ten_subdomains' )
315	CALL update_stoch_ten_subdomains(ru_tendf, rv_tendf, t_tendf,&
316	grid%ru_tendf_stoch, &
317	grid%rv_tendf_stoch, &
318	grid%rt_tendf_stoch, &
319	ids, ide, jds, jde, kds, kde, &
320	ims, ime, jms, jme, kms, kme, &
321	grid%i_start(ij), grid%i_end(ij), &
322	grid%j_start(ij), grid%j_end(ij), &
323	k_start, k_end, &
324	grid%dt )
325
326	ENDDO
327	!$OMP END PARALLEL DO
328	END IF
329
330	END SELECT stoch_force_select
331
332	#ifdef LMDZ1
333	PRINT *,' Lluis checking variables k t u v p ph alt p8w inside in1_rk_step2 ________'
334	DO iz=kms,kme
335	PRINT *,'in1_rk_step2 ', iz, grid%t_2(im2,iz,jm2), grid%u_2(im2,iz,jm2), grid%v_2(im2,iz,jm2), &
336	grid%p(im2,iz,jm2), grid%ph_2(im2,iz,jm2), grid%alt(im2,iz,jm2), p8w(im2,iz,jm2)
337	END DO
338	#endif
339
340
341	! calculate_phy_tend
342
343	BENCH_START(cal_phy_tend)
344	!$OMP PARALLEL DO &
345	!$OMP PRIVATE ( ij )
346
347	DO ij = 1 , grid%num_tiles
348
349	CALL wrf_debug ( 200 , ' call calculate_phy_tend' )
350	CALL calculate_phy_tend (config_flags,grid%mut,grid%muu,grid%muv,pi_phy, &
351	grid%rthraten, &
352	grid%rublten,grid%rvblten,grid%rthblten, &
353	grid%rqvblten,grid%rqcblten,grid%rqiblten, &
354	grid%rucuten,grid%rvcuten,grid%rthcuten, &
355	grid%rqvcuten,grid%rqccuten,grid%rqrcuten, &
356	grid%rqicuten,grid%rqscuten, &
357	grid%rushten,grid%rvshten,grid%rthshten, &
358	grid%rqvshten,grid%rqcshten,grid%rqrshten, &
359	grid%rqishten,grid%rqsshten,grid%rqgshten, &
360	grid%RUNDGDTEN,grid%RVNDGDTEN,grid%RTHNDGDTEN,grid%RQVNDGDTEN, &
361	grid%RMUNDGDTEN, &
362	ids,ide, jds,jde, kds,kde, &
363	ims,ime, jms,jme, kms,kme, &
364	grid%i_start(ij), min(grid%i_end(ij),ide-1), &
365	grid%j_start(ij), min(grid%j_end(ij),jde-1), &
366	k_start , min(k_end,kde-1) )
367
368	ENDDO
369	!$OMP END PARALLEL DO
370	BENCH_END(cal_phy_tend)
371	#ifdef LMDZ1
372	PRINT *,' Lluis checking variables k t u v p ph alt p8w inside in2_rk_step2 ________'
373	DO iz=kms,kme
374	PRINT *,'in2_rk_step2 ', iz, grid%t_2(im2,iz,jm2), grid%u_2(im2,iz,jm2), grid%v_2(im2,iz,jm2), &
375	grid%p(im2,iz,jm2), grid%ph_2(im2,iz,jm2), grid%alt(im2,iz,jm2), p8w(im2,iz,jm2)
376	END DO
377	#endif
378
379	! tke diffusion
380
381	IF(config_flags%diff_opt .eq. 2 .OR. config_flags%diff_opt .eq. 1) THEN
382
383	BENCH_START(comp_diff_metrics_tim)
384	!$OMP PARALLEL DO &
385	!$OMP PRIVATE ( ij )
386	DO ij = 1 , grid%num_tiles
387	CALL wrf_debug ( 200 , ' call compute_diff_metrics ' )
388	CALL compute_diff_metrics ( config_flags, grid%ph_2, grid%phb, grid%z, grid%rdz, grid%rdzw, &
389	grid%zx, grid%zy, grid%rdx, grid%rdy, &
390	ids, ide, jds, jde, kds, kde, &
391	ims, ime, jms, jme, kms, kme, &
392	grid%i_start(ij), grid%i_end(ij), &
393	grid%j_start(ij), grid%j_end(ij), &
394	k_start , k_end )
395	ENDDO
396	!$OMP END PARALLEL DO
397	BENCH_END(comp_diff_metrics_tim)
398
399	#ifdef DM_PARALLEL
400	# include "HALO_EM_TKE_C.inc"
401	# include "PERIOD_BDY_EM_A1.inc"
402	#endif
403
404	BENCH_START(tke_diff_bc_tim)
405	!$OMP PARALLEL DO &
406	!$OMP PRIVATE ( ij )
407
408	DO ij = 1 , grid%num_tiles
409
410	CALL wrf_debug ( 200 , ' call bc for diffusion_metrics ' )
411	CALL set_physical_bc3d( grid%rdzw , 'w', config_flags, &
412	ids, ide, jds, jde, kds, kde, &
413	ims, ime, jms, jme, kms, kme, &
414	ips, ipe, jps, jpe, kps, kpe, &
415	grid%i_start(ij), grid%i_end(ij), &
416	grid%j_start(ij), grid%j_end(ij), &
417	k_start , k_end )
418	CALL set_physical_bc3d( grid%rdz , 'w', config_flags, &
419	ids, ide, jds, jde, kds, kde, &
420	ims, ime, jms, jme, kms, kme, &
421	ips, ipe, jps, jpe, kps, kpe, &
422	grid%i_start(ij), grid%i_end(ij), &
423	grid%j_start(ij), grid%j_end(ij), &
424	k_start , k_end )
425	CALL set_physical_bc3d( grid%z , 'w', config_flags, &
426	ids, ide, jds, jde, kds, kde, &
427	ims, ime, jms, jme, kms, kme, &
428	ips, ipe, jps, jpe, kps, kpe, &
429	grid%i_start(ij), grid%i_end(ij), &
430	grid%j_start(ij), grid%j_end(ij), &
431	k_start , k_end )
432	CALL set_physical_bc3d( grid%zx , 'w', config_flags, &
433	ids, ide, jds, jde, kds, kde, &
434	ims, ime, jms, jme, kms, kme, &
435	ips, ipe, jps, jpe, kps, kpe, &
436	grid%i_start(ij), grid%i_end(ij), &
437	grid%j_start(ij), grid%j_end(ij), &
438	k_start , k_end )
439	CALL set_physical_bc3d( grid%zy , 'w', config_flags, &
440	ids, ide, jds, jde, kds, kde, &
441	ims, ime, jms, jme, kms, kme, &
442	ips, ipe, jps, jpe, kps, kpe, &
443	grid%i_start(ij), grid%i_end(ij), &
444	grid%j_start(ij), grid%j_end(ij), &
445	k_start , k_end )
446	CALL set_physical_bc2d( grid%ustm, 't', config_flags, &
447	ids, ide, jds, jde, &
448	ims, ime, jms, jme, &
449	ips, ipe, jps, jpe, &
450	grid%i_start(ij), grid%i_end(ij), &
451	grid%j_start(ij), grid%j_end(ij) )
452
453	ENDDO
454	!$OMP END PARALLEL DO
455	BENCH_END(tke_diff_bc_tim)
456
457	BENCH_START(deform_div_tim)
458
459	!$OMP PARALLEL DO &
460	!$OMP PRIVATE ( ij )
461
462	DO ij = 1 , grid%num_tiles
463
464	CALL wrf_debug ( 200 , ' call cal_deform_and_div' )
465	CALL cal_deform_and_div ( config_flags,grid%u_2,grid%v_2,grid%w_2,grid%div, &
466	grid%defor11,grid%defor22,grid%defor33, &
467	grid%defor12,grid%defor13,grid%defor23, &
468	nba_rij, n_nba_rij, & !JDM
469	grid%u_base, grid%v_base,grid%msfux,grid%msfuy, &
470	grid%msfvx,grid%msfvy,grid%msftx,grid%msfty, &
471	grid%rdx, grid%rdy, grid%dn, grid%dnw, grid%rdz, &
472	grid%rdzw,grid%fnm,grid%fnp,grid%cf1,grid%cf2, &
473	grid%cf3,grid%zx,grid%zy, &
474	ids, ide, jds, jde, kds, kde, &
475	ims, ime, jms, jme, kms, kme, &
476	grid%i_start(ij), grid%i_end(ij), &
477	grid%j_start(ij), grid%j_end(ij), &
478	k_start , k_end )
479	ENDDO
480	!$OMP END PARALLEL DO
481	BENCH_END(deform_div_tim)
482
483	#ifdef DM_PARALLEL
484	# include "HALO_EM_TKE_D.inc"
485	#endif
486
487	! calculate tke, kmh, and kmv
488
489	BENCH_START(calc_tke_tim)
490	!$OMP PARALLEL DO &
491	!$OMP PRIVATE ( ij )
492	DO ij = 1 , grid%num_tiles
493
494	CALL wrf_debug ( 200 , ' call calculate_km_kh' )
495	CALL calculate_km_kh( config_flags,grid%dt,grid%dampcoef,grid%zdamp, &
496	config_flags%damp_opt, &
497	grid%xkmh,grid%xkmv,grid%xkhh,grid%xkhv,grid%bn2, &
498	grid%khdif,grid%kvdif,grid%div, &
499	grid%defor11,grid%defor22,grid%defor33,grid%defor12, &
500	grid%defor13,grid%defor23, &
501	grid%tke_2,p8w,t8w,th_phy, &
502	t_phy,p_phy,moist,grid%dn,grid%dnw, &
503	grid%dx,grid%dy,grid%rdz,grid%rdzw, &
504	config_flags%mix_isotropic,num_moist, &
505	grid%cf1, grid%cf2, grid%cf3, grid%warm_rain, &
506	grid%mix_upper_bound, &
507	grid%msftx, grid%msfty, &
508	ids,ide, jds,jde, kds,kde, &
509	ims,ime, jms,jme, kms,kme, &
510	grid%i_start(ij), grid%i_end(ij), &
511	grid%j_start(ij), grid%j_end(ij), &
512	k_start , k_end )
513	ENDDO
514	!$OMP END PARALLEL DO
515	BENCH_END(calc_tke_tim)
516	#ifdef LMDZ1
517	PRINT *,' Lluis checking variables k t u v p ph alt p8w inside in3_rk_step2 ________'
518	DO iz=kms,kme
519	PRINT *,'in3_rk_step2 ', iz, grid%t_2(im2,iz,jm2), grid%u_2(im2,iz,jm2), grid%v_2(im2,iz,jm2), &
520	grid%p(im2,iz,jm2), grid%ph_2(im2,iz,jm2), grid%alt(im2,iz,jm2), p8w(im2,iz,jm2)
521	END DO
522	#endif
523
524	#ifdef DM_PARALLEL
525	# include "HALO_EM_TKE_E.inc"
526	#endif
527
528	ENDIF
529
530	#ifdef DM_PARALLEL
531	# include "PERIOD_BDY_EM_PHY_BC.inc"
532	IF ( config_flags%grid_fdda .eq. 1) THEN
533	# include "PERIOD_BDY_EM_FDDA_BC.inc"
534	ENDIF
535	# include "PERIOD_BDY_EM_CHEM.inc"
536	#endif
537
538	BENCH_START(phy_bc_tim)
539	!$OMP PARALLEL DO &
540	!$OMP PRIVATE ( ij )
541
542	DO ij = 1 , grid%num_tiles
543
544	CALL wrf_debug ( 200 , ' call phy_bc' )
545	CALL phy_bc (config_flags,grid%div,grid%defor11,grid%defor22,grid%defor33, &
546	grid%defor12,grid%defor13,grid%defor23, &
547	grid%xkmh,grid%xkmv,grid%xkhh,grid%xkhv, &
548	grid%tke_2, &
549	grid%rublten, grid%rvblten, &
550	grid%rucuten, grid%rvcuten, &
551	grid%rushten, grid%rvshten, &
552	ids, ide, jds, jde, kds, kde, &
553	ims, ime, jms, jme, kms, kme, &
554	ips, ipe, jps, jpe, kps, kpe, &
555	grid%i_start(ij), grid%i_end(ij), &
556	grid%j_start(ij), grid%j_end(ij), &
557	k_start , k_end )
558	ENDDO
559	!$OMP END PARALLEL DO
560	BENCH_END(phy_bc_tim)
561
562	!JDM
563	IF ( ( config_flags%sfs_opt .GT. 0 ) .AND. ( config_flags%diff_opt .eq. 2 ) ) THEN
564
565	CALL sfs_driver( grid, config_flags, &
566	nba_mij, n_nba_mij, &
567	nba_rij, n_nba_rij )
568
569	ENDIF
570
571	#ifdef DM_PARALLEL
572	!-----------------------------------------------------------------------
573	!
574	! MPP for some physics tendency, km, kh, deformation, and divergence
575	!
576	! * * * * * * *
577	! * * * * * * * * * * * *
578	! * * * * * * * * * * * * * *
579	! * + * * + * + * * + * * * * * + * * *
580	! * * * * * * * * * * * * * *
581	! * * * * * * * * * * * *
582	! * * * * * * *
583	!
584	! (for PBL)
585	! rublten x
586	! rvblten x
587	!
588	! (for Cumulus)
589	! rucuten x
590	! rvcuten x
591	!
592	! (for Shallow Cumulus)
593	! rushten x
594	! rvshten x
595	!
596	! (for FDDA)
597	! rundgdten x
598	! rvndgdten x
599	!
600	! (for TKE3)
601	! tke_2 x
602	! (for TKE5)
603	! tke_2 x
604	!
605	! (for diff_opt >= 1)
606	! defor11 x
607	! defor22 x
608	! defor12 x
609	! defor13 x
610	! defor23 x
611	! div x
612	! xkmv x
613	! xkmh x
614	! xkhv x
615	! xkhh x
616	! tke x
617	!
618	!-----------------------------------------------------------------------
619	IF ( config_flags%bl_pbl_physics .ge. 1 ) THEN
620	# include "HALO_EM_PHYS_PBL.inc"
621	ENDIF
622	IF ( config_flags%shcu_physics .gt. 1 ) THEN
623	# include "HALO_EM_PHYS_SHCU.inc"
624	ENDIF
625	IF ( config_flags%cu_physics == SASSCHEME .or. &
626	config_flags%cu_physics == TIEDTKESCHEME .or. &
627	config_flags%cu_physics == CAMZMSCHEME .or. &
628	config_flags%cu_physics == NSASSCHEME ) THEN
629	# include "HALO_EM_PHYS_CU.inc"
630	ENDIF
631	IF ( config_flags%grid_fdda .ge. 1) THEN
632	# include "HALO_EM_FDDA.inc"
633	ENDIF
634	IF ( config_flags%diff_opt .ge. 1 ) THEN
635	# include "HALO_EM_PHYS_DIFFUSION.inc"
636	ENDIF
637
638	IF ( config_flags%h_mom_adv_order <= 4 ) THEN
639	# include "HALO_EM_TKE_3.inc"
640	ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
641	# include "HALO_EM_TKE_5.inc"
642	ELSE
643	WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
644	CALL wrf_error_fatal(TRIM(wrf_err_message))
645	ENDIF
646	#endif
647
648	BENCH_START(update_phy_ten_tim)
649	!$OMP PARALLEL DO &
650	!$OMP PRIVATE ( ij )
651
652	DO ij = 1 , grid%num_tiles
653
654	CALL wrf_debug ( 200 , ' call update_phy_ten' )
655	#if ( WRF_DFI_RADAR == 1 )
656	if (config_flags%cu_physics .gt. 0) then
657	i_start = grid%i_start(ij)
658	i_end = min( grid%i_end(ij),ide-1 )
659	j_start = grid%j_start(ij)
660	j_end = min( grid%j_end(ij),jde-1 )
661	if (config_flags%dfi_radar == 1 .and. grid%dfi_stage == DFI_FWD ) &
662	CALL wrf_debug ( 200 , ' Zero out cu_physics' )
663	DO j = j_start, j_end
664	DO k = k_start, min( k_end,kde-1 ) - 1
665	DO i = i_start, i_end
666	if (config_flags%dfi_radar == 1 .and. grid%dfi_stage ==DFI_FWD &
667	.and. grid%dfi_tten_rad(i,k,j) >= 1.0e-7 .and. &
668	grid%dfi_tten_rad(i,k,j) <= 10.) then
669	! zero out cu-param temp tendency
670	grid%rthcuten(i,k,j) = 0.0
671	endif
672	ENDDO
673	ENDDO
674	ENDDO
675	ENDIF
676	#endif
677	CALL update_phy_ten(ph_tendf,t_tendf, ru_tendf, rv_tendf,moist_tend ,&
678	scalar_tend, mu_tendf, &
679	grid%rthraten,grid%rthblten,grid%rthcuten,grid%rthshten, &
680	grid%rublten,grid%rucuten,grid%rushten, &
681	grid%rvblten,grid%rvcuten,grid%rvshten, &
682	grid%rqvblten,grid%rqcblten,grid%rqiblten, &
683	grid%rqvcuten,grid%rqccuten,grid%rqrcuten, &
684	grid%rqicuten,grid%rqscuten, &
685	grid%rqvshten,grid%rqcshten,grid%rqrshten, &
686	grid%rqishten,grid%rqsshten,grid%rqgshten, &
687	grid%RUNDGDTEN, &
688	grid%RVNDGDTEN,grid%RTHNDGDTEN,grid%RPHNDGDTEN, &
689	grid%RQVNDGDTEN,grid%RMUNDGDTEN, &
690	grid%rthfrten,grid%rqvfrten, & ! fire
691	num_moist,num_scalar,config_flags,rk_step, &
692	grid%adv_moist_cond, &
693	ids, ide, jds, jde, kds, kde, &
694	ims, ime, jms, jme, kms, kme, &
695	grid%i_start(ij), grid%i_end(ij), &
696	grid%j_start(ij), grid%j_end(ij), &
697	k_start, k_end )
698
699	END DO
700	!$OMP END PARALLEL DO
701	BENCH_END(update_phy_ten_tim)
702
703	#ifdef PLANET
704	! do rayleigh (and zonal-average newtonian) damping during
705	! first iteration of RK loop only
706
707	IF ( (config_flags%damp_opt == 101) .OR. &
708	(config_flags%damp_opt == 103) ) THEN
709	!$OMP PARALLEL DO &
710	!$OMP PRIVATE ( ij )
711	DO ij = 1 , grid%num_tiles
712	CALL damptop( grid%u_2, grid%v_2, grid%t_2, &
713	grid%mut, grid%muu, grid%muv, &
714	pi_phy, &
715	t_tendf, ru_tendf, rv_tendf, P2SI, &
716	ids, ide, jds, jde, kds, kde, &
717	ims, ime, jms, jme, kms, kme, &
718	grid%i_start(ij), grid%i_end(ij), &
719	grid%j_start(ij), grid%j_end(ij), &
720	k_start, k_end )
721	END DO
722	!$OMP END PARALLEL DO
723	END IF
724	#endif
725
726	IF( config_flags%diff_opt .eq. 2 .and. config_flags%km_opt .eq. 2 ) THEN
727
728	BENCH_START(tke_rhs_tim)
729	!$OMP PARALLEL DO &
730	!$OMP PRIVATE ( ij )
731	DO ij = 1 , grid%num_tiles
732
733	CALL tke_rhs ( tke_tend,grid%bn2, &
734	config_flags,grid%defor11,grid%defor22, &
735	grid%defor33, &
736	grid%defor12,grid%defor13,grid%defor23, &
737	grid%u_2,grid%v_2,grid%w_2,grid%div, &
738	grid%tke_2,grid%mut, &
739	th_phy,p_phy,p8w,t8w,grid%z,grid%fnm, &
740	grid%fnp,grid%cf1,grid%cf2,grid%cf3, &
741	grid%msftx,grid%msfty,grid%xkmh, &
742	grid%xkmv,grid%xkhv,grid%rdx,grid%rdy, &
743	grid%dx,grid%dy,grid%dt,grid%zx,grid%zy, &
744	grid%rdz,grid%rdzw,grid%dn, &
745	grid%dnw,config_flags%mix_isotropic, &
746	grid%hfx, grid%qfx, moist(ims,kms,jms,P_QV), &
747	grid%ustm, rho, &
748	ids, ide, jds, jde, kds, kde, &
749	ims, ime, jms, jme, kms, kme, &
750	grid%i_start(ij), grid%i_end(ij), &
751	grid%j_start(ij), grid%j_end(ij), &
752	k_start , k_end )
753
754	ENDDO
755	!$OMP END PARALLEL DO
756	BENCH_END(tke_rhs_tim)
757
758	ENDIF
759
760	! calculate vertical diffusion first and then horizontal
761	! (keep this order)
762
763	IF(config_flags%diff_opt .eq. 2) THEN
764
765	IF (config_flags%bl_pbl_physics .eq. 0) THEN
766
767	BENCH_START(vert_diff_tim)
768	!$OMP PARALLEL DO &
769	!$OMP PRIVATE ( ij )
770	DO ij = 1 , grid%num_tiles
771
772	CALL wrf_debug ( 200 , ' call vertical_diffusion_2 ' )
773	CALL vertical_diffusion_2( ru_tendf, rv_tendf, rw_tendf, &
774	t_tendf, tke_tend, &
775	moist_tend, num_moist, &
776	chem_tend, num_chem, &
777	scalar_tend, num_scalar, &
778	tracer_tend, num_tracer, &
779	grid%u_2, grid%v_2, &
780	grid%t_2,grid%u_base,grid%v_base,grid%t_base,grid%qv_base, &
781	grid%mut,grid%tke_2,config_flags, &
782	grid%defor13,grid%defor23,grid%defor33, &
783	nba_mij, num_nba_mij, & !JDM
784	grid%div, moist, chem, scalar,tracer, &
785	grid%xkmv, grid%xkhv, config_flags%km_opt, &
786	grid%fnm, grid%fnp, grid%dn, grid%dnw, grid%rdz, grid%rdzw, &
787	grid%hfx, grid%qfx, grid%ustm, rho, &
788	ids, ide, jds, jde, kds, kde, &
789	ims, ime, jms, jme, kms, kme, &
790	grid%i_start(ij), grid%i_end(ij), &
791	grid%j_start(ij), grid%j_end(ij), &
792	k_start, k_end )
793
794	ENDDO
795	!$OMP END PARALLEL DO
796	BENCH_END(vert_diff_tim)
797
798	ENDIF
799	!
800	BENCH_START(hor_diff_tim)
801	!$OMP PARALLEL DO &
802	!$OMP PRIVATE ( ij )
803	DO ij = 1 , grid%num_tiles
804
805	CALL wrf_debug ( 200 , ' call horizontal_diffusion_2' )
806	CALL horizontal_diffusion_2( t_tendf, ru_tendf, rv_tendf, rw_tendf, &
807	tke_tend, &
808	moist_tend, num_moist, &
809	chem_tend, num_chem, &
810	scalar_tend, num_scalar, &
811	tracer_tend, num_tracer, &
812	grid%t_2, th_phy, &
813	grid%mut, grid%tke_2, config_flags, &
814	grid%defor11, grid%defor22, grid%defor12, &
815	grid%defor13, grid%defor23, &
816	nba_mij, num_nba_mij, & !JDM
817	grid%div, &
818	moist, chem, scalar,tracer, &
819	grid%msfux,grid%msfuy, grid%msfvx,grid%msfvy, grid%msftx, &
820	grid%msfty, grid%xkmh, grid%xkhh, config_flags%km_opt, &
821	grid%rdx, grid%rdy, grid%rdz, grid%rdzw, &
822	grid%fnm, grid%fnp, grid%cf1, grid%cf2, grid%cf3, &
823	grid%zx, grid%zy, grid%dn, grid%dnw, &
824	ids, ide, jds, jde, kds, kde, &
825	ims, ime, jms, jme, kms, kme, &
826	grid%i_start(ij), grid%i_end(ij), &
827	grid%j_start(ij), grid%j_end(ij), &
828	k_start , k_end )
829	ENDDO
830	!$OMP END PARALLEL DO
831	BENCH_END(hor_diff_tim)
832	ENDIF
833
834	IF ( grid%obs_nudge_opt .EQ. 1 ) THEN
835	# ifdef DM_PARALLEL
836	# include "HALO_OBS_NUDGE.inc"
837	#endif
838	#ifdef LMDZ1
839	PRINT *,' Lluis checking variables k t u v p ph alt p8w inside in4_rk_step2 ________'
840	DO iz=kms,kme
841	PRINT *,'in4_rk_step2 ', iz, grid%t_2(im2,iz,jm2), grid%u_2(im2,iz,jm2), grid%v_2(im2,iz,jm2), &
842	grid%p(im2,iz,jm2), grid%ph_2(im2,iz,jm2), grid%alt(im2,iz,jm2), p8w(im2,iz,jm2)
843	END DO
844	#endif
845
846	!***********************************************************************
847	! This section for obs nudging
848	!$OMP PARALLEL DO &
849	!$OMP PRIVATE ( ij )
850
851	DO ij = 1 , grid%num_tiles
852
853	CALL fddaobs_driver (grid%grid_id, model_config_rec%grid_id, &
854	model_config_rec%parent_id, config_flags%restart, &
855	config_flags, &
856	grid%obs_nudge_opt, &
857	grid%obs_ipf_errob, &
858	grid%obs_ipf_nudob, &
859	grid%fdda_start, &
860	grid%fdda_end, &
861	grid%obs_nudge_wind, &
862	grid%obs_nudge_temp, &
863	grid%obs_nudge_mois, &
864	grid%obs_nudge_pstr, &
865	grid%obs_coef_wind, &
866	grid%obs_coef_temp, &
867	grid%obs_coef_mois, &
868	grid%obs_coef_pstr, &
869	grid%obs_rinxy, &
870	grid%obs_rinsig, &
871	grid%obs_npfi, &
872	grid%obs_ionf, &
873	grid%obs_prt_max, &
874	grid%obs_prt_freq, &
875	grid%obs_idynin, &
876	grid%obs_dtramp, &
877	grid%parent_grid_ratio, &
878	grid%max_dom, grid%itimestep, &
879	grid%xtime, &
880	grid%dt, grid%gmt, grid%julday, grid%fdob, &
881	grid%max_obs, &
882	model_config_rec%nobs_ndg_vars, &
883	model_config_rec%nobs_err_flds, &
884	grid%fdob%nstat, grid%fdob%varobs, grid%fdob%errf, &
885	grid%dx, grid%KPBL,grid%HT, &
886	grid%mut, grid%muu, grid%muv, &
887	grid%msftx, grid%msfty, grid%msfux, grid%msfuy, grid%msfvx, grid%msfvy, &
888	p_phy, t_tendf, t0, &
889	grid%u_2, grid%v_2, grid%t_2, &
890	moist(ims,kms,jms,P_QV), &
891	grid%pb, grid%p_top, grid%p, grid%phb, grid%ph_2, &
892	grid%uratx, grid%vratx, grid%tratx, &
893	ru_tendf, rv_tendf, &
894	moist_tend(ims,kms,jms,P_QV), grid%obs_savwt, &
895	grid%regime, grid%pblh, grid%z_at_w, grid%z, &
896	ids,ide, jds,jde, kds,kde, &
897	ims,ime, jms,jme, kms,kme, &
898	grid%i_start(ij), min(grid%i_end(ij),ide-1), &
899	grid%j_start(ij), min(grid%j_end(ij),jde-1), &
900	k_start , min(k_end,kde-1) )
901
902	ENDDO
903	!$OMP END PARALLEL DO
904	ENDIF ! obs_nudge_opt .eq. 1
905	!
906	!***********************************************************************
907
908	END SUBROUTINE first_rk_step_part2
909
910	END MODULE module_first_rk_step_part2
911

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format