ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pilaenvx.f
Go to the documentation of this file.
1  INTEGER FUNCTION pilaenvx( ICTXT, ISPEC, NAME, OPTS, N1, N2, N3,
2  $ N4 )
3 *
4 * Contribution from the Department of Computing Science and HPC2N,
5 * Umea University, Sweden
6 *
7 * -- ScaLAPACK auxiliary routine (version 2.0.1) --
8 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
9 * Univ. of Colorado Denver and University of California, Berkeley.
10 * January, 2012
11 *
12  IMPLICIT NONE
13 *
14 * .. Scalar Arguments ..
15  CHARACTER*( * ) name, opts
16  INTEGER ictxt, ispec, n1, n2, n3, n4
17 * ..
18 *
19 * Purpose
20 * =======
21 *
22 * PILAENVX is called from the ScaLAPACK routines to choose problem-
23 * dependent parameters for the local environment. See ISPEC for a
24 * description of the parameters.
25 *
26 * This version provides a set of parameters which should give good,
27 * but not optimal, performance on many of the currently available
28 * computers. Users are encouraged to modify this subroutine to set
29 * the tuning parameters for their particular machine using the option
30 * and problem size information in the arguments.
31 *
32 * This routine will not function correctly if it is converted to all
33 * lower case. Converting it to all upper case is allowed.
34 *
35 * Arguments
36 * =========
37 *
38 * ICTXT (local input) INTEGER
39 * On entry, ICTXT specifies the BLACS context handle, indica-
40 * ting the global context of the operation. The context itself
41 * is global, but the value of ICTXT is local.
42 *
43 * ISPEC (global input) INTEGER
44 * Specifies the parameter to be returned as the value of
45 * PILAENVX.
46 * = 1: the optimal blocksize; if this value is 1, an unblocked
47 * algorithm will give the best performance (unlikely).
48 * = 2: the minimum block size for which the block routine
49 * should be used; if the usable block size is less than
50 * this value, an unblocked routine should be used.
51 * = 3: the crossover point (in a block routine, for N less
52 * than this value, an unblocked routine should be used)
53 * = 4: the number of shifts, used in the nonsymmetric
54 * eigenvalue routines (DEPRECATED)
55 * = 5: the minimum column dimension for blocking to be used;
56 * rectangular blocks must have dimension at least k by m,
57 * where k is given by PILAENVX(2,...) and m by PILAENVX(5,...)
58 * = 6: the crossover point for the SVD (when reducing an m by n
59 * matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds
60 * this value, a QR factorization is used first to reduce
61 * the matrix to a triangular form.)
62 * = 7: the number of processors
63 * = 8: the crossover point for the multishift QR method
64 * for nonsymmetric eigenvalue problems (DEPRECATED)
65 * = 9: maximum size of the subproblems at the bottom of the
66 * computation tree in the divide-and-conquer algorithm
67 * (used by xGELSD and xGESDD)
68 * =10: ieee NaN arithmetic can be trusted not to trap
69 * =11: infinity arithmetic can be trusted not to trap
70 * 12 <= ISPEC <= 16:
71 * PxHSEQR or one of its subroutines,
72 * see PIPARMQ for detailed explanation
73 * 17 <= ISPEC <= 22:
74 * Parameters for PBxTRORD/PxHSEQR (not all), as follows:
75 * =17: maximum number of concurrent computational windows;
76 * =18: number of eigenvalues/bulges in each window;
77 * =19: computational window size;
78 * =20: minimal percentage of flops required for
79 * performing matrix-matrix multiplications instead
80 * of pipelined orthogonal transformations;
81 * =21: width of block column slabs for row-wise
82 * application of pipelined orthogonal
83 * transformations in their factorized form;
84 * =22: the maximum number of eigenvalues moved together
85 * over a process border;
86 * =23: the number of processors involved in AED;
87 * =99: Maximum iteration chunksize in OpenMP parallelization
88 *
89 * NAME (global input) CHARACTER*(*)
90 * The name of the calling subroutine, in either upper case or
91 * lower case.
92 *
93 * OPTS (global input) CHARACTER*(*)
94 * The character options to the subroutine NAME, concatenated
95 * into a single character string. For example, UPLO = 'U',
96 * TRANS = 'T', and DIAG = 'N' for a triangular routine would
97 * be specified as OPTS = 'UTN'.
98 *
99 * N1 (global input) INTEGER
100 * N2 (global input) INTEGER
101 * N3 (global input) INTEGER
102 * N4 (global input) INTEGER
103 * Problem dimensions for the subroutine NAME; these may not all
104 * be required.
105 *
106 * (PILAENVX) (global output) INTEGER
107 * >= 0: the value of the parameter specified by ISPEC
108 * < 0: if PILAENVX = -k, the k-th argument had an illegal value.
109 *
110 * Further Details
111 * ===============
112 *
113 * The following conventions have been used when calling ILAENV from the
114 * LAPACK routines:
115 * 1) OPTS is a concatenation of all of the character options to
116 * subroutine NAME, in the same order that they appear in the
117 * argument list for NAME, even if they are not used in determining
118 * the value of the parameter specified by ISPEC.
119 * 2) The problem dimensions N1, N2, N3, N4 are specified in the order
120 * that they appear in the argument list for NAME. N1 is used
121 * first, N2 second, and so on, and unused problem dimensions are
122 * passed a value of -1.
123 * 3) The parameter value returned by ILAENV is checked for validity in
124 * the calling subroutine. For example, ILAENV is used to retrieve
125 * the optimal blocksize for STRTRI as follows:
126 *
127 * NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )
128 * IF( NB.LE.1 ) NB = MAX( 1, N )
129 *
130 * The same conventions will hold for this ScaLAPACK-style variant.
131 *
132 * =====================================================================
133 *
134 * .. Local Scalars ..
135  INTEGER i, ic, iz, nb, nbmin, nx, nprow, npcol, myrow,
136  $ mycol
137  LOGICAL cname, sname
138  CHARACTER c1*1, c2*2, c4*2, c3*3, subnam*6
139 * ..
140 * .. Intrinsic Functions ..
141  INTRINSIC char, ichar, int, min, real
142 * ..
143 * .. External Functions ..
144  INTEGER ieeeck, piparmq, iceil
145  EXTERNAL ieeeck, piparmq, iceil
146 * ..
147 * .. Executable Statements ..
148 *
149  IF( ispec.GT.23 ) GO TO 990
150  GO TO ( 10, 10, 10, 80, 90, 100, 110, 120,
151  $ 130, 140, 150, 160, 160, 160, 160, 160,
152  $ 170, 180, 190, 200, 210, 220, 230, 160)ispec
153 *
154 * Invalid value for ISPEC
155 *
156  pilaenvx = -1
157  RETURN
158 *
159  10 CONTINUE
160 *
161 * Convert NAME to upper case if the first character is lower case.
162 *
163  pilaenvx = 1
164  subnam = name
165  ic = ichar( subnam( 1: 1 ) )
166  iz = ichar( 'Z' )
167  IF( iz.EQ.90 .OR. iz.EQ.122 ) THEN
168 *
169 * ASCII character set
170 *
171  IF( ic.GE.97 .AND. ic.LE.122 ) THEN
172  subnam( 1: 1 ) = char( ic-32 )
173  DO 20 i = 2, 6
174  ic = ichar( subnam( i: i ) )
175  IF( ic.GE.97 .AND. ic.LE.122 )
176  $ subnam( i: i ) = char( ic-32 )
177  20 CONTINUE
178  END IF
179 *
180  ELSE IF( iz.EQ.233 .OR. iz.EQ.169 ) THEN
181 *
182 * EBCDIC character set
183 *
184  IF( ( ic.GE.129 .AND. ic.LE.137 ) .OR.
185  $ ( ic.GE.145 .AND. ic.LE.153 ) .OR.
186  $ ( ic.GE.162 .AND. ic.LE.169 ) ) THEN
187  subnam( 1: 1 ) = char( ic+64 )
188  DO 30 i = 2, 6
189  ic = ichar( subnam( i: i ) )
190  IF( ( ic.GE.129 .AND. ic.LE.137 ) .OR.
191  $ ( ic.GE.145 .AND. ic.LE.153 ) .OR.
192  $ ( ic.GE.162 .AND. ic.LE.169 ) )subnam( i:
193  $ i ) = char( ic+64 )
194  30 CONTINUE
195  END IF
196 *
197  ELSE IF( iz.EQ.218 .OR. iz.EQ.250 ) THEN
198 *
199 * Prime machines: ASCII+128
200 *
201  IF( ic.GE.225 .AND. ic.LE.250 ) THEN
202  subnam( 1: 1 ) = char( ic-32 )
203  DO 40 i = 2, 6
204  ic = ichar( subnam( i: i ) )
205  IF( ic.GE.225 .AND. ic.LE.250 )
206  $ subnam( i: i ) = char( ic-32 )
207  40 CONTINUE
208  END IF
209  END IF
210 *
211  c1 = subnam( 1: 1 )
212  sname = c1.EQ.'S' .OR. c1.EQ.'D'
213  cname = c1.EQ.'C' .OR. c1.EQ.'Z'
214  IF( .NOT.( cname .OR. sname ) )
215  $ RETURN
216  c2 = subnam( 2: 3 )
217  c3 = subnam( 4: 6 )
218  c4 = c3( 2: 3 )
219 *
220  GO TO ( 50, 60, 70 )ispec
221 *
222  50 CONTINUE
223 *
224 * ISPEC = 1: block size
225 *
226 * In these examples, separate code is provided for setting NB for
227 * real and complex. We assume that NB will take the same value in
228 * single or double precision.
229 *
230  nb = 1
231 *
232  IF( c2.EQ.'GE' ) THEN
233  IF( c3.EQ.'TRF' ) THEN
234  IF( sname ) THEN
235  nb = 64
236  ELSE
237  nb = 64
238  END IF
239  ELSE IF( c3.EQ.'QRF' .OR. c3.EQ.'RQF' .OR. c3.EQ.'LQF' .OR.
240  $ c3.EQ.'QLF' ) THEN
241  IF( sname ) THEN
242  nb = 32
243  ELSE
244  nb = 32
245  END IF
246  ELSE IF( c3.EQ.'HRD' ) THEN
247  IF( sname ) THEN
248  nb = 32
249  ELSE
250  nb = 32
251  END IF
252  ELSE IF( c3.EQ.'BRD' ) THEN
253  IF( sname ) THEN
254  nb = 32
255  ELSE
256  nb = 32
257  END IF
258  ELSE IF( c3.EQ.'TRI' ) THEN
259  IF( sname ) THEN
260  nb = 64
261  ELSE
262  nb = 64
263  END IF
264  END IF
265  ELSE IF( c2.EQ.'PO' ) THEN
266  IF( c3.EQ.'TRF' ) THEN
267  IF( sname ) THEN
268  nb = 64
269  ELSE
270  nb = 64
271  END IF
272  END IF
273  ELSE IF( c2.EQ.'SY' ) THEN
274  IF( c3.EQ.'TRF' ) THEN
275  IF( sname ) THEN
276  nb = 64
277  ELSE
278  nb = 64
279  END IF
280  ELSE IF( sname .AND. c3.EQ.'TRD' ) THEN
281  nb = 32
282  ELSE IF( sname .AND. c3.EQ.'GST' ) THEN
283  nb = 64
284  END IF
285  ELSE IF( cname .AND. c2.EQ.'HE' ) THEN
286  IF( c3.EQ.'TRF' ) THEN
287  nb = 64
288  ELSE IF( c3.EQ.'TRD' ) THEN
289  nb = 32
290  ELSE IF( c3.EQ.'GST' ) THEN
291  nb = 64
292  END IF
293  ELSE IF( sname .AND. c2.EQ.'OR' ) THEN
294  IF( c3( 1: 1 ).EQ.'G' ) THEN
295  IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
296  $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
297  $ THEN
298  nb = 32
299  END IF
300  ELSE IF( c3( 1: 1 ).EQ.'M' ) THEN
301  IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
302  $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
303  $ THEN
304  nb = 32
305  END IF
306  END IF
307  ELSE IF( cname .AND. c2.EQ.'UN' ) THEN
308  IF( c3( 1: 1 ).EQ.'G' ) THEN
309  IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
310  $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
311  $ THEN
312  nb = 32
313  END IF
314  ELSE IF( c3( 1: 1 ).EQ.'M' ) THEN
315  IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
316  $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
317  $ THEN
318  nb = 32
319  END IF
320  END IF
321  ELSE IF( c2.EQ.'GB' ) THEN
322  IF( c3.EQ.'TRF' ) THEN
323  IF( sname ) THEN
324  IF( n4.LE.64 ) THEN
325  nb = 1
326  ELSE
327  nb = 32
328  END IF
329  ELSE
330  IF( n4.LE.64 ) THEN
331  nb = 1
332  ELSE
333  nb = 32
334  END IF
335  END IF
336  END IF
337  ELSE IF( c2.EQ.'PB' ) THEN
338  IF( c3.EQ.'TRF' ) THEN
339  IF( sname ) THEN
340  IF( n2.LE.64 ) THEN
341  nb = 1
342  ELSE
343  nb = 32
344  END IF
345  ELSE
346  IF( n2.LE.64 ) THEN
347  nb = 1
348  ELSE
349  nb = 32
350  END IF
351  END IF
352  END IF
353  ELSE IF( c2.EQ.'TR' ) THEN
354  IF( c3.EQ.'TRI' ) THEN
355  IF( sname ) THEN
356  nb = 64
357  ELSE
358  nb = 64
359  END IF
360  END IF
361  ELSE IF( c2.EQ.'LA' ) THEN
362  IF( c3.EQ.'UUM' ) THEN
363  IF( sname ) THEN
364  nb = 64
365  ELSE
366  nb = 64
367  END IF
368  END IF
369  ELSE IF( sname .AND. c2.EQ.'ST' ) THEN
370  IF( c3.EQ.'EBZ' ) THEN
371  nb = 1
372  END IF
373  END IF
374  pilaenvx = nb
375  RETURN
376 *
377  60 CONTINUE
378 *
379 * ISPEC = 2: minimum block size
380 *
381  nbmin = 2
382  IF( c2.EQ.'GE' ) THEN
383  IF( c3.EQ.'QRF' .OR. c3.EQ.'RQF' .OR. c3.EQ.'LQF' .OR. c3.EQ.
384  $ 'QLF' ) THEN
385  IF( sname ) THEN
386  nbmin = 2
387  ELSE
388  nbmin = 2
389  END IF
390  ELSE IF( c3.EQ.'HRD' ) THEN
391  IF( sname ) THEN
392  nbmin = 2
393  ELSE
394  nbmin = 2
395  END IF
396  ELSE IF( c3.EQ.'BRD' ) THEN
397  IF( sname ) THEN
398  nbmin = 2
399  ELSE
400  nbmin = 2
401  END IF
402  ELSE IF( c3.EQ.'TRI' ) THEN
403  IF( sname ) THEN
404  nbmin = 2
405  ELSE
406  nbmin = 2
407  END IF
408  END IF
409  ELSE IF( c2.EQ.'SY' ) THEN
410  IF( c3.EQ.'TRF' ) THEN
411  IF( sname ) THEN
412  nbmin = 8
413  ELSE
414  nbmin = 8
415  END IF
416  ELSE IF( sname .AND. c3.EQ.'TRD' ) THEN
417  nbmin = 2
418  END IF
419  ELSE IF( cname .AND. c2.EQ.'HE' ) THEN
420  IF( c3.EQ.'TRD' ) THEN
421  nbmin = 2
422  END IF
423  ELSE IF( sname .AND. c2.EQ.'OR' ) THEN
424  IF( c3( 1: 1 ).EQ.'G' ) THEN
425  IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
426  $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
427  $ THEN
428  nbmin = 2
429  END IF
430  ELSE IF( c3( 1: 1 ).EQ.'M' ) THEN
431  IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
432  $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
433  $ THEN
434  nbmin = 2
435  END IF
436  END IF
437  ELSE IF( cname .AND. c2.EQ.'UN' ) THEN
438  IF( c3( 1: 1 ).EQ.'G' ) THEN
439  IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
440  $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
441  $ THEN
442  nbmin = 2
443  END IF
444  ELSE IF( c3( 1: 1 ).EQ.'M' ) THEN
445  IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
446  $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
447  $ THEN
448  nbmin = 2
449  END IF
450  END IF
451  END IF
452  pilaenvx = nbmin
453  RETURN
454 *
455  70 CONTINUE
456 *
457 * ISPEC = 3: crossover point
458 *
459  nx = 0
460  IF( c2.EQ.'GE' ) THEN
461  IF( c3.EQ.'QRF' .OR. c3.EQ.'RQF' .OR. c3.EQ.'LQF' .OR. c3.EQ.
462  $ 'QLF' ) THEN
463  IF( sname ) THEN
464  nx = 128
465  ELSE
466  nx = 128
467  END IF
468  ELSE IF( c3.EQ.'HRD' ) THEN
469  IF( sname ) THEN
470  nx = 128
471  ELSE
472  nx = 128
473  END IF
474  ELSE IF( c3.EQ.'BRD' ) THEN
475  IF( sname ) THEN
476  nx = 128
477  ELSE
478  nx = 128
479  END IF
480  END IF
481  ELSE IF( c2.EQ.'SY' ) THEN
482  IF( sname .AND. c3.EQ.'TRD' ) THEN
483  nx = 32
484  END IF
485  ELSE IF( cname .AND. c2.EQ.'HE' ) THEN
486  IF( c3.EQ.'TRD' ) THEN
487  nx = 32
488  END IF
489  ELSE IF( sname .AND. c2.EQ.'OR' ) THEN
490  IF( c3( 1: 1 ).EQ.'G' ) THEN
491  IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
492  $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
493  $ THEN
494  nx = 128
495  END IF
496  END IF
497  ELSE IF( cname .AND. c2.EQ.'UN' ) THEN
498  IF( c3( 1: 1 ).EQ.'G' ) THEN
499  IF( c4.EQ.'QR' .OR. c4.EQ.'RQ' .OR. c4.EQ.'LQ' .OR. c4.EQ.
500  $ 'QL' .OR. c4.EQ.'HR' .OR. c4.EQ.'TR' .OR. c4.EQ.'BR' )
501  $ THEN
502  nx = 128
503  END IF
504  END IF
505  END IF
506  pilaenvx = nx
507  RETURN
508 *
509  80 CONTINUE
510 *
511 * ISPEC = 4: number of shifts (used by xHSEQR)
512 *
513  pilaenvx = 6
514  RETURN
515 *
516  90 CONTINUE
517 *
518 * ISPEC = 5: minimum column dimension (not used)
519 *
520  pilaenvx = 2
521  RETURN
522 *
523  100 CONTINUE
524 *
525 * ISPEC = 6: crossover point for SVD (used by xGELSS and xGESVD)
526 *
527  pilaenvx = int( real( min( n1, n2 ) )*1.6e0 )
528  RETURN
529 *
530  110 CONTINUE
531 *
532 * ISPEC = 7: number of processors (not used)
533 *
534  pilaenvx = 1
535  RETURN
536 *
537  120 CONTINUE
538 *
539 * ISPEC = 8: crossover point for multishift (used by xHSEQR)
540 *
541  pilaenvx = 50
542  RETURN
543 *
544  130 CONTINUE
545 *
546 * ISPEC = 9: maximum size of the subproblems at the bottom of the
547 * computation tree in the divide-and-conquer algorithm
548 * (used by xGELSD and xGESDD)
549 *
550  pilaenvx = 25
551  RETURN
552 *
553  140 CONTINUE
554 *
555 * ISPEC = 10: ieee NaN arithmetic can be trusted not to trap
556 *
557 * PILAENVX = 0
558  pilaenvx = 1
559  IF( pilaenvx.EQ.1 ) THEN
560  pilaenvx = ieeeck( 0, 0.0, 1.0 )
561  END IF
562  RETURN
563 *
564  150 CONTINUE
565 *
566 * ISPEC = 11: infinity arithmetic can be trusted not to trap
567 *
568 * PILAENVX = 0
569  pilaenvx = 1
570  IF( pilaenvx.EQ.1 ) THEN
571  pilaenvx = ieeeck( 1, 0.0, 1.0 )
572  END IF
573  RETURN
574 *
575  160 CONTINUE
576 *
577 * 12 <= ISPEC <= 16 or ISPEC = 24: xHSEQR or one of its subroutines.
578 *
579  pilaenvx = piparmq( ictxt, ispec, name, opts, n1, n2, n3, n4 )
580  RETURN
581 *
582  170 CONTINUE
583 *
584 * ISPEC = 17: maximum number of independent computational windows
585 *
586  CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
587  pilaenvx = min( iceil(n1,n2), min( nprow, npcol) )
588  RETURN
589 *
590  180 CONTINUE
591 *
592 * ISPEC = 18: number of eigenvalues in each window
593 *
594  pilaenvx = min(n2/2,40)
595  RETURN
596 *
597  190 CONTINUE
598 *
599 * ISPEC = 19: computational window size
600 *
601  pilaenvx = min(n2,80)
602  RETURN
603 *
604  200 CONTINUE
605 *
606 * ISPEC = 20: minimal percentage of flops required for
607 * performing matrix-matrix multiplications instead of
608 * pipelined orthogonal transformations
609 *
610 *
611  pilaenvx = 50
612  RETURN
613 *
614  210 CONTINUE
615 *
616 * ISPEC = 21: width of block column slabs for row-wise
617 * application of pipelined orthogonal transformations in
618 * their factorized form
619 *
620 *
621  pilaenvx = min(n2,32)
622  RETURN
623 *
624  220 CONTINUE
625 *
626 * ISPEC = 22: maximum number of eigenvalues to bring over
627 * the block border
628 *
629 *
630  pilaenvx = min(n2/2,40)
631  RETURN
632  230 CONTINUE
633 *
634 * ISPEC = 23: number of processors involved in AED
635 *
636 *
637  pilaenvx = iceil(n1, iceil(384, n2)*n2)
638  RETURN
639  990 CONTINUE
640 *
641 * ISPEC = 99: maximum chunksize of iterations in OpenMP
642 * parallelization
643 *
644  pilaenvx = 32
645  RETURN
646 *
647 * End of PILAENVX
648 *
649  END
piparmq
integer function piparmq(ICTXT, ISPEC, NAME, OPTS, N, ILO, IHI, LWORKNB)
Definition: piparmq.f:3
pilaenvx
integer function pilaenvx(ICTXT, ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: pilaenvx.f:3
min
#define min(A, B)
Definition: pcgemr.c:181
iceil
integer function iceil(INUM, IDENOM)
Definition: iceil.f:2