C******************************************************************************
C PVM Matrix Multiply - Fortran Version
C Master Program 
C FILE: pvm_mm.master.f
C OTHER FILES: pvm_mm.worker.f, make.pvm_mm.f
C DESCRIPTION:  PVM matrix multiply example code master task.  Fortran version.
C   In this example code, the master program acts as the parent and spawns
C   NPROC worker tasks.  The first worker task is spawned on a specific machine.
C   The master program performs the matrix multiply by sending all of matrix A
C   to every worker task and then partitioning columns of matrix B among the
C   workers.  The worker tasks perform the actual multiplications and send back
C   to the master task their respective results.
C   NOTE1:  C and Fortran versions of this code differ because of the way
C   arrays are stored/passed.  C arrays are row-major order but Fortran
C   arrays are column-major order.
C PVM VERSION: 3.x
C AUTHOR: Blaise Barney - adapted from C version
C LAST REVISED: 4/18/94 Blaise Barney
C******************************************************************************
C Explanation of constants and variables used in this program:
C   NPROC 		= number of PVM worker tasks to spawn 
C   NRA 		= number of rows in matrix A 
C   NCA 		= number of columns in matrix A 
C   NCB 		= number of columns in matrix B
C   mtid 		= PVM task id of master task 
C   wtids             	= array of PVM task ids for worker tasks 
C   mtype             	= PVM message type 
C   cols 		= columns of matrix B sent to each worker 
C   avecol, extra	= used to determine columns sent to each worker 
C   offset		= starting position within the matrix
C   rcode, i, j		= misc.
C   a            	= matrix A to be multiplied 
C   b                 	= matrix B to be multiplied
C   c           	= result matrix C 
C   thishost     	= name of selected master
C --------------------------------------------------------------------------

      program mm_master
C     PVM Version 3.0 include file
      include 'fpvm3.h'

      parameter (NPROC = 4)
      parameter (NRA = 62)
      parameter (NCA = 15)
      parameter (NCB = 7)

      integer 	mtid, wtids(NPROC), mtype, cols, avecol, extra, offset,
     &      	rcode, i, j
      real*8	a(NRA,NCA), b(NCA,NCB), c(NRA,NCB)
      character*35 thishost

C  Enroll this task in PVM 
      call pvmfmytid(mtid)

C  The master task now spawns worker tasks by calling pvm_spawn.  The unique 
C  worker task ids are stored in the wtids array.  The first worker task is 
C  spawned on a specific machine.  The return code tells the number of tasks 
C  successfully spawned, and in this example, is not checked for errors.     
      do 20 i=1, NPROC
      if (i .eq. 1) then
        write(*,9)
 9      format('Enter selected hostname - must match PVM config: ',$)
        read (*, 10) thishost
 10     format (a35)
        call pvmfspawn("mm.worker",PVMHOST,thishost,1,wtids(1),rcode)
      else
        call pvmfspawn("mm.worker", PVMDEFAULT, " ", 1, wtids(i), rcode)
      endif
 20   continue       


C  Initialize A and B 
      do 30 i=1, NRA
        do 30 j=1, NCA
        a(i,j) = (i-1)+(j-1)
 30   continue

      do 40 i=1, NCA
        do 40 j=1, NCB
	b(i,j) = (i-1)*(j-1)
 40   continue

      avecol = NCB/NPROC
      extra = mod(NCB, NPROC)
      offset = 1
      mtype = 1

C  Send data to the worker tasks 
C  First find #columns from B to send to each worker task
      do 50 i=1, NPROC
      if (i .le. extra) then
        cols = avecol + 1
      else
        cols = avecol
      endif
        
C  Next call initializes send buffer and specifies to do XDR data format 
C  conversion only in heterogenous environment 
      call pvmfinitsend(PVMDEFAULT, rcode)

C  Next four calls pack values into the send buffer - rcode not checked 
C     offset	= starting position in matrix 
C     cols	= number of columns of B to send 
C     a        	= send all of A 
C     b		= send some columns from B beginning at offset
      call pvmfpack(INTEGER4, offset, 1, 1, rcode)
      call pvmfpack(INTEGER4, cols, 1, 1, rcode)
      call pvmfpack(REAL8, a, NRA*NCA, 1, rcode)
      call pvmfpack(REAL8, b(1,offset), cols*NCA, 1, rcode)

C  Send contents of send buffer to worker task 
      call pvmfsend(wtids(i), mtype, rcode)

      offset = offset + cols
 50   continue

C  Wait for results from all worker tasks.  After setting message type,
C  loop for NPROCs.  Receive following data from each worker:
C     offset		= starting position in matrix 
C     cols		= number of columns to receive
C     c(1,offset)	= columns of matrix C beginning at offset
      mtype = 2
      do 60 i=1, NPROC
      call pvmfrecv(-1, mtype, rcode)
      call pvmfunpack(INTEGER4, offset, 1, 1, rcode)
      call pvmfunpack(INTEGER4, cols, 1, 1, rcode)
      call pvmfunpack(REAL8, c(1,offset), cols*NRA, 1, rcode)
 60   continue

C  Print results 
      do 90 i=1, NRA
        do 80 j = 1, NCB
        write(*,70)c(i,j)
 70     format(2x,f8.2,$)
 80     continue
      print *, ' '
 90   continue

C  task now exits from PVM 
      call pvmfexit(rcode)
      end