Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_first_rk_step_part2.F @ 3552

Last change on this file since 3552 was 2761, checked in by aslmd, 3 years ago
Applied planetary adaptation changes to WRFV3. job done previously by LMD_LES_MARS_install. Moved Registry.EM.newphys to put it simply in Registry.EM
File size: 30.7 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	, scalar , scalar_tend &
14	, fdda3d, fdda2d &
15	, ru_tendf, rv_tendf &
16	, rw_tendf, t_tendf &
17	, ph_tendf, mu_tendf &
18	, tke_tend &
19	, adapt_step_flag , curr_secs &
20	, psim , psih , wspd , gz1oz0 , br , chklowq &
21	, cu_act_flag , hol , th_phy &
22	, pi_phy , p_phy , t_phy , u_phy , v_phy &
23	, dz8w , p8w , t8w , rho_phy , rho &
24	, z_at_w , mu_3d &
25	, ids, ide, jds, jde, kds, kde &
26	, ims, ime, jms, jme, kms, kme &
27	, ips, ipe, jps, jpe, kps, kpe &
28	, k_start , k_end &
29	)
30	USE module_state_description
31	USE module_model_constants
32	USE module_domain, ONLY : domain
33	USE module_configure, ONLY : grid_config_rec_type, model_config_rec
34	USE module_dm
35	USE module_diffusion_em, ONLY : phy_bc, cal_deform_and_div, compute_diff_metrics, &
36	vertical_diffusion_2, horizontal_diffusion_2, calculate_km_kh, &
37	tke_rhs
38	USE module_em, ONLY : calculate_phy_tend
39	!!!!****MARS MARS
40	! USE module_fddaobs_driver, ONLY : fddaobs_driver
41	USE module_bc, ONLY : set_physical_bc3d, set_physical_bc2d
42	USE module_physics_addtendc, ONLY : update_phy_ten
43
44	IMPLICIT NONE
45
46	TYPE ( domain ), INTENT(INOUT) :: grid
47	TYPE ( grid_config_rec_type ), INTENT(IN) :: config_flags
48
49	INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
50	ims, ime, jms, jme, kms, kme, &
51	ips, ipe, jps, jpe, kps, kpe
52
53	LOGICAL ,INTENT(IN) :: adapt_step_flag
54	REAL, INTENT(IN) :: curr_secs
55
56	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: moist
57	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: moist_tend
58	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: chem
59	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: chem_tend
60	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: scalar
61	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: scalar_tend
62	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_fdda3d),INTENT(INOUT) :: fdda3d
63	REAL ,DIMENSION(ims:ime,1:1,jms:jme,num_fdda2d),INTENT(INOUT) :: fdda2d
64	REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: psim
65	REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: psih
66	REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: wspd
67	REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: gz1oz0
68	REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: br
69	REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: chklowq
70	LOGICAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: cu_act_flag
71	REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: hol
72
73	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: th_phy
74	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: pi_phy
75	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: p_phy
76	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t_phy
77	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: u_phy
78	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: v_phy
79	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: dz8w
80	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: p8w
81	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t8w
82	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rho_phy
83	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rho
84	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: z_at_w
85	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: mu_3d
86
87	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: ru_tendf
88	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rv_tendf
89	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rw_tendf
90	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: ph_tendf
91	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t_tendf
92	REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: tke_tend
93
94	REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: mu_tendf
95
96	INTEGER , INTENT(IN) :: k_start, k_end
97
98	! Local
99
100	REAL, DIMENSION( ims:ime, jms:jme ) :: ht_loc
101	INTEGER, DIMENSION( ims:ime, jms:jme ) :: shadowmask
102	INTEGER :: ij
103	INTEGER num_roof_layers
104	INTEGER num_wall_layers
105	INTEGER num_road_layers
106	INTEGER iswater
107	INTEGER rk_step
108
109	! initialize all tendencies to zero in order to update physics
110	! tendencies first (separate from dry dynamics).
111
112	rk_step = 1
113
114	! calculate_phy_tend
115
116	BENCH_START(cal_phy_tend)
117	!$OMP PARALLEL DO &
118	!$OMP PRIVATE ( ij )
119
120	DO ij = 1 , grid%num_tiles
121
122	CALL wrf_debug ( 200 , ' call calculate_phy_tend' )
123	CALL calculate_phy_tend (config_flags,grid%mut,grid%muu,grid%muv,pi_phy, &
124	grid%rthraten, &
125	grid%rublten,grid%rvblten,grid%rthblten, &
126	grid%rqvblten,grid%rqcblten,grid%rqiblten, &
127	grid%rthcuten,grid%rqvcuten,grid%rqccuten,grid%rqrcuten, &
128	grid%rqicuten,grid%rqscuten, &
129	grid%RUNDGDTEN,grid%RVNDGDTEN,grid%RTHNDGDTEN,grid%RQVNDGDTEN, &
130	grid%RMUNDGDTEN, &
131	ids,ide, jds,jde, kds,kde, &
132	ims,ime, jms,jme, kms,kme, &
133	grid%i_start(ij), min(grid%i_end(ij),ide-1), &
134	grid%j_start(ij), min(grid%j_end(ij),jde-1), &
135	k_start , min(k_end,kde-1) )
136
137	ENDDO
138	!$OMP END PARALLEL DO
139	BENCH_END(cal_phy_tend)
140
141	! tke diffusion
142
143	IF(config_flags%diff_opt .eq. 2 .OR. config_flags%diff_opt .eq. 1) THEN
144
145	BENCH_START(comp_diff_metrics_tim)
146	!$OMP PARALLEL DO &
147	!$OMP PRIVATE ( ij )
148	DO ij = 1 , grid%num_tiles
149	CALL wrf_debug ( 200 , ' call compute_diff_metrics ' )
150	CALL compute_diff_metrics ( config_flags, grid%ph_2, grid%phb, grid%z, grid%rdz, grid%rdzw, &
151	grid%zx, grid%zy, grid%rdx, grid%rdy, &
152	ids, ide, jds, jde, kds, kde, &
153	ims, ime, jms, jme, kms, kme, &
154	grid%i_start(ij), grid%i_end(ij), &
155	grid%j_start(ij), grid%j_end(ij), &
156	k_start , k_end )
157	ENDDO
158	!$OMP END PARALLEL DO
159	BENCH_END(comp_diff_metrics_tim)
160
161	#ifdef DM_PARALLEL
162	# include "HALO_EM_TKE_C.inc"
163	# include "PERIOD_BDY_EM_A1.inc"
164	#endif
165
166	BENCH_START(tke_diff_bc_tim)
167	!$OMP PARALLEL DO &
168	!$OMP PRIVATE ( ij )
169
170	DO ij = 1 , grid%num_tiles
171
172	CALL wrf_debug ( 200 , ' call bc for diffusion_metrics ' )
173	CALL set_physical_bc3d( grid%rdzw , 'w', config_flags, &
174	ids, ide, jds, jde, kds, kde, &
175	ims, ime, jms, jme, kms, kme, &
176	ips, ipe, jps, jpe, kps, kpe, &
177	grid%i_start(ij), grid%i_end(ij), &
178	grid%j_start(ij), grid%j_end(ij), &
179	k_start , k_end )
180	CALL set_physical_bc3d( grid%rdz , 'w', config_flags, &
181	ids, ide, jds, jde, kds, kde, &
182	ims, ime, jms, jme, kms, kme, &
183	ips, ipe, jps, jpe, kps, kpe, &
184	grid%i_start(ij), grid%i_end(ij), &
185	grid%j_start(ij), grid%j_end(ij), &
186	k_start , k_end )
187	CALL set_physical_bc3d( grid%z , 'w', config_flags, &
188	ids, ide, jds, jde, kds, kde, &
189	ims, ime, jms, jme, kms, kme, &
190	ips, ipe, jps, jpe, kps, kpe, &
191	grid%i_start(ij), grid%i_end(ij), &
192	grid%j_start(ij), grid%j_end(ij), &
193	k_start , k_end )
194	CALL set_physical_bc3d( grid%zx , 'w', config_flags, &
195	ids, ide, jds, jde, kds, kde, &
196	ims, ime, jms, jme, kms, kme, &
197	ips, ipe, jps, jpe, kps, kpe, &
198	grid%i_start(ij), grid%i_end(ij), &
199	grid%j_start(ij), grid%j_end(ij), &
200	k_start , k_end )
201	CALL set_physical_bc3d( grid%zy , 'w', config_flags, &
202	ids, ide, jds, jde, kds, kde, &
203	ims, ime, jms, jme, kms, kme, &
204	ips, ipe, jps, jpe, kps, kpe, &
205	grid%i_start(ij), grid%i_end(ij), &
206	grid%j_start(ij), grid%j_end(ij), &
207	k_start , k_end )
208	CALL set_physical_bc2d( grid%ustm, 't', config_flags, &
209	ids, ide, jds, jde, &
210	ims, ime, jms, jme, &
211	ips, ipe, jps, jpe, &
212	grid%i_start(ij), grid%i_end(ij), &
213	grid%j_start(ij), grid%j_end(ij) )
214
215	ENDDO
216	!$OMP END PARALLEL DO
217	BENCH_END(tke_diff_bc_tim)
218
219	BENCH_START(deform_div_tim)
220
221	!$OMP PARALLEL DO &
222	!$OMP PRIVATE ( ij )
223
224	DO ij = 1 , grid%num_tiles
225
226	CALL wrf_debug ( 200 , ' call cal_deform_and_div' )
227	CALL cal_deform_and_div ( config_flags,grid%u_2,grid%v_2,grid%w_2,grid%div, &
228	grid%defor11,grid%defor22,grid%defor33, &
229	grid%defor12,grid%defor13,grid%defor23, &
230	grid%u_base, grid%v_base,grid%msfux,grid%msfuy, &
231	grid%msfvx,grid%msfvy,grid%msftx,grid%msfty, &
232	grid%rdx, grid%rdy, grid%dn, grid%dnw, grid%rdz, &
233	grid%rdzw,grid%fnm,grid%fnp,grid%cf1,grid%cf2, &
234	grid%cf3,grid%zx,grid%zy, &
235	ids, ide, jds, jde, kds, kde, &
236	ims, ime, jms, jme, kms, kme, &
237	grid%i_start(ij), grid%i_end(ij), &
238	grid%j_start(ij), grid%j_end(ij), &
239	k_start , k_end )
240	ENDDO
241	!$OMP END PARALLEL DO
242	BENCH_END(deform_div_tim)
243
244	#ifdef DM_PARALLEL
245	# include "HALO_EM_TKE_D.inc"
246	#endif
247
248	! calculate tke, kmh, and kmv
249
250	BENCH_START(calc_tke_tim)
251	!$OMP PARALLEL DO &
252	!$OMP PRIVATE ( ij )
253	DO ij = 1 , grid%num_tiles
254
255	CALL wrf_debug ( 200 , ' call calculate_km_kh' )
256	CALL calculate_km_kh( config_flags,grid%dt,grid%dampcoef,grid%zdamp, &
257	config_flags%damp_opt, &
258	grid%xkmh,grid%xkmv,grid%xkhh,grid%xkhv,grid%bn2, &
259	grid%khdif,grid%kvdif,grid%div, &
260	grid%defor11,grid%defor22,grid%defor33,grid%defor12, &
261	grid%defor13,grid%defor23, &
262	grid%tke_2,p8w,t8w,th_phy, &
263	t_phy,p_phy,moist,grid%dn,grid%dnw, &
264	grid%dx,grid%dy,grid%rdz,grid%rdzw, &
265	config_flags%mix_isotropic,num_moist, &
266	grid%cf1, grid%cf2, grid%cf3, grid%warm_rain, &
267	grid%mix_upper_bound, &
268	grid%msftx, grid%msfty, &
269	ids,ide, jds,jde, kds,kde, &
270	ims,ime, jms,jme, kms,kme, &
271	grid%i_start(ij), grid%i_end(ij), &
272	grid%j_start(ij), grid%j_end(ij), &
273	k_start , k_end )
274	ENDDO
275	!$OMP END PARALLEL DO
276	BENCH_END(calc_tke_tim)
277
278	#ifdef DM_PARALLEL
279	# include "HALO_EM_TKE_E.inc"
280	#endif
281
282	ENDIF
283
284	#ifdef DM_PARALLEL
285	# include "PERIOD_BDY_EM_PHY_BC.inc"
286	IF ( config_flags%grid_fdda .eq. 1) THEN
287	# include "PERIOD_BDY_EM_FDDA_BC.inc"
288	ENDIF
289	# include "PERIOD_BDY_EM_CHEM.inc"
290	#endif
291
292	BENCH_START(phy_bc_tim)
293	!$OMP PARALLEL DO &
294	!$OMP PRIVATE ( ij )
295
296	DO ij = 1 , grid%num_tiles
297
298	CALL wrf_debug ( 200 , ' call phy_bc' )
299	CALL phy_bc (config_flags,grid%div,grid%defor11,grid%defor22,grid%defor33, &
300	grid%defor12,grid%defor13,grid%defor23, &
301	grid%xkmh,grid%xkmv,grid%xkhh,grid%xkhv, &
302	grid%tke_2, &
303	grid%rublten, grid%rvblten, &
304	ids, ide, jds, jde, kds, kde, &
305	ims, ime, jms, jme, kms, kme, &
306	ips, ipe, jps, jpe, kps, kpe, &
307	grid%i_start(ij), grid%i_end(ij), &
308	grid%j_start(ij), grid%j_end(ij), &
309	k_start , k_end )
310	ENDDO
311	!$OMP END PARALLEL DO
312	BENCH_END(phy_bc_tim)
313
314	#ifdef DM_PARALLEL
315	!-----------------------------------------------------------------------
316	!
317	! MPP for some physics tendency, km, kh, deformation, and divergence
318	!
319	! * * * * * * *
320	! * * * * * * * * * * * *
321	! * * * * * * * * * * * * * *
322	! * + * * + * + * * + * * * * * + * * *
323	! * * * * * * * * * * * * * *
324	! * * * * * * * * * * * *
325	! * * * * * * *
326	!
327	! (for PBL)
328	! rublten x
329	! rvblten x
330	!
331	! (for FDDA)
332	! rundgdten x
333	! rvndgdten x
334	!
335	! (for TKE3)
336	! tke_2 x
337	! (for TKE5)
338	! tke_2 x
339	!
340	! (for diff_opt >= 1)
341	! defor11 x
342	! defor22 x
343	! defor12 x
344	! defor13 x
345	! defor23 x
346	! div x
347	! xkmv x
348	! xkmh x
349	! xkhv x
350	! xkhh x
351	! tke x
352	!
353	!-----------------------------------------------------------------------
354
355	!!****MARS: always include this HALO for Mars version ...
356	IF ( ( config_flags%bl_pbl_physics .ge. 1 ) &
357	.OR. ( config_flags%modif_wrf ) ) THEN
358	! IF ( config_flags%bl_pbl_physics .ge. 1 ) THEN
359	# include "HALO_EM_PHYS_PBL.inc"
360	ENDIF
361	IF ( config_flags%grid_fdda .eq. 1) THEN
362	# include "HALO_EM_FDDA.inc"
363	ENDIF
364	IF ( config_flags%diff_opt .ge. 1 ) THEN
365	# include "HALO_EM_PHYS_DIFFUSION.inc"
366	ENDIF
367
368	IF ( config_flags%h_mom_adv_order <= 4 ) THEN
369	# include "HALO_EM_TKE_3.inc"
370	ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
371	# include "HALO_EM_TKE_5.inc"
372	ELSE
373	WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
374	CALL wrf_error_fatal(TRIM(wrf_err_message))
375	ENDIF
376	#endif
377
378	BENCH_START(update_phy_ten_tim)
379	!$OMP PARALLEL DO &
380	!$OMP PRIVATE ( ij )
381
382	DO ij = 1 , grid%num_tiles
383
384	CALL wrf_debug ( 200 , ' call update_phy_ten' )
385	CALL update_phy_ten(t_tendf, ru_tendf, rv_tendf,moist_tend, &
386	scalar_tend, mu_tendf, &
387	grid%rthraten,grid%rthblten,grid%rthcuten, &
388	grid%rublten,grid%rvblten, &
389	grid%rqvblten,grid%rqcblten,grid%rqiblten, &
390	grid%rqvcuten,grid%rqccuten,grid%rqrcuten, &
391	grid%rqicuten,grid%rqscuten,grid%RUNDGDTEN, &
392	grid%RVNDGDTEN,grid%RTHNDGDTEN,grid%RQVNDGDTEN, &
393	grid%RMUNDGDTEN, &
394	num_moist,num_scalar,config_flags,rk_step, &
395	grid%adv_moist_cond, &
396	ids, ide, jds, jde, kds, kde, &
397	ims, ime, jms, jme, kms, kme, &
398	grid%i_start(ij), grid%i_end(ij), &
399	grid%j_start(ij), grid%j_end(ij), &
400	k_start, k_end )
401
402	END DO
403	!$OMP END PARALLEL DO
404	BENCH_END(update_phy_ten_tim)
405
406	#ifdef PLANET
407	! do rayleigh (and zonal-average newtonian) damping during
408	! first iteration of RK loop only
409
410	IF ( (config_flags%damp_opt == 101) .OR. &
411	(config_flags%damp_opt == 103) ) THEN
412	!$OMP PARALLEL DO &
413	!$OMP PRIVATE ( ij )
414	DO ij = 1 , grid%num_tiles
415	CALL damptop( grid%u_2, grid%v_2, grid%t_2, &
416	grid%mut, grid%muu, grid%muv, &
417	pi_phy, &
418	t_tendf, ru_tendf, rv_tendf, P2SI, &
419	ids, ide, jds, jde, kds, kde, &
420	ims, ime, jms, jme, kms, kme, &
421	grid%i_start(ij), grid%i_end(ij), &
422	grid%j_start(ij), grid%j_end(ij), &
423	k_start, k_end )
424	END DO
425	!$OMP END PARALLEL DO
426	END IF
427	#endif
428
429	IF( config_flags%diff_opt .eq. 2 .and. config_flags%km_opt .eq. 2 ) THEN
430
431	BENCH_START(tke_rhs_tim)
432	!$OMP PARALLEL DO &
433	!$OMP PRIVATE ( ij )
434	DO ij = 1 , grid%num_tiles
435
436	CALL tke_rhs ( tke_tend,grid%bn2, &
437	config_flags,grid%defor11,grid%defor22, &
438	grid%defor33, &
439	grid%defor12,grid%defor13,grid%defor23, &
440	grid%u_2,grid%v_2,grid%w_2,grid%div, &
441	grid%tke_2,grid%mut, &
442	th_phy,p_phy,p8w,t8w,grid%z,grid%fnm, &
443	grid%fnp,grid%cf1,grid%cf2,grid%cf3, &
444	grid%msftx,grid%msfty,grid%xkmh, &
445	grid%xkmv,grid%xkhv,grid%rdx,grid%rdy, &
446	grid%dx,grid%dy,grid%dt,grid%zx,grid%zy, &
447	grid%rdz,grid%rdzw,grid%dn, &
448	grid%dnw,config_flags%mix_isotropic, &
449	grid%hfx, grid%qfx, moist(ims,kms,jms,P_QV), &
450	grid%ustm, rho, &
451	ids, ide, jds, jde, kds, kde, &
452	ims, ime, jms, jme, kms, kme, &
453	grid%i_start(ij), grid%i_end(ij), &
454	grid%j_start(ij), grid%j_end(ij), &
455	k_start , k_end )
456
457	ENDDO
458	!$OMP END PARALLEL DO
459	BENCH_END(tke_rhs_tim)
460
461	ENDIF
462
463	! calculate vertical diffusion first and then horizontal
464	! (keep this order)
465
466	IF(config_flags%diff_opt .eq. 2) THEN
467
468	!!!!****MARS: vertical diffusion is done by the physics
469	!!!!****MARS: a part si isfflx=1 (SGS completement fait par WRF)
470	!!!!****MARS: ou si TKE_heat precisee dans la namelist
471	! IF ( (config_flags%bl_pbl_physics .eq. 0) &
472	! .AND. (.not. config_flags%modif_wrf ) ) THEN
473	!! IF (config_flags%bl_pbl_physics .eq. 0) THEN
474	!!
475	!!
476	IF ( ( config_flags%bl_pbl_physics .eq. 0 ) &
477	.AND. ( ( config_flags%isfflx .ge. 1 ) &
478	.OR. ( config_flags%tke_heat_flux .ne. 0.) ) ) THEN
479	!!
480	!!
481	BENCH_START(vert_diff_tim)
482	!$OMP PARALLEL DO &
483	!$OMP PRIVATE ( ij )
484	DO ij = 1 , grid%num_tiles
485
486	CALL wrf_debug ( 200 , ' call vertical_diffusion_2 ' )
487	CALL vertical_diffusion_2( ru_tendf, rv_tendf, rw_tendf, &
488	t_tendf, tke_tend, &
489	moist_tend, num_moist, &
490	chem_tend, num_chem, &
491	scalar_tend, num_scalar, &
492	grid%u_2, grid%v_2, &
493	grid%t_2,grid%u_base,grid%v_base,grid%t_base,grid%qv_base, &
494	grid%mut,grid%tke_2,config_flags, &
495	grid%defor13,grid%defor23,grid%defor33, &
496	grid%div, moist, chem, scalar, &
497	grid%xkmv, grid%xkhv, config_flags%km_opt, &
498	grid%fnm, grid%fnp, grid%dn, grid%dnw, grid%rdz, grid%rdzw, &
499	grid%hfx, grid%qfx, grid%ustm, rho, &
500	ids, ide, jds, jde, kds, kde, &
501	ims, ime, jms, jme, kms, kme, &
502	grid%i_start(ij), grid%i_end(ij), &
503	grid%j_start(ij), grid%j_end(ij), &
504	k_start, k_end )
505
506	ENDDO
507	!$OMP END PARALLEL DO
508	BENCH_END(vert_diff_tim)
509
510	ENDIF
511	!
512	BENCH_START(hor_diff_tim)
513	!$OMP PARALLEL DO &
514	!$OMP PRIVATE ( ij )
515	DO ij = 1 , grid%num_tiles
516
517	CALL wrf_debug ( 200 , ' call horizontal_diffusion_2' )
518	CALL horizontal_diffusion_2( t_tendf, ru_tendf, rv_tendf, rw_tendf, &
519	tke_tend, &
520	moist_tend, num_moist, &
521	chem_tend, num_chem, &
522	scalar_tend, num_scalar, &
523	grid%t_2, th_phy, &
524	grid%mut, grid%tke_2, config_flags, &
525	grid%defor11, grid%defor22, grid%defor12, &
526	grid%defor13, grid%defor23, grid%div, &
527	moist, chem, scalar, &
528	grid%msfux,grid%msfuy, grid%msfvx,grid%msfvy, grid%msftx, &
529	grid%msfty, grid%xkmh, grid%xkhh, config_flags%km_opt, &
530	grid%rdx, grid%rdy, grid%rdz, grid%rdzw, &
531	grid%fnm, grid%fnp, grid%cf1, grid%cf2, grid%cf3, &
532	grid%zx, grid%zy, grid%dn, grid%dnw, &
533	ids, ide, jds, jde, kds, kde, &
534	ims, ime, jms, jme, kms, kme, &
535	grid%i_start(ij), grid%i_end(ij), &
536	grid%j_start(ij), grid%j_end(ij), &
537	k_start , k_end )
538	ENDDO
539	!$OMP END PARALLEL DO
540	BENCH_END(hor_diff_tim)
541	ENDIF
542
543	!!!!****MARS MARS
544	!!!!****MARS MARS
545
546	! IF ( grid%obs_nudge_opt .EQ. 1 ) THEN
547	!# ifdef DM_PARALLEL
548	!# include "HALO_OBS_NUDGE.inc"
549	!#endif
550	!!***********************************************************************
551	!! This section for obs nudging
552	! !$OMP PARALLEL DO &
553	! !$OMP PRIVATE ( ij )
554	!
555	! DO ij = 1 , grid%num_tiles
556	!
557	! CALL fddaobs_driver (grid%grid_id, model_config_rec%grid_id, &
558	! model_config_rec%parent_id, config_flags%restart, &
559	! grid%obs_nudge_opt, &
560	! grid%obs_ipf_errob, &
561	! grid%obs_ipf_nudob, &
562	! grid%fdda_start, &
563	! grid%fdda_end, &
564	! grid%obs_nudge_wind, &
565	! grid%obs_nudge_temp, &
566	! grid%obs_nudge_mois, &
567	! grid%obs_nudge_pstr, &
568	! grid%obs_coef_wind, &
569	! grid%obs_coef_temp, &
570	! grid%obs_coef_mois, &
571	! grid%obs_coef_pstr, &
572	! grid%obs_rinxy, &
573	! grid%obs_rinsig, &
574	! grid%obs_npfi, &
575	! grid%obs_ionf, &
576	! grid%obs_nobs_prt, &
577	! grid%obs_idynin, &
578	! grid%obs_dtramp, &
579	! model_config_rec%cen_lat(1), &
580	! model_config_rec%cen_lon(1), &
581	! config_flags%truelat1, &
582	! config_flags%truelat2, &
583	! config_flags%map_proj, &
584	! model_config_rec%i_parent_start, &
585	! model_config_rec%j_parent_start, &
586	! grid%parent_grid_ratio, &
587	! grid%max_dom, grid%itimestep, &
588	! grid%dt, grid%gmt, grid%julday, grid%fdob, &
589	! grid%max_obs, &
590	! model_config_rec%nobs_ndg_vars, &
591	! model_config_rec%nobs_err_flds, &
592	! grid%fdob%nstat, grid%fdob%varobs, grid%fdob%errf, &
593	! grid%dx, grid%KPBL,grid%HT, &
594	! grid%mut, grid%muu, grid%muv, &
595	! grid%msftx, grid%msfty, grid%msfux, grid%msfuy, grid%msfvx, grid%msfvy, &
596	! p_phy, t_tendf, t0, &
597	! grid%u_2, grid%v_2, grid%t_2, &
598	! moist(ims,kms,jms,P_QV), &
599	! grid%pb, grid%p_top, grid%p, &
600	! grid%uratx, grid%vratx, grid%tratx, &
601	! ru_tendf, rv_tendf, &
602	! moist_tend(ims,kms,jms,P_QV), grid%obs_savwt, &
603	! ids,ide, jds,jde, kds,kde, &
604	! ims,ime, jms,jme, kms,kme, &
605	! grid%i_start(ij), min(grid%i_end(ij),ide-1), &
606	! grid%j_start(ij), min(grid%j_end(ij),jde-1), &
607	! k_start , min(k_end,kde-1) )
608	!
609	! ENDDO
610	! !$OMP END PARALLEL DO
611	! ENDIF ! obs_nudge_opt .eq. 1
612	!!
613	!!***********************************************************************
614
615	END SUBROUTINE first_rk_step_part2
616
617	END MODULE module_first_rk_step_part2
618

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

Download in other formats:

Original Format