c---------------------------------------- 
c   SPMD Fortran example using PVM 3
c   also illustrates group functions
c---------------------------------------- 
       program spmd
       include '../include/fpvm3.h'
       PARAMETER( NPROC=4 )

       integer mytid, me, info
       integer tids(0:NPROC)

c      -------------
c      Enroll in pvm
c      -------------
       call pvmfmytid( mytid )

c      --------------------------------------------
c      Join a group and if I am the first instance 
c      i.e. me=0 spawn more copies of myself
c      --------------------------------------------
       call pvmfjoingroup( 'foo', me )
       print*,'me =',me, '  mytid =',mytid
       if( me .eq. 0 )  then
         call pvmfspawn('spmd',PVMDEFAULT,'*',NPROC-1,tids(1),info)
       endif
c      -----------------------------------------------------
c      Wait for everyone to startup before proceeding.
c      -----------------------------------------------------
       call pvmfbarrier( 'foo', NPROC, info )
c-----------------------------------------------------------------------------
       if( me .eq. 0 ) print*,'setup complete'

       call dowork( me, NPROC )

c      -------------------------
c      program finished leave group and exit pvm
c      -------------------------
       call pvmflvgroup( 'foo', info )
       call pvmfexit(info)
       stop
       end


       subroutine dowork( me, nproc )
       include '../include/fpvm3.h'
c-------------------------------------------------
c Simple subroutine to pass a token around a ring
c-------------------------------------------------
       integer me, nproc
 
       integer token, src, dest, count, stride, msgtag 

c      -------------------------------
c      Determine neighbors in the ring
c      -------------------------------
       call pvmfgettid( 'foo', me-1, src )
       call pvmfgettid( 'foo', me+1, dest )
       if( me .eq. 0 ) call pvmfgettid( 'foo', NPROC-1, src )
       if( me .eq. NPROC-1 ) call pvmfgettid( 'foo', 0, dest)

       count  = 1
       stride = 1
       msgtag = 4


       if( me .eq. 0 ) then
          token = dest
          call pvmfinitsend( PVMDEFAULT, info )
          call pvmfpack( INTEGER4, token, count, stride, info )
          call pvmfsend( dest, msgtag, info )
          call pvmfrecv( src, msgtag, info )
          print*, 'token ring done'
       else
          call pvmfrecv( src, msgtag, info )
          call pvmfunpack( INTEGER4, token, count, stride, info )
          call pvmfinitsend( PVMDEFAULT, info )
          call pvmfpack( INTEGER4, token, count, stride, info )
          call pvmfsend( dest, msgtag, info )
       endif
      
       return
       end
