source: lmdz_wrf/trunk/WRFV3/external/RSL_LITE/tfp_tester.F @ 1361

Last change on this file since 1361 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
10MODULE 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
110END MODULE module_driver_constants
111
112MODULE 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
252END MODULE module_machine
253
254SUBROUTINE 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
572END SUBROUTINE compute_memory_dims_rsl_lite
573
574SUBROUTINE 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
587END SUBROUTINE tfp_message
588
589SUBROUTINE wrf_message( mess )
590  CHARACTER*(*) mess
591  PRINT*,'info: ',TRIM(mess)
592END SUBROUTINE wrf_message
593
594SUBROUTINE wrf_error_fatal( mess )
595  CHARACTER*(*) mess
596  PRINT*,'fatal: ',TRIM(mess)
597  STOP
598END SUBROUTINE wrf_error_fatal
599
600
601PROGRAM 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
648END PROGRAM tfp_tester
649
Note: See TracBrowser for help on using the repository browser.