1 SUBROUTINE PDQRT13( SCALE, M, N, A, IA, JA, DESCA, NORMA, ISEED, 2 $ WORK ) 3* 4* -- ScaLAPACK routine (version 1.7) -- 5* University of Tennessee, Knoxville, Oak Ridge National Laboratory, 6* and University of California, Berkeley. 7* May 1, 1997 8* 9* .. Scalar Arguments .. 10 INTEGER IA, ISEED, JA, M, N, SCALE 11 DOUBLE PRECISION NORMA 12* .. 13* .. Array Arguments .. 14 INTEGER DESCA( * ) 15 DOUBLE PRECISION WORK( * ) 16 DOUBLE PRECISION A( * ) 17* .. 18* 19* Purpose 20* ======= 21* 22* PDQRT13 generates a full-rank matrix that may be scaled to have 23* large or small norm. 24* 25* Notes 26* ===== 27* 28* Each global data object is described by an associated description 29* vector. This vector stores the information required to establish 30* the mapping between an object element and its corresponding process 31* and memory location. 32* 33* Let A be a generic term for any 2D block cyclicly distributed array. 34* Such a global array has an associated description vector DESCA. 35* In the following comments, the character _ should be read as 36* "of the global array". 37* 38* NOTATION STORED IN EXPLANATION 39* --------------- -------------- -------------------------------------- 40* DTYPE_A(global) DESCA( DTYPE_ )The descriptor type. In this case, 41* DTYPE_A = 1. 42* CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating 43* the BLACS process grid A is distribu- 44* ted over. The context itself is glo- 45* bal, but the handle (the integer 46* value) may vary. 47* M_A (global) DESCA( M_ ) The number of rows in the global 48* array A. 49* N_A (global) DESCA( N_ ) The number of columns in the global 50* array A. 51* MB_A (global) DESCA( MB_ ) The blocking factor used to distribute 52* the rows of the array. 53* NB_A (global) DESCA( NB_ ) The blocking factor used to distribute 54* the columns of the array. 55* RSRC_A (global) DESCA( RSRC_ ) The process row over which the first 56* row of the array A is distributed. 57* CSRC_A (global) DESCA( CSRC_ ) The process column over which the 58* first column of the array A is 59* distributed. 60* LLD_A (local) DESCA( LLD_ ) The leading dimension of the local 61* array. LLD_A >= MAX(1,LOCr(M_A)). 62* 63* Let K be the number of rows or columns of a distributed matrix, 64* and assume that its process grid has dimension p x q. 65* LOCr( K ) denotes the number of elements of K that a process 66* would receive if K were distributed over the p processes of its 67* process column. 68* Similarly, LOCc( K ) denotes the number of elements of K that a 69* process would receive if K were distributed over the q processes of 70* its process row. 71* The values of LOCr() and LOCc() may be determined via a call to the 72* ScaLAPACK tool function, NUMROC: 73* LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ), 74* LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ). 75* An upper bound for these quantities may be computed by: 76* LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A 77* LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A 78* 79* Arguments 80* ========= 81* 82* SCALE (global input) INTEGER 83* SCALE = 1: normally scaled matrix 84* SCALE = 2: matrix scaled up 85* SCALE = 3: matrix scaled down 86* 87* M (global input) INTEGER 88* The number of rows to be operated on, i.e. the number of rows 89* of the distributed submatrix sub( A ). M >= 0. 90* 91* N (global input) INTEGER 92* The number of columns to be operated on, i.e. the number of 93* columns of the distributed submatrix sub( A ). N >= 0. 94* 95* A (local output) DOUBLE PRECISION pointer into the local memory 96* to an array of dimension (LLD_A,LOCc(JA+N-1)). This array 97* contains the local pieces of the distributed matrix sub( A ). 98* 99* IA (global input) INTEGER 100* The row index in the global array A indicating the first 101* row of sub( A ). 102* 103* JA (global input) INTEGER 104* The column index in the global array A indicating the 105* first column of sub( A ). 106* 107* DESCA (global and local input) INTEGER array of dimension DLEN_. 108* The array descriptor for the distributed matrix A. 109* 110* NORMA (global output) DOUBLE PRECISION 111* The one-norm of A. 112* 113* ISEED (global input/global output) INTEGER 114* Seed for random number generator. 115* 116* WORK (local workspace) DOUBLE PRECISION array, dimension (LWORK) 117* LWORK >= Nq0, where 118* 119* ICOFFA = MOD( JA-1, NB_A ), 120* IACOL = INDXG2P( JA, NB_A, MYCOL, CSRC_A, NPCOL ), and 121* Nq0 = NUMROC( N+ICOFFA, NB_A, MYCOL, IACOL, NPCOL ). 122* 123* INDXG2P and NUMROC are ScaLAPACK tool functions; MYROW, 124* MYCOL, NPROW and NPCOL can be determined by calling the 125* subroutine BLACS_GRIDINFO. 126* 127* ===================================================================== 128* 129* .. Parameters .. 130 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_, 131 $ LLD_, MB_, M_, NB_, N_, RSRC_ 132 PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, 133 $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, 134 $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 ) 135 DOUBLE PRECISION ONE 136 PARAMETER ( ONE = 1.0D0 ) 137* .. 138* .. Local Scalars .. 139 INTEGER I, IACOL, IAROW, ICOFFA, ICTXT, IIA, INFO, 140 $ IROFFA, J, JJA, MP, MYCOL, MYROW, NPCOL, 141 $ NPROW, NQ 142 DOUBLE PRECISION AJJ, ASUM, BIGNUM, SMLNUM 143* .. 144* .. External Functions .. 145 INTEGER NUMROC 146 DOUBLE PRECISION PDLAMCH, PDLANGE 147 EXTERNAL NUMROC, PDLAMCH, PDLANGE 148* .. 149* .. External Subroutines .. 150 EXTERNAL BLACS_GRIDINFO, INFOG2L, PDLABAD, PDLASCL, 151 $ PDMATGEN, PDASUM, PDELGET, PDELSET 152* .. 153* .. Intrinsic Functions .. 154 INTRINSIC MOD, SIGN 155* .. 156* .. Executable Statements .. 157* 158 ICTXT = DESCA( CTXT_ ) 159 CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) 160* 161 IF( M.LE.0 .OR. N.LE.0 ) 162 $ RETURN 163* 164* generate the matrix 165* 166 IROFFA = MOD( IA-1, DESCA( MB_ ) ) 167 ICOFFA = MOD( JA-1, DESCA( NB_ ) ) 168 CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, IIA, 169 $ JJA, IAROW, IACOL ) 170 MP = NUMROC( M+IROFFA, DESCA( MB_ ), MYROW, IAROW, NPROW ) 171 NQ = NUMROC( N+ICOFFA, DESCA( NB_ ), MYCOL, IACOL, NPCOL ) 172 IF( MYROW.EQ.IAROW ) 173 $ MP = MP - IROFFA 174 IF( MYCOL.EQ.IACOL ) 175 $ NQ = NQ - ICOFFA 176* 177 CALL PDMATGEN( ICTXT, 'N', 'N', DESCA( M_ ), DESCA( N_ ), 178 $ DESCA( MB_ ), DESCA( NB_ ), A, DESCA( LLD_ ), 179 $ DESCA( RSRC_ ), DESCA( CSRC_ ), ISEED, IIA-1, MP, 180 $ JJA-1, NQ, MYROW, MYCOL, NPROW, NPCOL ) 181* 182 DO 10 J = JA, JA+N-1 183 I = IA + J - JA 184 IF( I.LE.IA+M-1 ) THEN 185 CALL PDASUM( M, ASUM, A, IA, J, DESCA, 1 ) 186 CALL PDELGET( 'Column', ' ', AJJ, A, I, J, DESCA ) 187 AJJ = AJJ + SIGN( ASUM, AJJ ) 188 CALL PDELSET( A, I, J, DESCA, AJJ ) 189 END IF 190 10 CONTINUE 191* 192* scaled versions 193* 194 IF( SCALE.NE.1 ) THEN 195* 196 NORMA = PDLANGE( 'M', M, N, A, IA, JA, DESCA, WORK ) 197 SMLNUM = PDLAMCH( ICTXT, 'Safe minimum' ) 198 BIGNUM = ONE / SMLNUM 199 CALL PDLABAD( ICTXT, SMLNUM, BIGNUM ) 200 SMLNUM = SMLNUM / PDLAMCH( ICTXT, 'Epsilon' ) 201 BIGNUM = ONE / SMLNUM 202* 203 IF( SCALE.EQ.2 ) THEN 204* 205* matrix scaled up 206* 207 CALL PDLASCL( 'General', NORMA, BIGNUM, M, N, A, IA, 208 $ JA, DESCA, INFO ) 209* 210 ELSE IF( SCALE.EQ.3 ) THEN 211* 212* matrix scaled down 213* 214 CALL PDLASCL( 'General', NORMA, SMLNUM, M, N, A, IA, 215 $ JA, DESCA, INFO ) 216* 217 END IF 218* 219 END IF 220* 221 NORMA = PDLANGE( 'One-norm', M, N, A, IA, JA, DESCA, WORK ) 222* 223 RETURN 224* 225* End of PDQRT13 226* 227 END 228