Developer Reference for Intel® oneAPI Math Kernel Library for Fortran

ID 766686
Date 3/22/2024
Public
Document Table of Contents

Examples of BLACS Routines Usage

Example. BLACS Usage. Hello World

The following routine takes the available processes, forms them into a process grid, and then has each process check in with the process at {0,0} in the process grid.

      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)
               END IF 
*     
*              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

Example. BLACS Usage. PROCMAP

This routine maps processes to a grid using blacs_gridmap.

      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
      END IF 
*     
*     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 + 1W
            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(*,*) 'Unknown 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

Example. BLACS Usage. PARALLEL DOT PRODUCT

This routine does a bone-headed parallel double precision dot product of two vectors. Arguments are input on process {0,0}, and output everywhere else.

      DOUBLE PRECISION FUNCTION PDDOT( CONTEXT, N, X, Y ) 
*     
*     -- BLACS example code --

*     Written by Clint Whaley 7/26/94 
*     .. 
*     .. Scalar Arguments ..
      INTEGER CONTEXT, 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, that is, PDDOT = X' Y.   
*     
*  Arguments

*  ========= 
*     
*  CONTEXT      (input) 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. 
*     
*  N            (input/output) 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 is 1-D 
*     
      CALL BLACS_GRIDINFO( CONTXT, NPROW, NPCOL, MYPROW, MYPCOL )

      IAM = MYPROW*NPCOL + MYPCOL
      NPROCS = NPROW * NPCOL 
*     
*     Temporarily map all processes into 1 x NPROCS grid


*     
      CALL BLACS_GET( 0, 0, TMPCONTXT )
      CALL BLACS_GRIDINIT( TMPCONTXT, 'Row', 1, NPROCS )
      K = BEGPROC


*     
*     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
 

Example. BLACS Usage. PARALLEL MATRIX INFINITY NORM

This routine does a parallel infinity norm on a distributed double precision matrix. Unlike the PDDOT example, this routine assumes the matrix has already been distributed.

      DOUBLE PRECISION FUNCTION PDINFNRM(CONTXT, LM, LN, A, LDA, WORK) 
*     
*     -- BLACS example code --

*     Written by Clint Whaley. 
*     .. 
*     .. Scalar Arguments ..
      INTEGER CONTEXT, 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 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. 
*     
*  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 whose 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, MYPROW, MYPCOL )

*     
*     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