Routine: PDLASSQ()  File: SRC\pdlassq.f

 
 
# lines: 263
  # code: 263
  # comment: 0
  # blank:0
# Variables:37
# Callers:0
# Callings:0
# Words:97
# Keywords:58
 

 

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PDLASSQ  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 ) = X( IX+(JX-1)*DESCX(M_)+(i-1)*INCX ).
  The value of sumsq is assumed to be non-negative and scl returns the
  value
     scl = max( scale, abs( x( 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) DOUBLE PRECISION
          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 Find AutoScroll Reload FontSize: - + Hide Comments Hide Blanks Frame FullScreen MailPrint

 
001        SUBROUTINE PDLASSQ( 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 , 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  
055            IF( MYROW.NE.IXROW )
056       $        RETURN
057                ICOFF = MOD( JX , DESCX( NB_ ) )
058                NQ = NUMROC( N + ICOFF , DESCX( NB_ ) , MYCOL , IXCOL , NPCOL )
059                IF( MYCOL.EQ.IXCOL )
060       $            NQ = NQ - ICOFF
061  
062  *                 Code direct from LAPACK's DLASSQ ,(save subroutine call)
063  
064                    IF( NQ.GT.0 ) THEN
065                        IOFF = IIX + ( JJX - 1 ) * LDX
066                        DO 10 I = 1 , NQ
067                            IF( X( IOFF ).NE.ZERO ) THEN
068                                TEMP1 = ABS( X( IOFF ) )
069                                IF( SCALE.LT.TEMP1 ) THEN
070                                    SUMSQ = 1 + SUMSQ * ( SCALE / TEMP1 )**2
071                                    SCALE = TEMP1
072                                ELSE
073                                    SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
074                                END IF
075                            END IF
076                            IOFF = IOFF + LDX
077     10                 CONTINUE
078                    END IF
079  
080  *                 Take local result and find global
081  
082                    WORK( 1 ) = SCALE
083                    WORK( 2 ) = SUMSQ
084  
085                    CALL PDTREECOMB( ICTXT , 'Rowwise' , 2 , WORK , - 1 , IXCOL ,
086       $            DCOMBSSQ )
087  
088                    SCALE = WORK( 1 )
089                    SUMSQ = WORK( 2 )
090  
091                ELSE IF( INCX.EQ.1 ) THEN
092  
093  *                 X is columnwise distributed.
094  
095                    IF( MYCOL.NE.IXCOL )
096       $                RETURN
097                        IROFF = MOD( IX , DESCX( MB_ ) )
098                        NP = NUMROC( N + IROFF , DESCX( MB_ ) , MYROW , IXROW , NPROW )
099                        IF( MYROW.EQ.IXROW )
100       $                    NP = NP - IROFF
101  
102  *                         Code direct from LAPACK's DLASSQ ,(save subroutine call)
103  
104                            IF( NP.GT.0 ) THEN
105                                IOFF = IIX + ( JJX - 1 ) * LDX
106                                DO 20 I = 1 , NP
107                                    IF( X( IOFF ).NE.ZERO ) THEN
108                                        TEMP1 = ABS( X( IOFF ) )
109                                        IF( SCALE.LT.TEMP1 ) THEN
110                                            SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
111                                            SCALE = TEMP1
112                                        ELSE
113                                            SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
114                                        END IF
115                                    END IF
116                                    IOFF = IOFF + 1
117     20                         CONTINUE
118                            END IF
119  
120  *                         Take local result and find global
121  
122                            WORK( 1 ) = SCALE
123                            WORK( 2 ) = SUMSQ
124  
125                            CALL PDTREECOMB( ICTXT , 'Columnwise' , 2 , WORK , - 1 , IXCOL ,
126       $                    DCOMBSSQ )
127  
128                            SCALE = WORK( 1 )
129                            SUMSQ = WORK( 2 )
130  
131                        END IF
132  
133                        RETURN
134  
135  *                     End of PDLASSQ
136  
137                    END