Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_tiles.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: 17.9 KB

Line
1	!WRF:DRIVER_LAYER:TILING
2	!
3
4	MODULE module_tiles
5
6	USE module_configure
7
8	INTERFACE set_tiles
9	MODULE PROCEDURE set_tiles1 , set_tiles2, set_tiles3
10	END INTERFACE
11
12	CONTAINS
13
14	! CPP macro for error checking
15	#define ERROR_TEST(A,O,B) IF( A O B )THEN;WRITE(mess,'(3A4)')'A','O','B';CALL WRF_ERROR_FATAL(mess);ENDIF
16
17	! this version is used to compute only on a boundary of some width
18	! The ids, ide, jds, and jde arguments specify the edge of the boundary (a way of
19	! accounting for staggering, and the bdyw gives the number of cells
20	! (idea: if bdyw is negative, have it do the reverse and specify the
21	! interior, less the boundary.
22
23	SUBROUTINE set_tiles1 ( grid , ids , ide , jds , jde , bdyw )
24
25	USE module_domain, ONLY : domain
26	USE module_driver_constants
27	USE module_machine
28	USE module_wrf_error
29
30	IMPLICIT NONE
31
32	! Input data.
33
34	TYPE(domain) , INTENT(INOUT) :: grid
35	INTEGER , INTENT(IN) :: ids , ide , jds , jde , bdyw
36
37	! Local data
38
39	INTEGER :: spx, epx, spy, epy, t, tt, ts, te
40	INTEGER :: smx, emx, smy, emy
41	INTEGER :: ntiles , num_tiles
42
43	CHARACTER*80 :: mess
44
45	data_ordering : SELECT CASE ( model_data_order )
46	CASE ( DATA_ORDER_XYZ )
47	spx = grid%sp31 ; epx = grid%ep31 ; spy = grid%sp32 ; epy = grid%ep32
48	CASE ( DATA_ORDER_YXZ )
49	spx = grid%sp32 ; epx = grid%ep32 ; spy = grid%sp31 ; epy = grid%ep31
50	CASE ( DATA_ORDER_ZXY )
51	spx = grid%sp32 ; epx = grid%ep32 ; spy = grid%sp33 ; epy = grid%ep33
52	CASE ( DATA_ORDER_ZYX )
53	spx = grid%sp33 ; epx = grid%ep33 ; spy = grid%sp32 ; epy = grid%ep32
54	CASE ( DATA_ORDER_XZY )
55	spx = grid%sp31 ; epx = grid%ep31 ; spy = grid%sp33 ; epy = grid%ep33
56	CASE ( DATA_ORDER_YZX )
57	spx = grid%sp33 ; epx = grid%ep33 ; spy = grid%sp31 ; epy = grid%ep31
58	END SELECT data_ordering
59
60	num_tiles = 4
61
62	IF ( num_tiles > grid%max_tiles ) THEN
63	IF ( ASSOCIATED(grid%i_start) ) THEN ; DEALLOCATE( grid%i_start ) ; NULLIFY( grid%i_start ) ; ENDIF
64	IF ( ASSOCIATED(grid%i_end) ) THEN ; DEALLOCATE( grid%i_end ) ; NULLIFY( grid%i_end ) ; ENDIF
65	IF ( ASSOCIATED(grid%j_start) ) THEN ; DEALLOCATE( grid%j_start ) ; NULLIFY( grid%j_start ) ; ENDIF
66	IF ( ASSOCIATED(grid%j_end) ) THEN ; DEALLOCATE( grid%j_end ) ; NULLIFY( grid%j_end ) ; ENDIF
67	ALLOCATE(grid%i_start(num_tiles))
68	ALLOCATE(grid%i_end(num_tiles))
69	ALLOCATE(grid%j_start(num_tiles))
70	ALLOCATE(grid%j_end(num_tiles))
71	grid%max_tiles = num_tiles
72	ENDIF
73
74	! XS boundary
75	IF ( ids .ge. spx .and. ids .le. epx ) THEN
76	grid%i_start(1) = ids
77	grid%i_end(1) = min( ids+bdyw-1 , epx )
78	grid%j_start(1) = max( spy , jds )
79	grid%j_end(1) = min( epy , jde )
80	ELSEIF ( (ids+bdyw-1) .ge. spx .and. (ids+bdyw-1) .le. epx ) THEN
81	grid%i_start(1) = max( ids , spx )
82	grid%i_end(1) = ids+bdyw-1
83	grid%j_start(1) = max( spy , jds )
84	grid%j_end(1) = min( epy , jde )
85	ELSE
86	grid%i_start(1) = 1
87	grid%i_end(1) = -1
88	grid%j_start(1) = 1
89	grid%j_end(1) = -1
90	ENDIF
91
92	! XE boundary
93	IF ( ide .ge. spx .and. ide .le. epx ) THEN
94	grid%i_start(2) = max( ide-bdyw+1 , spx )
95	grid%i_end(2) = ide
96	grid%j_start(2) = max( spy , jds )
97	grid%j_end(2) = min( epy , jde )
98	ELSEIF ( (ide-bdyw+1) .ge. spx .and. (ide-bdyw+1) .le. epx ) THEN
99	grid%i_start(2) = ide-bdyw+1
100	grid%i_end(2) = min( ide , epx )
101	grid%j_start(2) = max( spy , jds )
102	grid%j_end(2) = min( epy , jde )
103	ELSE
104	grid%i_start(2) = 1
105	grid%i_end(2) = -1
106	grid%j_start(2) = 1
107	grid%j_end(2) = -1
108	ENDIF
109
110	! YS boundary (note that the corners may already be done by XS and XE)
111	IF ( jds .ge. spy .and. jds .le. epy ) THEN
112	grid%j_start(3) = jds
113	grid%j_end(3) = min( jds+bdyw-1 , epy )
114	grid%i_start(3) = max( spx , ids+bdyw )
115	grid%i_end(3) = min( epx , ide-bdyw )
116	ELSEIF ( (jds+bdyw-1) .ge. spy .and. (jds+bdyw-1) .le. epy ) THEN
117	grid%j_start(3) = max( jds , spy )
118	grid%j_end(3) = jds+bdyw-1
119	grid%i_start(3) = max( spx , ids+bdyw )
120	grid%i_end(3) = min( epx , ide-bdyw )
121	ELSE
122	grid%j_start(3) = 1
123	grid%j_end(3) = -1
124	grid%i_start(3) = 1
125	grid%i_end(3) = -1
126	ENDIF
127
128	! YE boundary (note that the corners may already be done by XS and XE)
129	IF ( jde .ge. spy .and. jde .le. epy ) THEN
130	grid%j_start(4) = max( jde-bdyw+1 , spy )
131	grid%j_end(4) = jde
132	grid%i_start(4) = max( spx , ids+bdyw )
133	grid%i_end(4) = min( epx , ide-bdyw )
134	ELSEIF ( (jde-bdyw+1) .ge. spy .and. (jde-bdyw+1) .le. epy ) THEN
135	grid%j_start(4) = jde-bdyw+1
136	grid%j_end(4) = min( jde , epy )
137	grid%i_start(4) = max( spx , ids+bdyw )
138	grid%i_end(4) = min( epx , ide-bdyw )
139	ELSE
140	grid%j_start(4) = 1
141	grid%j_end(4) = -1
142	grid%i_start(4) = 1
143	grid%i_end(4) = -1
144	ENDIF
145
146	grid%num_tiles = num_tiles
147
148	RETURN
149	END SUBROUTINE set_tiles1
150
151	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
152	! this version is used to limit the domain or compute onto halos
153	SUBROUTINE set_tiles2 ( grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
154	USE module_domain, ONLY : domain
155	USE module_driver_constants
156	USE module_machine
157	USE module_wrf_error
158
159	IMPLICIT NONE
160
161	! Input data.
162
163	TYPE(domain) , INTENT(INOUT) :: grid
164	INTEGER , INTENT(IN) :: ids , ide , jds , jde
165	INTEGER , INTENT(IN) :: ips , ipe , jps , jpe
166
167	! Output data.
168
169	! Local data.
170
171	INTEGER :: num_tiles_x, num_tiles_y, num_tiles
172	INTEGER :: tile_sz_x, tile_sz_y
173	INTEGER :: spx, epx, spy, epy, t, tt, ts, te
174	INTEGER :: smx, emx, smy, emy
175	INTEGER :: ntiles
176	INTEGER :: one
177	INTEGER :: nt
178	#ifdef _OPENMP
179	INTEGER , EXTERNAL :: omp_get_max_threads
180	#endif
181	CHARACTER*80 :: mess
182	LOGICAL :: verbose ! whether to output tile info messages
183
184	data_ordering : SELECT CASE ( model_data_order )
185	CASE ( DATA_ORDER_XYZ )
186	spx = grid%sp31 ; epx = grid%ep31 ; spy = grid%sp32 ; epy = grid%ep32
187	smx = grid%sm31 ; emx = grid%em31 ; smy = grid%sm32 ; emy = grid%em32
188	CASE ( DATA_ORDER_YXZ )
189	spx = grid%sp32 ; epx = grid%ep32 ; spy = grid%sp31 ; epy = grid%ep31
190	smx = grid%sm32 ; emx = grid%em32 ; smy = grid%sm31 ; emy = grid%em31
191	CASE ( DATA_ORDER_ZXY )
192	spx = grid%sp32 ; epx = grid%ep32 ; spy = grid%sp33 ; epy = grid%ep33
193	smx = grid%sm32 ; emx = grid%em32 ; smy = grid%sm33 ; emy = grid%em33
194	CASE ( DATA_ORDER_ZYX )
195	spx = grid%sp33 ; epx = grid%ep33 ; spy = grid%sp32 ; epy = grid%ep32
196	smx = grid%sm33 ; emx = grid%em33 ; smy = grid%sm32 ; emy = grid%em32
197	CASE ( DATA_ORDER_XZY )
198	spx = grid%sp31 ; epx = grid%ep31 ; spy = grid%sp33 ; epy = grid%ep33
199	smx = grid%sm31 ; emx = grid%em31 ; smy = grid%sm33 ; emy = grid%em33
200	CASE ( DATA_ORDER_YZX )
201	spx = grid%sp33 ; epx = grid%ep33 ; spy = grid%sp31 ; epy = grid%ep31
202	smx = grid%sm33 ; emx = grid%em33 ; smy = grid%sm31 ; emy = grid%em31
203	END SELECT data_ordering
204
205	ERROR_TEST(ips,<,smx)
206	ERROR_TEST(ipe,>,emx)
207	ERROR_TEST(jps,<,smy)
208	ERROR_TEST(jpe,>,emy)
209
210	! Here's how the number of tiles is arrived at:
211	!
212	! if tile sizes are specified use those otherwise
213	! if num_tiles is specified use that otherwise
214	! if omp provides a value use that otherwise
215	! use 1.
216	!
217
218	verbose = .false.
219	IF ( grid%num_tiles_spec .EQ. 0 ) THEN
220	verbose = .true.
221	CALL nl_get_numtiles( 1, num_tiles )
222	IF ( num_tiles .EQ. 1 ) THEN
223	#ifdef _OPENMP
224	num_tiles = omp_get_max_threads()
225	WRITE(mess,'("WRF NUMBER OF TILES FROM OMP_GET_MAX_THREADS = ",I3)')num_tiles
226	CALL WRF_MESSAGE ( mess )
227	#else
228	num_tiles = 1
229	#endif
230	ENDIF
231	! override num_tiles setting (however gotten) if tile sizes are specified
232	CALL nl_get_tile_sz_x( 1, tile_sz_x )
233	CALL nl_get_tile_sz_y( 1, tile_sz_y )
234	IF ( tile_sz_x >= 1 .and. tile_sz_y >= 1 ) THEN
235	! figure number of whole tiles and add 1 for any partials in each dim
236	num_tiles_x = (epx-spx+1) / tile_sz_x
237	if ( tile_sz_x*num_tiles_x < epx-spx+1 ) num_tiles_x = num_tiles_x + 1
238	num_tiles_y = (epy-spy+1) / tile_sz_y
239	if ( tile_sz_y*num_tiles_y < epy-spy+1 ) num_tiles_y = num_tiles_y + 1
240	num_tiles = num_tiles_x * num_tiles_y
241	ELSE
242	IF ( machine_info%tile_strategy == TILE_X ) THEN
243	num_tiles_x = num_tiles
244	num_tiles_y = 1
245	ELSE IF ( machine_info%tile_strategy == TILE_Y ) THEN
246	num_tiles_x = 1
247	num_tiles_y = num_tiles
248	ELSE ! Default ( machine_info%tile_strategy == TILE_XY ) THEN
249	one = 1
250	call least_aspect( num_tiles, one, one, num_tiles_y, num_tiles_x )
251	ENDIF
252	ENDIF
253	grid%num_tiles_spec = num_tiles
254	grid%num_tiles_x = num_tiles_x
255	grid%num_tiles_y = num_tiles_y
256	ELSE
257	num_tiles = grid%num_tiles_spec
258	IF ( machine_info%tile_strategy == TILE_X ) THEN
259	num_tiles_x = num_tiles
260	num_tiles_y = 1
261	ELSE IF ( machine_info%tile_strategy == TILE_Y ) THEN
262	num_tiles_x = 1
263	num_tiles_y = num_tiles
264	ELSE ! Default ( machine_info%tile_strategy == TILE_XY ) THEN
265	one = 1
266	call least_aspect( num_tiles, one, one, num_tiles_y, num_tiles_x )
267	ENDIF
268	grid%num_tiles_x = num_tiles_x
269	grid%num_tiles_y = num_tiles_y
270	ENDIF
271
272	num_tiles = grid%num_tiles_spec
273	num_tiles_x = grid%num_tiles_x
274	num_tiles_y = grid%num_tiles_y
275
276	IF ( num_tiles > grid%max_tiles ) THEN
277	IF ( ASSOCIATED(grid%i_start) ) THEN ; DEALLOCATE( grid%i_start ) ; NULLIFY( grid%i_start ) ; ENDIF
278	IF ( ASSOCIATED(grid%i_end) ) THEN ; DEALLOCATE( grid%i_end ) ; NULLIFY( grid%i_end ) ; ENDIF
279	IF ( ASSOCIATED(grid%j_start) ) THEN ; DEALLOCATE( grid%j_start ) ; NULLIFY( grid%j_start ) ; ENDIF
280	IF ( ASSOCIATED(grid%j_end) ) THEN ; DEALLOCATE( grid%j_end ) ; NULLIFY( grid%j_end ) ; ENDIF
281	ALLOCATE(grid%i_start(num_tiles))
282	ALLOCATE(grid%i_end(num_tiles))
283	ALLOCATE(grid%j_start(num_tiles))
284	ALLOCATE(grid%j_end(num_tiles))
285	grid%max_tiles = num_tiles
286	ENDIF
287
288	nt = 1
289	DO t = 0, num_tiles-1
290
291	! do y
292	ntiles = t / num_tiles_x
293	CALL region_bounds( spy, epy, &
294	num_tiles_y, ntiles, &
295	ts, te )
296	! first y (major dimension)
297	IF ( ts .LE. te ) THEN ! converse happens if number of tiles > number of points in dim
298	!!!
299	! This bit allows the user to specify execution out onto the halo region
300	! in the call to set_tiles. If the low patch boundary specified by the arguments
301	! is less than what the model already knows to be the patch boundary and if
302	! the user hasn't erred by specifying something that would fall off memory
303	! (safety tests are higher up in this routine, outside the IF) then adjust
304	! the tile boundary of the low edge tiles accordingly. Likewise for high edges.
305	IF ( jps .lt. spy .and. ts .eq. spy ) ts = jps ;
306	IF ( jpe .gt. epy .and. te .eq. epy ) te = jpe ;
307	!
308	grid%j_start(nt) = max ( ts , jds )
309	grid%j_end(nt) = min ( te , jde )
310
311	! now x
312	ntiles = mod(t,num_tiles_x)
313	CALL region_bounds( spx, epx, &
314	num_tiles_x, ntiles, &
315	ts, te )
316	IF ( ts .LE. te ) THEN ! converse happens if number of tiles > number of points in dim
317	IF ( ips .lt. spx .and. ts .eq. spx ) ts = ips ;
318	IF ( ipe .gt. epx .and. te .eq. epx ) te = ipe ;
319	!!!
320	grid%i_start(nt) = max ( ts , ids )
321	grid%i_end(nt) = min ( te , ide )
322	IF ( verbose ) THEN
323	WRITE(mess,'("WRF TILE ",I3," IS ",I6," IE ",I6," JS ",I6," JE ",I6)') &
324	nt,grid%i_start(nt),grid%i_end(nt),grid%j_start(nt),grid%j_end(nt)
325	CALL WRF_MESSAGE ( mess )
326	ENDIF
327	nt = nt + 1
328	ENDIF
329	ENDIF
330	END DO
331	num_tiles = nt-1
332	IF ( verbose ) THEN
333	WRITE(mess,'("WRF NUMBER OF TILES = ",I3)')num_tiles
334	CALL WRF_MESSAGE ( mess )
335	ENDIF
336	grid%num_tiles = num_tiles
337
338	RETURN
339	END SUBROUTINE set_tiles2
340
341
342	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
343	! this version sets the tiles based on a passed in integer mask
344	! the assumption here is that the mask is relatively straigthforward
345	! and coverable with 2 or three rectangles. No weird stuff...
346
347	SUBROUTINE set_tiles3 ( grid , imask, ims, ime, jms, jme, ips, ipe, jps, jpe )
348	USE module_domain, ONLY : domain
349	USE module_driver_constants
350	USE module_machine
351	USE module_wrf_error
352
353	IMPLICIT NONE
354
355	! Input data.
356
357	TYPE(domain) , INTENT(INOUT) :: grid
358	INTEGER , INTENT(IN) :: ims , ime , jms , jme
359	INTEGER , INTENT(IN) :: ips , ipe , jps , jpe
360	INTEGER, DIMENSION(ims:ime,jms:jme), INTENT(IN) :: imask
361	INTEGER :: num_tiles
362	INTEGER, DIMENSION(50) :: i_start, i_end, j_start, j_end
363
364	! Output data.
365
366	! Local data.
367	INTEGER nt
368	CHARACTER*80 :: mess
369
370	CALL set_tiles_masked ( imask, ims, ime, jms, jme, ips, ipe, jps, jpe, &
371	num_tiles, i_start, i_end, j_start, j_end )
372
373	IF ( num_tiles > grid%max_tiles ) THEN
374	IF ( ASSOCIATED(grid%i_start) ) THEN ; DEALLOCATE( grid%i_start ) ; NULLIFY( grid%i_start ) ; ENDIF
375	IF ( ASSOCIATED(grid%i_end) ) THEN ; DEALLOCATE( grid%i_end ) ; NULLIFY( grid%i_end ) ; ENDIF
376	IF ( ASSOCIATED(grid%j_start) ) THEN ; DEALLOCATE( grid%j_start ) ; NULLIFY( grid%j_start ) ; ENDIF
377	IF ( ASSOCIATED(grid%j_end) ) THEN ; DEALLOCATE( grid%j_end ) ; NULLIFY( grid%j_end ) ; ENDIF
378	ALLOCATE(grid%i_start(num_tiles))
379	ALLOCATE(grid%i_end(num_tiles))
380	ALLOCATE(grid%j_start(num_tiles))
381	ALLOCATE(grid%j_end(num_tiles))
382	grid%max_tiles = num_tiles
383	ENDIF
384	grid%num_tiles = num_tiles
385	grid%i_start(1:num_tiles) = i_start(1:num_tiles)
386	grid%i_end(1:num_tiles) = i_end(1:num_tiles)
387	grid%j_start(1:num_tiles) = j_start(1:num_tiles)
388	grid%j_end(1:num_tiles) = j_end(1:num_tiles)
389	DO nt = 1, num_tiles
390	WRITE(mess,'("WRF TILE ",I3," IS ",I6," IE ",I6," JS ",I6," JE ",I6)') &
391	nt,grid%i_start(nt),grid%i_end(nt),grid%j_start(nt),grid%j_end(nt)
392	CALL wrf_debug ( 1, mess )
393	ENDDO
394	WRITE(mess,'("set_tiles3: NUMBER OF TILES = ",I3)')num_tiles
395	CALL wrf_debug ( 1, mess )
396
397	RETURN
398	END SUBROUTINE set_tiles3
399
400	SUBROUTINE set_tiles_masked ( imask, ims, ime, jms, jme, ips, ipe, jps, jpe, &
401	num_tiles, istarts, iends, jstarts, jends )
402
403	IMPLICIT NONE
404
405	! Arguments
406
407	INTEGER , INTENT(IN) :: ims , ime , jms , jme
408	INTEGER, DIMENSION(ims:ime,jms:jme), INTENT(IN) :: imask
409	INTEGER , INTENT(IN) :: ips , ipe , jps , jpe
410	INTEGER , INTENT(OUT) :: num_tiles
411	INTEGER, DIMENSION(*) , INTENT(OUT) :: istarts, iends
412	INTEGER, DIMENSION(*) , INTENT(OUT) :: jstarts, jends
413
414	! Output data.
415
416	! Local data.
417	CHARACTER*80 :: mess
418	INTEGER :: i, j, ir, jr
419	INTEGER :: imaskcopy(ips:ipe,jps:jpe) ! copy of imask to write on
420
421	imaskcopy = imask(ips:ipe,jps:jpe)
422	num_tiles = 0
423	! simple multi-pass scheme, optimize later...
424	DO WHILE (ANY(imaskcopy == 1))
425	DO j = jps,jpe
426	DO i = ips,ipe
427	! find first "1" and build a rectangle from it
428	IF ( imaskcopy(i,j) == 1 ) THEN
429	num_tiles = num_tiles + 1
430	istarts(num_tiles) = i
431	iends(num_tiles) = i
432	jstarts(num_tiles) = j
433	jends(num_tiles) = j
434	! don't check this point again
435	imaskcopy(i,j) = 0
436	! find length of first row
437	DO ir = istarts(num_tiles)+1,ipe
438	IF ( imaskcopy(ir,j) == 1 ) THEN
439	iends(num_tiles) = ir
440	! don't check this point again
441	imaskcopy(ir,j) = 0
442	ELSE
443	EXIT
444	ENDIF
445	ENDDO
446	! find number of rows
447	DO jr = jstarts(num_tiles)+1,jpe
448	IF (ALL(imaskcopy(istarts(num_tiles):iends(num_tiles),jr) == 1)) THEN
449	jends(num_tiles) = jr
450	! don't check these points again
451	imaskcopy(istarts(num_tiles):iends(num_tiles),jr) = 0
452	ELSE
453	EXIT
454	ENDIF
455	ENDDO
456	ENDIF ! if ( imaskcopy(i,j) == 1 )
457	ENDDO
458	ENDDO
459	ENDDO
460	RETURN
461	END SUBROUTINE set_tiles_masked
462
463
464	SUBROUTINE init_module_tiles
465	END SUBROUTINE init_module_tiles
466
467	END MODULE module_tiles
468

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

Download in other formats:

Original Format