File: pjlaenv.f

package info (click to toggle)
scalapack 1.8.0-9
  • links: PTS
  • area: main
  • in suites: wheezy
  • size: 32,664 kB
  • sloc: fortran: 288,069; ansic: 64,035; makefile: 1,958
file content (364 lines) | stat: -rw-r--r-- 10,968 bytes parent folder | download | duplicates (8)
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