3
4
5
6
7
8
9
10 CHARACTER*( * ) NAME, OPTS
11 INTEGER ICTXT, ISPEC, N1, N2, N3, N4
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 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
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
126 INTRINSIC char, ichar
127
128
129
130
131 EXTERNAL igamx2d
132
133
134
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
143
145 RETURN
146
147 10 CONTINUE
148
149
150
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
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
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
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
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
220
221
222
223
224
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
264 global = .true.
265 GO TO 100
266
267 60 CONTINUE
268
269
270
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
283 global = .false.
284 GO TO 100
285
286
287 70 CONTINUE
288
289
290
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
303 global = .true.
304 GO TO 100
305
306 80 CONTINUE
307
308
309
310
312 IF( c2.EQ.'SY' .OR. c2.EQ.'HE' ) THEN
313 IF( c3.EQ.'TTR' ) THEN
314
315 IF( n1.EQ.1 ) THEN
317 END IF
318
319
320 IF( n1.EQ.2 ) THEN
322 END IF
323
324 IF( n1.EQ.3 ) THEN
326 END IF
327 END IF
328 END IF
329 global = .true.
330 GO TO 100
331
332 90 CONTINUE
333
334
335
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
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
364
integer function pjlaenv(ictxt, ispec, name, opts, n1, n2, n3, n4)