examples/smpi/NAS/LU/exchange_5.f

   1
   2 c---------------------------------------------------------------------
   3 c---------------------------------------------------------------------
   4
   5       subroutine exchange_5(g,ibeg,ifin1)
   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(0:isiz2+1,0:isiz3+1)
  23       integer ibeg, ifin1
  24
  25 c---------------------------------------------------------------------
  26 c  local variables
  27 c---------------------------------------------------------------------
  28       integer k
  29       double precision  dum(1024)
  30
  31       integer msgid1
  32       integer STATUS(MPI_STATUS_SIZE)
  33       integer IERROR
  34
  35
  36
  37 c---------------------------------------------------------------------
  38 c   communicate in the south and north directions
  39 c---------------------------------------------------------------------
  40
  41 c---------------------------------------------------------------------
  42 c   receive from south
  43 c---------------------------------------------------------------------
  44       if (ifin1.eq.nx) then
  45         call MPI_IRECV( dum,
  46      >                  nz,
  47      >                  dp_type,
  48      >                  MPI_ANY_SOURCE,
  49      >                  from_s,
  50      >                  MPI_COMM_WORLD,
  51      >                  msgid1,
  52      >                  IERROR )
  53
  54         call MPI_WAIT( msgid1, STATUS, IERROR )
  55
  56         do k = 1,nz
  57           g(nx+1,k) = dum(k)
  58         end do
  59
  60       end if
  61
  62 c---------------------------------------------------------------------
  63 c   send north
  64 c---------------------------------------------------------------------
  65       if (ibeg.eq.1) then
  66         do k = 1,nz
  67           dum(k) = g(1,k)
  68         end do
  69
  70         call MPI_SEND( dum,
  71      >                 nz,
  72      >                 dp_type,
  73      >                 north,
  74      >                 from_s,
  75      >                 MPI_COMM_WORLD,
  76      >                 IERROR )
  77
  78       end if
  79
  80       return
  81       end