001        REAL FUNCTION PCLANTR( NORM , UPLO , DIAG , M , N , A ,
002       $IA , JA , DESCA , 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 DIAG , NORM , UPLO
011        INTEGER IA , JA , M , N
012  *     ..
013  *     .. Array Arguments ..
014        INTEGER DESCA( * )
015        REAL WORK( * )
016        COMPLEX A( * )
017  *     ..
018  
019  *     Purpose
020  *     === ====
021  
022  *     PCLANTR returns the value of the one norm , or the Frobenius norm ,
023  *     or the infinity norm , or the element of largest absolute value of a
024  *     trapezoidal or triangular distributed matrix sub( A ) denoting
025  *     A(IA : IA + M - 1 , JA : JA + N - 1).
026  
027  *     PCLANTR returns the value
028  
029  *     ( max(abs(A(i , j))) , NORM = 'M' or 'm' with ia <= i <= ia + m - 1 ,
030  *     ( and ja <= j <= ja + n - 1 ,
031  *     (
032  *     ( norm1( sub( A ) ) , NORM = '1' , 'O' or 'o'
033  *     (
034  *     ( normI( sub( A ) ) , NORM = 'I' or 'i'
035  *     (
036  *     ( normF( sub( A ) ) , NORM = 'F' , 'f' , 'E' or 'e'
037  
038  *     where norm1 denotes the one norm of a matrix(maximum column sum) ,
039  *     normI denotes the infinity norm of a matrix(maximum row sum) and
040  *     normF denotes the Frobenius norm of a matrix(square root of sum of
041  *     squares). Note that max(abs(A(i , j))) is not a matrix norm.
042  
043  *     Notes
044  *     === ==
045  
046  *     Each global data object is described by an associated description
047  *     vector. This vector stores the information required to establish
048  *     the mapping between an object element and its corresponding process
049  *     and memory location.
050  
051  *     Let A be a generic term for any 2D block cyclicly distributed array.
052  *     Such a global array has an associated description vector DESCA.
053  *     In the following comments , the character _ should be read as
054  *     "of the global array".
055  
056  *     NOTATION STORED IN EXPLANATION
057  *     --- ------------ -------------- --------------------------------------
058  *     DTYPE_A(global) DESCA( DTYPE_ )The descriptor type. In this case ,
059  *     DTYPE_A = 1.
060  *     CTXT_A(global) DESCA( CTXT_ ) The BLACS context handle , indicating
061  *     the BLACS process grid A is distribu -
062  *     ted over. The context itself is glo -
063  *     bal , but the handle(the integer
064  *     value) may vary.
065  *     M_A(global) DESCA( M_ ) The number of rows in the global
066  *     array A.
067  *     N_A(global) DESCA( N_ ) The number of columns in the global
068  *     array A.
069  *     MB_A(global) DESCA( MB_ ) The blocking factor used to distribute
070  *     the rows of the array.
071  *     NB_A(global) DESCA( NB_ ) The blocking factor used to distribute
072  *     the columns of the array.
073  *     RSRC_A(global) DESCA( RSRC_ ) The process row over which the first
074  *     row of the array A is distributed.
075  *     CSRC_A(global) DESCA( CSRC_ ) The process column over which the
076  *     first column of the array A is
077  *     distributed.
078  *     LLD_A(local) DESCA( LLD_ ) The leading dimension of the local
079  *     array. LLD_A >= MAX(1 , LOCr(M_A)).
080  
081  *     Let K be the number of rows or columns of a distributed matrix ,
082  *     and assume that its process grid has dimension p x q.
083  *     LOCr( K ) denotes the number of elements of K that a process
084  *     would receive if K were distributed over the p processes of its
085  *     process column.
086  *     Similarly , LOCc( K ) denotes the number of elements of K that a
087  *     process would receive if K were distributed over the q processes of
088  *     its process row.
089  *     The values of LOCr() and LOCc() may be determined via a call to the
090  *     ScaLAPACK tool function , NUMROC :
091  *     LOCr( M ) = NUMROC( M , MB_A , MYROW , RSRC_A , NPROW ) ,
092  *     LOCc( N ) = NUMROC( N , NB_A , MYCOL , CSRC_A , NPCOL ).
093  *     An upper bound for these quantities may be computed by :
094  *     LOCr( M ) <= ceil( ceil(M / MB_A) / NPROW )*MB_A
095  *     LOCc( N ) <= ceil( ceil(N / NB_A) / NPCOL )*NB_A
096  
097  *     Arguments
098  *     === ======
099  
100  *     NORM(global input) CHARACTER
101  *     Specifies the value to be returned in PCLANTR as described
102  *     above.
103  
104  *     UPLO(global input) CHARACTER
105  *     Specifies whether the matrix sub( A ) is upper or lower
106  *     trapezoidal.
107  *     = 'U' : Upper trapezoidal
108  *     = 'L' : Lower trapezoidal
109  *     Note that sub( A ) is triangular instead of trapezoidal
110  *     if M = N.
111  
112  *     DIAG(global input) CHARACTER
113  *     Specifies whether or not the distributed matrix sub( A ) has
114  *     unit diagonal.
115  *     = 'N' : Non - unit diagonal
116  *     = 'U' : Unit diagonal
117  
118  *     M(global input) INTEGER
119  *     The number of rows to be operated on i.e the number of rows
120  *     of the distributed submatrix sub( A ). When M = 0 , PCLANTR is
121  *     set to zero. M >= 0.
122  
123  *     N(global input) INTEGER
124  *     The number of columns to be operated on i.e the number of
125  *     columns of the distributed submatrix sub( A ). When N = 0 ,
126  *     PCLANTR is set to zero. N >= 0.
127  
128  *     A(local input) COMPLEX pointer into the local memory
129  *     to an array of dimension(LLD_A , LOCc(JA + N - 1) ) containing
130  *     the local pieces of sub( A ).
131  
132  *     IA(global input) INTEGER
133  *     The row index in the global array A indicating the first
134  *     row of sub( A ).
135  
136  *     JA(global input) INTEGER
137  *     The column index in the global array A indicating the
138  *     first column of sub( A ).
139  
140  *     DESCA(global and local input) INTEGER array of dimension DLEN_.
141  *     The array descriptor for the distributed matrix A.
142  
143  *     WORK(local workspace) REAL array dimension(LWORK)
144  *     LWORK >= 0 if NORM = 'M' or 'm'(not referenced) ,
145  *     Nq0 if NORM = '1' , 'O' or 'o' ,
146  *     Mp0 if NORM = 'I' or 'i' ,
147  *     0 if NORM = 'F' , 'f' , 'E' or 'e'(not referenced) ,
148  *     where
149  
150  *     IROFFA = MOD( IA - 1 , MB_A ) , ICOFFA = MOD( JA - 1 , NB_A ) ,
151  *     IAROW = INDXG2P( IA , MB_A , MYROW , RSRC_A , NPROW ) ,
152  *     IACOL = INDXG2P( JA , NB_A , MYCOL , CSRC_A , NPCOL ) ,
153  *     Mp0 = NUMROC( M + IROFFA , MB_A , MYROW , IAROW , NPROW ) ,
154  *     Nq0 = NUMROC( N + ICOFFA , NB_A , MYCOL , IACOL , NPCOL ) ,
155  
156  *     INDXG2P and NUMROC are ScaLAPACK tool functions ; MYROW ,
157  *     MYCOL , NPROW and NPCOL can be determined by calling the
158  *     subroutine BLACS_GRIDINFO.
159  
160  *     === ==================================================================
161  
162  *     .. Parameters ..
163        INTEGER BLOCK_CYCLIC_2D , CSRC_ , CTXT_ , DLEN_ , DTYPE_ ,
164       $LLD_ , MB_ , M_ , NB_ , N_ , RSRC_
165        PARAMETER( BLOCK_CYCLIC_2D = 1 , DLEN_ = 9 , DTYPE_ = 1 ,
166       $CTXT_ = 2 , M_ = 3 , N_ = 4 , MB_ = 5 , NB_ = 6 ,
167       $RSRC_ = 7 , CSRC_ = 8 , LLD_ = 9 )
168        REAL ONE , ZERO
169        PARAMETER( ONE = 1.0E + 0 , ZERO = 0.0E + 0 )
170        END IF
171  
172  *     Broadcast the result to every process in the grid.
173  
174        IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
174               
175            CALL SGEBS2D( ICTXT , 'All' , ' ' , 1 , 1 , VALUE , 1 )
176        ELSE
176               
177            CALL SGEBR2D( ICTXT , 'All' , ' ' , 1 , 1 , VALUE , 1 , 0 , 0 )
178        END IF
179  
180        PCLANTR = VALUE
181  
182        RETURN
183  
184  *     End of PCLANTR
185  
186        END13033