examples/smpi/NAS/BT/make_set.f

   1 c---------------------------------------------------------------------
   2 c---------------------------------------------------------------------
   3
   4       subroutine make_set
   5
   6 c---------------------------------------------------------------------
   7 c---------------------------------------------------------------------
   8
   9 c---------------------------------------------------------------------
  10 c     This function allocates space for a set of cells and fills the set
  11 c     such that communication between cells on different nodes is only
  12 c     nearest neighbor
  13 c---------------------------------------------------------------------
  14
  15       include 'header.h'
  16       include 'mpinpb.h'
  17
  18
  19       integer p, i, j, c, dir, size, excess, ierr,ierrcode
  20
  21 c---------------------------------------------------------------------
  22 c     compute square root; add small number to allow for roundoff
  23 c     (note: this is computed in setup_mpi.f also, but prefer to do
  24 c     it twice because of some include file problems).
  25 c---------------------------------------------------------------------
  26       ncells = dint(dsqrt(dble(no_nodes) + 0.00001d0))
  27
  28 c---------------------------------------------------------------------
  29 c     this makes coding easier
  30 c---------------------------------------------------------------------
  31       p = ncells
  32
  33 c---------------------------------------------------------------------
  34 c     determine the location of the cell at the bottom of the 3D
  35 c     array of cells
  36 c---------------------------------------------------------------------
  37       cell_coord(1,1) = mod(node,p)
  38       cell_coord(2,1) = node/p
  39       cell_coord(3,1) = 0
  40
  41 c---------------------------------------------------------------------
  42 c     set the cell_coords for cells in the rest of the z-layers;
  43 c     this comes down to a simple linear numbering in the z-direct-
  44 c     ion, and to the doubly-cyclic numbering in the other dirs
  45 c---------------------------------------------------------------------
  46       do c=2, p
  47          cell_coord(1,c) = mod(cell_coord(1,c-1)+1,p)
  48          cell_coord(2,c) = mod(cell_coord(2,c-1)-1+p,p)
  49          cell_coord(3,c) = c-1
  50       end do
  51
  52 c---------------------------------------------------------------------
  53 c     offset all the coordinates by 1 to adjust for Fortran arrays
  54 c---------------------------------------------------------------------
  55       do dir = 1, 3
  56          do c = 1, p
  57             cell_coord(dir,c) = cell_coord(dir,c) + 1
  58          end do
  59       end do
  60
  61 c---------------------------------------------------------------------
  62 c     slice(dir,n) contains the sequence number of the cell that is in
  63 c     coordinate plane n in the dir direction
  64 c---------------------------------------------------------------------
  65       do dir = 1, 3
  66          do c = 1, p
  67             slice(dir,cell_coord(dir,c)) = c
  68          end do
  69       end do
  70
  71
  72 c---------------------------------------------------------------------
  73 c     fill the predecessor and successor entries, using the indices
  74 c     of the bottom cells (they are the same at each level of k
  75 c     anyway) acting as if full periodicity pertains; note that p is
  76 c     added to those arguments to the mod functions that might
  77 c     otherwise return wrong values when using the modulo function
  78 c---------------------------------------------------------------------
  79       i = cell_coord(1,1)-1
  80       j = cell_coord(2,1)-1
  81
  82       predecessor(1) = mod(i-1+p,p) + p*j
  83       predecessor(2) = i + p*mod(j-1+p,p)
  84       predecessor(3) = mod(i+1,p) + p*mod(j-1+p,p)
  85       successor(1)   = mod(i+1,p) + p*j
  86       successor(2)   = i + p*mod(j+1,p)
  87       successor(3)   = mod(i-1+p,p) + p*mod(j+1,p)
  88
  89 c---------------------------------------------------------------------
  90 c     now compute the sizes of the cells
  91 c---------------------------------------------------------------------
  92       do dir= 1, 3
  93 c---------------------------------------------------------------------
  94 c     set cell_coord range for each direction
  95 c---------------------------------------------------------------------
  96          size   = grid_points(dir)/p
  97          excess = mod(grid_points(dir),p)
  98          do c=1, ncells
  99             if (cell_coord(dir,c) .le. excess) then
 100                cell_size(dir,c) = size+1
 101                cell_low(dir,c) = (cell_coord(dir,c)-1)*(size+1)
 102                cell_high(dir,c) = cell_low(dir,c)+size
 103             else
 104                cell_size(dir,c) = size
 105                cell_low(dir,c)  = excess*(size+1)+
 106      >              (cell_coord(dir,c)-excess-1)*size
 107                cell_high(dir,c) = cell_low(dir,c)+size-1
 108             endif
 109             if (cell_size(dir, c) .le. 2) then
 110                write(*,50)
 111  50            format(' Error: Cell size too small. Min size is 3')
 112                call MPI_Abort(mpi_comm_world,ierrcode,ierr)
 113                stop
 114             endif
 115          end do
 116       end do
 117
 118       return
 119       end
 120
 121 c---------------------------------------------------------------------
 122 c---------------------------------------------------------------------
 123
 124