teshsuite/smpi/mpich-test/pt2pt/send1.f

   1 C
   2 C Test program from Kevin Maguire (K.Maguire@dl.ac.uk); hung earlier
   3 C T3D verions.  Modified by WDG to be Fortran 77
   4 C
   5       PROGRAM TEST
   6       IMPLICIT NONE
   7
   8       INCLUDE 'mpif.h'
   9
  10       INTEGER STRT,STOP,STEP
  11       PARAMETER ( STRT = 1 , STOP = 1000 , STEP = 10 )
  12
  13       INTEGER MAX_MESS
  14       PARAMETER (MAX_MESS = STOP)
  15
  16       INTEGER NUM_LOOPS
  17       PARAMETER (NUM_LOOPS = 5)
  18
  19       LOGICAL VERBOSE
  20       PARAMETER (VERBOSE = .FALSE.)
  21
  22       REAL MESSAGE1(MAX_MESS),MESSAGE2(MAX_MESS)
  23
  24       INTEGER MES_SIZE,MES_NUM,ID,IERR
  25       INTEGER TO1,FROM1,MES_ID1
  26       INTEGER TO2,FROM2,MES_ID2
  27       INTEGER INODE,ITOTNODE
  28       INTEGER STATUS(MPI_STATUS_SIZE)
  29
  30       INTEGER TAG_UP_BD
  31
  32       CALL MPI_INIT(IERR)
  33       CALL MPI_COMM_RANK
  34      $     (MPI_COMM_WORLD,INODE,IERR)
  35       CALL MPI_COMM_SIZE
  36      $     (MPI_COMM_WORLD,ITOTNODE,IERR)
  37 C      CALL MPI_ATTR_GET
  38 C     $     (MPI_COMM_WORLD,MPI_TAG_UB,TAG_UP_BD,FLAG,IERR)
  39       TAG_UP_BD=1000000
  40
  41       CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)
  42
  43       ID = 0
  44
  45       DO 10 MES_SIZE=STRT,STOP,STEP
  46
  47          DO 20 MES_NUM=1,NUM_LOOPS
  48
  49             MESSAGE1(1) =  1.
  50             MESSAGE2(1) =  2.
  51
  52             MES_ID1 = ID
  53             ID = ID + 100
  54             IF (ID.GE.TAG_UP_BD) ID = 0
  55             FROM1   = 0
  56             TO1     = ITOTNODE-1
  57
  58             MES_ID2 = ID
  59             ID = ID + 100
  60             IF (ID.GE.TAG_UP_BD) ID = 0
  61             FROM2   = ITOTNODE-1
  62             TO2     = 0
  63
  64             IF (INODE.EQ.0) THEN
  65
  66                CALL MPI_SEND(
  67      $              MESSAGE1,MES_SIZE,MPI_REAL,
  68      $              TO1,MES_ID1,MPI_COMM_WORLD,
  69      $              IERR)
  70
  71                CALL MPI_RECV(
  72      $              MESSAGE2,MES_SIZE,MPI_REAL,
  73      $              FROM2,MES_ID2,MPI_COMM_WORLD,
  74      $              STATUS,IERR)
  75
  76             ENDIF
  77
  78             IF (INODE.EQ.(ITOTNODE-1)) THEN
  79
  80                CALL MPI_RECV(
  81      $              MESSAGE1,MES_SIZE,MPI_REAL,
  82      $              FROM1,MES_ID1,MPI_COMM_WORLD,
  83      $              STATUS,IERR)
  84
  85                CALL MPI_SEND(
  86      $              MESSAGE2,MES_SIZE,MPI_REAL,
  87      $              TO2,MES_ID2,MPI_COMM_WORLD,
  88      $              IERR)
  89
  90             ENDIF
  91
  92             CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)
  93
  94             IF (INODE.EQ.0 .AND. VERBOSE) THEN
  95                WRITE (*,'(5I10)')
  96      $              MES_SIZE,MES_NUM,TO1,FROM1,MES_ID1
  97                WRITE (*,'(5I10)')
  98      $              MES_SIZE,MES_NUM,TO2,FROM2,MES_ID2
  99                WRITE (*,'(5I10)')
 100             ENDIF
 101
 102  20      CONTINUE
 103
 104  10   CONTINUE
 105       IF (INODE.EQ.0) THEN
 106 C        If we get here at all, we're ok
 107          PRINT *, ' No Errors'
 108       ENDIF
 109       CALL MPI_FINALIZE(IERR)
 110
 111       END