examples/smpi/NAS/LU/exchange_3.f

   1
   2 c---------------------------------------------------------------------
   3 c---------------------------------------------------------------------
   4
   5       subroutine exchange_3(g,iex)
   6
   7 c---------------------------------------------------------------------
   8 c---------------------------------------------------------------------
   9
  10 c---------------------------------------------------------------------
  11 c   compute the right hand side based on exact solution
  12 c---------------------------------------------------------------------
  13
  14       implicit none
  15
  16       include 'mpinpb.h'
  17       include 'applu.incl'
  18
  19 c---------------------------------------------------------------------
  20 c  input parameters
  21 c---------------------------------------------------------------------
  22       double precision  g(5,-1:isiz1+2,-1:isiz2+2,isiz3)
  23       integer iex
  24
  25 c---------------------------------------------------------------------
  26 c  local variables
  27 c---------------------------------------------------------------------
  28       integer i, j, k
  29       integer ipos1, ipos2
  30
  31       integer mid
  32       integer STATUS(MPI_STATUS_SIZE)
  33       integer IERROR
  34
  35
  36
  37       if (iex.eq.0) then
  38 c---------------------------------------------------------------------
  39 c   communicate in the south and north directions
  40 c---------------------------------------------------------------------
  41       if (north.ne.-1) then
  42           call MPI_IRECV( buf1,
  43      >                    10*ny*nz,
  44      >                    dp_type,
  45      >                    MPI_ANY_SOURCE,
  46      >                    from_n,
  47      >                    MPI_COMM_WORLD,
  48      >                    mid,
  49      >                    IERROR )
  50       end if
  51
  52 c---------------------------------------------------------------------
  53 c   send south
  54 c---------------------------------------------------------------------
  55       if (south.ne.-1) then
  56           do k = 1,nz
  57             do j = 1,ny
  58               ipos1 = (k-1)*ny + j
  59               ipos2 = ipos1 + ny*nz
  60               buf(1,ipos1) = g(1,nx-1,j,k)
  61               buf(2,ipos1) = g(2,nx-1,j,k)
  62               buf(3,ipos1) = g(3,nx-1,j,k)
  63               buf(4,ipos1) = g(4,nx-1,j,k)
  64               buf(5,ipos1) = g(5,nx-1,j,k)
  65               buf(1,ipos2) = g(1,nx,j,k)
  66               buf(2,ipos2) = g(2,nx,j,k)
  67               buf(3,ipos2) = g(3,nx,j,k)
  68               buf(4,ipos2) = g(4,nx,j,k)
  69               buf(5,ipos2) = g(5,nx,j,k)
  70             end do
  71           end do
  72
  73           call MPI_SEND( buf,
  74      >                   10*ny*nz,
  75      >                   dp_type,
  76      >                   south,
  77      >                   from_n,
  78      >                   MPI_COMM_WORLD,
  79      >                   IERROR )
  80         end if
  81
  82 c---------------------------------------------------------------------
  83 c   receive from north
  84 c---------------------------------------------------------------------
  85         if (north.ne.-1) then
  86           call MPI_WAIT( mid, STATUS, IERROR )
  87
  88           do k = 1,nz
  89             do j = 1,ny
  90               ipos1 = (k-1)*ny + j
  91               ipos2 = ipos1 + ny*nz
  92               g(1,-1,j,k) = buf1(1,ipos1)
  93               g(2,-1,j,k) = buf1(2,ipos1)
  94               g(3,-1,j,k) = buf1(3,ipos1)
  95               g(4,-1,j,k) = buf1(4,ipos1)
  96               g(5,-1,j,k) = buf1(5,ipos1)
  97               g(1,0,j,k) = buf1(1,ipos2)
  98               g(2,0,j,k) = buf1(2,ipos2)
  99               g(3,0,j,k) = buf1(3,ipos2)
 100               g(4,0,j,k) = buf1(4,ipos2)
 101               g(5,0,j,k) = buf1(5,ipos2)
 102             end do
 103           end do
 104
 105         end if
 106
 107       if (south.ne.-1) then
 108           call MPI_IRECV( buf1,
 109      >                    10*ny*nz,
 110      >                    dp_type,
 111      >                    MPI_ANY_SOURCE,
 112      >                    from_s,
 113      >                    MPI_COMM_WORLD,
 114      >                    mid,
 115      >                    IERROR )
 116       end if
 117
 118 c---------------------------------------------------------------------
 119 c   send north
 120 c---------------------------------------------------------------------
 121         if (north.ne.-1) then
 122           do k = 1,nz
 123             do j = 1,ny
 124               ipos1 = (k-1)*ny + j
 125               ipos2 = ipos1 + ny*nz
 126               buf(1,ipos1) = g(1,2,j,k)
 127               buf(2,ipos1) = g(2,2,j,k)
 128               buf(3,ipos1) = g(3,2,j,k)
 129               buf(4,ipos1) = g(4,2,j,k)
 130               buf(5,ipos1) = g(5,2,j,k)
 131               buf(1,ipos2) = g(1,1,j,k)
 132               buf(2,ipos2) = g(2,1,j,k)
 133               buf(3,ipos2) = g(3,1,j,k)
 134               buf(4,ipos2) = g(4,1,j,k)
 135               buf(5,ipos2) = g(5,1,j,k)
 136             end do
 137           end do
 138
 139           call MPI_SEND( buf,
 140      >                   10*ny*nz,
 141      >                   dp_type,
 142      >                   north,
 143      >                   from_s,
 144      >                   MPI_COMM_WORLD,
 145      >                   IERROR )
 146         end if
 147
 148 c---------------------------------------------------------------------
 149 c   receive from south
 150 c---------------------------------------------------------------------
 151         if (south.ne.-1) then
 152           call MPI_WAIT( mid, STATUS, IERROR )
 153
 154           do k = 1,nz
 155             do j = 1,ny
 156               ipos1 = (k-1)*ny + j
 157               ipos2 = ipos1 + ny*nz
 158               g(1,nx+2,j,k)  = buf1(1,ipos1)
 159               g(2,nx+2,j,k)  = buf1(2,ipos1)
 160               g(3,nx+2,j,k)  = buf1(3,ipos1)
 161               g(4,nx+2,j,k)  = buf1(4,ipos1)
 162               g(5,nx+2,j,k)  = buf1(5,ipos1)
 163               g(1,nx+1,j,k) = buf1(1,ipos2)
 164               g(2,nx+1,j,k) = buf1(2,ipos2)
 165               g(3,nx+1,j,k) = buf1(3,ipos2)
 166               g(4,nx+1,j,k) = buf1(4,ipos2)
 167               g(5,nx+1,j,k) = buf1(5,ipos2)
 168             end do
 169           end do
 170         end if
 171
 172       else
 173
 174 c---------------------------------------------------------------------
 175 c   communicate in the east and west directions
 176 c---------------------------------------------------------------------
 177       if (west.ne.-1) then
 178           call MPI_IRECV( buf1,
 179      >                    10*nx*nz,
 180      >                    dp_type,
 181      >                    MPI_ANY_SOURCE,
 182      >                    from_w,
 183      >                    MPI_COMM_WORLD,
 184      >                    mid,
 185      >                    IERROR )
 186       end if
 187
 188 c---------------------------------------------------------------------
 189 c   send east
 190 c---------------------------------------------------------------------
 191         if (east.ne.-1) then
 192           do k = 1,nz
 193             do i = 1,nx
 194               ipos1 = (k-1)*nx + i
 195               ipos2 = ipos1 + nx*nz
 196               buf(1,ipos1) = g(1,i,ny-1,k)
 197               buf(2,ipos1) = g(2,i,ny-1,k)
 198               buf(3,ipos1) = g(3,i,ny-1,k)
 199               buf(4,ipos1) = g(4,i,ny-1,k)
 200               buf(5,ipos1) = g(5,i,ny-1,k)
 201               buf(1,ipos2) = g(1,i,ny,k)
 202               buf(2,ipos2) = g(2,i,ny,k)
 203               buf(3,ipos2) = g(3,i,ny,k)
 204               buf(4,ipos2) = g(4,i,ny,k)
 205               buf(5,ipos2) = g(5,i,ny,k)
 206             end do
 207           end do
 208
 209           call MPI_SEND( buf,
 210      >                   10*nx*nz,
 211      >                   dp_type,
 212      >                   east,
 213      >                   from_w,
 214      >                   MPI_COMM_WORLD,
 215      >                   IERROR )
 216         end if
 217
 218 c---------------------------------------------------------------------
 219 c   receive from west
 220 c---------------------------------------------------------------------
 221         if (west.ne.-1) then
 222           call MPI_WAIT( mid, STATUS, IERROR )
 223
 224           do k = 1,nz
 225             do i = 1,nx
 226               ipos1 = (k-1)*nx + i
 227               ipos2 = ipos1 + nx*nz
 228               g(1,i,-1,k) = buf1(1,ipos1)
 229               g(2,i,-1,k) = buf1(2,ipos1)
 230               g(3,i,-1,k) = buf1(3,ipos1)
 231               g(4,i,-1,k) = buf1(4,ipos1)
 232               g(5,i,-1,k) = buf1(5,ipos1)
 233               g(1,i,0,k) = buf1(1,ipos2)
 234               g(2,i,0,k) = buf1(2,ipos2)
 235               g(3,i,0,k) = buf1(3,ipos2)
 236               g(4,i,0,k) = buf1(4,ipos2)
 237               g(5,i,0,k) = buf1(5,ipos2)
 238             end do
 239           end do
 240
 241         end if
 242
 243       if (east.ne.-1) then
 244           call MPI_IRECV( buf1,
 245      >                    10*nx*nz,
 246      >                    dp_type,
 247      >                    MPI_ANY_SOURCE,
 248      >                    from_e,
 249      >                    MPI_COMM_WORLD,
 250      >                    mid,
 251      >                    IERROR )
 252       end if
 253
 254 c---------------------------------------------------------------------
 255 c   send west
 256 c---------------------------------------------------------------------
 257       if (west.ne.-1) then
 258           do k = 1,nz
 259             do i = 1,nx
 260               ipos1 = (k-1)*nx + i
 261               ipos2 = ipos1 + nx*nz
 262               buf(1,ipos1) = g(1,i,2,k)
 263               buf(2,ipos1) = g(2,i,2,k)
 264               buf(3,ipos1) = g(3,i,2,k)
 265               buf(4,ipos1) = g(4,i,2,k)
 266               buf(5,ipos1) = g(5,i,2,k)
 267               buf(1,ipos2) = g(1,i,1,k)
 268               buf(2,ipos2) = g(2,i,1,k)
 269               buf(3,ipos2) = g(3,i,1,k)
 270               buf(4,ipos2) = g(4,i,1,k)
 271               buf(5,ipos2) = g(5,i,1,k)
 272             end do
 273           end do
 274
 275           call MPI_SEND( buf,
 276      >                   10*nx*nz,
 277      >                   dp_type,
 278      >                   west,
 279      >                   from_e,
 280      >                   MPI_COMM_WORLD,
 281      >                   IERROR )
 282         end if
 283
 284 c---------------------------------------------------------------------
 285 c   receive from east
 286 c---------------------------------------------------------------------
 287         if (east.ne.-1) then
 288           call MPI_WAIT( mid, STATUS, IERROR )
 289
 290           do k = 1,nz
 291             do i = 1,nx
 292               ipos1 = (k-1)*nx + i
 293               ipos2 = ipos1 + nx*nz
 294               g(1,i,ny+2,k)  = buf1(1,ipos1)
 295               g(2,i,ny+2,k)  = buf1(2,ipos1)
 296               g(3,i,ny+2,k)  = buf1(3,ipos1)
 297               g(4,i,ny+2,k)  = buf1(4,ipos1)
 298               g(5,i,ny+2,k)  = buf1(5,ipos1)
 299               g(1,i,ny+1,k) = buf1(1,ipos2)
 300               g(2,i,ny+1,k) = buf1(2,ipos2)
 301               g(3,i,ny+1,k) = buf1(3,ipos2)
 302               g(4,i,ny+1,k) = buf1(4,ipos2)
 303               g(5,i,ny+1,k) = buf1(5,ipos2)
 304             end do
 305           end do
 306
 307         end if
 308
 309       end if
 310
 311       return
 312       end