1 DOUBLE PRECISION FUNCTION PZLANGE( NORM, M, N, A, IA, JA, DESCA, 2 $ WORK ) 3 IMPLICIT NONE 4* 5* -- ScaLAPACK auxiliary routine (version 1.7) -- 6* University of Tennessee, Knoxville, Oak Ridge National Laboratory, 7* and University of California, Berkeley. 8* May 1, 1997 9* 10* .. Scalar Arguments .. 11 CHARACTER NORM 12 INTEGER IA, JA, M, N 13* .. 14* .. Array Arguments .. 15 INTEGER DESCA( * ) 16 DOUBLE PRECISION WORK( * ) 17 COMPLEX*16 A( * ) 18* .. 19* 20* Purpose 21* ======= 22* 23* PZLANGE returns the value of the one norm, or the Frobenius norm, 24* or the infinity norm, or the element of largest absolute value of a 25* distributed matrix sub( A ) = A(IA:IA+M-1, JA:JA+N-1). 26* 27* PZLANGE returns the value 28* 29* ( max(abs(A(i,j))), NORM = 'M' or 'm' with IA <= i <= IA+M-1, 30* ( and JA <= j <= JA+N-1, 31* ( 32* ( norm1( sub( A ) ), NORM = '1', 'O' or 'o' 33* ( 34* ( normI( sub( A ) ), NORM = 'I' or 'i' 35* ( 36* ( normF( sub( A ) ), NORM = 'F', 'f', 'E' or 'e' 37* 38* where norm1 denotes the one norm of a matrix (maximum column sum), 39* normI denotes the infinity norm of a matrix (maximum row sum) and 40* normF denotes the Frobenius norm of a matrix (square root of sum of 41* squares). Note that max(abs(A(i,j))) is not a matrix norm. 42* 43* Notes 44* ===== 45* 46* Each global data object is described by an associated description 47* vector. This vector stores the information required to establish 48* the mapping between an object element and its corresponding process 49* and memory location. 50* 51* Let A be a generic term for any 2D block cyclicly distributed array. 52* Such a global array has an associated description vector DESCA. 53* In the following comments, the character _ should be read as 54* "of the global array". 55* 56* NOTATION STORED IN EXPLANATION 57* --------------- -------------- -------------------------------------- 58* DTYPE_A(global) DESCA( DTYPE_ )The descriptor type. In this case, 59* DTYPE_A = 1. 60* CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating 61* the BLACS process grid A is distribu- 62* ted over. The context itself is glo- 63* bal, but the handle (the integer 64* value) may vary. 65* M_A (global) DESCA( M_ ) The number of rows in the global 66* array A. 67* N_A (global) DESCA( N_ ) The number of columns in the global 68* array A. 69* MB_A (global) DESCA( MB_ ) The blocking factor used to distribute 70* the rows of the array. 71* NB_A (global) DESCA( NB_ ) The blocking factor used to distribute 72* the columns of the array. 73* RSRC_A (global) DESCA( RSRC_ ) The process row over which the first 74* row of the array A is distributed. 75* CSRC_A (global) DESCA( CSRC_ ) The process column over which the 76* first column of the array A is 77* distributed. 78* LLD_A (local) DESCA( LLD_ ) The leading dimension of the local 79* array. LLD_A >= MAX(1,LOCr(M_A)). 80* 81* Let K be the number of rows or columns of a distributed matrix, 82* and assume that its process grid has dimension p x q. 83* LOCr( K ) denotes the number of elements of K that a process 84* would receive if K were distributed over the p processes of its 85* process column. 86* Similarly, LOCc( K ) denotes the number of elements of K that a 87* process would receive if K were distributed over the q processes of 88* its process row. 89* The values of LOCr() and LOCc() may be determined via a call to the 90* ScaLAPACK tool function, NUMROC: 91* LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ), 92* LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ). 93* An upper bound for these quantities may be computed by: 94* LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A 95* LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A 96* 97* Arguments 98* ========= 99* 100* NORM (global input) CHARACTER 101* Specifies the value to be returned in PZLANGE as described 102* above. 103* 104* M (global input) INTEGER 105* The number of rows to be operated on i.e the number of rows 106* of the distributed submatrix sub( A ). When M = 0, PZLANGE 107* is set to zero. M >= 0. 108* 109* N (global input) INTEGER 110* The number of columns to be operated on i.e the number of 111* columns of the distributed submatrix sub( A ). When N = 0, 112* PZLANGE is set to zero. N >= 0. 113* 114* A (local input) COMPLEX*16 pointer into the local memory 115* to an array of dimension (LLD_A, LOCc(JA+N-1)) containing the 116* local pieces of the distributed matrix sub( A ). 117* 118* IA (global input) INTEGER 119* The row index in the global array A indicating the first 120* row of sub( A ). 121* 122* JA (global input) INTEGER 123* The column index in the global array A indicating the 124* first column of sub( A ). 125* 126* DESCA (global and local input) INTEGER array of dimension DLEN_. 127* The array descriptor for the distributed matrix A. 128* 129* WORK (local workspace) DOUBLE PRECISION array dimension (LWORK) 130* LWORK >= 0 if NORM = 'M' or 'm' (not referenced), 131* Nq0 if NORM = '1', 'O' or 'o', 132* Mp0 if NORM = 'I' or 'i', 133* 0 if NORM = 'F', 'f', 'E' or 'e' (not referenced), 134* where 135* 136* IROFFA = MOD( IA-1, MB_A ), ICOFFA = MOD( JA-1, NB_A ), 137* IAROW = INDXG2P( IA, MB_A, MYROW, RSRC_A, NPROW ), 138* IACOL = INDXG2P( JA, NB_A, MYCOL, CSRC_A, NPCOL ), 139* Mp0 = NUMROC( M+IROFFA, MB_A, MYROW, IAROW, NPROW ), 140* Nq0 = NUMROC( N+ICOFFA, NB_A, MYCOL, IACOL, NPCOL ), 141* 142* INDXG2P and NUMROC are ScaLAPACK tool functions; MYROW, 143* MYCOL, NPROW and NPCOL can be determined by calling the 144* subroutine BLACS_GRIDINFO. 145* 146* ===================================================================== 147* 148* .. Parameters .. 149 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, 150 $ LLD_, MB_, M_, NB_, N_, RSRC_ 151 PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, 152 $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, 153 $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) 154 DOUBLE PRECISION ONE, ZERO 155 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) 156* .. 157* .. Local Scalars .. 158 INTEGER I, IACOL, IAROW, ICTXT, II, ICOFF, IOFFA, 159 $ IROFF, J, JJ, LDA, MP, MYCOL, MYROW, NPCOL, 160 $ NPROW, NQ 161 DOUBLE PRECISION SUM, VALUE 162* .. 163* .. Local Arrays .. 164 DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) 165* .. 166* .. External Subroutines .. 167 EXTERNAL BLACS_GRIDINFO, DCOMBSSQ, DGEBR2D, 168 $ DGEBS2D, DGAMX2D, DGSUM2D, INFOG2L, 169 $ PDTREECOMB, ZLASSQ 170* .. 171* .. External Functions .. 172 LOGICAL LSAME 173 INTEGER IDAMAX, NUMROC 174 EXTERNAL LSAME, IDAMAX, NUMROC 175* .. 176* .. Intrinsic Functions .. 177 INTRINSIC ABS, MAX, MIN, MOD, SQRT 178* .. 179* .. Executable Statements .. 180* 181* Get grid parameters. 182* 183 ICTXT = DESCA( CTXT_ ) 184 CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) 185* 186 CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, II, JJ, 187 $ IAROW, IACOL ) 188 IROFF = MOD( IA-1, DESCA( MB_ ) ) 189 ICOFF = MOD( JA-1, DESCA( NB_ ) ) 190 MP = NUMROC( M+IROFF, DESCA( MB_ ), MYROW, IAROW, NPROW ) 191 NQ = NUMROC( N+ICOFF, DESCA( NB_ ), MYCOL, IACOL, NPCOL ) 192 IF( MYROW.EQ.IAROW ) 193 $ MP = MP - IROFF 194 IF( MYCOL.EQ.IACOL ) 195 $ NQ = NQ - ICOFF 196 LDA = DESCA( LLD_ ) 197* 198 IF( MIN( M, N ).EQ.0 ) THEN 199* 200 VALUE = ZERO 201* 202************************************************************************ 203* max norm 204* 205 ELSE IF( LSAME( NORM, 'M' ) ) THEN 206* 207* Find max(abs(A(i,j))). 208* 209 VALUE = ZERO 210 IF( NQ.GT.0 .AND. MP.GT.0 ) THEN 211 IOFFA = (JJ-1)*LDA 212 DO 20 J = JJ, JJ+NQ-1 213 DO 10 I = II, MP+II-1 214 VALUE = MAX( VALUE, ABS( A( IOFFA+I ) ) ) 215 10 CONTINUE 216 IOFFA = IOFFA + LDA 217 20 CONTINUE 218 END IF 219 CALL DGAMX2D( ICTXT, 'All', ' ', 1, 1, VALUE, 1, I, J, -1, 220 $ 0, 0 ) 221* 222************************************************************************ 223* one norm 224* 225 ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' ) THEN 226* 227* Find norm1( sub( A ) ). 228* 229 IF( NQ.GT.0 ) THEN 230 IOFFA = ( JJ - 1 ) * LDA 231 DO 40 J = JJ, JJ+NQ-1 232 SUM = ZERO 233 IF( MP.GT.0 ) THEN 234 DO 30 I = II, MP+II-1 235 SUM = SUM + ABS( A( IOFFA+I ) ) 236 30 CONTINUE 237 END IF 238 IOFFA = IOFFA + LDA 239 WORK( J-JJ+1 ) = SUM 240 40 CONTINUE 241 END IF 242* 243* Find sum of global matrix columns and store on row 0 of 244* process grid 245* 246 CALL DGSUM2D( ICTXT, 'Columnwise', ' ', 1, NQ, WORK, 1, 247 $ 0, MYCOL ) 248* 249* Find maximum sum of columns for 1-norm 250* 251 IF( MYROW.EQ.0 ) THEN 252 IF( NQ.GT.0 ) THEN 253 VALUE = WORK( IDAMAX( NQ, WORK, 1 ) ) 254 ELSE 255 VALUE = ZERO 256 END IF 257 CALL DGAMX2D( ICTXT, 'Rowwise', ' ', 1, 1, VALUE, 1, I, J, 258 $ -1, 0, 0 ) 259 END IF 260* 261************************************************************************ 262* inf norm 263* 264 ELSE IF( LSAME( NORM, 'I' ) ) THEN 265* 266* Find normI( sub( A ) ). 267* 268 IF( MP.GT.0 ) THEN 269 IOFFA = II + ( JJ - 1 ) * LDA 270 DO 60 I = II, II+MP-1 271 SUM = ZERO 272 IF( NQ.GT.0 ) THEN 273 DO 50 J = IOFFA, IOFFA + NQ*LDA - 1, LDA 274 SUM = SUM + ABS( A( J ) ) 275 50 CONTINUE 276 END IF 277 WORK( I-II+1 ) = SUM 278 IOFFA = IOFFA + 1 279 60 CONTINUE 280 END IF 281* 282* Find sum of global matrix rows and store on column 0 of 283* process grid 284* 285 CALL DGSUM2D( ICTXT, 'Rowwise', ' ', MP, 1, WORK, MAX( 1, MP ), 286 $ MYROW, 0 ) 287* 288* Find maximum sum of rows for supnorm 289* 290 IF( MYCOL.EQ.0 ) THEN 291 IF( MP.GT.0 ) THEN 292 VALUE = WORK( IDAMAX( MP, WORK, 1 ) ) 293 ELSE 294 VALUE = ZERO 295 END IF 296 CALL DGAMX2D( ICTXT, 'Columnwise', ' ', 1, 1, VALUE, 1, I, 297 $ J, -1, 0, 0 ) 298 END IF 299* 300************************************************************************ 301* Frobenius norm 302* SSQ(1) is scale 303* SSQ(2) is sum-of-squares 304* 305 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN 306* 307* Find normF( sub( A ) ). 308* 309 SSQ(1) = ZERO 310 SSQ(2) = ONE 311 IOFFA = II + ( JJ - 1 ) * LDA 312 IF( NQ.GT.0 ) THEN 313 DO 70 J = IOFFA, IOFFA + NQ*LDA - 1, LDA 314 COLSSQ(1) = ZERO 315 COLSSQ(2) = ONE 316 CALL ZLASSQ( MP, A( J ), 1, COLSSQ(1), COLSSQ(2) ) 317 CALL DCOMBSSQ( SSQ, COLSSQ ) 318 70 CONTINUE 319 END IF 320* 321* Perform the global scaled sum 322* 323 CALL PDTREECOMB( ICTXT, 'All', 2, SSQ, 0, 0, DCOMBSSQ ) 324 VALUE = SSQ( 1 ) * SQRT( SSQ( 2 ) ) 325* 326 END IF 327* 328 IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN 329 CALL DGEBS2D( ICTXT, 'All', ' ', 1, 1, VALUE, 1 ) 330 ELSE 331 CALL DGEBR2D( ICTXT, 'All', ' ', 1, 1, VALUE, 1, 0, 0 ) 332 END IF 333* 334 PZLANGE = VALUE 335* 336 RETURN 337* 338* End of PZLANGE 339* 340 END 341