PZHETTRD(3) MathKeisan ScaLAPACK routine PZHETTRD(3)
NAME
SYNOPSIS
SUBROUTINE PZHETTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, LWORK,
INFO )
CHARACTER UPLO
INTEGER IA, INFO, JA, LWORK, N
INTEGER DESCA( * )
DOUBLE PRECISION D( * ), E( * )
COMPLEX*16 A( * ), TAU( * ), WORK( * )
INTEGER BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
MB_, NB_, RSRC_, CSRC_, LLD_
PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1,
CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, RSRC_
= 7, CSRC_ = 8, LLD_ = 9 )
DOUBLE PRECISION ONE
PARAMETER ( ONE = 1.0D0 )
COMPLEX*16 Z_ONE, Z_NEGONE, Z_ZERO
PARAMETER ( Z_ONE = 1.0D0, Z_NEGONE = -1.0D0, Z_ZERO = 0.0D0
)
DOUBLE PRECISION ZERO
PARAMETER ( ZERO = 0.0D+0 )
LOGICAL BALANCED, INTERLEAVE, TWOGEMMS, UPPER
INTEGER ANB, BINDEX, CURCOL, CURROW, I, ICTXT, INDEX,
INDEXA, INDEXINH, INDEXINV, INH, INHB, INHT,
INHTB, INTMP, INV, INVB, INVT, INVTB, J, LDA, LDV,
LDZG, LII, LIIB, LIIP1, LIJ, LIJB, LIJP1, LTLIP1,
LTNM1, LWMIN, MAXINDEX, MININDEX, MYCOL,
MYFIRSTROW, MYROW, MYSETNUM, NBZG, NP, NPB, NPCOL,
NPM0, NPM1, NPROW, NPS, NPSET, NQ, NQB, NQM1, NUM-
ROWS, NXTCOL, NXTROW, PBMAX, PBMIN, PBSIZE, PNB,
ROWSPERPROC
DOUBLE PRECISION NORM, SAFMAX, SAFMIN
COMPLEX*16 ALPHA, BETA, C, CONJTOPH, CONJTOPV, ONEOVERBETA,
TOPH, TOPNV, TOPTAU, TOPV
INTEGER IDUM1( 1 ), IDUM2( 1 )
DOUBLE PRECISION DTMP( 5 )
COMPLEX*16 CC( 3 )
EXTERNAL BLACS_GRIDINFO, CHK1MAT, DCOMBNRM2, DGEBR2D,
DGEBS2D, DGSUM2D, PCHK1MAT, PDTREECOMB, PXERBLA,
ZGEBR2D, ZGEBS2D, ZGEMM, ZGEMV, ZGERV2D, ZGESD2D,
ZGSUM2D, ZLACPY, ZSCAL, ZTRMVT
LOGICAL LSAME
INTEGER ICEIL, NUMROC, PJLAENV
DOUBLE PRECISION DZNRM2, PDLAMCH
EXTERNAL LSAME, ICEIL, NUMROC, PJLAENV, DZNRM2, PDLAMCH
INTRINSIC DBLE, DCMPLX, DCONJG, DIMAG, ICHAR, MAX, MIN, MOD,
SIGN, SQRT
IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_*
RSRC_.LT.0 )RETURN
ICTXT = DESCA( CTXT_ )
CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL
)
SAFMAX = SQRT( PDLAMCH( ICTXT, 'O' ) ) / N
SAFMIN = SQRT( PDLAMCH( ICTXT, 'S' ) )
INFO = 0
IF( NPROW.EQ.-1 ) THEN
INFO = -( 600+CTXT_ )
ELSE
PNB = PJLAENV( ICTXT, 2, 'PZHETTRD', 'L', 0, 0, 0, 0 )
ANB = PJLAENV( ICTXT, 3, 'PZHETTRD', 'L', 0, 0, 0, 0 )
INTERLEAVE = ( PJLAENV( ICTXT, 4, 'PZHETTRD', 'L', 1, 0, 0, 0
).EQ.1 )
TWOGEMMS = ( PJLAENV( ICTXT, 4, 'PZHETTRD', 'L', 2, 0, 0, 0
).EQ.1 )
BALANCED = ( PJLAENV( ICTXT, 4, 'PZHETTRD', 'L', 3, 0, 0, 0
).EQ.1 )
CALL CHK1MAT( N, 2, N, 2, IA, JA, DESCA, 6, INFO )
UPPER = LSAME( UPLO, 'U' )
IF( INFO.EQ.0 .AND. DESCA( NB_ ).NE.1 ) INFO = 600 +
NB_
IF( INFO.EQ.0 ) THEN
NPS = MAX( NUMROC( N, 1, 0, 0, NPROW ), 2*ANB )
LWMIN = 2*( ANB+1 )*( 4*NPS+2 ) + NPS
WORK( 1 ) = DCMPLX( LWMIN )
IF(
INFO = -1
ELSE IF( IA.NE.1 ) THEN
INFO = -4
ELSE IF( JA.NE.1 ) THEN
INFO = -5
ELSE IF( NPROW.NE.NPCOL ) THEN
INFO = -( 600+CTXT_ )
ELSE IF( DESCA( DTYPE_ ).NE.1 ) THEN
INFO = -( 600+DTYPE_ )
ELSE IF( DESCA( MB_ ).NE.1 ) THEN
INFO = -( 600+MB_ )
ELSE IF( DESCA( NB_ ).NE.1 ) THEN
INFO = -( 600+NB_ )
ELSE IF( DESCA( RSRC_ ).NE.0 ) THEN
INFO = -( 600+RSRC_ )
ELSE IF( DESCA( CSRC_ ).NE.0 ) THEN
INFO = -( 600+CSRC_ )
ELSE IF( LWORK.LT.LWMIN ) THEN
INFO = -11
END IF
END IF
IF( UPPER ) THEN
IDUM1( 1 ) = ICHAR( 'U' )
ELSE
IDUM1( 1 ) = ICHAR( 'L' )
END IF
IDUM2( 1 ) = 1
CALL PCHK1MAT( N, 2, N, 2, IA, JA, DESCA, 6, 1, IDUM1,
IDUM2, INFO )
END IF
IF( INFO.NE.0 ) THEN
CALL PXERBLA( ICTXT, 'PZHETTRD', -INFO )
RETURN
END IF
IF( N.EQ.0 ) RETURN
NP = NUMROC( N, 1, MYROW, 0, NPROW )
NQ = NUMROC( N, 1, MYCOL, 0, NPCOL )
NXTROW = 0
NXTCOL = 0
LIIP1 = 1
LIJP1 = 1
NPM1 = NP
NQM1 = NQ
LDA = DESCA( LLD_ )
ICTXT = DESCA( CTXT_ )
INH = 1
IF( INTERLEAVE ) THEN
LDV = 4*( MAX( NPM1, NQM1 ) ) + 2
INH = 1
INV = INH + LDV / 2
INVT = INH + ( ANB+1 )*LDV
INHT = INVT + LDV / 2
INTMP = INVT + LDV*( ANB+1 )
ELSE
LDV = MAX( NPM1, NQM1 )
INHT = INH + LDV*( ANB+1 )
INV = INHT + LDV*( ANB+1 )
INVT = INV + LDV*( ANB+1 ) + 1
INTMP = INVT + LDV*( 2*ANB )
END IF
IF( INFO.NE.0 ) THEN
CALL PXERBLA( ICTXT, 'PZHETTRD', -INFO )
WORK( 1 ) = DCMPLX( LWMIN )
RETURN
END IF
DO 10 I = 1, NP
WORK( INH+I-1 ) = Z_ZERO
WORK( INV+I-1 ) = Z_ZERO
10 CONTINUE
DO 20 I = 1, NQ
WORK( INHT+I-1 ) = Z_ZERO
20 CONTINUE
TOPNV = Z_ZERO
LTLIP1 = LIJP1
LTNM1 = NPM1
IF( MYCOL.GT.MYROW ) THEN
LTLIP1 = LTLIP1 + 1
LTNM1 = LTNM1 - 1
END IF
DO 210 MININDEX = 1, N - 1, ANB
MAXINDEX = MIN( MININDEX+ANB-1, N )
LIJB = NUMROC( MAXINDEX, 1, MYCOL, 0, NPCOL ) + 1
LIIB = NUMROC( MAXINDEX, 1, MYROW, 0, NPROW ) + 1
NQB = NQ - LIJB + 1
NPB = NP - LIIB + 1
INHTB = INHT + LIJB - 1
INVTB = INVT + LIJB - 1
INHB = INH + LIIB - 1
INVB = INV + LIIB - 1
DO 160 INDEX = MININDEX, MIN( MAXINDEX, N-1 )
BINDEX = INDEX - MININDEX
CURROW = NXTROW
CURCOL = NXTCOL
NXTROW = MOD( CURROW+1, NPROW )
NXTCOL = MOD( CURCOL+1, NPCOL )
LII = LIIP1
LIJ = LIJP1
NPM0 = NPM1
IF( MYROW.EQ.CURROW ) THEN
NPM1 = NPM1 - 1
LIIP1 = LIIP1 + 1
END IF
IF( MYCOL.EQ.CURCOL ) THEN
NQM1 = NQM1 - 1
LIJP1 = LIJP1 + 1
LTLIP1 = LTLIP1 + 1
LTNM1 = LTNM1 - 1
END IF
IF( MYCOL.EQ.CURCOL ) THEN
INDEXA = LII + ( LIJ-1 )*LDA
INDEXINV = INV + LII - 1 + ( BINDEX-1 )*LDV
INDEXINH = INH + LII - 1 + ( BINDEX-1 )*LDV
CONJTOPH = DCONJG( WORK( INHT+LIJ-1+BINDEX*LDV ) )
CONJTOPV = DCONJG( TOPNV )
IF( INDEX.GT.1 ) THEN
DO 30 I = 0, NPM0 - 1
A( INDEXA+I ) = A( INDEXA+I ) - WORK( INDEXINV+LDV+I
)*CONJTOPH - WORK( INDEXINH+LDV+I )*CONJTOPV
30 CONTINUE
END IF
END IF
IF( MYCOL.EQ.CURCOL ) THEN
IF( MYROW.EQ.CURROW ) THEN
DTMP( 2 ) = DBLE( A( LII+( LIJ-1 )*LDA ) )
ELSE
DTMP( 2 ) = ZERO
END IF
IF( MYROW.EQ.NXTROW ) THEN
DTMP( 3 ) = DBLE( A( LIIP1+( LIJ-1 )*LDA ) )
DTMP( 4 ) = DIMAG( A( LIIP1+( LIJ-1 )*LDA ) )
ELSE
DTMP( 3 ) = ZERO
DTMP( 4 ) = ZERO
END IF
NORM = DZNRM2( NPM1, A( LIIP1+( LIJ-1 )*LDA ), 1 )
DTMP( 1 ) = NORM
DTMP( 5 ) = ZERO
IF( DTMP( 1 ).GE.SAFMAX .OR. DTMP( 1 ).LT.SAFMIN )
THEN
DTMP( 5 ) = ONE
DTMP( 1 ) = ZERO
END IF
DTMP( 1 ) = DTMP( 1 )*DTMP( 1 )
CALL DGSUM2D( ICTXT, 'C', ' ', 5, 1, DTMP, 5, -1, CUR-
COL )
IF( DTMP( 5 ).EQ.ZERO ) THEN
DTMP( 1 ) = SQRT( DTMP( 1 ) )
ELSE
DTMP( 1 ) = NORM
CALL PDTREECOMB( ICTXT, 'C', 1, DTMP, -1, MYCOL, DCOMB-
NRM2 )
END IF
NORM = DTMP( 1 )
D( LIJ ) = DTMP( 2 )
IF( MYROW.EQ.CURROW .AND. MYCOL.EQ.CURCOL ) THEN
A( LII+( LIJ-1 )*LDA ) = DCMPLX( D( LIJ ), ZERO )
END IF
ALPHA = DCMPLX( DTMP( 3 ), DTMP( 4 ) )
NORM = SIGN( NORM, DBLE( ALPHA ) )
IF( NORM.EQ.ZERO ) THEN
TOPTAU = ZERO
ELSE
BETA = NORM + ALPHA
TOPTAU = BETA / NORM
ONEOVERBETA = 1.0D0 / BETA
CALL ZSCAL( NPM1, ONEOVERBETA, A( LIIP1+( LIJ-1 )*LDA
), 1 )
END IF
IF( MYROW.EQ.NXTROW ) THEN
A( LIIP1+( LIJ-1 )*LDA ) = Z_ONE
END IF
TAU( LIJ ) = TOPTAU
E( LIJ ) = -NORM
END IF
DO 40 I = 0, NPM1 - 1
WORK( INV+LIIP1-1+BINDEX*LDV+NPM1+I ) = A( LIIP1+I+ (
LIJ-1 )*LDA )
40 CONTINUE
IF( MYCOL.EQ.CURCOL ) THEN
WORK( INV+LIIP1-1+BINDEX*LDV+NPM1+NPM1 ) = TOPTAU
CALL ZGEBS2D( ICTXT, 'R', ' ', NPM1+NPM1+1, 1, WORK(
INV+LIIP1-1+BINDEX*LDV ), NPM1+NPM1+1 )
ELSE
CALL ZGEBR2D( ICTXT, 'R', ' ', NPM1+NPM1+1, 1, WORK(
INV+LIIP1-1+BINDEX*LDV ), NPM1+NPM1+1, MYROW, CUR-
COL )
TOPTAU = WORK( INV+LIIP1-1+BINDEX*LDV+NPM1+NPM1 )
END IF
DO 50 I = 0, NPM1 - 1
WORK( INH+LIIP1-1+( BINDEX+1 )*LDV+I ) = WORK(
INV+LIIP1- 1+BINDEX*LDV+NPM1+I )
50 CONTINUE
IF( INDEX.LT.N ) THEN
IF( MYROW.EQ.NXTROW .AND. MYCOL.EQ.CURCOL ) A( LIIP1+(
LIJ-1 )*LDA ) = E( LIJ )
END IF
IF( MYROW.EQ.MYCOL ) THEN
DO 60 I = 0, NPM1 + NPM1
WORK( INVT+LIJP1-1+BINDEX*LDV+I ) = WORK( INV+LIIP1-1+
BINDEX*LDV+I )
60 CONTINUE
ELSE
CALL ZGESD2D( ICTXT, NPM1+NPM1, 1, WORK(
INV+LIIP1-1+BINDEX*LDV ), NPM1+NPM1, MYCOL, MYROW
)
CALL ZGERV2D( ICTXT, NQM1+NQM1, 1, WORK(
INVT+LIJP1-1+BINDEX*LDV ), NQM1+NQM1, MYCOL, MYROW
)
END IF
DO 70 I = 0, NQM1 - 1
WORK( INHT+LIJP1-1+( BINDEX+1 )*LDV+I ) = WORK( INVT+
LIJP1-1+BINDEX*LDV+NQM1+I )
70 CONTINUE
IF( INDEX.GT.1 ) THEN
DO 90 J = LIJP1, LIJB - 1
DO 80 I = 0, NPM1 - 1
A( LIIP1+I+( J-1 )*LDA ) = A( LIIP1+I+( J-1 )*LDA ) -
WORK( INV+LIIP1-1+BINDEX*LDV+I )* DCONJG( WORK(
INHT+J-1+BINDEX*LDV ) ) - WORK(
INH+LIIP1-1+BINDEX*LDV+I )* DCONJG( WORK(
INVT+J-1+BINDEX*LDV ) )
80 CONTINUE
90 CONTINUE
END IF
WORK( INV+LIIP1-1+( BINDEX+1 )*LDV ) = Z_ZERO
WORK( INVT+LIJP1-1+( BINDEX+1 )*LDV+NQM1-1 ) = Z_ZERO
IF( MYROW.EQ.MYCOL ) THEN
IF( LTNM1.GT.1 ) THEN
CALL ZTRMVT( 'L', LTNM1-1, A( LTLIP1+1+( LIJP1-1 )*LDA
), LDA, WORK( INVT+LIJP1-1+( BINDEX+1 )*LDV ), 1,
WORK( INH+LTLIP1+1-1+( BINDEX+1 )*LDV ), 1, WORK(
INV+LTLIP1+1-1+( BINDEX+1 )* LDV ), 1, WORK(
INHT+LIJP1-1+( BINDEX+ 1 )*LDV ), 1 )
END IF
DO 100 I = 1, LTNM1
WORK( INVT+LIJP1+I-1-1+( BINDEX+1 )*LDV ) = WORK(
INVT+LIJP1+I-1-1+( BINDEX+1 )*LDV ) + A(
LTLIP1+I-1+( LIJP1+I-1-1 )*LDA )* WORK(
INH+LTLIP1+I-1-1+( BINDEX+1 )*LDV )
100 CONTINUE
ELSE
IF( LTNM1.GT.0 ) CALL ZTRMVT( 'L', LTNM1, A( LTLIP1+(
LIJP1-1 )*LDA ), LDA, WORK( INVT+LIJP1-1+(
BINDEX+1 )* LDV ), 1, WORK( INH+LTLIP1-1+( BINDEX+
1 )*LDV ), 1, WORK( INV+LTLIP1-1+ ( BINDEX+1 )*LDV
), 1, WORK( INHT+LIJP1-1+( BINDEX+1 )*LDV ), 1 )
END IF
DO 110 I = 1, 2*( BINDEX+1 )
WORK( INTMP-1+I ) = 0
110 CONTINUE
IF( BALANCED ) THEN
NPSET = NPROW
MYSETNUM = MYROW
ROWSPERPROC = ICEIL( NQB, NPSET )
MYFIRSTROW = MIN( NQB+1, 1+ROWSPERPROC*MYSETNUM )
NUMROWS = MIN( ROWSPERPROC, NQB-MYFIRSTROW+1 )
CALL ZGEMV( 'C', NUMROWS, BINDEX+1, Z_ONE, WORK(
INHTB+MYFIRSTROW-1 ), LDV, WORK(
INHTB+MYFIRSTROW-1+( BINDEX+1 )*LDV ), 1, Z_ZERO,
WORK( INTMP ), 1 )
CALL ZGEMV( 'C', NUMROWS, BINDEX+1, Z_ONE, WORK(
INVTB+MYFIRSTROW-1 ), LDV, WORK(
INHTB+MYFIRSTROW-1+( BINDEX+1 )*LDV ), 1, Z_ZERO,
WORK( INTMP+BINDEX+1 ), 1 )
CALL ZGSUM2D( ICTXT, 'C', ' ', 2*( BINDEX+1 ), 1, WORK(
INTMP ), 2*( BINDEX+1 ), -1, -1 )
ELSE
CALL ZGEMV( 'C', NQB, BINDEX+1, Z_ONE, WORK( INHTB ),
LDV, WORK( INHTB+( BINDEX+1 )*LDV ), 1, Z_ZERO,
WORK( INTMP ), 1 )
CALL ZGEMV( 'C', NQB, BINDEX+1, Z_ONE, WORK( INVTB ),
LDV, WORK( INHTB+( BINDEX+1 )*LDV ), 1, Z_ZERO,
WORK( INTMP+BINDEX+1 ), 1 )
END IF
IF( BALANCED ) THEN
MYSETNUM = MYCOL
ROWSPERPROC = ICEIL( NPB, NPSET )
MYFIRSTROW = MIN( NPB+1, 1+ROWSPERPROC*MYSETNUM )
NUMROWS = MIN( ROWSPERPROC, NPB-MYFIRSTROW+1 )
CALL ZGSUM2D( ICTXT, 'R', ' ', 2*( BINDEX+1 ), 1, WORK(
INTMP ), 2*( BINDEX+1 ), -1, -1 )
IF( INDEX.GT.1. ) THEN
CALL ZGEMV( 'N', NUMROWS, BINDEX+1, Z_NEGONE, WORK(
INVB+MYFIRSTROW-1 ), LDV, WORK( INTMP ), 1, Z_ONE,
WORK( INVB+MYFIRSTROW-1+( BINDEX+1 )* LDV ), 1 )
CALL ZGEMV( 'N', NUMROWS, BINDEX+1, Z_NEGONE, WORK(
INHB+MYFIRSTROW-1 ), LDV, WORK( INTMP+BINDEX+1 ),
1, Z_ONE, WORK( INVB+MYFIRSTROW-1+( BINDEX+1 )*
LDV ), 1 )
END IF
ELSE
CALL ZGEMV( 'N', NPB, BINDEX+1, Z_NEGONE, WORK( INVB ),
LDV, WORK( INTMP ), 1, Z_ONE, WORK( INVB+(
BINDEX+1 )*LDV ), 1 )
CALL ZGEMV( 'N', NPB, BINDEX+1, Z_NEGONE, WORK( INHB ),
LDV, WORK( INTMP+BINDEX+1 ), 1, Z_ONE, WORK(
INVB+( BINDEX+1 )*LDV ), 1 )
END IF
IF( MYROW.EQ.MYCOL ) THEN
DO 120 I = 0, NQM1 - 1
WORK( INTMP+I ) = WORK( INVT+LIJP1-1+( BINDEX+1 )*LDV+ I
)
120 CONTINUE
ELSE
CALL ZGESD2D( ICTXT, NQM1, 1, WORK( INVT+LIJP1-1+(
BINDEX+1 )*LDV ), NQM1, MYCOL, MYROW )
CALL ZGERV2D( ICTXT, NPM1, 1, WORK( INTMP ), NPM1,
MYCOL, MYROW )
END IF
DO 130 I = 0, NPM1 - 1
WORK( INV+LIIP1-1+( BINDEX+1 )*LDV+I ) = WORK(
INV+LIIP1- 1+( BINDEX+1 )*LDV+I ) + WORK( INTMP+I
)
130 CONTINUE
CALL ZGSUM2D( ICTXT, 'R', ' ', NPM1, 1, WORK(
INV+LIIP1-1+( BINDEX+1 )*LDV ), NPM1, MYROW,
NXTCOL )
IF( MYCOL.EQ.NXTCOL ) THEN
CC( 1 ) = Z_ZERO
DO 140 I = 0, NPM1 - 1
CC( 1 ) = CC( 1 ) + DCONJG( WORK( INV+LIIP1-1+ (
BINDEX+1 )*LDV+I ) )* WORK( INH+LIIP1-1+( BINDEX+1
)*LDV+I )
140 CONTINUE
IF( MYROW.EQ.NXTROW ) THEN
CC( 2 ) = WORK( INV+LIIP1-1+( BINDEX+1 )*LDV )
CC( 3 ) = WORK( INH+LIIP1-1+( BINDEX+1 )*LDV )
ELSE
CC( 2 ) = Z_ZERO
CC( 3 ) = Z_ZERO
END IF
CALL ZGSUM2D( ICTXT, 'C', ' ', 3, 1, CC, 3, -1, NXTCOL
)
TOPV = CC( 2 )
C = CC( 1 )
TOPH = CC( 3 )
TOPNV = TOPTAU*( TOPV-C*DCONJG( TOPTAU ) / 2*TOPH )
DO 150 I = 0, NPM1 - 1
WORK( INV+LIIP1-1+( BINDEX+1 )*LDV+I ) = TOPTAU* ( WORK(
INV+LIIP1-1+( BINDEX+1 )*LDV+I )-C* DCONJG( TOPTAU
) / 2*WORK( INH+LIIP1-1+( BINDEX+ 1 )*LDV+I ) )
150 CONTINUE
END IF
160 CONTINUE
IF( MAXINDEX.LT.N ) THEN
DO 170 I = 0, NPM1 - 1
WORK( INTMP+I ) = WORK( INH+LIIP1-1+ANB*LDV+I )
170 CONTINUE
IF(
IF( INTERLEAVE ) THEN
LDZG = LDV / 2
ELSE
CALL ZLACPY( 'A', LTNM1, ANB, WORK( INHT+LIJP1-1 ),
LDV, WORK( INVT+LIJP1-1+ANB*LDV ), LDV )
CALL ZLACPY( 'A', LTNM1, ANB, WORK( INV+LTLIP1-1 ),
LDV, WORK( INH+LTLIP1-1+ANB*LDV ), LDV )
LDZG = LDV
END IF
NBZG = ANB*2
ELSE
LDZG = LDV
NBZG = ANB
END IF
DO 180 PBMIN = 1, LTNM1, PNB
PBSIZE = MIN( PNB, LTNM1-PBMIN+1 )
PBMAX = MIN( LTNM1, PBMIN+PNB-1 )
CALL ZGEMM( 'N', 'C', PBSIZE, PBMAX, NBZG, Z_NEGONE,
WORK( INH+LTLIP1-1+PBMIN-1 ), LDZG, WORK(
INVT+LIJP1-1 ), LDZG, Z_ONE, A( LTLIP1+PBMIN-1+(
LIJP1-1 )*LDA ), LDA )
IF( TWOGEMMS ) THEN
CALL ZGEMM( 'N', 'C', PBSIZE, PBMAX, ANB, Z_NEGONE,
WORK( INV+LTLIP1-1+PBMIN-1 ), LDZG, WORK(
INHT+LIJP1-1 ), LDZG, Z_ONE, A( LTLIP1+PBMIN-1+(
LIJP1-1 )*LDA ), LDA )
END IF
180 CONTINUE
DO 190 I = 0, NPM1 - 1
WORK( INV+LIIP1-1+I ) = WORK( INV+LIIP1-1+ANB*LDV+I )
WORK( INH+LIIP1-1+I ) = WORK( INTMP+I )
190 CONTINUE
DO 200 I = 0, NQM1 - 1
WORK( INHT+LIJP1-1+I ) = WORK( INHT+LIJP1-1+ANB*LDV+I )
200 CONTINUE
END IF
210 CONTINUE
IF( MYCOL.EQ.NXTCOL ) THEN
IF( MYROW.EQ.NXTROW ) THEN
D( NQ ) = DBLE( A( NP+( NQ-1 )*LDA ) )
A( NP+( NQ-1 )*LDA ) = D( NQ )
CALL DGEBS2D( ICTXT, 'C', ' ', 1, 1, D( NQ ), 1 )
ELSE
CALL DGEBR2D( ICTXT, 'C', ' ', 1, 1, D( NQ ), 1,
NXTROW, NXTCOL )
END IF
END IF
WORK( 1 ) = DCMPLX( LWMIN )
RETURN
END
PURPOSE
ScaLAPACK version 1.7 13 August 2001 PZHETTRD(3)