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       LOGICAL FLAG
  32
  33       CALL MPI_INIT(IERR)
  34       CALL MPI_COMM_RANK
  35      $     (MPI_COMM_WORLD,INODE,IERR)
  36       CALL MPI_COMM_SIZE
  37      $     (MPI_COMM_WORLD,ITOTNODE,IERR)
  38       CALL MPI_ATTR_GET
  39      $     (MPI_COMM_WORLD,MPI_TAG_UB,TAG_UP_BD,FLAG,IERR)
  40
  41       IF (.NOT.FLAG) STOP
  42
  43       CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)
  44
  45       ID = 0
  46
  47       DO 10 MES_SIZE=STRT,STOP,STEP
  48
  49          DO 20 MES_NUM=1,NUM_LOOPS
  50
  51             MESSAGE1(1) =  1.
  52             MESSAGE2(1) =  2.
  53
  54             MES_ID1 = ID
  55             ID = ID + 100
  56             IF (ID.GE.TAG_UP_BD) ID = 0
  57             FROM1   = 0
  58             TO1     = ITOTNODE-1
  59
  60             MES_ID2 = ID
  61             ID = ID + 100
  62             IF (ID.GE.TAG_UP_BD) ID = 0
  63             FROM2   = ITOTNODE-1
  64             TO2     = 0
  65
  66             IF (INODE.EQ.0) THEN
  67
  68                CALL MPI_SEND(
  69      $              MESSAGE1,MES_SIZE,MPI_REAL,
  70      $              TO1,MES_ID1,MPI_COMM_WORLD,
  71      $              IERR)
  72
  73                CALL MPI_RECV(
  74      $              MESSAGE2,MES_SIZE,MPI_REAL,
  75      $              FROM2,MES_ID2,MPI_COMM_WORLD,
  76      $              STATUS,IERR)
  77
  78             ENDIF
  79
  80             IF (INODE.EQ.(ITOTNODE-1)) THEN
  81
  82                CALL MPI_RECV(
  83      $              MESSAGE1,MES_SIZE,MPI_REAL,
  84      $              FROM1,MES_ID1,MPI_COMM_WORLD,
  85      $              STATUS,IERR)
  86
  87                CALL MPI_SEND(
  88      $              MESSAGE2,MES_SIZE,MPI_REAL,
  89      $              TO2,MES_ID2,MPI_COMM_WORLD,
  90      $              IERR)
  91
  92             ENDIF
  93
  94             CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)
  95
  96             IF (INODE.EQ.0 .AND. VERBOSE) THEN
  97                WRITE (*,'(5I10)')
  98      $              MES_SIZE,MES_NUM,TO1,FROM1,MES_ID1
  99                WRITE (*,'(5I10)')
 100      $              MES_SIZE,MES_NUM,TO2,FROM2,MES_ID2
 101                WRITE (*,'(5I10)')
 102             ENDIF
 103
 104  20      CONTINUE
 105
 106  10   CONTINUE
 107       IF (INODE.EQ.0) THEN
 108 C        If we get here at all, we're ok
 109          PRINT *, ' No Errors'
 110       ENDIF
 111       CALL MPI_FINALIZE(IERR)
 112
 113       END