|
SRC\pjlaenv.f |
|
| #lines: 364 size: 10 Kb creation: 18/01/2006 23:36:04 last modification: 08/05/2008 18:38:00 attribute: ARCH Find Reload | |
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176: 177: 178: 179: 180: 181: 182: 183: 184: 185: 186: 187: 188: 189: 190: 191: 192: 193: 194: 195: 196: 197: 198: 199: 200: 201: 202: 203: 204: 205: 206: 207: 208: 209: 210: 211: 212: 213: 214: 215: 216: 217: 218: 219: 220: 221: 222: 223: 224: 225: 226: 227: 228: 229: 230: 231: 232: 233: 234: 235: 236: 237: 238: 239: 240: 241: 242: 243: 244: 245: 246: 247: 248: 249: 250: 251: 252: 253: 254: 255: 256: 257: 258: 259: 260: 261: 262: 263: 264: 265: 266: 267: 268: 269: 270: 271: 272: 273: 274: 275: 276: 277: 278: 279: 280: 281: 282: 283: 284: 285: 286: 287: 288: 289: 290: 291: 292: 293: 294: 295: 296: 297: 298: 299: 300: 301: 302: 303: 304: 305: 306: 307: 308: 309: 310: 311: 312: 313: 314: 315: 316: 317: 318: 319: 320: 321: 322: 323: 324: 325: 326: 327: 328: 329: 330: 331: 332: 333: 334: 335: 336: 337: 338: 339: 340: 341: 342: 343: 344: 345: 346: 347: 348: 349: 350: 351: 352: 353: 354: 355: 356: 357: 358: 359: 360: 361: 362: 363: 364: |
INTEGER FUNCTION PJLAENV( ICTXT, ISPEC, NAME, OPTS, N1,
$ N2, N3, N4 )
*
* -- ScaLAPACK test routine (version 1.7) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
* October 15, 1999
*
* .. Scalar Arguments ..
CHARACTER*( * ) NAME, OPTS
INTEGER ICTXT, ISPEC, N1, N2, N3, N4
* ..
*
* Purpose
*
* =======
*
* PJLAENV is called from the ScaLAPACK symmetric and Hermitian
* tailored eigen-routines to choose
* problem-dependent parameters for the local environment. See ISPEC
* for a description of the parameters.
*
* This version provides a set of parameters which should give good,
* but not optimal, performance on many of the currently available
* computers. Users are encouraged to modify this subroutine to set
* the tuning parameters for their particular machine using the option
* and problem size information in the arguments.
*
* This routine will not function correctly if it is converted to all
* lower case. Converting it to all upper case is allowed.
*
* Arguments
* =========
*
* ISPEC (global input) INTEGER
* Specifies the parameter to be returned as the value of
* PJLAENV.
* = 1: the data layout blocksize;
* = 2: the panel blocking factor;
* = 3: the algorithmic blocking factor;
* = 4: execution path control;
* = 5: maximum size for direct call to the LAPACK routine
*
* NAME (global input) CHARACTER*(*)
* The name of the calling subroutine, in either upper case or
* lower case.
*
* OPTS (global input) CHARACTER*(*)
* The character options to the subroutine NAME, concatenated
* into a single character string. For example, UPLO = 'U',
* TRANS = 'T', and DIAG = 'N' for a triangular routine would
* be specified as OPTS = 'UTN'.
*
* N1 (global input) INTEGER
* N2 (global input) INTEGER
* N3 (global input) INTEGER
* N4 (global input) INTEGER
* Problem dimensions for the subroutine NAME; these may not all
* be required.
*
* At present, only N1 is used, and it (N1) is used only for
* 'TTRD'
*
* (PJLAENV) (global or local output) INTEGER
* >= 0: the value of the parameter specified by ISPEC
* < 0: if PJLAENV = -k, the k-th argument had an illegal
* value.
*
* Most parameters set via a call to PJLAENV must be identical
* on all processors and hence PJLAENV will return the same
* value to all procesors (i.e. global output). However some,
* in particular, the panel blocking factor can be different
* on each processor and hence PJLAENV can return different
* values on different processors (i.e. local output).
*
* Further Details
* ===============
*
* The following conventions have been used when calling PJLAENV from
* the ScaLAPACK routines:
* 1) OPTS is a concatenation of all of the character options to
* subroutine NAME, in the same order that they appear in the
* argument list for NAME, even if they are not used in determining
* the value of the parameter specified by ISPEC.
* 2) The problem dimensions N1, N2, N3, N4 are specified in the order
* that they appear in the argument list for NAME. N1 is used
* first, N2 second, and so on, and unused problem dimensions are
* passed a value of -1.
* 3) The parameter value returned by PJLAENV is checked for validity
* in the calling subroutine. For example, PJLAENV is used to
* retrieve the optimal blocksize for STRTRI as follows:
*
* NB = PJLAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )
* IF( NB.LE.1 ) NB = MAX( 1, N )
*
* PJLAENV is patterned after ILAENV and keeps the same interface in
* anticipation of future needs, even though PJLAENV is only sparsely
* used at present in ScaLAPACK. Most ScaLAPACK codes use the input
* data layout blocking factor as the algorithmic blocking factor -
* hence there is no need or opportunity to set the algorithmic or
* data decomposition blocking factor.
*
* pXYYtevx.f and pXYYtgvx.f and pXYYttrd.f are the only codes which
* call PJLAENV in this release. pXYYtevx.f and pXYYtgvx.f redistribute
* the data to the best data layout for each transformation. pXYYttrd.f
* uses a data layout blocking factor of 1 and a
*
* =====================================================================
*
* .. Parameters ..
INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
$ LLD_, MB_, M_, NB_, N_, RSRC_
PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1,
$ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6,
$ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 )
* ..
* .. Local Scalars ..
LOGICAL CNAME, GLOBAL, SNAME
CHARACTER C1
CHARACTER*2 C2, C4
CHARACTER*3 C3
CHARACTER*8 SUBNAM
INTEGER I, IC, IDUMM, IZ, MSZ, NB
* ..
* .. Intrinsic Functions ..
INTRINSIC CHAR, ICHAR
* ..
*
*
* .. External Subroutines ..
EXTERNAL IGAMX2D
* ..
* .. Executable Statements ..
* This is just to keep ftnchek and toolpack/1 happy
IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_*
$ RSRC_.LT.0 )RETURN
*
*
*
GO TO ( 10, 10, 10, 10, 10 )ISPEC
*
* Invalid value for ISPEC
*
PJLAENV = -1
RETURN
*
10 CONTINUE
*
* Convert NAME to upper case if the first character is lower case.
*
PJLAENV = 1
SUBNAM = NAME
IC = ICHAR( SUBNAM( 1: 1 ) )
IZ = ICHAR( 'Z' )
IF( IZ.EQ.100 .OR. IZ.EQ.122 ) THEN
*
* ASCII character set
*
IF( IC.GE.97 .AND. IC.LE.122 ) THEN
SUBNAM( 1: 1 ) = CHAR( IC-32 )
DO 20 I = 2, 6
IC = ICHAR( SUBNAM( I: I ) )
IF( IC.GE.97 .AND. IC.LE.122 )
$ SUBNAM( I: I ) = CHAR( IC-32 )
20 CONTINUE
END IF
*
ELSE IF( IZ.EQ.233 .OR. IZ.EQ.169 ) THEN
*
* EBCDIC character set
*
IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR.
$ ( IC.GE.145 .AND. IC.LE.153 ) .OR.
$ ( IC.GE.162 .AND. IC.LE.169 ) ) THEN
SUBNAM( 1: 1 ) = CHAR( IC+64 )
DO 30 I = 2, 6
IC = ICHAR( SUBNAM( I: I ) )
IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR.
$ ( IC.GE.145 .AND. IC.LE.153 ) .OR.
$ ( IC.GE.162 .AND. IC.LE.169 ) )SUBNAM( I:
$ I ) = CHAR( IC+64 )
30 CONTINUE
END IF
*
ELSE IF( IZ.EQ.218 .OR. IZ.EQ.250 ) THEN
*
* Prime machines: ASCII+128
*
IF( IC.GE.225 .AND. IC.LE.250 ) THEN
SUBNAM( 1: 1 ) = CHAR( IC-32 )
DO 40 I = 2, 6
IC = ICHAR( SUBNAM( I: I ) )
IF( IC.GE.225 .AND. IC.LE.250 )
$ SUBNAM( I: I ) = CHAR( IC-32 )
40 CONTINUE
END IF
END IF
*
C1 = SUBNAM( 2: 2 )
SNAME = C1.EQ.'S' .OR. C1.EQ.'D'
CNAME = C1.EQ.'C' .OR. C1.EQ.'Z'
IF( .NOT.( CNAME .OR. SNAME ) )
$ RETURN
C2 = SUBNAM( 3: 4 )
C3 = SUBNAM( 5: 7 )
C4 = C3( 2: 3 )
*
* This is to keep ftnchek happy
*
IF( ( N2+N3+N4 )*0.NE.0 ) THEN
C4 = OPTS
C3 = C4
END IF
*
GO TO ( 50, 60, 70, 80, 90 )ISPEC
*
50 CONTINUE
*
* ISPEC = 1: data layout block size
* (global - all processes must use the same value)
*
* In these examples, separate code is provided for setting NB for
* real and complex. We assume that NB will take the same value in
* single or double precision.
*
NB = 1
*
IF( C2.EQ.'SY' .OR. C2.EQ.'HE' ) THEN
IF( C3.EQ.'LLT' ) THEN
IF( SNAME ) THEN
NB = 64
ELSE
NB = 64
END IF
ELSE IF( C3.EQ.'TTR' ) THEN
IF( SNAME ) THEN
NB = 1
ELSE
NB = 1
END IF
ELSE IF( C3.EQ.'GST' ) THEN
IF( SNAME ) THEN
NB = 32
ELSE
NB = 32
END IF
ELSE IF( C3.EQ.'BCK' ) THEN
IF( SNAME ) THEN
NB = 32
ELSE
NB = 32
END IF
ELSE IF( C3.EQ.'TRS' ) THEN
IF( SNAME ) THEN
NB = 64
ELSE
NB = 64
END IF
END IF
END IF
*
*
PJLAENV = NB
GLOBAL = .TRUE.
GO TO 100
*
60 CONTINUE
*
* ISPEC = 2: panel blocking factor (Used only in PxyyTTRD)
* (local - different processes may use different values)
*
NB = 16
IF( C2.EQ.'SY' .OR. C2.EQ.'HE' ) THEN
IF( C3.EQ.'TTR' ) THEN
IF( SNAME ) THEN
NB = 32
ELSE
NB = 32
END IF
END IF
END IF
PJLAENV = NB
GLOBAL = .FALSE.
GO TO 100
*
*
70 CONTINUE
*
* ISPEC = 3: algorithmic blocking factor (Used only in PxyyTTRD)
* (global - all processes must use the same value)
*
NB = 1
IF( C2.EQ.'SY' .OR. C2.EQ.'HE' ) THEN
IF( C3.EQ.'TTR' ) THEN
IF( SNAME ) THEN
NB = 16
ELSE
NB = 16
END IF
END IF
END IF
PJLAENV = NB
GLOBAL = .TRUE.
GO TO 100
*
80 CONTINUE
*
* ISPEC = 4: Execution path options (Used only in PxyyTTRD)
* (global - all processes must use the same value)
*
PJLAENV = -4
IF( C2.EQ.'SY' .OR. C2.EQ.'HE' ) THEN
IF( C3.EQ.'TTR' ) THEN
* V and H interleaved (default is not interleaved)
IF( N1.EQ.1 ) THEN
PJLAENV = 1
END IF
*
* Two ZGEMMs (default is one ZGEMM)
IF( N1.EQ.2 ) THEN
PJLAENV = 0
END IF
* Balanced Update (default is minimum communication update)
IF( N1.EQ.3 ) THEN
PJLAENV = 0
END IF
END IF
END IF
GLOBAL = .TRUE.
GO TO 100
*
90 CONTINUE
*
* ISPEC = 5: Minimum size to justify call to parallel code
* (global - all processes must use the same value)
*
MSZ = 0
IF( C2.EQ.'SY' .OR. C2.EQ.'HE' ) THEN
IF( C3.EQ.'TTR' ) THEN
IF( SNAME ) THEN
MSZ = 100
ELSE
MSZ = 100
END IF
END IF
END IF
PJLAENV = MSZ
GLOBAL = .TRUE.
GO TO 100
*
100 CONTINUE
*
IF( GLOBAL ) THEN
CALL IGAMX2D( ICTXT, 'All', ' ', 1, 1, PJLAENV, 1, IDUMM,
$ IDUMM, -1, -1, IDUMM )
END IF
*
*
*
RETURN
*
* End of PJLAENV
*
END
|