PROGRAM PSDOT
*
* PSDOT performs a parallel inner (or dot) product, where the vectors
* X and Y start out on a master node, which then sets up the virtual
* machine, farms out the data and work, and sums up the local pieces
* to get a global inner product.
*
* .. External Subroutines ..
EXTERNAL PVMFMYTID, PVMFPARENT, PVMFSPAWN, PVMFEXIT, PVMFINITSEND
EXTERNAL PVMFPACK, PVMFSEND, PVMFRECV, PVMFUNPACK, SGENMAT
*
* .. External Functions ..
INTEGER ISAMAX
REAL SDOT
EXTERNAL ISAMAX, SDOT
*
* .. Intrinsic Functions ..
INTRINSIC MOD
*
* .. Parameters ..
INTEGER MAXN
PARAMETER ( MAXN = 8000 )
INCLUDE 'fpvm3.h'
*
* .. Scalars ..
INTEGER N, LN, MYTID, NPROCS, IBUF, IERR
INTEGER I, J, K
REAL LDOT, GDOT
*
* .. Arrays ..
INTEGER TIDS(0:63)
REAL X(MAXN), Y(MAXN)
*
* Enroll in PVM and get my and the master process' task ID number
*
CALL PVMFMYTID( MYTID )
CALL PVMFPARENT( TIDS(0) )
*
* If I need to spawn other processes (I am master process)
*
IF ( TIDS(0) .EQ. PVMNOPARENT ) THEN
*
* Get starting information
*
WRITE(*,*) 'How many processes should participate (1-64)?'
READ(*,*) NPROCS
WRITE(*,2000) MAXN
READ(*,*) N
TIDS(0) = MYTID
IF ( N .GT. MAXN ) THEN
WRITE(*,*) 'N too large. Increase parameter MAXN to run'//
$ 'this case.'
STOP
END IF
*
* LN is the number of elements of the dot product to do
* locally. Everyone has the same number, with the master
* getting any left over elements. J stores the number of
* elements rest of procs do.
*
J = N / NPROCS
LN = J + MOD(N, NPROCS)
I = LN + 1
*
* Randomly generate X and Y
*
CALL SGENMAT( N, 1, X, N, MYTID, NPROCS, MAXN, J )
CALL SGENMAT( N, 1, Y, N, I, N, LN, NPROCS )
*
* Loop over all worker processes
*
DO 10 K = 1, NPROCS-1
*
* Spawn process and check for error
*
CALL PVMFSPAWN( 'psdot', 0, 'anywhere', 1, TIDS(K), IERR )
IF (IERR .NE. 1) THEN
WRITE(*,*) 'ERROR, could not spawn process #',K,
$ '. Dying . . .'
CALL PVMFEXIT( IERR )
STOP
END IF
*
* Send out startup info
*
CALL PVMFINITSEND( PVMDEFAULT, IBUF )
CALL PVMFPACK( INTEGER4, J, 1, 1, IERR )
CALL PVMFPACK( REAL4, X(I), J, 1, IERR )
CALL PVMFPACK( REAL4, Y(I), J, 1, IERR )
CALL PVMFSEND( TIDS(K), 0, IERR )
I = I + J
10 CONTINUE
*
* Figure master's part of dot product
*
GDOT = SDOT( LN, X, 1, Y, 1 )
*
* Receive the local dot products, and
* add to get the global dot product
*
DO 20 K = 1, NPROCS-1
CALL PVMFRECV( -1, 1, IBUF )
CALL PVMFUNPACK( REAL4, LDOT, 1, 1, IERR )
GDOT = GDOT + LDOT
20 CONTINUE
*
* Print out result
*
WRITE(*,*) ' '
WRITE(*,*) '<x,y> = ',GDOT
*
* Do sequential dot product and subtract from
* distributed dot product to get desired error estimate
*
LDOT = SDOT( N, X, 1, Y, 1 )
WRITE(*,*) '<x,y> : sequential dot product. <x,y>^ : '//
$ 'distributed dot product.'
WRITE(*,*) '| <x,y> - <x,y>^ | = ',ABS(GDOT - LDOT)
WRITE(*,*) 'Run completed.'
*
* If I am a worker process (i.e. spawned by master process)
*
ELSE
*
* Receive startup info
*
CALL PVMFRECV( TIDS(0), 0, IBUF )
CALL PVMFUNPACK( INTEGER4, LN, 1, 1, IERR )
CALL PVMFUNPACK( REAL4, X, LN, 1, IERR )
CALL PVMFUNPACK( REAL4, Y, LN, 1, IERR )
*
* Figure local dot product and send it in to master
*
LDOT = SDOT( LN, X, 1, Y, 1 )
CALL PVMFINITSEND( PVMDEFAULT, IBUF )
CALL PVMFPACK( REAL4, LDOT, 1, 1, IERR )
CALL PVMFSEND( TIDS(0), 1, IERR )
END IF
*
CALL PVMFEXIT( 0 )
*
1000 FORMAT(I10,' Successfully spawned process #',I2,', TID =',I10)
2000 FORMAT('Enter the length of vectors to multiply (1 -',I7,'):')
STOP
*
* End program PSDOT
*
END