program knock
c
c this program demonstrates a very simple MPI program illustrating
c communication between two nodes.  Node 0 sends a message consisting
c of 3 integers to node 1.  Upon receipt, node 1 replies with another
c message consisting of 3 integers.
c
      implicit none
c get definition of MPI constants
      include 'mpif.h'
c
c define variables
c ierror = error indicator
c nproc = number of processors participating
c idproc = each processor's id number (0 <= idproc < nproc)
c len = length of message (in words)
c tag = message tag, used to distinguish between messages
      integer ierror, nproc, idproc, len, tag
c status = status array returned by MPI_RECV
      integer status(MPI_STATUS_SIZE)
c sendmsg = message being sent
c recvmsg = message being received
c replymsg = reply message being sent
      integer sendmsg(3), recvmsg(3), replymsg(3)
      data sendmsg /1802399587,1798073198,1868786465/
      data replymsg /2003332903,1931506792,1701995839/
      data len /3/, tag /1/
c
c initialize the MPI execution environment
      call MPI_INIT(ierror)
c stop if MPI could not be initialized
      if (ierror.ne.0) stop
c determine nproc, number of participating processors
      call MPI_COMM_SIZE(MPI_COMM_WORLD,nproc,ierror)
c determine idproc, the processor's id
      call MPI_COMM_RANK(MPI_COMM_WORLD,idproc,ierror)
c
c use only even number of processors
      nproc = 2*(nproc/2)
      if (idproc.lt.nproc) then
c even processor sends and prints message,
c then receives and prints reply
         if (mod(idproc,2).eq.0) then
            call MPI_SEND(sendmsg,len,MPI_INTEGER,idproc+1,tag,
     &MPI_COMM_WORLD,ierror)
            write (*,'("proc",i2," sent: ",3a4)') idproc, sendmsg
            call MPI_RECV(recvmsg,len,MPI_INTEGER,idproc+1,tag+1,
     &MPI_COMM_WORLD,status,ierror)
            write (*,'("proc",i2," received: ",3a4)') idproc, recvmsg
c odd processor receives and prints message,
c then sends reply and prints it
         else
            call MPI_RECV(recvmsg,len,MPI_INTEGER,idproc-1,tag,
     &MPI_COMM_WORLD,status,ierror)
            write (*,'("proc",i2," received: ",3a4)') idproc, recvmsg
            call MPI_SEND(replymsg,len,MPI_INTEGER,idproc-1,tag+1,
     &MPI_COMM_WORLD,ierror)
            write (*,'("proc",i2," sent: ",3a4)') idproc, replymsg
         endif
      endif
c
c terminate MPI execution environment
      call MPI_FINALIZE(ierror)
c
      if (idproc.lt.nproc) then
         write (*,*) 'hit carriage return to continue'
         pause
      endif
      stop
      end