2
3
4
5 INTEGER DESC_IN( * ), DESC_OUT( * ), INFO
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 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DT_,
31 $ LLD_, MB_, M_, NB_, N_, RSRC_
32 parameter( block_cyclic_2d = 1, dlen_ = 9, dt_ = 1,
33 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
34 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
35
36
37
38 INTEGER DESC_TYPE, DESC_TYPE_IN, ICTXT
39 INTEGER CSRC, RSRC, MB, NB, LLDA
40 INTEGER M, N, NPROW, NPCOL, IDUM1, IDUM2
41
42
43
44
45
46
47 info = 0
48
49 desc_type_in = desc_in( 1 )
50
51
52
53 rsrc = 0
54 nb = 0
55 n = 0
56 mb = 0
57 m = 0
58 llda = 0
59 csrc = 0
60
61 IF( desc_type_in .EQ. block_cyclic_2d ) THEN
62 ictxt = desc_in( ctxt_ )
63 rsrc = desc_in( rsrc_ )
64 csrc = desc_in( csrc_ )
65 mb = desc_in( mb_ )
66 nb = desc_in( nb_ )
67 llda = desc_in( lld_ )
68 m = desc_in( m_ )
69 n = desc_in( n_ )
70 CALL blacs_gridinfo( ictxt, nprow, npcol, idum1, idum2 )
71 ELSEIF ( desc_type_in .EQ. 502 ) THEN
72 ictxt = desc_in( 2 )
73 rsrc = desc_in( 5 )
74 csrc = 1
75 mb = desc_in( 4 )
76 nb = 1
77 llda = desc_in( 6 )
78 m = desc_in( 3 )
79 n = 1
80 nprow = 0
81 npcol = 1
82 ELSEIF ( desc_type_in .EQ. 501 ) THEN
83 ictxt = desc_in( 2 )
84 rsrc = 1
85 csrc = desc_in( 5 )
86 mb = 1
87 nb = desc_in( 4 )
88 llda = desc_in( 6 )
89 m = 1
90 n = desc_in( 3 )
91 nprow = 1
92 npcol = 0
93 ENDIF
94
95
96 desc_type = desc_out( 1 )
97
98 IF( desc_type .EQ. 501 ) THEN
99 IF( nprow .NE. 1 )THEN
100 info = -1
101 RETURN
102 ENDIF
103 desc_out( 2 ) = ictxt
104 desc_out( 5 ) = csrc
105 desc_out( 4 ) = nb
106 desc_out( 6 ) = llda
107 desc_out( 3 ) = n
108 ELSEIF( desc_type .EQ. 502 ) THEN
109 IF( npcol .NE. 1 )THEN
110 info = -1
111 RETURN
112 ENDIF
113 desc_out( 2 ) = ictxt
114 desc_out( 5 ) = rsrc
115 desc_out( 4 ) = mb
116 desc_out( 6 ) = llda
117 desc_out( 3 ) = m
118 ENDIF
119
120 RETURN
121
122
123