examples/smpi/NAS/LU/exchange_1.f

   1
   2 c---------------------------------------------------------------------
   3 c---------------------------------------------------------------------
   4
   5       subroutine exchange_1( g,k,iex )
   6
   7 c---------------------------------------------------------------------
   8 c---------------------------------------------------------------------
   9
  10
  11       implicit none
  12
  13       include 'mpinpb.h'
  14       include 'applu.incl'
  15
  16       double precision  g(5,-1:isiz1+2,-1:isiz2+2,isiz3)
  17       integer k
  18       integer iex
  19       integer i, j
  20       double precision dum(5,isiz1+isiz2), dum1(5,isiz1+isiz2)
  21
  22       integer STATUS(MPI_STATUS_SIZE)
  23       integer IERROR
  24
  25
  26
  27       if( iex .eq. 0 ) then
  28
  29           if( north .ne. -1 ) then
  30               call MPI_RECV( dum1(1,jst),
  31      >                       5*(jend-jst+1),
  32      >                       dp_type,
  33      >                       north,
  34      >                       from_n,
  35      >                       MPI_COMM_WORLD,
  36      >                       status,
  37      >                       IERROR )
  38               do j=jst,jend
  39                   g(1,0,j,k) = dum1(1,j)
  40                   g(2,0,j,k) = dum1(2,j)
  41                   g(3,0,j,k) = dum1(3,j)
  42                   g(4,0,j,k) = dum1(4,j)
  43                   g(5,0,j,k) = dum1(5,j)
  44               enddo
  45           endif
  46
  47           if( west .ne. -1 ) then
  48               call MPI_RECV( dum1(1,ist),
  49      >                       5*(iend-ist+1),
  50      >                       dp_type,
  51      >                       west,
  52      >                       from_w,
  53      >                       MPI_COMM_WORLD,
  54      >                       status,
  55      >                       IERROR )
  56               do i=ist,iend
  57                   g(1,i,0,k) = dum1(1,i)
  58                   g(2,i,0,k) = dum1(2,i)
  59                   g(3,i,0,k) = dum1(3,i)
  60                   g(4,i,0,k) = dum1(4,i)
  61                   g(5,i,0,k) = dum1(5,i)
  62               enddo
  63           endif
  64
  65       else if( iex .eq. 1 ) then
  66
  67           if( south .ne. -1 ) then
  68               call MPI_RECV( dum1(1,jst),
  69      >                       5*(jend-jst+1),
  70      >                       dp_type,
  71      >                       south,
  72      >                       from_s,
  73      >                       MPI_COMM_WORLD,
  74      >                       status,
  75      >                       IERROR )
  76               do j=jst,jend
  77                   g(1,nx+1,j,k) = dum1(1,j)
  78                   g(2,nx+1,j,k) = dum1(2,j)
  79                   g(3,nx+1,j,k) = dum1(3,j)
  80                   g(4,nx+1,j,k) = dum1(4,j)
  81                   g(5,nx+1,j,k) = dum1(5,j)
  82               enddo
  83           endif
  84
  85           if( east .ne. -1 ) then
  86               call MPI_RECV( dum1(1,ist),
  87      >                       5*(iend-ist+1),
  88      >                       dp_type,
  89      >                       east,
  90      >                       from_e,
  91      >                       MPI_COMM_WORLD,
  92      >                       status,
  93      >                       IERROR )
  94               do i=ist,iend
  95                   g(1,i,ny+1,k) = dum1(1,i)
  96                   g(2,i,ny+1,k) = dum1(2,i)
  97                   g(3,i,ny+1,k) = dum1(3,i)
  98                   g(4,i,ny+1,k) = dum1(4,i)
  99                   g(5,i,ny+1,k) = dum1(5,i)
 100               enddo
 101           endif
 102
 103       else if( iex .eq. 2 ) then
 104
 105           if( south .ne. -1 ) then
 106               do j=jst,jend
 107                   dum(1,j) = g(1,nx,j,k)
 108                   dum(2,j) = g(2,nx,j,k)
 109                   dum(3,j) = g(3,nx,j,k)
 110                   dum(4,j) = g(4,nx,j,k)
 111                   dum(5,j) = g(5,nx,j,k)
 112               enddo
 113               call MPI_SEND( dum(1,jst),
 114      >                       5*(jend-jst+1),
 115      >                       dp_type,
 116      >                       south,
 117      >                       from_n,
 118      >                       MPI_COMM_WORLD,
 119      >                       IERROR )
 120           endif
 121
 122           if( east .ne. -1 ) then
 123               do i=ist,iend
 124                   dum(1,i) = g(1,i,ny,k)
 125                   dum(2,i) = g(2,i,ny,k)
 126                   dum(3,i) = g(3,i,ny,k)
 127                   dum(4,i) = g(4,i,ny,k)
 128                   dum(5,i) = g(5,i,ny,k)
 129               enddo
 130               call MPI_SEND( dum(1,ist),
 131      >                       5*(iend-ist+1),
 132      >                       dp_type,
 133      >                       east,
 134      >                       from_w,
 135      >                       MPI_COMM_WORLD,
 136      >                       IERROR )
 137           endif
 138
 139       else
 140
 141           if( north .ne. -1 ) then
 142               do j=jst,jend
 143                   dum(1,j) = g(1,1,j,k)
 144                   dum(2,j) = g(2,1,j,k)
 145                   dum(3,j) = g(3,1,j,k)
 146                   dum(4,j) = g(4,1,j,k)
 147                   dum(5,j) = g(5,1,j,k)
 148               enddo
 149               call MPI_SEND( dum(1,jst),
 150      >                       5*(jend-jst+1),
 151      >                       dp_type,
 152      >                       north,
 153      >                       from_s,
 154      >                       MPI_COMM_WORLD,
 155      >                       IERROR )
 156           endif
 157
 158           if( west .ne. -1 ) then
 159               do i=ist,iend
 160                   dum(1,i) = g(1,i,1,k)
 161                   dum(2,i) = g(2,i,1,k)
 162                   dum(3,i) = g(3,i,1,k)
 163                   dum(4,i) = g(4,i,1,k)
 164                   dum(5,i) = g(5,i,1,k)
 165               enddo
 166               call MPI_SEND( dum(1,ist),
 167      >                       5*(iend-ist+1),
 168      >                       dp_type,
 169      >                       west,
 170      >                       from_e,
 171      >                       MPI_COMM_WORLD,
 172      >                       IERROR )
 173           endif
 174
 175       endif
 176
 177       end
 178
 179
 180