There are two ways of indexing into this file. You may click on a particular example, to go to the beginning of the indicated routine. If you are interested in seeing a call to a particular BLACS routine, you may click on its name or classification in the routine list, and you will be taken to the specific call within an example routine. Please note that the call to the selected BLACS routine will be at the top of your screen, so you will probably want to scroll upward in order to see the code before the call.
Example (sub)routines:
PROGRAM HELLO
* -- BLACS example code --
* Written by Clint Whaley 7/26/94
* Performs a simple check-in type hello world
* ..
* .. External Functions ..
INTEGER BLACS_PNUM
EXTERNAL BLACS_PNUM
* ..
* .. Variable Declaration ..
INTEGER CONTXT, IAM, NPROCS, NPROW, NPCOL, MYPROW, MYPCOL
INTEGER ICALLER, I, J, HISROW, HISCOL
*
* Determine my process number and the number of processes in
* machine
*
CALL BLACS_PINFO(IAM, NPROCS)
*
* If in PVM, create virtual machine if it doesn't exist
*
IF (NPROCS .LT. 1) THEN
IF (IAM .EQ. 0) THEN
WRITE(*, 1000)
READ(*, 2000) NPROCS
END IF
CALL BLACS_SETUP(IAM, NPROCS)
END IF
*
* Set up process grid that is as close to square as possible
*
NPROW = INT( SQRT( REAL(NPROCS) ) )
NPCOL = NPROCS / NPROW
*
* Get default system context, and define grid
*
CALL BLACS_GET(0, 0, CONTXT)
CALL BLACS_GRIDINIT(CONTXT, 'Row', NPROW, NPCOL)
CALL BLACS_GRIDINFO(CONTXT, NPROW, NPCOL, MYPROW, MYPCOL)
*
* If I'm not in grid, go to end of program
*
IF ( (MYPROW.GE.NPROW) .OR. (MYPCOL.GE.NPCOL) ) GOTO 30
*
* Get my process ID from my grid coordinates
*
ICALLER = BLACS_PNUM(CONTXT, MYPROW, MYPCOL)
*
* If I am process {0,0}, receive check-in messages from
* all nodes
*
IF ( (MYPROW.EQ.0) .AND. (MYPCOL.EQ.0) ) THEN
WRITE(*,*) ' '
DO 20 I = 0, NPROW-1
DO 10 J = 0, NPCOL-1
IF ( (I.NE.0) .OR. (J.NE.0) ) THEN
CALL IGERV2D(CONTXT, 1, 1, ICALLER, 1, I, J)
ENDIF
*
* Make sure ICALLER is where we think in process grid
*
CALL BLACS_PCOORD(CONTXT, ICALLER, HISROW, HISCOL)
IF ( (HISROW.NE.I) .OR. (HISCOL.NE.J) ) THEN
WRITE(*,*) 'Grid error! Halting . . .'
STOP
END IF
WRITE(*, 3000) I, J, ICALLER
10 CONTINUE
20 CONTINUE
WRITE(*,*) ' '
WRITE(*,*) 'All processes checked in. Run finished.'
*
* All processes but {0,0} send process ID as a check-in
*
ELSE
CALL IGESD2D(CONTXT, 1, 1, ICALLER, 1, 0, 0)
END IF
30 CONTINUE
CALL BLACS_EXIT(0)
1000 FORMAT('How many processes in machine?')
2000 FORMAT(I)
3000 FORMAT('Process {',i2,',',i2,'} (node number =',I,
$ ') has checked in.')
STOP
END
DOUBLE PRECISION FUNCTION PDDOT( CONTXT, N, X, Y )
*
* -- BLACS example code --
* Written by Clint Whaley 7/26/94.
* ..
* .. Scalar Arguments ..
INTEGER CONTXT, N
* ..
* .. Array Arguments ..
DOUBLE PRECISION X(*), Y(*)
* ..
*
* Purpose
* =======
* PDDOT is a restricted parallel version of the BLAS routine
* DDOT. It assumes that the increment on both vectors is one,
* and that process {0,0} starts out owning the vectors and
* has N. It returns the dot product of the two N-length vectors
* X and Y, i.e. PDDOT = X' Y.
*
* Arguments
* =========
*
* CONTEXT (input) INTEGER
* This integer is passed to the BLACS to indicate a context.
* A context is a universe where messages exist and do not
* interact with other context's messages. The context includes
* the definition of a grid, and each process's coordinates in it.
*
* N (input/ouput) INTEGER
* The length of the vectors X and Y. Input
* for {0,0}, output for everyone else.
*
* X (input/output) DOUBLE PRECISION array of dimension (N)
* The vector X of PDDOT = X' Y. Input for {0,0},
* output for everyone else.
*
* Y (input/output) DOUBLE PRECISION array of dimension (N)
* The vector Y of PDDOT = X' Y. Input for {0,0},
* output for everyone else.
*
* =====================================================================
* ..
* .. External Functions ..
DOUBLE PRECISION DDOT
EXTERNAL DDOT
* ..
* .. External Subroutines ..
EXTERNAL BLACS_GRIDINFO, DGEBS2D, DGEBR2D, DGSUM2D
* ..
* .. Local Scalars ..
INTEGER IAM, NPROCS, NPROW, NPCOL, MYPROW, MYPCOL, I, LN
DOUBLE PRECISION LDDOT
* ..
* .. Executable Statements ..
*
* Find out what grid has been set up, and pretend it's 1-D
*
CALL BLACS_GRIDINFO( CONTXT, NPROW, NPCOL, MYPROW, MYPCOL )
IAM = MYPROW*NPCOL + MYPCOL
NPROCS = NPROW * NPCOL
*
* Do bone-headed thing, and just send entire X and Y to
* everyone
*
IF ( (MYPROW.EQ.0) .AND. (MYPCOL.EQ.0) ) THEN
CALL IGEBS2D(CONTXT, 'All', 'i-ring', 1, 1, N, 1 )
CALL DGEBS2D(CONTXT, 'All', 'i-ring', N, 1, X, N )
CALL DGEBS2D(CONTXT, 'All', 'i-ring', N, 1, Y, N )
ELSE
CALL IGEBR2D(CONTXT, 'All', 'i-ring', 1, 1, N, 1, 0, 0 )
CALL DGEBR2D(CONTXT, 'All', 'i-ring', N, 1, X, N, 0, 0 )
CALL DGEBR2D(CONTXT, 'All', 'i-ring', N, 1, Y, N, 0, 0 )
ENDIF
*
* Find out the number of local rows to multiply (LN), and
* where in vectors to start (I)
*
LN = N / NPROCS
I = 1 + IAM * LN
*
* Last process does any extra rows
*
IF (IAM .EQ. NPROCS-1) LN = LN + MOD(N, NPROCS)
*
* Figure dot product of my piece of X and Y
*
LDDOT = DDOT( LN, X(I), 1, Y(I), 1 )
*
* Add local dot products to get global dot product;
* give all procs the answer
*
CALL DGSUM2D( CONTXT, 'All', '1-tree', 1, 1, LDDOT, 1, -1, 0 )
PDDOT = LDDOT
RETURN
END
DOUBLE PRECISION FUNCTION PDINFNRM(CONTXT, LM, LN, A, LDA, WORK)
*
* -- BLACS example routine --
* Written by Clint Whaley.
*
* .. Scalar Arguments ..
INTEGER CONTXT, LM, LN, LDA
*
* .. Array Arguments ..
DOUBLE PRECISION A(LDA, *), WORK(*)
*
* PURPOSE:
* ========
*
* Compute the infinity norm of a distributed matrix, where
* the matrix is spread across a 2D process grid. The result is
* left on all processes.
*
* Arguments
* =========
*
* CONTEXT (input) INTEGER
* This integer is passed to the BLACS to indicate a context.
* A context is a universe where messages exist and do not
* interact with other context's messages. The context includes
* the definition of a grid, and each process's coordinates in it.
*
* LM (input) INTEGER
* Number of rows of the global matrix owned by this process.
*
* LN (input) INTEGER
* Number of columns of the global matrix owned by this process.
*
* A (input) DOUBLE PRECISION, dimension (LDA,N)
* The matrix who's norm you wish to compute.
*
* LDA (input) INTEGER
* Leading Dimension of A.
*
* WORK (temporary) DOUBLE PRECISION array, dimension (LM)
* Temporary work space used for summing rows.
*
* .. External Subroutines ..
EXTERNAL BLACS_GRIDINFO, DGEBS2D, DGEBR2D, DGSUM2D, DGAMX2D
*
* .. External Functions ..
INTEGER IDAMAX
DOUBLE PRECISION DASUM
*
* .. Local Scalars ..
INTEGER NPROW, NPCOL, MYROW, MYCOL, I, J
DOUBLE PRECISION MAX
*
* .. Executable Statements ..
*
* Get process grid information
*
CALL BLACS_GRIDINFO(CONTXT, NPROW, NPCOL, MYROW, MYCOL)
*
* Add all local rows together
*
DO 20 I = 1, LM
WORK(I) = DASUM(LN, A(I,1), LDA)
20 CONTINUE
*
* Find sum of global matrix rows and store on column 0 of
* process grid
*
CALL DGSUM2D(CONTXT, 'Row', '1-tree', LM, 1, WORK, LM, MYROW, 0)
*
* Find maximum sum of rows for supnorm
*
IF (MYCOL .EQ. 0) THEN
MAX = WORK(IDAMAX(LM,WORK,1))
IF (LM .LT. 1) MAX = 0.0D0
CALL DGAMX2D(CONTXT, 'Col', 'h', 1, 1, MAX, 1, I, I, -1, -1, 0)
END IF
*
* Process column 0 has answer; send answer to all nodes
*
IF (MYCOL.EQ.0) THEN
CALL DGEBS2D(CONTXT, 'Row', ' ', 1, 1, MAX, 1)
ELSE
CALL DGEBR2D(CONTXT, 'Row', ' ', 1, 1, MAX, 1, 0, 0)
END IF
*
PDINFNRM = MAX
*
RETURN
*
* End of PDINFNRM
*
END
SUBROUTINE GETIDS(NIDS, MYBEGRNG, MYENDRNG)
*
* -- BLACS example code --
* Written by Clint Whaley 7/27/94.
* ..
* .. Scalar Arguments ..
INTEGER NIDS, MYBEGRNG, MYENDRNG
* ..
*
* Purpose
* =======
* GETIDS reserves NIDS message IDs for the user. The reserved
* IDs are on a continuous range, who's beginning is returned in
* MYBEGRNG, and who's ending is returned in MYENDRNG. Note:
* this routine must be called _before_ any calls to BLACS_GRIDINIT
* or BLACS_GRIDMAP.
*
* Arguments
* =========
* NIDS (input) INTEGER
* The number if IDs to reserve.
*
* MYBEGRNG (output) INTEGER
* The beginning of the reserved range.
*
* MYENDRNG (output) INTEGER
* The ending of the reserved range.
*
* =====================================================================
* ..
* .. External Subroutines ..
EXTERNAL BLACS_GET, BLACS_SET
* ..
* .. Local Arrays ..
INTEGER ITMP(2)
* ..
* .. Executable Statements ..
*
* Get system-dependant initial ID range
*
CALL BLACS_GET( -1, 1, ITMP )
*
* Reserve IDs for my own use
*
MYBEGRNG = ITMP(1)
ITMP(1) = ITMP(1) + NIDS + 1
CALL BLACS_SET( -1, 1, ITMP )
MYENDRNG = MYBEGRNG + NIDS
RETURN
END
SUBROUTINE PROCMAP(CONTEXT, MAPPING, BEGPROC, NPROW, NPCOL, IMAP)
*
* -- BLACS example code --
* Written by Clint Whaley 7/26/94.
* ..
* .. Scalar Arguments ..
INTEGER CONTEXT, MAPPING, BEGPROC, NPROW, NPCOL
* ..
* .. Array Arguments ..
INTEGER IMAP(NPROW, *)
* ..
*
* Purpose
* =======
* PROCMAP maps NPROW*NPCOL processes starting from process BEGPROC to
* the grid in a variety of ways depending on the parameter MAPPING.
*
* Arguments
* =========
*
* CONTEXT (output) INTEGER
* This integer is used by the BLACS to indicate a context.
* A context is a universe where messages exist and do not
* interact with other context's messages. The context includes
* the definition of a grid, and each process's coordinates in it.
*
* MAPPING (input) INTEGER
* Way to map processes to grid. Choices are:
* 1 : row-major natural ordering
* 2 : column-major natural ordering
*
* BEGPROC (input) INTEGER
* The process number (between 0 and NPROCS-1) to use as {0,0}.
* From this process, processes will be assigned to the grid
* as indicated by MAPPING.
*
* NPROW (input) INTEGER
* The number of process rows the created grid
* should have.
*
* NPCOL (input) INTEGER
* The number of process columns the created grid
* should have.
*
* IMAP (workspace) INTEGER array of dimension (NPROW, NPCOL)
* Workspace where the array which maps the
* processes to the grid will be stored for the
* call to GRIDMAP.
*
* =====================================================================
*
* ..
* .. External Functions ..
INTEGER BLACS_PNUM
EXTERNAL BLACS_PNUM
* ..
* .. External Subroutines ..
EXTERNAL BLACS_PINFO, BLACS_GRIDINIT, BLACS_GRIDMAP
* ..
* .. Local Scalars ..
INTEGER TMPCONTXT, NPROCS, I, J, K
* ..
* .. Executable Statements ..
*
* See how many processes there are in the system
*
CALL BLACS_PINFO( I, NPROCS )
IF (NPROCS-BEGPROC .LT. NPROW*NPCOL) THEN
WRITE(*,*) 'Not enough processes for grid'
STOP
ENDIF
*
* Temporarily map all processes into 1 x NPROCS grid
*
CALL BLACS_GET( 0, 0, TMPCONTXT )
CALL BLACS_GRIDINIT( TMPCONTXT, 'Row', 1, NPROCS )
K = BEGPROC
*
* If we want a row-major natural ordering
*
IF (MAPPING .EQ. 1) THEN
DO I = 1, NPROW
DO J = 1, NPCOL
IMAP(I, J) = BLACS_PNUM(TMPCONTXT, 0, K)
K = K + 1
END DO
END DO
*
* If we want a column-major natural ordering
*
ELSE IF (MAPPING .EQ. 2) THEN
DO J = 1, NPCOL
DO I = 1, NPROW
IMAP(I, J) = BLACS_PNUM(TMPCONTXT, 0, K)
K = K + 1
END DO
END DO
ELSE
WRITE(*,*) 'Uknown mapping.'
STOP
END IF
*
* Free temporary context
*
CALL BLACS_GRIDEXIT(TMPCONTXT)
*
* Apply the new mapping to form desired context
*
CALL BLACS_GET( 0, 0, CONTEXT )
CALL BLACS_GRIDMAP( CONTEXT, IMAP, NPROW, NPROW, NPCOL )
RETURN
END