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