Routine PCLARFG() Documented By Universal Report

Routine: PCLARFG()

# lines:	290
# code:	290
# comment:	0
# blank:	0
# Variables:	42
# Callers:	11
# Callings:	0
# Words:	116
# Keywords:	68

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PCLARFG generates a complex elementary reflector H of order n, such
  that
     H * sub( X ) = H * ( x(iax,jax) ) = ( alpha ),   H' * H = I.
                        (      x     )   (   0   )
  where alpha is a real scalar, and sub( X ) is an (N-1)-element
  complex distributed vector X(IX:IX+N-2,JX) if INCX = 1 and
  X(IX,JX:JX+N-2) if INCX = DESCX(M_).  H is represented in the form
        H = I - tau * ( 1 ) * ( 1 v' ) ,
                      ( v )
  where tau is a complex scalar and v is a complex (N-1)-element
  vector. Note that H is not Hermitian.
  If the elements of sub( X ) are all zero and X(IAX,JAX) is real,
  then tau = 0 and H is taken to be the unit matrix.
  Otherwise  1 <= real(tau) <= 2 and abs(tau-1) <= 1.
  Notes
  =====
  Each global data object is described by an associated description
  vector.  This vector stores the information required to establish
  the mapping between an object element and its corresponding process
  and memory location.
  Let A be a generic term for any 2D block cyclicly distributed array.
  Such a global array has an associated description vector DESCA.
  In the following comments, the character _ should be read as
  "of the global array".
  NOTATION        STORED IN      EXPLANATION
  --------------- -------------- --------------------------------------
  DTYPE_A(global) DESCA( DTYPE_ )The descriptor type.  In this case,
                                 DTYPE_A = 1.
  CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
                                 the BLACS process grid A is distribu-
                                 ted over. The context itself is glo-
                                 bal, but the handle (the integer
                                 value) may vary.
  M_A    (global) DESCA( M_ )    The number of rows in the global
                                 array A.
  N_A    (global) DESCA( N_ )    The number of columns in the global
                                 array A.
  MB_A   (global) DESCA( MB_ )   The blocking factor used to distribute
                                 the rows of the array.
  NB_A   (global) DESCA( NB_ )   The blocking factor used to distribute
                                 the columns of the array.
  RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
                                 row of the array A is distributed.
  CSRC_A (global) DESCA( CSRC_ ) The process column over which the
                                 first column of the array A is
                                 distributed.
  LLD_A  (local)  DESCA( LLD_ )  The leading dimension of the local
                                 array.  LLD_A >= MAX(1,LOCr(M_A)).
  Let K be the number of rows or columns of a distributed matrix,
  and assume that its process grid has dimension p x q.
  LOCr( K ) denotes the number of elements of K that a process
  would receive if K were distributed over the p processes of its
  process column.
  Similarly, LOCc( K ) denotes the number of elements of K that a
  process would receive if K were distributed over the q processes of
  its process row.
  The values of LOCr() and LOCc() may be determined via a call to the
  ScaLAPACK tool function, NUMROC:
          LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
          LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
  An upper bound for these quantities may be computed by:
          LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
          LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
  Because vectors may be viewed as a subclass of matrices, a
  distributed vector is considered to be a distributed matrix.
  Arguments
  =========
  N       (global input) INTEGER
          The global order of the elementary reflector. N >= 0.
  ALPHA   (local output) COMPLEX
          On exit, alpha is computed in the process scope having the
          vector sub( X ).
  IAX     (global input) INTEGER
          The global row index in X of X(IAX,JAX).
  JAX     (global input) INTEGER
          The global column index in X of X(IAX,JAX).
  X       (local input/local output) COMPLEX, pointer into the
          local memory to an array of dimension (LLD_X,*). This array
          contains the local pieces of the distributed vector sub( X ).
          Before entry, the incremented array sub( X ) must contain
          the vector x. On exit, it is overwritten with the vector v.
  IX      (global input) INTEGER
          The row index in the global array X indicating the first
          row of sub( X ).
  JX      (global input) INTEGER
          The column index in the global array X indicating the
          first column of sub( X ).
  DESCX   (global and local input) INTEGER array of dimension DLEN_.
          The array descriptor for the distributed matrix X.
  INCX    (global input) INTEGER
          The global increment for the elements of X. Only two values
          of INCX are supported in this version, namely 1 and M_X.
          INCX must not be zero.
  TAU     (local output) COMPLEX, array, dimension  LOCc(JX)
          if INCX = 1, and LOCr(IX) otherwise. This array contains the
          Householder scalars related to the Householder vectors.
          TAU is tied to the distributed matrix X.
  =====================================================================
     .. Parameters ..

Display dynamic version

FontSize: - +

001        SUBROUTINE PCLARFG( N , ALPHA , IAX , JAX , X , IX , JX , DESCX , INCX ,
002       $TAU )
003  
004  *     -- ScaLAPACK auxiliary routine(version 1.7) --
005  *     University of Tennessee , Knoxville , Oak Ridge National Laboratory ,
006  *     and University of California , Berkeley.
007  *     May 1 , 1997
008  
009  *     .. Scalar Arguments ..
010        INTEGER IAX , INCX , IX , JAX , JX , N
011        COMPLEX ALPHA
012        INTEGER BLOCK_CYCLIC_2D , CSRC_ , CTXT_ , DLEN_ , DTYPE_ ,
013       $LLD_ , MB_ , M_ , NB_ , N_ , RSRC_
014        PARAMETER( BLOCK_CYCLIC_2D = 1 , DLEN_ = 9 , DTYPE_ = 1 ,
015       $CTXT_ = 2 , M_ = 3 , N_ = 4 , MB_ = 5 , NB_ = 6 ,
016       $RSRC_ = 7 , CSRC_ = 8 , LLD_ = 9 )
017        REAL ONE , ZERO
018        PARAMETER( ONE = 1.0E + 0 , ZERO = 0.0E + 0 )
019  *     ..
020  *     .. Local Scalars ..
021        INTEGER ICTXT , IIAX , INDXTAU , IXCOL , IXROW , J , JJAX ,
022       $KNT , MYCOL , MYROW , NPCOL , NPROW
023        REAL ALPHI , ALPHR , BETA , RSAFMN , SAFMIN , XNORM
024  *     ..
025  *     .. External Subroutines ..
026        EXTERNAL BLACS_GRIDINFO , CGEBR2D , CGEBS2D , PCSCAL ,
027       $PCSSCAL , INFOG2L , PSCNRM2
028  *     ..
029  *     .. External Functions ..
030        REAL SLAMCH , SLAPY3
031        COMPLEX CLADIV
032        EXTERNAL CLADIV , SLAPY3 , SLAMCH
033  *     ..
034  *     .. Intrinsic Functions ..
035        INTRINSIC ABS , AIMAG , CMPLX , REAL , SIGN
036  *     ..
037  *     .. Executable Statements ..
038  
039  *     Get grid parameters.
040  
041        ICTXT = DESCX( CTXT_ )
042        CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
043  
044        IF( INCX.EQ.DESCX( M_ ) ) THEN
045  
046  *         sub( X ) is distributed across a process row.
047  
047               
048            CALL INFOG2L( IX , JAX , DESCX , NPROW , NPCOL , MYROW , MYCOL ,
049       $    IIAX , JJAX , IXROW , IXCOL )
050  
051            IF( MYROW.NE.IXROW )
051                   
052       $        RETURN
053  
054  *             Broadcast X(IAX , JAX) across the process row.
055  
056                IF( MYCOL.EQ.IXCOL ) THEN
056                       
057                    J = IIAX + (JJAX - 1)*DESCX( LLD_ )
058                    CALL CGEBS2D( ICTXT , 'Rowwise' , ' ' , 1 , 1 , X( J ) , 1 )
059                    ALPHA = X( J )
060                ELSE
060                       
061                    CALL CGEBR2D( ICTXT , 'Rowwise' , ' ' , 1 , 1 , ALPHA , 1 ,
062       $            MYROW , IXCOL )
063                END IF
064  
065                INDXTAU = IIAX
066  
067            ELSE
068  
069  *             sub( X ) is distributed across a process column.
070  
070                   
071                CALL INFOG2L( IAX , JX , DESCX , NPROW , NPCOL , MYROW , MYCOL ,
072       $        IIAX , JJAX , IXROW , IXCOL )
073  
074                IF( MYCOL.NE.IXCOL )
074                       
075       $            RETURN
076  
077  *                 Broadcast X(IAX , JAX) across the process column.
078  
079                    IF( MYROW.EQ.IXROW ) THEN
079                           
080                        J = IIAX + (JJAX - 1)*DESCX( LLD_ )
081                        CALL CGEBS2D( ICTXT , 'Columnwise' , ' ' , 1 , 1 , X( J ) , 1 )
082                        ALPHA = X( J )
083                    ELSE
083                           
084                        CALL CGEBR2D( ICTXT , 'Columnwise' , ' ' , 1 , 1 , ALPHA , 1 ,
085       $                IXROW , MYCOL )
086                    END IF
087  
088                    INDXTAU = JJAX
089  
090                END IF
091  
092                IF( N.LE.0 ) THEN
092                       
093                    TAU( INDXTAU ) = ZERO
094                    RETURN
095                END IF
096  
097                CALL PSCNRM2( N - 1 , XNORM , X , IX , JX , DESCX , INCX )
098                ALPHR = REAL( ALPHA )
099                ALPHI = AIMAG( ALPHA )
100  
101                IF( XNORM.EQ.ZERO .AND. ALPHI.EQ.ZERO ) THEN
102  
103  *                 H = I
104  
104                       
105                    TAU( INDXTAU ) = ZERO
106  
107                ELSE
108  
109  *                 General case
110  
110                       
111                    BETA = - SIGN( SLAPY3( ALPHR , ALPHI , XNORM ) , ALPHR )
112                    SAFMIN = SLAMCH( 'S' )
113                    RSAFMN = ONE / SAFMIN
114                    IF( ABS( BETA ).LT.SAFMIN ) THEN
115  
116  *                     XNORM , BETA may be inaccurate ; scale X and recompute them
117  
117                           
118                        KNT = 0
119     10 CONTINUE
120        KNT = KNT + 1
121        CALL PCSSCAL( N - 1 , RSAFMN , X , IX , JX , DESCX , INCX )
122        BETA = BETA*RSAFMN
123        ALPHI = ALPHI*RSAFMN
124        ALPHR = ALPHR*RSAFMN
125        IF( ABS( BETA ).LT.SAFMIN )
125               
126       $    GO TO 10
127  
128  *         New BETA is at most 1 , at least SAFMIN
129  
130            CALL PSCNRM2( N - 1 , XNORM , X , IX , JX , DESCX , INCX )
131            ALPHA = CMPLX( ALPHR , ALPHI )
132            BETA = - SIGN( SLAPY3( ALPHR , ALPHI , XNORM ) , ALPHR )
133            TAU( INDXTAU ) = CMPLX(( BETA - ALPHR ) / BETA ,
134       $    - ALPHI / BETA )
135            ALPHA = CLADIV( CMPLX( ONE ) , ALPHA - BETA )
136            CALL PCSCAL( N - 1 , ALPHA , X , IX , JX , DESCX , INCX )
137  
138  *         If ALPHA is subnormal , it may lose relative accuracy
139  
140            ALPHA = BETA
141            DO 20 J = 1 , KNT
141                   
142                ALPHA = ALPHA*SAFMIN
143     20     CONTINUE
144        ELSE
144               
145            TAU( INDXTAU ) = CMPLX(( BETA - ALPHR ) / BETA ,
146       $    - ALPHI / BETA )
147            ALPHA = CLADIV( CMPLX( ONE ) , ALPHA - BETA )
148            CALL PCSCAL( N - 1 , ALPHA , X , IX , JX , DESCX , INCX )
149            ALPHA = BETA
150        END IF
151        END IF
152  
153        RETURN
154  
155  *     End of PCLARFG
156  
157        END2636

Variables in Routine PCLARFG()

Summary Report
Data Type	Quantity	Size(byte)
COMPLEX	2	8
INTEGER	29	116
REAL	11	44
TOTAL	42	168

List of Variables

COMPLEX

ALPHA CLADIV

INTEGER

BLOCK_CYCLIC_2D CSRC_ CTXT_ DLEN_ DTYPE_
IAX ICTXT IIAX INCX INDXTAU
IX IXCOL IXROW J JAX
JJAX JX KNT LLD_ M_
MB_ MYCOL MYROW N N_
NB_ NPCOL NPROW RSRC_

REAL

ALPHI ALPHR BETA ONE RSAFMN
SAFMIN SLAMCH SLAPY3 TAU XNORM
ZERO

Variables Dependence Graph
Put the mouse over a right hand side variable to display the corresponding line of the dependence
-
- -
ALPHA <--- ALPHA{2ALPHA = ALPHA*SAFMIN, 3}, JALPHA = X( J ){2ALPHA = X( J )}, ALPHIALPHA = CMPLX( ALPHR, ALPHI ), ALPHRALPHA = CMPLX( ALPHR, ALPHI ), ONE{2}, SAFMINALPHA = ALPHA*SAFMIN, BETA{2ALPHA = BETA, 3, 4ALPHA = BETA}, CLADIV{2}

ALPHI <--- ALPHAALPHI = AIMAG( ALPHA ), ALPHIALPHI = ALPHI*RSAFMN, RSAFMNALPHI = ALPHI*RSAFMN

ALPHR <--- ALPHAALPHR = REAL( ALPHA ), ALPHRALPHR = ALPHR*RSAFMN, RSAFMNALPHR = ALPHR*RSAFMN

BETA <--- ALPHI{2}, ALPHR{2}, RSAFMNBETA = BETA*RSAFMN, SLAPY3{2}, BETABETA = BETA*RSAFMN, XNORM{2}

ICTXT <--- CTXT_ICTXT = DESCX( CTXT_ )

INDXTAU <--- IIAXINDXTAU = IIAX, JJAXINDXTAU = JJAX

J <--- IIAXJ = IIAX+(JJAX-1)*DESCX( LLD_ ){2J = IIAX+(JJAX-1)*DESCX( LLD_ )}, JJAXJ = IIAX+(JJAX-1)*DESCX( LLD_ ){2J = IIAX+(JJAX-1)*DESCX( LLD_ )}, KNTDO 20 J = 1, KNT, LLD_J = IIAX+(JJAX-1)*DESCX( LLD_ ){2J = IIAX+(JJAX-1)*DESCX( LLD_ )}

KNT <--- KNTKNT = KNT + 1

RSAFMN <--- ONERSAFMN = ONE / SAFMIN, SAFMINRSAFMN = ONE / SAFMIN

SAFMIN <--- SLAMCHSAFMIN = SLAMCH( 'S' )

TAU <--- ALPHI{2}, ALPHR{2}, BETA{2}, ZEROTAU( INDXTAU ) = ZERO{2TAU( INDXTAU ) = ZERO}