c---------------------------------------- 
c   SPMD Fortran example using PVM 3.0
c---------------------------------------- 
       program spmd
       include '../include/fpvm3.h'
       PARAMETER( NPROC=4 )

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

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

c      -----------------------------------------------------------------
c      Find out if I am parent or child - spawned processes have parents
c      -----------------------------------------------------------------
       call pvmfparent(tids(0))
       if( tids(0) .lt. 0 )  then
         tids(0) = mytid
         me = 0
c        -------------------------
c        start up copies of myself 
c        -------------------------
         call pvmfspawn('spmd',PVMDEFAULT,'*',NPROC-1,tids(1),info)
c        ---------------------------
c        multicast tids array to children 
c        ---------------------------
         call pvmfinitsend( PVMDEFAULT, info )
         call pvmfpack( INTEGER4, tids, NPROC, 1, info )
         call pvmfmcast( NPROC-1, tids(1), 0, info )
       else 
c        ---------------------------------
c        receive the tids array and set me
c        ---------------------------------
         call pvmfrecv( tids(0), 0, info )
         call pvmfunpack( INTEGER4, tids, NPROC, 1, info )
         do 30 i=1, NPROC-1
           if( mytid .eq. tids(i) ) me = i
   30    continue 
       endif
c------------------------------------------------------------
c  all NPROC tasks are equal now
c  and can address each other by tids(0) thru tids(NPROC-1)
c  for each process me => process number [0-(NPROC-1)]
c------------------------------------------------------------
       print*,'me =',me, '  mytid =',mytid
       call dowork( me, tids, NPROC )

c      -------------------------
c      program finished exit pvm
c      -------------------------
       call pvmfexit(info)
       stop
       end

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

       count  = 1
       stride = 1
       msgtag = 4

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