Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

tfp_tester.F @ 1

Last change on this file since 1 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:

Property svn:executable set to *

File size: 21.0 KB

Line
1	! to compile this
2	!
3	! g95
4	! gcc -c -DF2CSTYLE task_for_point.c ; g95 -ffree-form -ffree-line-length-huge tfp_tester.F task_for_point.o
5	! ifort
6	! icc -c task_for_point.c ; ifort -FR tfp_tester.F task_for_point.o
7	! ibm
8	! cc -c -DNOUNDERSCORE task_for_point.c ; xlf -qfree=f90 tfp_tester.F task_for_point.o
9
10	MODULE module_driver_constants
11
12	! 0. The following tells the rest of the model what data ordering we are
13	! using
14
15	INTEGER , PARAMETER :: DATA_ORDER_XYZ = 1
16	INTEGER , PARAMETER :: DATA_ORDER_YXZ = 2
17	INTEGER , PARAMETER :: DATA_ORDER_ZXY = 3
18	INTEGER , PARAMETER :: DATA_ORDER_ZYX = 4
19	INTEGER , PARAMETER :: DATA_ORDER_XZY = 5
20	INTEGER , PARAMETER :: DATA_ORDER_YZX = 6
21	INTEGER , PARAMETER :: DATA_ORDER_XY = DATA_ORDER_XYZ
22	INTEGER , PARAMETER :: DATA_ORDER_YX = DATA_ORDER_YXZ
23
24	!#include <model_data_order.inc>
25
26	! 1. Following are constants for use in defining maximal values for array
27	! definitions.
28	!
29
30	! The maximum number of levels in the model is how deeply the domains may
31	! be nested.
32
33	INTEGER , PARAMETER :: max_levels = 20
34
35	! The maximum number of nests that can depend on a single parent and other way round
36
37	INTEGER , PARAMETER :: max_nests = 20
38
39	! The maximum number of parents that a nest can have (simplified assumption -> one only)
40
41	INTEGER , PARAMETER :: max_parents = 1
42
43	! The maximum number of domains is how many grids the model will be running.
44
45	#define MAX_DOMAINS_F 10
46	INTEGER , PARAMETER :: max_domains = ( MAX_DOMAINS_F - 1 ) / 2 + 1
47
48	! The maximum number of nest move specifications allowed in a namelist
49
50	INTEGER , PARAMETER :: max_moves = 50
51
52	! The maximum number of eta levels
53
54	INTEGER , PARAMETER :: max_eta = 501
55
56	! The maximum number of outer iterations (for DA minimisation)
57
58	INTEGER , PARAMETER :: max_outer_iterations = 10
59
60	! The maximum number of instruments (for radiance DA)
61
62	INTEGER , PARAMETER :: max_instruments = 30
63
64	! 2. Following related to driver leve data structures for DM_PARALLEL communications
65
66	#ifdef DM_PARALLEL
67	INTEGER , PARAMETER :: max_comms = 1024
68	#else
69	INTEGER , PARAMETER :: max_comms = 1
70	#endif
71
72	! 3. Following is information related to the file I/O.
73
74	! These are the bounds of the available FORTRAN logical unit numbers for the file I/O.
75	! Only logical unti numbers within these bounds will be chosen for I/O unit numbers.
76
77	INTEGER , PARAMETER :: min_file_unit = 10
78	INTEGER , PARAMETER :: max_file_unit = 99
79
80	! 4. Unfortunately, the following definition is needed here (rather
81	! than the more logical place in share/module_model_constants.F)
82	! for the namelist reads in frame/module_configure.F, and for some
83	! conversions in share/set_timekeeping.F
84	! Actually, using it here will mean that we don't need to set it
85	! in share/module_model_constants.F, since this file will be
86	! included (USEd) in:
87	! frame/module_configure.F
88	! which will be USEd in:
89	! share/module_bc.F
90	! which will be USEd in:
91	! phys/module_radiation_driver.F
92	! which is the other important place for it to be, and where
93	! it is passed as a subroutine parameter to any physics subroutine.
94	!
95	! P2SI is the number of SI seconds in an planetary solar day
96	! divided by the number of SI seconds in an earth solar day
97	#if defined MARS
98	! For Mars, P2SI = 88775.2/86400.
99	REAL , PARAMETER :: P2SI = 1.0274907
100	#elif defined TITAN
101	! For Titan, P2SI = 1378080.0/86400.
102	REAL , PARAMETER :: P2SI = 15.95
103	#else
104	! Default for Earth
105	REAL , PARAMETER :: P2SI = 1.0
106	#endif
107	CONTAINS
108	SUBROUTINE init_module_driver_constants
109	END SUBROUTINE init_module_driver_constants
110	END MODULE module_driver_constants
111
112	MODULE module_machine
113
114	USE module_driver_constants
115
116	! Machine characteristics and utilities here.
117
118	! Tile strategy defined constants
119	INTEGER, PARAMETER :: TILE_X = 1, TILE_Y = 2, TILE_XY = 3
120
121	TYPE machine_type
122	INTEGER :: tile_strategy
123	END TYPE machine_type
124
125	TYPE (machine_type) machine_info
126
127	CONTAINS
128
129	RECURSIVE SUBROUTINE rlocproc(p,maxi,nproc,ml,mr,ret)
130	IMPLICIT NONE
131	INTEGER, INTENT(IN) :: p, maxi, nproc, ml, mr
132	INTEGER, INTENT(OUT) :: ret
133	INTEGER :: width, rem, ret2, bl, br, mid, adjust, &
134	p_r, maxi_r, nproc_r, zero
135	adjust = 0
136	rem = mod( maxi, nproc )
137	width = maxi / nproc
138	mid = maxi / 2
139	IF ( rem>0 .AND. (((mod(rem,2).EQ.0).OR.(rem.GT.2)).OR.(p.LE.mid))) THEN
140	width = width + 1
141	END IF
142	IF ( p.LE.mid .AND. mod(rem,2).NE.0 ) THEN
143	adjust = adjust + 1
144	END IF
145	bl = max(width,ml) ;
146	br = max(width,mr) ;
147	IF (p<bl) THEN
148	ret = 0
149	ELSE IF (p>maxi-br-1) THEN
150	ret = nproc-1
151	ELSE
152	p_r = p - bl
153	maxi_r = maxi-bl-br+adjust
154	nproc_r = max(nproc-2,1)
155	zero = 0
156	CALL rlocproc( p_r, maxi_r, nproc_r, zero, zero, ret2 ) ! Recursive
157	ret = ret2 + 1
158	END IF
159	RETURN
160	END SUBROUTINE rlocproc
161
162	INTEGER FUNCTION locproc( i, m, numpart )
163	implicit none
164	integer, intent(in) :: i, m, numpart
165	integer :: retval, ii, im, inumpart, zero
166	ii = i
167	im = m
168	inumpart = numpart
169	zero = 0
170	CALL rlocproc( ii, im, inumpart, zero, zero, retval )
171	locproc = retval
172	RETURN
173	END FUNCTION locproc
174
175	SUBROUTINE patchmap( res, y, x, py, px )
176	implicit none
177	INTEGER, INTENT(IN) :: y, x, py, px
178	INTEGER, DIMENSION(x,y), INTENT(OUT) :: res
179	INTEGER :: i, j, p_min, p_maj
180	DO j = 0,y-1
181	p_maj = locproc( j, y, py )
182	DO i = 0,x-1
183	p_min = locproc( i, x, px )
184	res(i+1,j+1) = p_min + px*p_maj
185	END DO
186	END DO
187	RETURN
188	END SUBROUTINE patchmap
189
190	SUBROUTINE region_bounds( region_start, region_end, &
191	num_p, p, &
192	patch_start, patch_end )
193	! 1-D decomposition routine: Given starting and ending indices of a
194	! vector, the number of patches dividing the vector, and the number of
195	! the patch, give the start and ending indices of the patch within the
196	! vector. This will work with tiles too. Implementation note. This is
197	! implemented somewhat inefficiently, now, with a loop, so we can use the
198	! locproc function above, which returns processor number for a given
199	! index, whereas what we want is index for a given processor number.
200	! With a little thought and a lot of debugging, we can come up with a
201	! direct expression for what we want. For time being, we loop...
202	! Remember that processor numbering starts with zero.
203
204	IMPLICIT NONE
205	INTEGER, INTENT(IN) :: region_start, region_end, num_p, p
206	INTEGER, INTENT(OUT) :: patch_start, patch_end
207	INTEGER :: offset, i
208	patch_end = -999999999
209	patch_start = 999999999
210	offset = region_start
211	do i = 0, region_end - offset
212	if ( locproc( i, region_end-region_start+1, num_p ) == p ) then
213	patch_end = max(patch_end,i)
214	patch_start = min(patch_start,i)
215	endif
216	enddo
217	patch_start = patch_start + offset
218	patch_end = patch_end + offset
219	RETURN
220	END SUBROUTINE region_bounds
221
222	SUBROUTINE least_aspect( nparts, minparts_y, minparts_x, nparts_y, nparts_x )
223	IMPLICIT NONE
224	! Input data.
225	INTEGER, INTENT(IN) :: nparts, &
226	minparts_y, minparts_x
227	! Output data.
228	INTEGER, INTENT(OUT) :: nparts_y, nparts_x
229	! Local data.
230	INTEGER :: x, y, mini
231	mini = 2*nparts
232	nparts_y = 1
233	nparts_x = nparts
234	DO y = 1, nparts
235	IF ( mod( nparts, y ) .eq. 0 ) THEN
236	x = nparts / y
237	IF ( abs( y-x ) .LT. mini &
238	.AND. y .GE. minparts_y &
239	.AND. x .GE. minparts_x ) THEN
240	mini = abs( y-x )
241	nparts_y = y
242	nparts_x = x
243	END IF
244	END IF
245	END DO
246	END SUBROUTINE least_aspect
247
248	SUBROUTINE init_module_machine
249	machine_info%tile_strategy = TILE_Y
250	END SUBROUTINE init_module_machine
251
252	END MODULE module_machine
253
254	SUBROUTINE compute_memory_dims_rsl_lite ( &
255	id , maxhalowidth , &
256	shw , bdx, bdy , &
257	ntasks_x, ntasks_y, &
258	mytask_x, mytask_y, &
259	ids, ide, jds, jde, kds, kde, &
260	ims, ime, jms, jme, kms, kme, &
261	imsx, imex, jmsx, jmex, kmsx, kmex, &
262	imsy, imey, jmsy, jmey, kmsy, kmey, &
263	ips, ipe, jps, jpe, kps, kpe, &
264	ipsx, ipex, jpsx, jpex, kpsx, kpex, &
265	ipsy, ipey, jpsy, jpey, kpsy, kpey )
266
267	USE module_machine
268	IMPLICIT NONE
269	INTEGER, INTENT(IN) :: id , maxhalowidth
270	INTEGER, INTENT(IN) :: shw, bdx, bdy
271	INTEGER, INTENT(IN) :: ntasks_x, ntasks_y
272	INTEGER, INTENT(IN) :: mytask_x, mytask_y
273	INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde
274	INTEGER, INTENT(OUT) :: ims, ime, jms, jme, kms, kme
275	INTEGER, INTENT(OUT) :: imsx, imex, jmsx, jmex, kmsx, kmex
276	INTEGER, INTENT(OUT) :: imsy, imey, jmsy, jmey, kmsy, kmey
277	INTEGER, INTENT(OUT) :: ips, ipe, jps, jpe, kps, kpe
278	INTEGER, INTENT(OUT) :: ipsx, ipex, jpsx, jpex, kpsx, kpex
279	INTEGER, INTENT(OUT) :: ipsy, ipey, jpsy, jpey, kpsy, kpey
280
281	INTEGER Px, Py, P, i, j, k, ierr
282
283	#if ( ! NMM_CORE == 1 )
284
285	! xy decomposition
286
287	ips = -1
288	j = jds
289	ierr = 0
290	DO i = ids, ide
291	CALL task_for_point ( i, j, ids, ide, jds, jde, ntasks_x, ntasks_y, Px, Py, &
292	maxhalowidth, maxhalowidth, ierr )
293	IF ( Px .EQ. mytask_x ) THEN
294	ipe = i
295	IF ( ips .EQ. -1 ) THEN
296	ips = i
297	ENDIF
298	ENDIF
299	ENDDO
300	IF ( ierr .NE. 0 ) THEN
301	CALL tfp_message(__FILE__,__LINE__)
302	ENDIF
303	! handle setting the memory dimensions where there are no X elements assigned to this proc
304	IF (ips .EQ. -1 ) THEN
305	ipe = -1
306	ips = 0
307	ENDIF
308	jps = -1
309	i = ids
310	ierr = 0
311	DO j = jds, jde
312	CALL task_for_point ( i, j, ids, ide, jds, jde, ntasks_x, ntasks_y, Px, Py, &
313	maxhalowidth, maxhalowidth, ierr )
314	IF ( Py .EQ. mytask_y ) THEN
315	jpe = j
316	IF ( jps .EQ. -1 ) jps = j
317	ENDIF
318	ENDDO
319	IF ( ierr .NE. 0 ) THEN
320	CALL tfp_message(__FILE__,__LINE__)
321	ENDIF
322	! handle setting the memory dimensions where there are no Y elements assigned to this proc
323	IF (jps .EQ. -1 ) THEN
324	jpe = -1
325	jps = 0
326	ENDIF
327
328	!begin: wig; 12-Mar-2008
329	! This appears redundant with the conditionals above, but we get cases with only
330	! one of the directions being set to "missing" when turning off extra processors.
331	! This may break the handling of setting only one of nproc_x or nproc_y via the namelist.
332	IF (ipe .EQ. -1 .or. jpe .EQ. -1) THEN
333	ipe = -1
334	ips = 0
335	jpe = -1
336	jps = 0
337	ENDIF
338	!end: wig; 12-Mar-2008
339
340	!
341	! description of transpose decomposition strategy for RSL LITE. 20061231jm
342	!
343	! Here is the tranpose scheme that is implemented for RSL_LITE. Upper-case
344	! XY corresponds to the dimension of the processor mesh, lower-case xyz
345	! corresponds to grid dimension.
346	!
347	! xy zy zx
348	!
349	! XxYy <--> XzYy <--> XzYx <- note x decomposed over Y procs
350	! ^ ^
351	! \| \|
352	! +------------------+ <- this edge is costly; see below
353	!
354	! The aim is to avoid all-to-all communication over whole
355	! communicator. Instead, when possible, use a transpose scheme that requires
356	! all-to-all within dimensional communicators; that is, communicators
357	! defined for the processes in a rank or column of the processor mesh. Note,
358	! however, it is not possible to create a ring of transposes between
359	! xy-yz-xz decompositions without at least one of the edges in the ring
360	! being fully all-to-all (in other words, one of the tranpose edges must
361	! rotate and not just transpose a plane of the model grid within the
362	! processor mesh). The issue is then, where should we put this costly edge
363	! in the tranpose scheme we chose? To avoid being completely arbitrary,
364	! we chose a scheme most natural for models that use parallel spectral
365	! transforms, where the costly edge is the one that goes from the xz to
366	! the xy decomposition. (May be implemented as just a two step transpose
367	! back through yz).
368	!
369	! Additional notational convention, below. The 'x' or 'y' appended to the
370	! dimension start or end variable refers to which grid dimension is all
371	! on-processor in the given decomposition. That is ipsx and ipex are the
372	! start and end for the i-dimension in the zy decomposition where x is
373	! on-processor. ('z' is assumed for xy decomposition and not appended to
374	! the ips, ipe, etc. variable names).
375	!
376
377	! XzYy decomposition
378
379	kpsx = -1
380	j = jds ;
381	ierr = 0
382	DO k = kds, kde
383	CALL task_for_point ( k, j, kds, kde, jds, jde, ntasks_x, ntasks_y, Px, Py, &
384	1, maxhalowidth, ierr )
385	IF ( Px .EQ. mytask_x ) THEN
386	kpex = k
387	IF ( kpsx .EQ. -1 ) kpsx = k
388	ENDIF
389	ENDDO
390	IF ( ierr .NE. 0 ) THEN
391	CALL tfp_message(__FILE__,__LINE__)
392	ENDIF
393
394	! handle case where no levels are assigned to this process
395	! no iterations. Do same for I and J. Need to handle memory alloc below.
396	IF (kpsx .EQ. -1 ) THEN
397	kpex = -1
398	kpsx = 0
399	ENDIF
400
401	jpsx = -1
402	k = kds ;
403	ierr = 0
404	DO j = jds, jde
405	CALL task_for_point ( k, j, kds, kde, jds, jde, ntasks_x, ntasks_y, Px, Py, &
406	1, maxhalowidth, ierr )
407	IF ( Py .EQ. mytask_y ) THEN
408	jpex = j
409	IF ( jpsx .EQ. -1 ) jpsx = j
410	ENDIF
411	ENDDO
412	IF ( ierr .NE. 0 ) THEN
413	CALL tfp_message(__FILE__,__LINE__)
414	ENDIF
415	IF (jpsx .EQ. -1 ) THEN
416	jpex = -1
417	jpsx = 0
418	ENDIF
419
420	!begin: wig; 12-Mar-2008
421	! This appears redundant with the conditionals above, but we get cases with only
422	! one of the directions being set to "missing" when turning off extra processors.
423	! This may break the handling of setting only one of nproc_x or nproc_y via the namelist.
424	IF (ipex .EQ. -1 .or. jpex .EQ. -1) THEN
425	ipex = -1
426	ipsx = 0
427	jpex = -1
428	jpsx = 0
429	ENDIF
430	!end: wig; 12-Mar-2008
431
432	! XzYx decomposition (note, x grid dim is decomposed over Y processor dim)
433
434	kpsy = kpsx ! same as above
435	kpey = kpex ! same as above
436
437	ipsy = -1
438	k = kds ;
439	ierr = 0
440	DO i = ids, ide
441	CALL task_for_point ( i, k, ids, ide, kds, kde, ntasks_y, ntasks_x, Py, Px, &
442	maxhalowidth, 1, ierr ) ! x and y for proc mesh reversed
443	IF ( Py .EQ. mytask_y ) THEN
444	ipey = i
445	IF ( ipsy .EQ. -1 ) ipsy = i
446	ENDIF
447	ENDDO
448	IF ( ierr .NE. 0 ) THEN
449	CALL tfp_message(__FILE__,__LINE__)
450	ENDIF
451	IF (ipsy .EQ. -1 ) THEN
452	ipey = -1
453	ipsy = 0
454	ENDIF
455
456
457	#else
458
459	! In case of NMM CORE, the domain only ever runs from ids..ide-1 and jds..jde-1 so
460	! adjust decomposition to reflect. 20051020 JM
461	ips = -1
462	j = jds
463	ierr = 0
464	DO i = ids, ide-1
465	CALL task_for_point ( i, j, ids, ide-1, jds, jde-1, ntasks_x, ntasks_y, Px, Py, &
466	maxhalowidth, maxhalowidth , ierr )
467	IF ( Px .EQ. mytask_x ) THEN
468	ipe = i
469	IF ( Px .EQ. ntasks_x-1 ) ipe = ipe + 1
470	IF ( ips .EQ. -1 ) ips = i
471	ENDIF
472	ENDDO
473	IF ( ierr .NE. 0 ) THEN
474	CALL tfp_message(__FILE__,__LINE__)
475	ENDIF
476	jps = -1
477	i = ids ;
478	ierr = 0
479	DO j = jds, jde-1
480	CALL task_for_point ( i, j, ids, ide-1, jds, jde-1, ntasks_x, ntasks_y, Px, Py, &
481	maxhalowidth , maxhalowidth , ierr )
482	IF ( Py .EQ. mytask_y ) THEN
483	jpe = j
484	IF ( Py .EQ. ntasks_y-1 ) jpe = jpe + 1
485	IF ( jps .EQ. -1 ) jps = j
486	ENDIF
487	ENDDO
488	IF ( ierr .NE. 0 ) THEN
489	CALL tfp_message(__FILE__,__LINE__)
490	ENDIF
491	#endif
492
493	! extend the patch dimensions out shw along edges of domain
494	IF ( ips < ipe .and. jps < jpe ) THEN !wig; 11-Mar-2008
495	IF ( mytask_x .EQ. 0 ) THEN
496	ips = ips - shw
497	ipsy = ipsy - shw
498	ENDIF
499	IF ( mytask_x .EQ. ntasks_x-1 ) THEN
500	ipe = ipe + shw
501	ipey = ipey + shw
502	ENDIF
503	IF ( mytask_y .EQ. 0 ) THEN
504	jps = jps - shw
505	jpsx = jpsx - shw
506	ENDIF
507	IF ( mytask_y .EQ. ntasks_y-1 ) THEN
508	jpe = jpe + shw
509	jpex = jpex + shw
510	ENDIF
511	ENDIF !wig; 11-Mar-2008
512
513	kps = 1
514	kpe = kde-kds+1
515
516	kms = 1
517	kme = kpe
518	kmsx = kpsx
519	kmex = kpex
520	kmsy = kpsy
521	kmey = kpey
522
523	! handle setting the memory dimensions where there are no levels assigned to this proc
524	IF ( kpsx .EQ. 0 .AND. kpex .EQ. -1 ) THEN
525	kmsx = 0
526	kmex = 0
527	ENDIF
528	IF ( kpsy .EQ. 0 .AND. kpey .EQ. -1 ) THEN
529	kmsy = 0
530	kmey = 0
531	ENDIF
532
533	IF ( (jps .EQ. 0 .AND. jpe .EQ. -1) .OR. (ips .EQ. 0 .AND. ipe .EQ. -1) ) THEN
534	ims = 0
535	ime = 0
536	ELSE
537	ims = max( ips - max(shw,maxhalowidth), ids - bdx ) - 1
538	ime = min( ipe + max(shw,maxhalowidth), ide + bdx ) + 1
539	ENDIF
540	imsx = ids
541	imex = ide
542	ipsx = imsx
543	ipex = imex
544	! handle setting the memory dimensions where there are no Y elements assigned to this proc
545	IF ( ipsy .EQ. 0 .AND. ipey .EQ. -1 ) THEN
546	imsy = 0
547	imey = 0
548	ELSE
549	imsy = ipsy
550	imey = ipey
551	ENDIF
552
553	IF ( (jps .EQ. 0 .AND. jpe .EQ. -1) .OR. (ips .EQ. 0 .AND. ipe .EQ. -1) ) THEN
554	jms = 0
555	jme = 0
556	ELSE
557	jms = max( jps - max(shw,maxhalowidth), jds - bdy ) - 1
558	jme = min( jpe + max(shw,maxhalowidth), jde + bdy ) + 1
559	ENDIF
560	jmsx = jpsx
561	jmex = jpex
562	jmsy = jds
563	jmey = jde
564	! handle setting the memory dimensions where there are no X elements assigned to this proc
565	IF ( jpsx .EQ. 0 .AND. jpex .EQ. -1 ) THEN
566	jmsx = 0
567	jmex = 0
568	ELSE
569	jpsy = jmsy
570	jpey = jmey
571	ENDIF
572	END SUBROUTINE compute_memory_dims_rsl_lite
573
574	SUBROUTINE tfp_message( fname, lno )
575	CHARACTER() fname
576	INTEGER lno
577	CHARACTER*1024 mess
578	#ifndef STUBMPI
579	WRITE(mess,*)'tfp_message: ',trim(fname),lno
580	CALL wrf_message(mess)
581	# ifdef ALLOW_OVERDECOMP
582	CALL task_for_point_message ! defined in RSL_LITE/task_for_point.c
583	# else
584	CALL wrf_error_fatal(mess)
585	# endif
586	#endif
587	END SUBROUTINE tfp_message
588
589	SUBROUTINE wrf_message( mess )
590	CHARACTER() mess
591	PRINT*,'info: ',TRIM(mess)
592	END SUBROUTINE wrf_message
593
594	SUBROUTINE wrf_error_fatal( mess )
595	CHARACTER() mess
596	PRINT*,'fatal: ',TRIM(mess)
597	STOP
598	END SUBROUTINE wrf_error_fatal
599
600
601	PROGRAM tfp_tester
602	INTEGER id , maxhalowidth , &
603	shw , bdx, bdy , &
604	ntasks_x, ntasks_y, &
605	mytask_x, mytask_y, &
606	ids, ide, jds, jde, kds, kde, &
607	ims, ime, jms, jme, kms, kme, &
608	imsx, imex, jmsx, jmex, kmsx, kmex, &
609	imsy, imey, jmsy, jmey, kmsy, kmey, &
610	ips, ipe, jps, jpe, kps, kpe, &
611	ipsx, ipex, jpsx, jpex, kpsx, kpex, &
612	ipsy, ipey, jpsy, jpey, kpsy, kpey
613
614	INTEGER i, j
615
616	PRINT*,'id,maxhalowidth,shw,bdx,bdy ? '
617	READ(,)id,maxhalowidth,shw,bdx,bdy
618	PRINT*,'ids,ide,jds,jde,kds,kde '
619	READ(,)ids, ide, jds, jde, kds, kde
620	PRINT*,'ntasks_x,ntasks_y'
621	READ(,)ntasks_x,ntasks_y
622
623
624	DO mytask_y = 0, ntasks_y-1
625	DO mytask_x = 0, ntasks_x-1
626	CALL compute_memory_dims_rsl_lite ( &
627	id , maxhalowidth , &
628	shw , bdx, bdy , &
629	ntasks_x, ntasks_y, &
630	mytask_x, mytask_y, &
631	ids, ide, jds, jde, kds, kde, &
632	ims, ime, jms, jme, kms, kme, &
633	imsx, imex, jmsx, jmex, kmsx, kmex, &
634	imsy, imey, jmsy, jmey, kmsy, kmey, &
635	ips, ipe, jps, jpe, kps, kpe, &
636	ipsx, ipex, jpsx, jpex, kpsx, kpex, &
637	ipsy, ipey, jpsy, jpey, kpsy, kpey )
638
639	PRINT*,' mytask_x, mytask_y ',mytask_x, mytask_y
640	PRINT*,' ips, ipe, jps, jpe, kps, kpe ',ips, ipe, jps, jpe, kps, kpe
641	PRINT*,' ims, ime, jms, jme, kms, kme ',ims, ime, jms, jme, kms, kme
642	PRINT*,' ipsx, ipex, jpsx, jpex, kpsx, kpex ',ipsx, ipex, jpsx, jpex, kpsx, kpex
643	PRINT*,' imsx, imex, jmsx, jmex, kmsx, kmex ',imsx, imex, jmsx, jmex, kmsx, kmex
644	PRINT*,' ipsy, ipey, jpsy, jpey, kpsy, kpey ',ipsy, ipey, jpsy, jpey, kpsy, kpey
645	PRINT*,' imsy, imey, jmsy, jmey, kmsy, kmey ',imsy, imey, jmsy, jmey, kmsy, kmey
646	ENDDO
647	ENDDO
648	END PROGRAM tfp_tester
649

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

Download in other formats:

Original Format