Routine PZLASSQ() Documented By Universal Report

Routine: PZLASSQ()

# lines:	286
# code:	286
# comment:	0
# blank:	0
# Variables:	37
# Callers:	0
# Callings:	0
# Words:	131
# Keywords:	74

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PZLASSQ  returns the values  scl  and  smsq  such that
     ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
  where x( i ) = sub( X ) = abs( X( IX+(JX-1)*DESCX(M_)+(i-1)*INCX ) ).
  The value of sumsq is assumed to be at least unity and the value of
  ssq will then satisfy
     1.0 .le. ssq .le. ( sumsq + 2*n ).
  scale is assumed to be non-negative and scl returns the value
     scl = max( scale, abs( real( x( i ) ) ), abs( aimag( x( i ) ) ) ),
            i
  scale and sumsq must be supplied in SCALE and SUMSQ respectively.
  SCALE and SUMSQ are overwritten by scl and ssq respectively.
  The routine makes only one pass through the vector sub( X ).
  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.
  The result are only available in the scope of sub( X ), i.e if
  sub( X ) is distributed along a process row, the correct results are
  only available in this process row of the grid. Similarly if sub( X )
  is distributed along a process column, the correct results are only
  available in this process column of the grid.
  Arguments
  =========
  N       (global input) INTEGER
          The length of the distributed vector sub( X ).
  X       (input) COMPLEX*16
          The vector for which a scaled sum of squares is computed.
             x( i )  = X(IX+(JX-1)*M_X +(i-1)*INCX ), 1 <= i <= n.
  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.
  SCALE   (local input/local output) DOUBLE PRECISION
          On entry, the value  scale  in the equation above.
          On exit, SCALE is overwritten with  scl , the scaling factor
          for the sum of squares.
  SUMSQ   (local input/local output) DOUBLE PRECISION
          On entry, the value  sumsq  in the equation above.
          On exit, SUMSQ is overwritten with  smsq , the basic sum of
          squares from which  scl  has been factored out.
  =====================================================================
     .. Parameters ..

Display dynamic version

FontSize: - +

001        SUBROUTINE PZLASSQ( N , X , IX , JX , DESCX , INCX , SCALE , SUMSQ )
002  
003  *     -- ScaLAPACK auxiliary routine(version 1.7) --
004  *     University of Tennessee , Knoxville , Oak Ridge National Laboratory ,
005  *     and University of California , Berkeley.
006  *     May 1 , 1997
007  
008  *     .. Scalar Arguments ..
009        INTEGER IX , INCX , JX , N
010        DOUBLE PRECISION SCALE , SUMSQ
011        INTEGER BLOCK_CYCLIC_2D , CSRC_ , CTXT_ , DLEN_ , DTYPE_ ,
012       $LLD_ , MB_ , M_ , NB_ , N_ , RSRC_
013        PARAMETER( BLOCK_CYCLIC_2D = 1 , DLEN_ = 9 , DTYPE_ = 1 ,
014       $CTXT_ = 2 , M_ = 3 , N_ = 4 , MB_ = 5 , NB_ = 6 ,
015       $RSRC_ = 7 , CSRC_ = 8 , LLD_ = 9 )
016        DOUBLE PRECISION ZERO
017        PARAMETER( ZERO = 0.0D + 0 )
018  *     ..
019  *     .. Local Scalars ..
020        INTEGER I , ICOFF , ICTXT , IIX , IOFF , IROFF , IXCOL ,
021       $IXROW , JJX , LDX , MYCOL , MYROW , NP , NPCOL ,
022       $NPROW , NQ
023        DOUBLE PRECISION TEMP1
024  *     ..
025  *     .. Local Arrays ..
026        DOUBLE PRECISION WORK( 2 )
027  *     ..
028  *     .. External Subroutines ..
029        EXTERNAL BLACS_GRIDINFO , DCOMBSSQ , INFOG2L , PDTREECOMB
030  *     ..
031  *     .. External Functions ..
032        INTEGER NUMROC
033        EXTERNAL NUMROC
034  *     ..
035  *     .. Intrinsic Functions ..
036        INTRINSIC ABS , DBLE , DIMAG , MOD
037  *     ..
038  *     .. Executable Statements ..
039  
040  *     Get grid parameters.
041  
042        ICTXT = DESCX( CTXT_ )
043        CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
044  
045  *     Figure local indexes
046  
047        CALL INFOG2L( IX , JX , DESCX , NPROW , NPCOL , MYROW , MYCOL , IIX , JJX ,
048       $IXROW , IXCOL )
049  
050        LDX = DESCX( LLD_ )
051        IF( INCX.EQ.DESCX( M_ ) ) THEN
052  
053  *         X is rowwise distributed.
054  
054               
055            IF( MYROW.NE.IXROW )
055                   
056       $        RETURN
057                ICOFF = MOD( JX , DESCX( NB_ ) )
058                NQ = NUMROC( N + ICOFF , DESCX( NB_ ) , MYCOL , IXCOL , NPCOL )
059                IF( MYCOL.EQ.IXCOL )
059                       
060       $            NQ = NQ - ICOFF
061  
062  *                 Code direct from LAPACK's ZLASSQ ,(save subroutine call)
063  
064                    IF( NQ.GT.0 ) THEN
064                           
065                        IOFF = IIX + ( JJX - 1 ) * LDX
066                        DO 10 I = 1 , NQ
066                               
067                            IF( DBLE( X( IOFF ) ).NE.ZERO ) THEN
067                                   
068                                TEMP1 = ABS( DBLE( X( IOFF ) ) )
069                                IF( SCALE.LT.TEMP1 ) THEN
069                                       
070                                    SUMSQ = 1 + SUMSQ * ( SCALE / TEMP1 )**2
071                                    SCALE = TEMP1
072                                ELSE
072                                       
073                                    SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
074                                END IF
075                            END IF
076                            IF( DIMAG( X( IOFF ) ).NE.ZERO ) THEN
076                                   
077                                TEMP1 = ABS( DIMAG( X( IOFF ) ) )
078                                IF( SCALE.LT.TEMP1 ) THEN
078                                       
079                                    SUMSQ = 1 + SUMSQ * ( SCALE / TEMP1 )**2
080                                    SCALE = TEMP1
081                                ELSE
081                                       
082                                    SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
083                                END IF
084                            END IF
085                            IOFF = IOFF + LDX
086     10                 CONTINUE
086                       
087                    END IF
088  
089  *                 Take local result and find global
090  
091                    WORK( 1 ) = SCALE
092                    WORK( 2 ) = SUMSQ
093  
094                    CALL PDTREECOMB( ICTXT , 'Rowwise' , 2 , WORK , - 1 , IXCOL ,
095       $            DCOMBSSQ )
096  
097                    SCALE = WORK( 1 )
098                    SUMSQ = WORK( 2 )
099  
100                ELSE IF( INCX.EQ.1 ) THEN
101  
102  *                 X is columnwise distributed.
103  
103                       
104                    IF( MYCOL.NE.IXCOL )
104                           
105       $                RETURN
106                        IROFF = MOD( IX , DESCX( MB_ ) )
107                        NP = NUMROC( N + IROFF , DESCX( MB_ ) , MYROW , IXROW , NPROW )
108                        IF( MYROW.EQ.IXROW )
108                               
109       $                    NP = NP - IROFF
110  
111  *                         Code direct from LAPACK's ZLASSQ ,(save subroutine call)
112  
113                            IF( NP.GT.0 ) THEN
113                                   
114                                IOFF = IIX + ( JJX - 1 ) * LDX
115                                DO 20 I = 1 , NP
115                                       
116                                    IF( DBLE( X( IOFF ) ).NE.ZERO ) THEN
116                                           
117                                        TEMP1 = ABS( DBLE( X( IOFF ) ) )
118                                        IF( SCALE.LT.TEMP1 ) THEN
118                                               
119                                            SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
120                                            SCALE = TEMP1
121                                        ELSE
121                                               
122                                            SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
123                                        END IF
124                                    END IF
125                                    IF( DIMAG( X( IOFF ) ).NE.ZERO ) THEN
125                                           
126                                        TEMP1 = ABS( DIMAG( X( IOFF ) ) )
127                                        IF( SCALE.LT.TEMP1 ) THEN
127                                               
128                                            SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
129                                            SCALE = TEMP1
130                                        ELSE
130                                               
131                                            SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
132                                        END IF
133                                    END IF
134                                    IOFF = IOFF + 1
135     20                         CONTINUE
135                               
136                            END IF
137  
138  *                         Take local result and find global
139  
140                            WORK( 1 ) = SCALE
141                            WORK( 2 ) = SUMSQ
142  
143                            CALL PDTREECOMB( ICTXT , 'Columnwise' , 2 , WORK , - 1 , IXCOL ,
144       $                    DCOMBSSQ )
145  
146                            SCALE = WORK( 1 )
147                            SUMSQ = WORK( 2 )
148  
149                        END IF
150  
151                        RETURN
152  
153  *                     End of PZLASSQ
154  
155                    END2628

Variables in Routine PZLASSQ()

Summary Report
Data Type	Quantity	Size(byte)
DOUBLE PRECISION	5	24
INTEGER	32	128
TOTAL	37	152

List of Variables

DOUBLE PRECISION

SCALE SUMSQ TEMP1 WORK( 2 ) ZERO

INTEGER

BLOCK_CYCLIC_2D CSRC_ CTXT_ DLEN_ DTYPE_
I ICOFF ICTXT IIX INCX
IOFF IROFF IX IXCOL IXROW
JJX JX LDX LLD_ M_
MB_ MYCOL MYROW N N_
NB_ NP NPCOL NPROW NQ
NUMROC RSRC_

Variables Dependence Graph
Put the mouse over a right hand side variable to display the corresponding line of the dependence
-
- -
I <--- NPDO 20 I = 1, NP, NQDO 10 I = 1, NQ

ICOFF <--- JXICOFF = MOD( JX, DESCX( NB_ ) ), NB_ICOFF = MOD( JX, DESCX( NB_ ) )

ICTXT <--- CTXT_ICTXT = DESCX( CTXT_ )

IOFF <--- IOFFIOFF = IOFF + 1{2IOFF = IOFF + LDX}, JJXIOFF = IIX + ( JJX - 1 ) * LDX{2IOFF = IIX + ( JJX - 1 ) * LDX}, LDXIOFF = IIX + ( JJX - 1 ) * LDX{2IOFF = IIX + ( JJX - 1 ) * LDX, 3IOFF = IOFF + LDX}, IIXIOFF = IIX + ( JJX - 1 ) * LDX{2IOFF = IIX + ( JJX - 1 ) * LDX}

IROFF <--- IXIROFF = MOD( IX, DESCX( MB_ ) ), MB_IROFF = MOD( IX, DESCX( MB_ ) )

LDX <--- LLD_LDX = DESCX( LLD_ )

NP <--- IROFF, IXROW, MB_, MYROW, N, NPROW, NUMROC

NQ <--- IXCOL, MYCOL, N, NB_, NPCOL, NUMROC, ICOFF

SCALE <--- TEMP1SCALE = TEMP1{2SCALE = TEMP1, 3SCALE = TEMP1, 4SCALE = TEMP1}, WORKSCALE = WORK( 1 ){2SCALE = WORK( 1 )}

SUMSQ <--- SCALESUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2{2SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2, 3SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2, 4SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2, 5, 6SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2, 7, 8SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2}, SUMSQSUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2{2SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2, 3SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2, 4SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2, 5, 6SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2, 7, 8SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2}, TEMP1SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2{2SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2, 3SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2, 4SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2, 5, 6SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2, 7, 8SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2}, WORKSUMSQ = WORK( 2 ){2SUMSQ = WORK( 2 )}

TEMP1 <--- IOFFTEMP1 = ABS( DBLE( X( IOFF ) ) ){2TEMP1 = ABS( DIMAG( X( IOFF ) ) ), 3TEMP1 = ABS( DBLE( X( IOFF ) ) ), 4TEMP1 = ABS( DIMAG( X( IOFF ) ) )}

WORK <--- SCALEWORK( 1 ) = SCALE{2WORK( 1 ) = SCALE}, SUMSQWORK( 2 ) = SUMSQ{2WORK( 2 ) = SUMSQ}