program master1 
      include '../include/fpvm3.h'
c ---------------------------------------------------------
c Example fortran program illustrating the use of PVM 3
c ---------------------------------------------------------
      integer i, info, nproc, nhost, msgtype
      integer mytid, iptid, dtid, tids(0:32)
      integer who, speed
      double precision result(32), data(100)
      character*18 nodename, host
      character*8 arch

c ------------ Starting up all the tasks ---------------------------

c     Enroll this program in PVM 
      call pvmfmytid( mytid )

c     Set number of slaves to spawn. 
c     Can't do standard input if master started with spawn so
c     just set nproc = number of hosts in this case. Else ask for nproc.

      call pvmfparent( iptid )
      if( iptid .gt. 1 ) then
        call pvmfconfig( nhost, narch, dtid, host, arch, speed, info )
        nproc = nhost
        if( nproc .gt. 32 ) nproc = 32
      else
        print *,'How many slave programs (1-32)?'
        read *, nproc
      endif
c
c     Initiate nproc instances of slave1 program 
c     If arch is set to '*' then ANY configured machine is acceptable
      nodename = 'slave1'
      arch = '*'
      call pvmfspawn( nodename, PVMDEFAULT, arch, nproc, tids, numt )

c     Print out task IDs of spawned tasks and check for problems
      do 100 i=0, nproc-1
         print *,'tid',i,tids(i)
100   continue
      if( numt .lt. nproc ) then
         print *, 'trouble spawning ',nodename
         print *, ' Check tids for error code'
         call shutdown( numt, tids )
      endif

c ------- Begin user program -------- 

      n = 10
c     Initiate data array
      do 20 i=1,n
         data(i) = 1
 20   continue

c     broadcast data to all node programs 
      call pvmfinitsend( PVMDEFAULT, info )
      call pvmfpack( INTEGER4, nproc, 1, 1, info )
      call pvmfpack( INTEGER4, tids, nproc, 1, info )
      call pvmfpack( INTEGER4, n, 1, 1, info )
      call pvmfpack( REAL8,    data, n, 1, info ) 
      msgtype  = 1 
      call pvmfmcast( nproc, tids, msgtype, info )
 
c     wait for results from nodes 
      msgtype  = 2 
      do 30 i=1,nproc 
         call pvmfrecv( -1, msgtype, info ) 
         call pvmfunpack( INTEGER4, who, 1, 1, info )
         call pvmfunpack( REAL8, result(who+1), 1, 1, info )
         print *, 'I got',result(who+1), '  from', who 
 30   continue 

c --------- End user program -------- 

c     program finished leave PVM before exiting 
      call pvmfexit(info) 
      stop
      end

      subroutine shutdown( nproc, tids )
      integer nproc, tids(*)
c
c     Kill all tasks I spawned and then myself
c
      do 10 i=0, nproc
         call pvmfkill( tids(i), info )
  10  continue
      call pvmfexit( info )
      return
      end