1 SUBROUTINE PCQRT13( 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 REAL NORMA 12* .. 13* .. Array Arguments .. 14 INTEGER DESCA( * ) 15 REAL WORK( * ) 16 COMPLEX A( * ) 17* .. 18* 19* Purpose 20* ======= 21* 22* PCQRT13 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) COMPLEX 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) REAL 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) REAL 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 REAL ONE 136 PARAMETER ( ONE = 1.0E0 ) 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 REAL ASUM, BIGNUM, SMLNUM 143 COMPLEX AJJ 144* .. 145* .. External Functions .. 146 INTEGER NUMROC 147 REAL PCLANGE, PSLAMCH 148 EXTERNAL NUMROC, PCLANGE, PSLAMCH 149* .. 150* .. External Subroutines .. 151 EXTERNAL BLACS_GRIDINFO, INFOG2L, PCLASCL, PCMATGEN, 152 $ PCELGET, PCELSET, PSCASUM, 153 $ PSLABAD 154* .. 155* .. Intrinsic Functions .. 156 INTRINSIC CMPLX, MOD, REAL, SIGN 157* .. 158* .. Executable Statements .. 159* 160 ICTXT = DESCA( CTXT_ ) 161 CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) 162* 163 IF( M.LE.0 .OR. N.LE.0 ) 164 $ RETURN 165* 166* generate the matrix 167* 168 IROFFA = MOD( IA-1, DESCA( MB_ ) ) 169 ICOFFA = MOD( JA-1, DESCA( NB_ ) ) 170 CALL INFOG2L( IA, JA, DESCA, NPROW, NPCOL, MYROW, MYCOL, IIA, 171 $ JJA, IAROW, IACOL ) 172 MP = NUMROC( M+IROFFA, DESCA( MB_ ), MYROW, IAROW, NPROW ) 173 NQ = NUMROC( N+ICOFFA, DESCA( NB_ ), MYCOL, IACOL, NPCOL ) 174 IF( MYROW.EQ.IAROW ) 175 $ MP = MP - IROFFA 176 IF( MYCOL.EQ.IACOL ) 177 $ NQ = NQ - ICOFFA 178* 179 CALL PCMATGEN( ICTXT, 'N', 'N', DESCA( M_ ), DESCA( N_ ), 180 $ DESCA( MB_ ), DESCA( NB_ ), A, DESCA( LLD_ ), 181 $ DESCA( RSRC_ ), DESCA( CSRC_ ), ISEED, IIA-1, MP, 182 $ JJA-1, NQ, MYROW, MYCOL, NPROW, NPCOL ) 183* 184 DO 10 J = JA, JA+N-1 185 I = IA + J - JA 186 IF( I.LE.IA+M-1 ) THEN 187 CALL PSCASUM( M, ASUM, A, IA, J, DESCA, 1 ) 188 CALL PCELGET( 'Column', ' ', AJJ, A, I, J, DESCA ) 189 AJJ = AJJ + CMPLX( SIGN( ASUM, REAL( AJJ ) ) ) 190 CALL PCELSET( A, I, J, DESCA, AJJ ) 191 END IF 192 10 CONTINUE 193* 194* scaled versions 195* 196 IF( SCALE.NE.1 ) THEN 197* 198 NORMA = PCLANGE( 'M', M, N, A, IA, JA, DESCA, WORK ) 199 SMLNUM = PSLAMCH( ICTXT, 'Safe minimum' ) 200 BIGNUM = ONE / SMLNUM 201 CALL PSLABAD( ICTXT, SMLNUM, BIGNUM ) 202 SMLNUM = SMLNUM / PSLAMCH( ICTXT, 'Epsilon' ) 203 BIGNUM = ONE / SMLNUM 204* 205 IF( SCALE.EQ.2 ) THEN 206* 207* matrix scaled up 208* 209 CALL PCLASCL( 'General', NORMA, BIGNUM, M, N, A, IA, 210 $ JA, DESCA, INFO ) 211* 212 ELSE IF( SCALE.EQ.3 ) THEN 213* 214* matrix scaled down 215* 216 CALL PCLASCL( 'General', NORMA, SMLNUM, M, N, A, IA, 217 $ JA, DESCA, INFO ) 218* 219 END IF 220* 221 END IF 222* 223 NORMA = PCLANGE( 'One-norm', M, N, A, IA, JA, DESCA, WORK ) 224* 225 RETURN 226* 227* End of PCQRT13 228* 229 END 230