Routine: PZLANGE()  File: SRC\pzlange.f

 
 
# lines: 324
  # code: 324
  # comment: 0
  # blank:0
# Variables:44
# Callers:6
# Callings:0
# Words:169
# Keywords:101
 

 

 
..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PZLANGE returns the value of the one norm, or the Frobenius norm,
  or the infinity norm, or the element of largest absolute value of a
  distributed matrix sub( A ) = A(IA:IA+M-1, JA:JA+N-1).
  PZLANGE returns the value
     ( max(abs(A(i,j))),  NORM = 'M' or 'm' with IA <= i <= IA+M-1,
     (                                      and  JA <= j <= JA+N-1,
     (
     ( norm1( sub( A ) ), NORM = '1', 'O' or 'o'
     (
     ( normI( sub( A ) ), NORM = 'I' or 'i'
     (
     ( normF( sub( A ) ), NORM = 'F', 'f', 'E' or 'e'
  where norm1 denotes the  one norm of a matrix (maximum column sum),
  normI denotes the  infinity norm  of a matrix  (maximum row sum) and
  normF denotes the  Frobenius norm of a matrix (square root of sum of
  squares).  Note that  max(abs(A(i,j)))  is not a  matrix norm.
  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
  Arguments
  =========
  NORM    (global input) CHARACTER
          Specifies the value to be returned in PZLANGE as described
          above.
  M       (global input) INTEGER
          The number of rows to be operated on i.e the number of rows
          of the distributed submatrix sub( A ). When M = 0, PZLANGE
          is set to zero. M >= 0.
  N       (global input) INTEGER
          The number of columns to be operated on i.e the number of
          columns of the distributed submatrix sub( A ). When N = 0,
          PZLANGE is set to zero. N >= 0.
  A       (local input) COMPLEX*16 pointer into the local memory
          to an array of dimension (LLD_A, LOCc(JA+N-1)) containing the
          local pieces of the distributed matrix sub( A ).
  IA      (global input) INTEGER
          The row index in the global array A indicating the first
          row of sub( A ).
  JA      (global input) INTEGER
          The column index in the global array A indicating the
          first column of sub( A ).
  DESCA   (global and local input) INTEGER array of dimension DLEN_.
          The array descriptor for the distributed matrix A.
  WORK    (local workspace) DOUBLE PRECISION array dimension (LWORK)
          LWORK >=   0 if NORM = 'M' or 'm' (not referenced),
                   Nq0 if NORM = '1', 'O' or 'o',
                   Mp0 if NORM = 'I' or 'i',
                     0 if NORM = 'F', 'f', 'E' or 'e' (not referenced),
          where
          IROFFA = MOD( IA-1, MB_A ), ICOFFA = MOD( JA-1, NB_A ),
          IAROW = INDXG2P( IA, MB_A, MYROW, RSRC_A, NPROW ),
          IACOL = INDXG2P( JA, NB_A, MYCOL, CSRC_A, NPCOL ),
          Mp0 = NUMROC( M+IROFFA, MB_A, MYROW, IAROW, NPROW ),
          Nq0 = NUMROC( N+ICOFFA, NB_A, MYCOL, IACOL, NPCOL ),
          INDXG2P and NUMROC are ScaLAPACK tool functions; MYROW,
          MYCOL, NPROW and NPCOL can be determined by calling the
          subroutine BLACS_GRIDINFO.
  =====================================================================
     .. Parameters ..
 
Display dynamic version Find AutoScroll Reload FontSize: - + Hide Comments Hide Blanks Frame FullScreen MailPrint

  
001        DOUBLE PRECISION FUNCTION PZLANGE( NORM , M , N , A , IA , JA , DESCA ,
002       $WORK )
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        CHARACTER NORM
011        INTEGER IA , JA , M , N
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        DOUBLE PRECISION ONE , ZERO
018        PARAMETER( ONE = 1.0D + 0 , ZERO = 0.0D + 0 )
019  *     ..
020  *     .. Local Scalars ..
021        INTEGER I , IACOL , IAROW , ICTXT , II , ICOFF , IOFFA ,
022       $IROFF , J , JJ , LDA , MP , MYCOL , MYROW , NPCOL ,
023       $NPROW , NQ
024        DOUBLE PRECISION SCALE , SUM , VALUE
025  *     ..
026  *     .. Local Arrays ..
027        DOUBLE PRECISION RWORK( 2 )
028  *     ..
029  *     .. External Subroutines ..
030        EXTERNAL BLACS_GRIDINFO , DCOMBSSQ , DGEBR2D ,
031       $DGEBS2D , DGAMX2D , DGSUM2D , INFOG2L ,
032       $PDTREECOMB , ZLASSQ
033  *     ..
034  *     .. External Functions ..
035        LOGICAL LSAME
036        INTEGER IDAMAX , NUMROC
037        EXTERNAL LSAME , IDAMAX , NUMROC
038  *     ..
039  *     .. Intrinsic Functions ..
040        INTRINSIC ABS , MAX , MIN , MOD , SQRT
041  *     ..
042  *     .. Executable Statements ..
043  
044  *     Get grid parameters.
045  
046        ICTXT = DESCA( CTXT_ )
047        CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
048  
049        CALL INFOG2L( IA , JA , DESCA , NPROW , NPCOL , MYROW , MYCOL , II , JJ ,
050       $IAROW , IACOL )
051        IROFF = MOD( IA - 1 , DESCA( MB_ ) )
052        ICOFF = MOD( JA - 1 , DESCA( NB_ ) )
053        MP = NUMROC( M + IROFF , DESCA( MB_ ) , MYROW , IAROW , NPROW )
054        NQ = NUMROC( N + ICOFF , DESCA( NB_ ) , MYCOL , IACOL , NPCOL )
055        IF( MYROW.EQ.IAROW )
056       $    MP = MP - IROFF
057            IF( MYCOL.EQ.IACOL )
058       $        NQ = NQ - ICOFF
059                LDA = DESCA( LLD_ )
060  
061                IF( MIN( M , N ).EQ.0 ) THEN
062  
063                    VALUE = ZERO
064  
065                ELSE IF( LSAME( NORM , 'M' ) ) THEN
066  
067  *                 Find max(abs(A(i , j))).
068  
069                    VALUE = ZERO
070                    IF( NQ.GT.0 .AND. MP.GT.0 ) THEN
071                        IOFFA =(JJ - 1)*LDA
072                        DO 20 J = JJ , JJ + NQ - 1
073                            DO 10 I = II , MP + II - 1
074                                VALUE = MAX( VALUE , ABS( A( IOFFA + I ) ) )
075     10                     CONTINUE
076                            IOFFA = IOFFA + LDA
077     20                 CONTINUE
078                    END IF
079                    CALL DGAMX2D( ICTXT , 'All' , ' ' , 1 , 1 , VALUE , 1 , I , J , - 1 ,
080       $            0 , 0 )
081  
082                ELSE IF( LSAME( NORM , 'O' ) .OR. NORM.EQ.'1' ) THEN
083  
084  *                 Find norm1( sub( A ) ).
085  
086                    IF( NQ.GT.0 ) THEN
087                        IOFFA =( JJ - 1 ) * LDA
088                        DO 40 J = JJ , JJ + NQ - 1
089                            SUM = ZERO
090                            IF( MP.GT.0 ) THEN
091                                DO 30 I = II , MP + II - 1
092                                    SUM = SUM + ABS( A( IOFFA + I ) )
093     30                         CONTINUE
094                            END IF
095                            IOFFA = IOFFA + LDA
096                            WORK( J - JJ + 1 ) = SUM
097     40                 CONTINUE
098                    END IF
099  
100  *                 Find sum of global matrix columns and store on row 0 of
101  *                 process grid
102  
103                    CALL DGSUM2D( ICTXT , 'Columnwise' , ' ' , 1 , NQ , WORK , 1 ,
104       $            0 , MYCOL )
105  
106  *                 Find maximum sum of columns for 1 - norm
107  
108                    IF( MYROW.EQ.0 ) THEN
109                        IF( NQ.GT.0 ) THEN
110                            VALUE = WORK( IDAMAX( NQ , WORK , 1 ) )
111                        ELSE
112                            VALUE = ZERO
113                        END IF
114                        CALL DGAMX2D( ICTXT , 'Rowwise' , ' ' , 1 , 1 , VALUE , 1 , I , J ,
115       $                - 1 , 0 , 0 )
116                    END IF
117  
118                ELSE IF( LSAME( NORM , 'I' ) ) THEN
119  
120  *                 Find normI( sub( A ) ).
121  
122                    IF( MP.GT.0 ) THEN
123                        IOFFA = II + ( JJ - 1 ) * LDA
124                        DO 60 I = II , II + MP - 1
125                            SUM = ZERO
126                            IF( NQ.GT.0 ) THEN
127                                DO 50 J = IOFFA , IOFFA + NQ*LDA - 1 , LDA
128                                    SUM = SUM + ABS( A( J ) )
129     50                         CONTINUE
130                            END IF
131                            WORK( I - II + 1 ) = SUM
132                            IOFFA = IOFFA + 1
133     60                 CONTINUE
134                    END IF
135  
136  *                 Find sum of global matrix rows and store on column 0 of
137  *                 process grid
138  
139                    CALL DGSUM2D( ICTXT , 'Rowwise' , ' ' , MP , 1 , WORK , MAX( 1 , MP ) ,
140       $            MYROW , 0 )
141  
142  *                 Find maximum sum of rows for supnorm
143  
144                    IF( MYCOL.EQ.0 ) THEN
145                        IF( MP.GT.0 ) THEN
146                            VALUE = WORK( IDAMAX( MP , WORK , 1 ) )
147                        ELSE
148                            VALUE = ZERO
149                        END IF
150                        CALL DGAMX2D( ICTXT , 'Columnwise' , ' ' , 1 , 1 , VALUE , 1 , I ,
151       $                J , - 1 , 0 , 0 )
152                    END IF
153  
154                ELSE IF(( LSAME( NORM , 'F' ) ) .OR.( LSAME( NORM , 'E' ) ) ) THEN
155  
156  *                 Find normF( sub( A ) ).
157  
158                    SCALE = ZERO
159                    SUM = ONE
160                    IOFFA = II + ( JJ - 1 ) * LDA
161                    IF( NQ.GT.0 ) THEN
162                        DO 70 J = IOFFA , IOFFA + NQ*LDA - 1 , LDA
163                            CALL ZLASSQ( MP , A( J ) , 1 , SCALE , SUM )
164     70                 CONTINUE
165                    END IF
166  
167  *                 Perform the global scaled sum
168  
169                    RWORK( 1 ) = SCALE
170                    RWORK( 2 ) = SUM
171                    CALL PDTREECOMB( ICTXT , 'All' , 2 , RWORK , 0 , 0 , DCOMBSSQ )
172                    VALUE = RWORK( 1 ) * SQRT( RWORK( 2 ) )
173  
174                END IF
175  
176                IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
177                    CALL DGEBS2D( ICTXT , 'All' , ' ' , 1 , 1 , VALUE , 1 )
178                ELSE
179                    CALL DGEBR2D( ICTXT , 'All' , ' ' , 1 , 1 , VALUE , 1 , 0 , 0 )
180                END IF
181  
182                PZLANGE = VALUE
183  
184                RETURN
185  
186  *             End of PZLANGE
187  
188            END