Developer Reference for Intel® oneAPI Math Kernel Library for Fortran

ID 766686
Date 7/13/2023
Public

A newer version of this document is available. Customers should click here to go to the newest version.

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