Issue with DESCINIT in Scalapack

[OP1]

There is an issue with calls to DESCINIT in some circumstances. The program below illustrates the problem. As is, the program implements a manual workaround and will complete successfully. To exhibit the buggy behavior of DESCINIT, uncomment the three lines of the code that are identified as problematic.

PROGRAM SCALAPACK_DEMOS
IMPLICIT NONE (TYPE, EXTERNAL)

! The intent of this program is to scatter a 2x2 matrix A
! defined on 1 process (1x1 BLACS process grid with context CONTEXT_A) 
! to local 1x1 matrices B on 4 processes (2x2 process grid with context CONTEXT_B),
! using the scalapack routine PDGEMR2D.
!
! This program must be run as 4 processes/images.
! Appropriate linking to Blacs/Scalapack is necessary.

INTEGER, PARAMETER :: DP = SELECTED_REAL_KIND(15, 307)

EXTERNAL :: &
    BLACS_GET, &
    BLACS_PINFO, &
    BLACS_GRIDINIT, &
    DESCINIT, &
    PDGEMR2D

INTEGER :: SYSTEM_CONTEXT, CONTEXT_A, CONTEXT_B ! BLACS CONTEXTS
INTEGER :: MY_PROC, N_PROCS ! BLACS DATA
INTEGER :: INFO ! SCALAPACK RETURN VALUE
INTEGER, DIMENSION(9) :: DESC_A, DESC_B ! MATRIX DESCRIPTORS
REAL(KIND = DP) :: &
    A(4), & ! Matrix to be scattered with meaningful values only on 1 process
    B(1)   ! Space for local matrix on a 2x2 process grid after scatterinng


CALL BLACS_GET(-1, 0, SYSTEM_CONTEXT) ! Get the BLACS System Context
CALL BLACS_PINFO(MY_PROC, N_PROCS) ! Determine my process number MY_PROC and the number of processes N_PROCS in machine 
IF(N_PROCS /= 4) STOP ! Ensure code is being called with 4 processes

CONTEXT_A = SYSTEM_CONTEXT
CALL BLACS_GRIDINIT(CONTEXT_A, 'R', 1, 1) ! Initialize context for A with 1x1 process grid
CONTEXT_B = SYSTEM_CONTEXT
CALL BLACS_GRIDINIT(CONTEXT_B, 'R', 2, 2) ! Initialize context for B with on a 2x2 process grid

B = -77.7_DP  ! Assign garbage at locations where A will be scattered to
CALL DESCINIT(DESC_B, 2, 2, 1, 1, 0, 0, CONTEXT_B, 1, INFO) ! Descriptor for B

IF (CONTEXT_A /= -1) THEN
    A = [1.1_DP, 2.2_DP, 3.3_DP, 4.4_DP] ! Value on process in CONTEXT_A which to be scattered
ELSE 
    A = -999.0_DP ! Not a processes in CONTEXT_A. Assign garbage values
END IF

! Create DESC_A 

! Issue is below : 
! The IF/ELSE below should not be necessary. 
! Instead it should be possible to call DESCINIT directly on all processes.
! However if we try to do this we will get an error with INFO = -6 for processes not in CONTEXT_A.
! An error is issued internally because CONTEXT_A = -1 on those processes. 
! But later PDGEMR2D demands DESC_A have -1 for context. So we have to create DESC_A manually.
!
! Uncomment the lines below to trigger the error above:
!
!CALL DESCINIT(DESC_A, 2, 2, 1, 1, 0, 0, CONTEXT_A, 2, INFO) 
!WRITE(*,*) 'INFO for DESC_A ON PROC ', MY_PROC, ' = ', INFO
!STOP

IF (CONTEXT_A /= -1) THEN ! Fill only on master
    CALL DESCINIT(DESC_A, 2, 2, 1, 1, 0, 0, CONTEXT_A, 2, INFO) 
ELSE
    DESC_A = -2 ! Garbage value. Only entry for context matters on these processes
    DESC_A(2) = -1 ! Context
END IF


! Scatter 2x2 A on 1 process to local 1x1 B's on 4 processes

CALL PDGEMR2D(2, 2, A, 1, 1, DESC_A, B, 1, 1, DESC_B, CONTEXT_B)
SYNC ALL
WRITE(*,*) 'B on ', MY_PROC, ' = ', B(1)

END PROGRAM SCALAPACK_DEMOS