examples/smpi/NAS/LU/subdomain.f

   1
   2 c---------------------------------------------------------------------
   3 c---------------------------------------------------------------------
   4
   5       subroutine subdomain
   6
   7 c---------------------------------------------------------------------
   8 c---------------------------------------------------------------------
   9
  10       implicit none
  11
  12       include 'mpinpb.h'
  13       include 'applu.incl'
  14
  15 c---------------------------------------------------------------------
  16 c  local variables
  17 c---------------------------------------------------------------------
  18       integer mm, ierror, errorcode
  19
  20
  21 c---------------------------------------------------------------------
  22 c
  23 c   set up the sub-domain sizes
  24 c
  25 c---------------------------------------------------------------------
  26
  27 c---------------------------------------------------------------------
  28 c   x dimension
  29 c---------------------------------------------------------------------
  30       mm   = mod(nx0,xdim)
  31       if (row.le.mm) then
  32         nx = nx0/xdim + 1
  33         ipt = (row-1)*nx
  34       else
  35         nx = nx0/xdim
  36         ipt = (row-1)*nx + mm
  37       end if
  38
  39 c---------------------------------------------------------------------
  40 c   y dimension
  41 c---------------------------------------------------------------------
  42       mm   = mod(ny0,ydim)
  43       if (col.le.mm) then
  44         ny = ny0/ydim + 1
  45         jpt = (col-1)*ny
  46       else
  47         ny = ny0/ydim
  48         jpt = (col-1)*ny + mm
  49       end if
  50
  51 c---------------------------------------------------------------------
  52 c   z dimension
  53 c---------------------------------------------------------------------
  54       nz = nz0
  55
  56 c---------------------------------------------------------------------
  57 c   check the sub-domain size
  58 c---------------------------------------------------------------------
  59       if ( ( nx .lt. 4 ) .or.
  60      >     ( ny .lt. 4 ) .or.
  61      >     ( nz .lt. 4 ) ) then
  62          write (*,2001) nx, ny, nz
  63  2001    format (5x,'SUBDOMAIN SIZE IS TOO SMALL - ',
  64      >        /5x,'ADJUST PROBLEM SIZE OR NUMBER OF PROCESSORS',
  65      >        /5x,'SO THAT NX, NY AND NZ ARE GREATER THAN OR EQUAL',
  66      >        /5x,'TO 4 THEY ARE CURRENTLY', 3I3)
  67           CALL MPI_ABORT( MPI_COMM_WORLD,
  68      >                    ERRORCODE,
  69      >                    IERROR )
  70       end if
  71
  72       if ( ( nx .gt. isiz1 ) .or.
  73      >     ( ny .gt. isiz2 ) .or.
  74      >     ( nz .gt. isiz3 ) ) then
  75          write (*,2002) nx, ny, nz
  76  2002    format (5x,'SUBDOMAIN SIZE IS TOO LARGE - ',
  77      >        /5x,'ADJUST PROBLEM SIZE OR NUMBER OF PROCESSORS',
  78      >        /5x,'SO THAT NX, NY AND NZ ARE LESS THAN OR EQUAL TO ',
  79      >        /5x,'ISIZ1, ISIZ2 AND ISIZ3 RESPECTIVELY.  THEY ARE',
  80      >        /5x,'CURRENTLY', 3I4)
  81           CALL MPI_ABORT( MPI_COMM_WORLD,
  82      >                    ERRORCODE,
  83      >                    IERROR )
  84       end if
  85
  86
  87 c---------------------------------------------------------------------
  88 c   set up the start and end in i and j extents for all processors
  89 c---------------------------------------------------------------------
  90       ist = 1
  91       iend = nx
  92       if (north.eq.-1) ist = 2
  93       if (south.eq.-1) iend = nx - 1
  94
  95       jst = 1
  96       jend = ny
  97       if (west.eq.-1) jst = 2
  98       if (east.eq.-1) jend = ny - 1
  99
 100       return
 101       end
 102
 103