Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_sfs_driver.F @ 2718

Last change on this file since 2718 was 1, checked in by lfita, 10 years ago

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

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 19.1 KB

Line
1	!WRF:MEDIATION_LAYER:PHYSICS
2
3	!==============================================================================
4	!
5	! © 2009. Lawrence Livermore National Security, LLC. All rights reserved.
6	! This work was produced at the Lawrence Livermore National Laboratory (LLNL) under
7	! contract no. DE-AC52-07NA27344 (Contract 44) between the U.S. Department of Energy (DOE)
8	! and Lawrence Livermore National Security, LLC (LLNS) for the operation of LLNL. Copyright
9	! is reserved to Lawrence Livermore National Security, LLC for purposes of controlled
10	! dissemination, commercialization through formal licensing, or other disposition under
11	! terms of Contract 44; DOE policies, regulations and orders; and U.S. statutes. The rights
12	! of the Federal Government are reserved under Contract 44.
13	!
14	! DISCLAIMER
15	! This work was prepared as an account of work sponsored by an agency of the United States
16	! Government. Neither the United States Government nor Lawrence Livermore National
17	! Security, LLC nor any of their employees, makes any warranty, express or implied, or
18	! assumes any liability or responsibility for the accuracy, completeness, or usefulness of
19	! any information, apparatus, product, or process disclosed, or represents that its use
20	! would not infringe privately-owned rights. Reference herein to any specific commercial
21	! products, process, or service by trade name, trademark, manufacturer or otherwise does
22	! not necessarily constitute or imply its endorsement, recommendation, or favoring by the
23	! United States Government or Lawrence Livermore National Security, LLC. The views and
24	! opinions of authors expressed herein do not necessarily state or reflect those of the
25	! United States Government or Lawrence Livermore National Security, LLC, and shall not be
26	! used for advertising or product endorsement purposes.
27	!
28	! LICENSING REQUIREMENTS
29	! Any use, reproduction, modification, or distribution of this software or documentation
30	! for commercial purposes requires a license from Lawrence Livermore National Security,
31	! LLC. Contact: Lawrence Livermore National Laboratory, Industrial Partnerships Office,
32	! P.O. Box 808, L-795, Livermore, CA 94551
33	!
34	!=============================================================================
35	!
36	! Modification History:
37	!
38	! Implemented 12/2009 by Jeff Mirocha, jmirocha@llnl.gov
39	!
40	!=============================================================================
41
42	MODULE module_sfs_driver
43
44	CONTAINS
45
46	!=============================================================================
47
48	SUBROUTINE sfs_driver( grid, config_flags, &
49	nba_mij, n_nba_mij, &
50	nba_rij, n_nba_rij )
51
52	!-----------------------------------------------------------------------------
53	!
54	! PURPOSE: Calls turbulence subfilter stress model subroutines and handles
55	! all MPI and OMP operations
56	!
57	!-----------------------------------------------------------------------------
58
59
60	! Driver layer modules
61	USE module_domain
62	USE module_configure
63	USE module_tiles
64	USE module_machine
65	USE module_state_description
66	! Model layer modules
67	USE module_bc
68
69	!! *** add new modules of schemes here
70
71	USE module_sfs_nba
72	#ifdef DM_PARALLEL
73	USE module_dm
74	USE module_comm_dm, ONLY : &
75	HALO_EM_NBA_RIJ_sub &
76	,PERIOD_EM_NBA_RIJ_sub &
77	,HALO_EM_NBA_MIJ_sub &
78	,PERIOD_EM_NBA_MIJ_sub
79	#endif
80
81	IMPLICIT NONE
82
83	! Input data.
84
85	TYPE(domain) , TARGET :: grid
86
87	TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
88
89	INTEGER, INTENT( IN ) :: n_nba_mij, n_nba_rij
90
91	REAL ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,n_nba_mij) &
92	:: nba_mij
93
94	REAL ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,n_nba_rij) &
95	:: nba_rij
96
97	! Local data
98
99	INTEGER :: k_start , k_end, its, ite, jts, jte
100	INTEGER :: ids , ide , jds , jde , kds , kde , &
101	ims , ime , jms , jme , kms , kme , &
102	ips , ipe , jps , jpe , kps , kpe
103
104	INTEGER :: imsx, imex, jmsx, jmex, kmsx, kmex, &
105	ipsx, ipex, jpsx, jpex, kpsx, kpex, &
106	imsy, imey, jmsy, jmey, kmsy, kmey, &
107	ipsy, ipey, jpsy, jpey, kpsy, kpey
108
109	INTEGER :: ij, i, j, k
110
111	CALL get_ijk_from_grid ( grid , &
112	ids, ide, jds, jde, kds, kde, &
113	ims, ime, jms, jme, kms, kme, &
114	ips, ipe, jps, jpe, kps, kpe, &
115	imsx, imex, jmsx, jmex, kmsx, kmex, &
116	ipsx, ipex, jpsx, jpex, kpsx, kpex, &
117	imsy, imey, jmsy, jmey, kmsy, kmey, &
118	ipsy, ipey, jpsy, jpey, kpsy, kpey )
119
120	k_start = kps
121	k_end = kpe
122
123	! Compute these starting and stopping locations for each tile and number of tiles.
124	! See: http://www.mmm.ucar.edu/wrf/WG2/topics/settiles
125
126	CALL set_tiles ( grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
127
128	IF ( (config_flags%sfs_opt .EQ. 1) .OR. (config_flags%sfs_opt .EQ. 2) ) THEN
129
130	!=======================================================================
131	!
132	! BEGIN NBA
133	!
134	!=======================================================================
135
136	! IF ( grid%itimestep .EQ. 1 ) THEN
137	!
138	! IF ( (config_flags%sfs_opt .EQ. 2) .AND. (config_flags%km_opt .NE. 2)) THEN
139	!
140	! CALL wrf_error_fatal( 'Must use km_opt=2 with sfs_opt=2' )
141	!
142	! ENDIF
143	!
144	! ENDIF
145
146	!_______________________________________________________________________
147	!
148	! Compute NBA model constants
149	!_______________________________________________________________________
150
151
152	!$OMP PARALLEL DO &
153	!$OMP PRIVATE ( ij )
154	DO ij = 1 , grid%num_tiles !----------------------------------------
155
156	CALL calc_mij_constants( )
157
158	ENDDO !-------------------------------------------------------------
159	!$OMP END PARALLEL DO
160
161	!_______________________________________________________________________
162	!
163	! Compute Smn*Smn
164	!_______________________________________________________________________
165
166	!$OMP PARALLEL DO &
167	!$OMP PRIVATE ( ij )
168	DO ij = 1 , grid%num_tiles !----------------------------------------
169
170	CALL calc_smnsmn( nba_rij(ims,kms,jms,P_smnsmn), &
171	grid%defor11, grid%defor22, &
172	grid%defor33, grid%defor12, &
173	grid%defor13, grid%defor23, &
174	config_flags, &
175	ids, ide, jds, jde, kds, kde, &
176	ims, ime, jms, jme, kms, kme, &
177	ips, ipe, jps, jpe, kps, kpe, &
178	grid%i_start(ij), grid%i_end(ij), &
179	grid%j_start(ij), grid%j_end(ij), &
180	k_start , k_end )
181
182	ENDDO !-------------------------------------------------------------
183	!$OMP END PARALLEL DO
184
185	!_______________________________________________________________________
186	!
187	! Update halos for R12, R13, R23 and smnsmn
188	!_______________________________________________________________________
189
190	#ifdef DM_PARALLEL
191	# include "HALO_EM_NBA_RIJ.inc"
192	# include "PERIOD_EM_NBA_RIJ.inc"
193	#endif
194
195	!$OMP PARALLEL DO &
196	!$OMP PRIVATE ( ij )
197	DO ij = 1 , grid%num_tiles !----------------------------------------
198
199	CALL set_physical_bc3d( nba_rij(ims,kms,jms,P_r12), 'd', &
200	config_flags, &
201	ids, ide, jds, jde, kds, kde, &
202	ims, ime, jms, jme, kms, kme, &
203	ips, ipe, jps, jpe, kps, kpe, &
204	grid%i_start(ij), grid%i_end(ij), &
205	grid%j_start(ij), grid%j_end(ij), &
206	k_start , k_end )
207
208
209	CALL set_physical_bc3d( nba_rij(ims,kms,jms,P_r13), 'e', &
210	config_flags, &
211	ids, ide, jds, jde, kds, kde, &
212	ims, ime, jms, jme, kms, kme, &
213	ips, ipe, jps, jpe, kps, kpe, &
214	grid%i_start(ij), grid%i_end(ij), &
215	grid%j_start(ij), grid%j_end(ij), &
216	k_start , k_end )
217
218	CALL set_physical_bc3d( nba_rij(ims,kms,jms,P_r23), 'f', &
219	config_flags, &
220	ids, ide, jds, jde, kds, kde, &
221	ims, ime, jms, jme, kms, kme, &
222	ips, ipe, jps, jpe, kps, kpe, &
223	grid%i_start(ij), grid%i_end(ij), &
224	grid%j_start(ij), grid%j_end(ij), &
225	k_start , k_end )
226
227	CALL set_physical_bc3d( nba_rij(ims,kms,jms,P_smnsmn), 'c', &
228	config_flags, &
229	ids, ide, jds, jde, kds, kde, &
230	ims, ime, jms, jme, kms, kme, &
231	ips, ipe, jps, jpe, kps, kpe, &
232	grid%i_start(ij), grid%i_end(ij), &
233	grid%j_start(ij), grid%j_end(ij), &
234	k_start , k_end )
235
236	ENDDO !-------------------------------------------------------------
237	!$OMP END PARALLEL DO
238
239	!_______________________________________________________________________
240	!
241	! Calculate M11, M22 and M33
242	!_______________________________________________________________________
243
244	!$OMP PARALLEL DO &
245	!$OMP PRIVATE ( ij )
246	DO ij = 1 , grid%num_tiles !----------------------------------------
247
248	CALL calc_mii( nba_mij(ims,kms,jms,P_m11), &
249	nba_mij(ims,kms,jms,P_m22), &
250	nba_mij(ims,kms,jms,P_m33), &
251	grid%defor11, grid%defor22, &
252	grid%defor33, grid%defor12, &
253	grid%defor13, grid%defor23, &
254	nba_rij(ims,kms,jms,P_r12), &
255	nba_rij(ims,kms,jms,P_r13), &
256	nba_rij(ims,kms,jms,P_r23), &
257	nba_rij(ims,kms,jms,P_smnsmn), &
258	grid%tke_2, &
259	grid%rdzw, grid%dx, grid%dy, &
260	config_flags, &
261	ids, ide, jds, jde, kds, kde, &
262	ims, ime, jms, jme, kms, kme, &
263	ips, ipe, jps, jpe, kps, kpe, &
264	grid%i_start(ij), grid%i_end(ij), &
265	grid%j_start(ij), grid%j_end(ij), &
266	k_start, k_end )
267
268	ENDDO !-------------------------------------------------------------
269	!$OMP END PARALLEL DO
270
271	!_______________________________________________________________________
272	!
273	! Calculate M12
274	!_______________________________________________________________________
275
276	!$OMP PARALLEL DO &
277	!$OMP PRIVATE ( ij )
278	DO ij = 1 , grid%num_tiles !----------------------------------------
279
280	CALL calc_m12( nba_mij(ims,kms,jms,P_m12), &
281	grid%defor11, grid%defor22, &
282	grid%defor12, grid%defor13, &
283	grid%defor23, &
284	nba_rij(ims,kms,jms,P_r12), &
285	nba_rij(ims,kms,jms,P_r13), &
286	nba_rij(ims,kms,jms,P_r23), &
287	nba_rij(ims,kms,jms,P_smnsmn), &
288	grid%tke_2, &
289	grid%rdzw, grid%dx, grid%dy, &
290	config_flags, &
291	ids, ide, jds, jde, kds, kde, &
292	ims, ime, jms, jme, kms, kme, &
293	ips, ipe, jps, jpe, kps, kpe, &
294	grid%i_start(ij), grid%i_end(ij), &
295	grid%j_start(ij), grid%j_end(ij), &
296	k_start, k_end )
297
298	ENDDO !-------------------------------------------------------------
299	!$OMP END PARALLEL DO
300
301	!_______________________________________________________________________
302	!
303	! Calculate M13
304	!_______________________________________________________________________
305
306	!$OMP PARALLEL DO &
307	!$OMP PRIVATE ( ij )
308	DO ij = 1 , grid%num_tiles !----------------------------------------
309
310	CALL calc_m13( nba_mij(ims,kms,jms,P_m13), &
311	grid%defor11, grid%defor33, &
312	grid%defor12, grid%defor13, &
313	grid%defor23, &
314	nba_rij(ims,kms,jms,P_r12), &
315	nba_rij(ims,kms,jms,P_r13), &
316	nba_rij(ims,kms,jms,P_r23), &
317	nba_rij(ims,kms,jms,P_smnsmn), &
318	grid%tke_2, &
319	grid%rdzw, grid%dx, grid%dy, &
320	grid%fnm, grid%fnp, &
321	config_flags, &
322	ids, ide, jds, jde, kds, kde, &
323	ims, ime, jms, jme, kms, kme, &
324	ips, ipe, jps, jpe, kps, kpe, &
325	grid%i_start(ij), grid%i_end(ij), &
326	grid%j_start(ij), grid%j_end(ij), &
327	k_start, k_end )
328
329	ENDDO !-------------------------------------------------------------
330	!$OMP END PARALLEL DO
331	!_______________________________________________________________________
332	!
333	! Calculate M23
334	!_______________________________________________________________________
335
336	!$OMP PARALLEL DO &
337	!$OMP PRIVATE ( ij )
338	DO ij = 1 , grid%num_tiles !----------------------------------------
339
340	CALL calc_m23( nba_mij(ims,kms,jms,P_m23), &
341	grid%defor22, grid%defor33, &
342	grid%defor12, grid%defor13, &
343	grid%defor23, &
344	nba_rij(ims,kms,jms,P_r12), &
345	nba_rij(ims,kms,jms,P_r13), &
346	nba_rij(ims,kms,jms,P_r23), &
347	nba_rij(ims,kms,jms,P_smnsmn), &
348	grid%tke_2, &
349	grid%rdzw, grid%dx, grid%dy, &
350	grid%fnm, grid%fnp, &
351	config_flags, &
352	ids, ide, jds, jde, kds, kde, &
353	ims, ime, jms, jme, kms, kme, &
354	ips, ipe, jps, jpe, kps, kpe, &
355	grid%i_start(ij), grid%i_end(ij), &
356	grid%j_start(ij), grid%j_end(ij), &
357	k_start, k_end )
358
359	ENDDO !-------------------------------------------------------------
360	!$OMP END PARALLEL DO
361	!_______________________________________________________________________
362	!
363	! Update boundary conditions and halos after calculating Mij
364	!_______________________________________________________________________
365
366	#ifdef DM_PARALLEL
367	# include "HALO_EM_NBA_MIJ.inc"
368	# include "PERIOD_EM_NBA_MIJ.inc"
369	#endif
370
371	!$OMP PARALLEL DO &
372	!$OMP PRIVATE ( ij )
373	DO ij = 1 , grid%num_tiles !----------------------------------------
374
375	CALL set_physical_bc3d( nba_mij(ims,kms,jms,P_m11), 'p', &
376	config_flags, &
377	ids, ide, jds, jde, kds, kde, &
378	ims, ime, jms, jme, kms, kme, &
379	ips, ipe, jps, jpe, kps, kpe, &
380	grid%i_start(ij), grid%i_end(ij), &
381	grid%j_start(ij), grid%j_end(ij), &
382	k_start , k_end )
383
384	CALL set_physical_bc3d( nba_mij(ims,kms,jms,P_m22), 'p', &
385	config_flags, &
386	ids, ide, jds, jde, kds, kde, &
387	ims, ime, jms, jme, kms, kme, &
388	ips, ipe, jps, jpe, kps, kpe, &
389	grid%i_start(ij), grid%i_end(ij), &
390	grid%j_start(ij), grid%j_end(ij), &
391	k_start , k_end )
392
393	CALL set_physical_bc3d( nba_mij(ims,kms,jms,P_m33), 'p', &
394	config_flags, &
395	ids, ide, jds, jde, kds, kde, &
396	ims, ime, jms, jme, kms, kme, &
397	ips, ipe, jps, jpe, kps, kpe, &
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	CALL set_physical_bc3d( nba_mij(ims,kms,jms,P_m12), 'd', &
403	config_flags, &
404	ids, ide, jds, jde, kds, kde, &
405	ims, ime, jms, jme, kms, kme, &
406	ips, ipe, jps, jpe, kps, kpe, &
407	grid%i_start(ij), grid%i_end(ij), &
408	grid%j_start(ij), grid%j_end(ij), &
409	k_start , k_end )
410
411	CALL set_physical_bc3d( nba_mij(ims,kms,jms,P_m13), 'e', &
412	config_flags, &
413	ids, ide, jds, jde, kds, kde, &
414	ims, ime, jms, jme, kms, kme, &
415	ips, ipe, jps, jpe, kps, kpe, &
416	grid%i_start(ij), grid%i_end(ij), &
417	grid%j_start(ij), grid%j_end(ij), &
418	k_start , k_end )
419
420	CALL set_physical_bc3d( nba_mij(ims,kms,jms,P_m23), 'f', &
421	config_flags, &
422	ids, ide, jds, jde, kds, kde, &
423	ims, ime, jms, jme, kms, kme, &
424	ips, ipe, jps, jpe, kps, kpe, &
425	grid%i_start(ij), grid%i_end(ij), &
426	grid%j_start(ij), grid%j_end(ij), &
427	k_start , k_end )
428
429	ENDDO !-------------------------------------------------------------
430	!$OMP END PARALLEL DO
431
432	!=======================================================================
433	!
434	! END NBA
435	!
436	!=======================================================================
437
438	ENDIF !(config_flags%sfs_opt .EQ. 1) .OR. (config_flags%sfs_opt .EQ. 2)
439
440	END SUBROUTINE sfs_driver
441
442	END MODULE module_sfs_driver

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

Download in other formats:

Original Format