1! 2! Copyright (C) 1996-2016 The SIESTA group 3! This file is distributed under the terms of the 4! GNU General Public License: see COPYING in the top directory 5! or http://www.gnu.org/copyleft/gpl.txt. 6! See Docs/Contributors.txt for a list of contributors. 7! 8! 9! Auxiliary file for IBM P4 machines 10! when using the PESSL library in parallel runs. 11! 12 SUBROUTINE CPUTIM (TIME) 13 14 DOUBLE PRECISION TIME 15 16 TIME = MCLOCK()*0.01D0 17 END 18! 19! Add these two routines here if you are using pessl. 20! (Thanks to Vladimir Timochevski and Fedwa El-Mellouhi) 21! 22 SUBROUTINE DESCINIT( DESC, M, N, MB, NB, IRSRC, ICSRC, ICTXT, 23 $ LLD, INFO ) 24* 25* -- ScaLAPACK tools routine (version 1.5) -- 26* University of Tennessee, Knoxville, Oak Ridge National Laboratory, 27* and University of California, Berkeley. 28* May 1, 1997 29* 30* .. Scalar Arguments .. 31 INTEGER ICSRC, ICTXT, INFO, IRSRC, LLD, M, MB, N, NB 32* .. 33* .. Array Arguments .. 34 INTEGER DESC( * ) 35* .. 36* 37* Purpose 38* ======= 39* 40* DESCINIT initializes the descriptor vector with the 8 input arguments 41* M, N, MB, NB, IRSRC, ICSRC, ICTXT, LLD. 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* DESC (output) INTEGER array of dimension DLEN_. 101* The array descriptor of a distributed matrix to be set. 102* 103* M (global input) INTEGER 104* The number of rows in the distributed matrix. M >= 0. 105* 106* N (global input) INTEGER 107* The number of columns in the distributed matrix. N >= 0. 108* 109* MB (global input) INTEGER 110* The blocking factor used to distribute the rows of the 111* matrix. MB >= 1. 112* 113* NB (global input) INTEGER 114* The blocking factor used to distribute the columns of the 115* matrix. NB >= 1. 116* 117* IRSRC (global input) INTEGER 118* The process row over which the first row of the matrix is 119* distributed. 0 <= IRSRC < NPROW. 120* 121* ICSRC (global input) INTEGER 122* The process column over which the first column of the 123* matrix is distributed. 0 <= ICSRC < NPCOL. 124* 125* ICTXT (global input) INTEGER 126* The BLACS context handle, indicating the global context of 127* the operation on the matrix. The context itself is global. 128* 129* LLD (local input) INTEGER 130* The leading dimension of the local array storing the local 131* blocks of the distributed matrix. LLD >= MAX(1,LOCr(M)). 132* 133* INFO (output) INTEGER 134* = 0: successful exit 135* < 0: if INFO = -i, the i-th argument had an illegal value 136* 137* Note 138* ==== 139* 140* If the routine can recover from an erroneous input argument, it will 141* return an acceptable descriptor vector. For example, if LLD = 0 on 142* input, DESC(LLD_) will contain the smallest leading dimension 143* required to store the specified M-by-N distributed matrix, INFO 144* will be set -9 in that case. 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* .. 155* .. Local Scalars .. 156 INTEGER MYCOL, MYROW, NPCOL, NPROW 157* .. 158* .. External Subroutines .. 159 EXTERNAL BLACS_GRIDINFO, local_PXERBLA 160* .. 161* .. External Functions .. 162 INTEGER NUMROC 163 EXTERNAL NUMROC 164* .. 165* .. Intrinsic Functions .. 166 INTRINSIC MAX, MIN 167* .. 168* .. Executable Statements .. 169* 170* Get grid parameters 171* 172 CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) 173* 174 INFO = 0 175 IF( M.LT.0 ) THEN 176 INFO = -2 177 ELSE IF( N.LT.0 ) THEN 178 INFO = -3 179 ELSE IF( MB.LT.1 ) THEN 180 INFO = -4 181 ELSE IF( NB.LT.1 ) THEN 182 INFO = -5 183 ELSE IF( IRSRC.LT.0 .OR. IRSRC.GE.NPROW ) THEN 184 INFO = -6 185 ELSE IF( ICSRC.LT.0 .OR. ICSRC.GE.NPCOL ) THEN 186 INFO = -7 187 ELSE IF( NPROW.EQ.-1 ) THEN 188 INFO = -8 189 ELSE IF( LLD.LT.MAX( 1, NUMROC( M, MB, MYROW, IRSRC, 190 $ NPROW ) ) ) THEN 191 INFO = -9 192 END IF 193* 194 IF( INFO.NE.0 ) 195 $ CALL local_PXERBLA( ICTXT, 'DESCINIT', -INFO ) 196* 197 DESC( DTYPE_ ) = BLOCK_CYCLIC_2D 198 DESC( M_ ) = MAX( 0, M ) 199 DESC( N_ ) = MAX( 0, N ) 200 DESC( MB_ ) = MAX( 1, MB ) 201 DESC( NB_ ) = MAX( 1, NB ) 202 DESC( RSRC_ ) = MAX( 0, MIN( IRSRC, NPROW-1 ) ) 203 DESC( CSRC_ ) = MAX( 0, MIN( ICSRC, NPCOL-1 ) ) 204 DESC( CTXT_ ) = ICTXT 205 DESC( LLD_ ) = MAX( LLD, MAX( 1, NUMROC( DESC( M_ ), DESC( MB_ ), 206 $ MYROW, DESC( RSRC_ ), NPROW ) ) ) 207* 208 RETURN 209* 210* End DESCINIT 211* 212 END 213! 214! Local copy of pxerbla, called local_pxerbla 215! IBM's PESSL apparently does its own error handling, and does 216! not use the pxerbla model of the reference implementation. 217! 218 SUBROUTINE local_PXERBLA( ICTXT, SRNAME, INFO ) 219* 220* -- ScaLAPACK auxiliary routine (version 1.0) -- 221* University of Tennessee, Knoxville, Oak Ridge National Laboratory, 222* and University of California, Berkeley. 223* March 20, 1995 224* 225* .. Scalar Arguments .. 226 INTEGER ICTXT, INFO 227* .. 228* .. Array Arguments .. 229 CHARACTER*(*) SRNAME 230* .. 231* 232* Purpose 233* ======= 234* 235* PXERBLA is an error handler for the ScaLAPACK routines. It is called 236* by a ScaLAPACK routine if an input parameter has an invalid value. 237* A message is printed. Installers may consider modifying this routine 238* in order to call system-specific exception-handling facilities. 239* 240* Arguments 241* ========= 242* 243* ICTXT (global input) INTEGER 244* The BLACS context handle, indicating the global context of 245* the operation. The context itself is global. 246* 247* SRNAME (global input) CHARACTER*(*) 248* The name of the routine which called PXERBLA. 249* 250* INFO (global input) INTEGER 251* The position of the invalid parameter in the parameter list 252* of the calling routine. 253* 254* ===================================================================== 255* 256* .. Local Scalars .. 257 INTEGER MYCOL, MYROW, NPCOL, NPROW 258* .. 259* .. External Subroutines .. 260 EXTERNAL BLACS_GRIDINFO 261* .. 262* .. Executable Statements .. 263* 264 CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) 265* 266 WRITE( *, FMT = 9999 ) MYROW, MYCOL, SRNAME, INFO 267* 268 9999 FORMAT( '{', I5, ',', I5, '}: On entry to ', A, 269 $ ' parameter number', I4, ' had an illegal value' ) 270* 271* End of PXERBLA 272* 273 END 274