PCHETTRD(3) MathKeisan ScaLAPACK routine PCHETTRD(3)
NAME
SYNOPSIS
SUBROUTINE PCHETTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, LWORK,
INFO )
CHARACTER UPLO
INTEGER IA, INFO, JA, LWORK, N
INTEGER DESCA( * )
REAL D( * ), E( * )
COMPLEX 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 )
REAL ONE
PARAMETER ( ONE = 1.0E0 )
COMPLEX Z_ONE, Z_NEGONE, Z_ZERO
PARAMETER ( Z_ONE = 1.0E0, Z_NEGONE = -1.0E0, Z_ZERO = 0.0E0
)
REAL ZERO
PARAMETER ( ZERO = 0.0E+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
REAL NORM, SAFMAX, SAFMIN
COMPLEX ALPHA, BETA, C, ONEOVERBETA, TOPH, TOPNV, TOPTAU,
TOPV, TTOPH, TTOPV
INTEGER IDUM1( 1 ), IDUM2( 1 )
REAL DTMP( 5 )
COMPLEX CC( 3 )
EXTERNAL BLACS_GRIDINFO, CGEBR2D, CGEBS2D, CGEMM, CGEMV,
CGERV2D, CGESD2D, CGSUM2D, CHK1MAT, CLACPY, CSCAL,
CTRMVT, PCHK1MAT, PSTREECOMB, PXERBLA, SCOMBNRM2,
SGEBR2D, SGEBS2D, SGSUM2D
LOGICAL LSAME
INTEGER ICEIL, NUMROC, PJLAENV
REAL PSLAMCH, SCNRM2
EXTERNAL LSAME, ICEIL, NUMROC, PJLAENV, PSLAMCH, SCNRM2
INTRINSIC AIMAG, CMPLX, CONJG, ICHAR, MAX, MIN, MOD, REAL,
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( PSLAMCH( ICTXT, 'O' ) ) / N
SAFMIN = SQRT( PSLAMCH( ICTXT, 'S' ) )
INFO = 0
IF( NPROW.EQ.-1 ) THEN
INFO = -( 600+CTXT_ )
ELSE
PNB = PJLAENV( ICTXT, 2, 'PCHETTRD', 'L', 0, 0, 0, 0 )
ANB = PJLAENV( ICTXT, 3, 'PCHETTRD', 'L', 0, 0, 0, 0 )
INTERLEAVE = ( PJLAENV( ICTXT, 4, 'PCHETTRD', 'L', 1, 0, 0, 0
).EQ.1 )
TWOGEMMS = ( PJLAENV( ICTXT, 4, 'PCHETTRD', 'L', 2, 0, 0, 0
).EQ.1 )
BALANCED = ( PJLAENV( ICTXT, 4, 'PCHETTRD', '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 ) = CMPLX( 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, 'PCHETTRD', -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, 'PCHETTRD', -INFO )
WORK( 1 ) = CMPLX( 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
TTOPH = CONJG( WORK( INHT+LIJ-1+BINDEX*LDV ) )
TTOPV = CONJG( TOPNV )
IF( INDEX.GT.1 ) THEN
DO 30 I = 0, NPM0 - 1
A( INDEXA+I ) = A( INDEXA+I ) - WORK( INDEXINV+LDV+I
)*TTOPH - WORK( INDEXINH+LDV+I )*TTOPV
30 CONTINUE
END IF
END IF
IF( MYCOL.EQ.CURCOL ) THEN
IF( MYROW.EQ.CURROW ) THEN
DTMP( 2 ) = REAL( A( LII+( LIJ-1 )*LDA ) )
ELSE
DTMP( 2 ) = ZERO
END IF
IF( MYROW.EQ.NXTROW ) THEN
DTMP( 3 ) = REAL( A( LIIP1+( LIJ-1 )*LDA ) )
DTMP( 4 ) = AIMAG( A( LIIP1+( LIJ-1 )*LDA ) )
ELSE
DTMP( 3 ) = ZERO
DTMP( 4 ) = ZERO
END IF
NORM = SCNRM2( 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 SGSUM2D( 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 PSTREECOMB( ICTXT, 'C', 1, DTMP, -1, MYCOL, SCOMB-
NRM2 )
END IF
NORM = DTMP( 1 )
D( LIJ ) = DTMP( 2 )
IF( MYROW.EQ.CURROW .AND. MYCOL.EQ.CURCOL ) THEN
A( LII+( LIJ-1 )*LDA ) = CMPLX( D( LIJ ), ZERO )
END IF
ALPHA = CMPLX( DTMP( 3 ), DTMP( 4 ) )
NORM = SIGN( NORM, REAL( ALPHA ) )
IF( NORM.EQ.ZERO ) THEN
TOPTAU = ZERO
ELSE
BETA = NORM + ALPHA
TOPTAU = BETA / NORM
ONEOVERBETA = 1.0E0 / BETA
CALL CSCAL( 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 CGEBS2D( ICTXT, 'R', ' ', NPM1+NPM1+1, 1, WORK(
INV+LIIP1-1+BINDEX*LDV ), NPM1+NPM1+1 )
ELSE
CALL CGEBR2D( 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 CGESD2D( ICTXT, NPM1+NPM1, 1, WORK(
INV+LIIP1-1+BINDEX*LDV ), NPM1+NPM1, MYCOL, MYROW
)
CALL CGERV2D( 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 )* CONJG( WORK(
INHT+J-1+BINDEX*LDV ) ) - WORK(
INH+LIIP1-1+BINDEX*LDV+I )* CONJG( 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 CTRMVT( '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 CTRMVT( '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 CGEMV( '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 CGEMV( '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 CGSUM2D( ICTXT, 'C', ' ', 2*( BINDEX+1 ), 1, WORK(
INTMP ), 2*( BINDEX+1 ), -1, -1 )
ELSE
CALL CGEMV( 'C', NQB, BINDEX+1, Z_ONE, WORK( INHTB ),
LDV, WORK( INHTB+( BINDEX+1 )*LDV ), 1, Z_ZERO,
WORK( INTMP ), 1 )
CALL CGEMV( '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 CGSUM2D( ICTXT, 'R', ' ', 2*( BINDEX+1 ), 1, WORK(
INTMP ), 2*( BINDEX+1 ), -1, -1 )
IF( INDEX.GT.1. ) THEN
CALL CGEMV( '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 CGEMV( '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 CGEMV( 'N', NPB, BINDEX+1, Z_NEGONE, WORK( INVB ),
LDV, WORK( INTMP ), 1, Z_ONE, WORK( INVB+(
BINDEX+1 )*LDV ), 1 )
CALL CGEMV( '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 CGESD2D( ICTXT, NQM1, 1, WORK( INVT+LIJP1-1+(
BINDEX+1 )*LDV ), NQM1, MYCOL, MYROW )
CALL CGERV2D( 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 CGSUM2D( 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 ) + CONJG( 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 CGSUM2D( ICTXT, 'C', ' ', 3, 1, CC, 3, -1, NXTCOL
)
TOPV = CC( 2 )
C = CC( 1 )
TOPH = CC( 3 )
TOPNV = TOPTAU*( TOPV-C*CONJG( 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* CONJG( 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 CLACPY( 'A', LTNM1, ANB, WORK( INHT+LIJP1-1 ),
LDV, WORK( INVT+LIJP1-1+ANB*LDV ), LDV )
CALL CLACPY( '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 CGEMM( '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 CGEMM( '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 ) = REAL( A( NP+( NQ-1 )*LDA ) )
A( NP+( NQ-1 )*LDA ) = D( NQ )
CALL SGEBS2D( ICTXT, 'C', ' ', 1, 1, D( NQ ), 1 )
ELSE
CALL SGEBR2D( ICTXT, 'C', ' ', 1, 1, D( NQ ), 1,
NXTROW, NXTCOL )
END IF
END IF
WORK( 1 ) = CMPLX( LWMIN )
RETURN
END
PURPOSE
ScaLAPACK version 1.7 13 August 2001 PCHETTRD(3)