external/RSL_LITE/tfp_tester.F

   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 ! xy decomposition
 284
 285     ips = -1
 286     j = jds
 287     ierr = 0
 288     DO i = ids, ide
 289        CALL task_for_point ( i, j, ids, ide, jds, jde, ntasks_x, ntasks_y, Px, Py, &
 290                              maxhalowidth, maxhalowidth, ierr )
 291        IF ( Px .EQ. mytask_x ) THEN
 292           ipe = i
 293           IF ( ips .EQ. -1 ) THEN
 294             ips = i
 295           ENDIF
 296        ENDIF
 297     ENDDO
 298     IF ( ierr .NE. 0 ) THEN
 299        CALL tfp_message(__FILE__,__LINE__)
 300     ENDIF
 301     ! handle setting the memory dimensions where there are no X elements assigned to this proc
 302     IF (ips .EQ. -1 ) THEN
 303        ipe = -1
 304        ips = 0
 305     ENDIF
 306     jps = -1
 307     i = ids
 308     ierr = 0
 309     DO j = jds, jde
 310        CALL task_for_point ( i, j, ids, ide, jds, jde, ntasks_x, ntasks_y, Px, Py, &
 311                              maxhalowidth, maxhalowidth, ierr )
 312        IF ( Py .EQ. mytask_y ) THEN
 313           jpe = j
 314           IF ( jps .EQ. -1 ) jps = j
 315        ENDIF
 316     ENDDO
 317     IF ( ierr .NE. 0 ) THEN
 318        CALL tfp_message(__FILE__,__LINE__)
 319     ENDIF
 320     ! handle setting the memory dimensions where there are no Y elements assigned to this proc
 321     IF (jps .EQ. -1 ) THEN
 322        jpe = -1
 323        jps = 0
 324     ENDIF
 325
 326 !begin: wig; 12-Mar-2008
 327 ! This appears redundant with the conditionals above, but we get cases with only
 328 ! one of the directions being set to "missing" when turning off extra processors.
 329 ! This may break the handling of setting only one of nproc_x or nproc_y via the namelist.
 330     IF (ipe .EQ. -1 .or. jpe .EQ. -1) THEN
 331        ipe = -1
 332        ips = 0
 333        jpe = -1
 334        jps = 0
 335     ENDIF
 336 !end: wig; 12-Mar-2008
 337
 338 !
 339 ! description of transpose decomposition strategy for RSL LITE. 20061231jm
 340 !
 341 ! Here is the tranpose scheme that is implemented for RSL_LITE. Upper-case
 342 ! XY corresponds to the dimension of the processor mesh, lower-case xyz
 343 ! corresponds to grid dimension.
 344 !
 345 !      xy        zy        zx
 346 !
 347 !     XxYy <--> XzYy <--> XzYx <- note x decomposed over Y procs
 348 !       ^                  ^
 349 !       |                  |
 350 !       +------------------+  <- this edge is costly; see below
 351 !
 352 ! The aim is to avoid all-to-all communication over whole
 353 ! communicator. Instead, when possible, use a transpose scheme that requires
 354 ! all-to-all within dimensional communicators; that is, communicators
 355 ! defined for the processes in a rank or column of the processor mesh. Note,
 356 ! however, it is not possible to create a ring of transposes between
 357 ! xy-yz-xz decompositions without at least one of the edges in the ring
 358 ! being fully all-to-all (in other words, one of the tranpose edges must
 359 ! rotate and not just transpose a plane of the model grid within the
 360 ! processor mesh). The issue is then, where should we put this costly edge
 361 ! in the tranpose scheme we chose? To avoid being completely arbitrary,
 362 ! we chose a scheme most natural for models that use parallel spectral
 363 ! transforms, where the costly edge is the one that goes from the xz to
 364 ! the xy decomposition.  (May be implemented as just a two step transpose
 365 ! back through yz).
 366 !
 367 ! Additional notational convention, below. The 'x' or 'y' appended to the
 368 ! dimension start or end variable refers to which grid dimension is all
 369 ! on-processor in the given decomposition. That is ipsx and ipex are the
 370 ! start and end for the i-dimension in the zy decomposition where x is
 371 ! on-processor. ('z' is assumed for xy decomposition and not appended to
 372 ! the ips, ipe, etc. variable names).
 373 !
 374
 375 ! XzYy decomposition
 376
 377     kpsx = -1
 378     j = jds ;
 379     ierr = 0
 380     DO k = kds, kde
 381        CALL task_for_point ( k, j, kds, kde, jds, jde, ntasks_x, ntasks_y, Px, Py, &
 382                              1, maxhalowidth, ierr )
 383        IF ( Px .EQ. mytask_x ) THEN
 384           kpex = k
 385           IF ( kpsx .EQ. -1 ) kpsx = k
 386        ENDIF
 387     ENDDO
 388     IF ( ierr .NE. 0 ) THEN
 389        CALL tfp_message(__FILE__,__LINE__)
 390     ENDIF
 391
 392 ! handle case where no levels are assigned to this process
 393 ! no iterations.  Do same for I and J. Need to handle memory alloc below.
 394     IF (kpsx .EQ. -1 ) THEN
 395        kpex = -1
 396        kpsx = 0
 397     ENDIF
 398
 399     jpsx = -1
 400     k = kds ;
 401     ierr = 0
 402     DO j = jds, jde
 403        CALL task_for_point ( k, j, kds, kde, jds, jde, ntasks_x, ntasks_y, Px, Py, &
 404                              1, maxhalowidth, ierr )
 405        IF ( Py .EQ. mytask_y ) THEN
 406           jpex = j
 407           IF ( jpsx .EQ. -1 ) jpsx = j
 408        ENDIF
 409     ENDDO
 410     IF ( ierr .NE. 0 ) THEN
 411        CALL tfp_message(__FILE__,__LINE__)
 412     ENDIF
 413     IF (jpsx .EQ. -1 ) THEN
 414        jpex = -1
 415        jpsx = 0
 416     ENDIF
 417
 418 !begin: wig; 12-Mar-2008
 419 ! This appears redundant with the conditionals above, but we get cases with only
 420 ! one of the directions being set to "missing" when turning off extra processors.
 421 ! This may break the handling of setting only one of nproc_x or nproc_y via the namelist.
 422     IF (ipex .EQ. -1 .or. jpex .EQ. -1) THEN
 423        ipex = -1
 424        ipsx = 0
 425        jpex = -1
 426        jpsx = 0
 427     ENDIF
 428 !end: wig; 12-Mar-2008
 429
 430 ! XzYx decomposition  (note, x grid dim is decomposed over Y processor dim)
 431
 432     kpsy = kpsx   ! same as above
 433     kpey = kpex   ! same as above
 434
 435     ipsy = -1
 436     k = kds ;
 437     ierr = 0
 438     DO i = ids, ide
 439        CALL task_for_point ( i, k, ids, ide, kds, kde, ntasks_y, ntasks_x, Py, Px, &
 440                              maxhalowidth, 1, ierr ) ! x and y for proc mesh reversed
 441        IF ( Py .EQ. mytask_y ) THEN
 442           ipey = i
 443           IF ( ipsy .EQ. -1 ) ipsy = i
 444        ENDIF
 445     ENDDO
 446     IF ( ierr .NE. 0 ) THEN
 447        CALL tfp_message(__FILE__,__LINE__)
 448     ENDIF
 449     IF (ipsy .EQ. -1 ) THEN
 450        ipey = -1
 451        ipsy = 0
 452     ENDIF
 453
 454 ! extend the patch dimensions out shw along edges of domain
 455     IF ( ips < ipe .and. jps < jpe ) THEN           !wig; 11-Mar-2008
 456        IF ( mytask_x .EQ. 0 ) THEN
 457           ips = ips - shw
 458           ipsy = ipsy - shw
 459        ENDIF
 460        IF ( mytask_x .EQ. ntasks_x-1 ) THEN
 461           ipe = ipe + shw
 462           ipey = ipey + shw
 463        ENDIF
 464        IF ( mytask_y .EQ. 0 ) THEN
 465           jps = jps - shw
 466           jpsx = jpsx - shw
 467        ENDIF
 468        IF ( mytask_y .EQ. ntasks_y-1 ) THEN
 469           jpe = jpe + shw
 470           jpex = jpex + shw
 471        ENDIF
 472     ENDIF                                           !wig; 11-Mar-2008
 473
 474     kps = 1
 475     kpe = kde-kds+1
 476
 477     kms = 1
 478     kme = kpe
 479     kmsx = kpsx
 480     kmex = kpex
 481     kmsy = kpsy
 482     kmey = kpey
 483
 484     ! handle setting the memory dimensions where there are no levels assigned to this proc
 485     IF ( kpsx .EQ. 0 .AND. kpex .EQ. -1 ) THEN
 486       kmsx = 0
 487       kmex = 0
 488     ENDIF
 489     IF ( kpsy .EQ. 0 .AND. kpey .EQ. -1 ) THEN
 490       kmsy = 0
 491       kmey = 0
 492     ENDIF
 493
 494     IF ( (jps .EQ. 0 .AND. jpe .EQ. -1) .OR. (ips .EQ. 0 .AND. ipe .EQ. -1) ) THEN
 495       ims = 0
 496       ime = 0
 497     ELSE
 498       ims = max( ips - max(shw,maxhalowidth), ids - bdx ) - 1
 499       ime = min( ipe + max(shw,maxhalowidth), ide + bdx ) + 1
 500     ENDIF
 501     imsx = ids
 502     imex = ide
 503     ipsx = imsx
 504     ipex = imex
 505     ! handle setting the memory dimensions where there are no Y elements assigned to this proc
 506     IF ( ipsy .EQ. 0 .AND. ipey .EQ. -1 ) THEN
 507       imsy = 0
 508       imey = 0
 509     ELSE
 510       imsy = ipsy
 511       imey = ipey
 512     ENDIF
 513
 514     IF ( (jps .EQ. 0 .AND. jpe .EQ. -1) .OR. (ips .EQ. 0 .AND. ipe .EQ. -1) ) THEN
 515       jms = 0
 516       jme = 0
 517     ELSE
 518       jms = max( jps - max(shw,maxhalowidth), jds - bdy ) - 1
 519       jme = min( jpe + max(shw,maxhalowidth), jde + bdy ) + 1
 520     ENDIF
 521     jmsx = jpsx
 522     jmex = jpex
 523     jmsy = jds
 524     jmey = jde
 525     ! handle setting the memory dimensions where there are no X elements assigned to this proc
 526     IF ( jpsx .EQ. 0 .AND. jpex .EQ. -1 ) THEN
 527       jmsx = 0
 528       jmex = 0
 529     ELSE
 530       jpsy = jmsy
 531       jpey = jmey
 532     ENDIF
 533 END SUBROUTINE compute_memory_dims_rsl_lite
 534
 535 SUBROUTINE tfp_message( fname, lno )
 536    CHARACTER*(*) fname
 537    INTEGER lno
 538    CHARACTER*1024 mess
 539 #ifndef STUBMPI
 540    WRITE(mess,*)'tfp_message: ',trim(fname),lno
 541    CALL wrf_message(mess)
 542 # ifdef ALLOW_OVERDECOMP
 543      CALL task_for_point_message  ! defined in RSL_LITE/task_for_point.c
 544 # else
 545      CALL wrf_error_fatal(mess)
 546 # endif
 547 #endif
 548 END SUBROUTINE tfp_message
 549
 550 SUBROUTINE wrf_message( mess )
 551   CHARACTER*(*) mess
 552   PRINT*,'info: ',TRIM(mess)
 553 END SUBROUTINE wrf_message
 554
 555 SUBROUTINE wrf_error_fatal( mess )
 556   CHARACTER*(*) mess
 557   PRINT*,'fatal: ',TRIM(mess)
 558   STOP
 559 END SUBROUTINE wrf_error_fatal
 560
 561
 562 PROGRAM tfp_tester
 563      INTEGER       id , maxhalowidth ,            &
 564                    shw , bdx,  bdy ,              &
 565                    ntasks_x, ntasks_y, &
 566                    mytask_x, mytask_y, &
 567                    ids,  ide,  jds,  jde,  kds,  kde, &
 568                    ims,  ime,  jms,  jme,  kms,  kme, &
 569                    imsx, imex, jmsx, jmex, kmsx, kmex, &
 570                    imsy, imey, jmsy, jmey, kmsy, kmey, &
 571                    ips,  ipe,  jps,  jpe,  kps,  kpe, &
 572                    ipsx, ipex, jpsx, jpex, kpsx, kpex, &
 573                    ipsy, ipey, jpsy, jpey, kpsy, kpey
 574
 575      INTEGER i, j
 576
 577      PRINT*,'id,maxhalowidth,shw,bdx,bdy ? '
 578      READ(*,*)id,maxhalowidth,shw,bdx,bdy
 579      PRINT*,'ids,ide,jds,jde,kds,kde '
 580      READ(*,*)ids,  ide,  jds,  jde,  kds,  kde
 581      PRINT*,'ntasks_x,ntasks_y'
 582      READ(*,*)ntasks_x,ntasks_y
 583
 584
 585      DO mytask_y = 0, ntasks_y-1
 586      DO mytask_x = 0, ntasks_x-1
 587        CALL compute_memory_dims_rsl_lite  (      &
 588                      id , maxhalowidth ,            &
 589                      shw , bdx,  bdy ,              &
 590                      ntasks_x, ntasks_y, &
 591                      mytask_x, mytask_y, &
 592                      ids,  ide,  jds,  jde,  kds,  kde, &
 593                      ims,  ime,  jms,  jme,  kms,  kme, &
 594                      imsx, imex, jmsx, jmex, kmsx, kmex, &
 595                      imsy, imey, jmsy, jmey, kmsy, kmey, &
 596                      ips,  ipe,  jps,  jpe,  kps,  kpe, &
 597                      ipsx, ipex, jpsx, jpex, kpsx, kpex, &
 598                      ipsy, ipey, jpsy, jpey, kpsy, kpey )
 599
 600        PRINT*,' mytask_x, mytask_y ',mytask_x, mytask_y
 601        PRINT*,' ips,  ipe,  jps,  jpe,  kps,  kpe  ',ips,  ipe,  jps,  jpe,  kps,  kpe
 602        PRINT*,' ims,  ime,  jms,  jme,  kms,  kme  ',ims,  ime,  jms,  jme,  kms,  kme
 603        PRINT*,' ipsx, ipex, jpsx, jpex, kpsx, kpex ',ipsx, ipex, jpsx, jpex, kpsx, kpex
 604        PRINT*,' imsx, imex, jmsx, jmex, kmsx, kmex ',imsx, imex, jmsx, jmex, kmsx, kmex
 605        PRINT*,' ipsy, ipey, jpsy, jpey, kpsy, kpey ',ipsy, ipey, jpsy, jpey, kpsy, kpey
 606        PRINT*,' imsy, imey, jmsy, jmey, kmsy, kmey ',imsy, imey, jmsy, jmey, kmsy, kmey
 607      ENDDO
 608      ENDDO
 609 END PROGRAM tfp_tester
 610