ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      program spmd
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c     This is a trivial "hello world" program for illustrating an
c     SPMD programming style.
c
c     The first pvm task will spawn other copies of itself, and the
c     parent task will take the role of the 'manager' program.    
c
c     Contact: Karin A. Remington, karin@cam.nist.gov 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

      implicit none
c
c     Note: full path is given in INCL compilation flag in makefile:
c
      include 'fpvm3.h'
      integer maxnprocs
      parameter (maxnprocs = 32)
      integer tids(maxnprocs)
c
c     The tids array is used by PVM to hold the identifiers for the
c     spawned worker programs.  The values are used to direct messages to
c     the workers in the pvmfsend command.
c
c     The following integers are used in the PVM calls...   
      integer info, i
      integer nprocs
      integer nodeid, parentid, fromid
      integer rc, bufid, hostnm_
      character*7 my_hostname, manager_name
c
c     The following integer is used to store the message returned by the workers...
      integer noderesult
c
c     Enroll the manager program in PVM and return an id for this process...
c     read input to determine number of processes to create...
c

      call pvmfmytid(nodeid)
c
c     Get hostname:
c
      rc = hostnm_(my_hostname)
c
c     Determine whether this is the first task by checking to see
c     whether it has a parent:
c
      call pvmfparent(parentid)
c     
c     If parentid == PvmNoParent (-23), then this is the original task 
c     which will act as the 'manager'; otherwise, the task will act as a 
c     'worker'.
c
      if (parentid == PvmNoParent ) then
c
c        Read from standard input the number of processes to create...
c
         write(6,*)'Enter the number of PVM processes to create:'
         write(6,*)'NOTE: for PVMe, must be < number of nodes in pool!'
         read(5,*) nprocs
c
c        Open the file for output 
c
         open(21,file='spmd.results')
         write(6,100)   
         write(21,100)   
 100     format('------ PVM program: spmd ----- ',/)

c
c        Spawn nprocs worker programs. Their task ids will be placed in 
c        the tids array for later use in message passing.
c
         if ( nprocs > 0 ) then
c
c          Must ensure nprocs > 0 or spawn will fail.
c
           call pvmfspawn('spmd', PVMDEFAULT, '*', nprocs, tids, info)
           if (info .ne. nprocs) then
             write(6,*) 'Error in spawning; Return code is ', info
             call pvmfexit(rc)
             stop
            endif
c    
c           multi-cast (broadcast) the manager hostname to all processors...
c
            call pvmfinitsend(0,bufid)
            call pvmfpack(STRING, my_hostname, 7, 1, rc)
            call pvmfmcast(nprocs, tids, 100, rc)
c
c           Send each processor an integer value to print out, modify and 
c           return.
c
            do 10 i = 1,nprocs
              call pvmfinitsend(0, bufid)
              call pvmfpack(INTEGER4, i, 1, 1, rc)
              call pvmfsend(tids(i), 200, rc)
 10         continue
         endif
c
c        Now, this task can perform some work while the other tasks are
c        working (though in the trivial program, the work isn't too
c        meaningful.  This could normally serve to increase the number
c        of tasks by one.
c
         i = nprocs+1
         call worker(i, nodeid, my_hostname, my_hostname)
c
c        Write result from this computation:         
c
         write(6,300) nodeid, i
         write(21,300) nodeid, i
c
c        Now, as manager, this process receives and prints the results 
c        of the workers.
c
         do 20 i = 1, nprocs
           call pvmfrecv(-1, 300, bufid)
           call pvmfunpack(INTEGER4, fromid, 1, 1, rc)
           call pvmfunpack(INTEGER4, noderesult, 1, 1, rc)
           write(6,300) fromid, noderesult
           write(21,300) fromid, noderesult
 20      continue

 300     format('Result from task ',I10,': ',I4)

c
c        Close the output file:
c
         close(21)
c
c        End of the 'manager' part of the program...
c
      else
c
c        if (parentid != PvmNoParent ) then this process was spawned
c        by the 'manager' process, and will act as a worker.
c
c        Receive a broadcast containing the manager's hostname:
c
         call pvmfrecv(parentid, 100, bufid)
         call pvmfunpack(STRING, manager_name, 7, 1, rc)
c
c        Receive (and unpack) the start-up information from the manager...
c
         call pvmfrecv(parentid, 200, bufid)
         call pvmfunpack(INTEGER4, i, 1, 1, rc)

c
c        Now, do the work assigned:
c
         call worker(i, nodeid, my_hostname, manager_name)
c
c        Send the computed information back to the manager.
c
         call pvmfinitsend(0, bufid)
         call pvmfpack(INTEGER4, nodeid, 1, 1, rc)
         call pvmfpack(INTEGER4, i, 1, 1, rc)
         call pvmfsend(parentid, 300, rc)
c
c        End of the 'worker' part of the program...
c
      endif
c
c     Call pvmfexit to terminate the PVM program gracefully...
c     (manager and worker programs...)
c
      call pvmfexit(rc)

      stop
      end        

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine worker(i, nodeid, my_hostname, manager_name)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c        This is a trivial routine which only prints out the 
c     item assigned by the 'manager' and then adds 100 to it.
c     In a more realistic setting, this routine would carry out
c     the useful work of the program.  
c
c     Because the 'manager' program calls this routine, even if
c     no 'workers' are spawned, debugging of this part of the program 
c     can be carried out in a serial setting.
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

      integer i, nodeid

      character*7 my_hostname, manager_name

      write(6,100) nodeid, my_hostname, i, manager_name

 100  format('Stdout from node ',I10,' (',A,'):  Received i = ',
     *                                   I3,' from host ', A ,'.')

      i = i+100
     
      return
      end