3
4
5
6
7
8
9
10 INTEGER DESCAPOS0, IA, INFO, JA, MA, MAPOS0, NA,
11 $ NAPOS0, NEXTRA
12
13
14 INTEGER DESCA( * ), EX( NEXTRA ), EXPOS( NEXTRA )
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 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
84 $ LLD_, MB_, M_, NB_, N_, RSRC_
85 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
86 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
87 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
88 INTEGER BIGNUM, DESCMULT, LDW
89 parameter( descmult = 100, bignum = descmult * descmult,
90 $ ldw = 25 )
91
92
93 INTEGER DESCPOS, K
94
95
96 INTEGER IWORK( LDW, 2 ), IWORK2( LDW )
97
98
100
101
102
103
104
105
106
107 IF( info.GE.0 ) THEN
108 info = bignum
109 ELSE IF( info.LT.-descmult ) THEN
110 info = -info
111 ELSE
112 info = -info * descmult
113 END IF
114
115
116
117
118 iwork( 1, 1 ) = ma
119 iwork( 1, 2 ) = mapos0 * descmult
120 iwork( 2, 1 ) = na
121 iwork( 2, 2 ) = napos0 * descmult
122 iwork( 3, 1 ) = ia
123 iwork( 3, 2 ) = (descapos0-2) * descmult
124 iwork( 4, 1 ) = ja
125 iwork( 4, 2 ) = (descapos0-1) * descmult
126 descpos = descapos0 * descmult
127
128 iwork( 5, 1 ) = desca( dtype_ )
129 iwork( 5, 2 ) = descpos + dtype_
130 iwork( 6, 1 ) = desca( m_ )
131 iwork( 6, 2 ) = descpos + m_
132 iwork( 7, 1 ) = desca( n_ )
133 iwork( 7, 2 ) = descpos + n_
134 iwork( 8, 1 ) = desca( mb_ )
135 iwork( 8, 2 ) = descpos + mb_
136 iwork( 9, 1 ) = desca( nb_ )
137 iwork( 9, 2 ) = descpos + nb_
138 iwork( 10, 1 ) = desca( rsrc_ )
139 iwork( 10, 2 ) = descpos + rsrc_
140 iwork( 11, 1 ) = desca( csrc_ )
141 iwork( 11, 2 ) = descpos + csrc_
142
143 IF( nextra.GT.0 ) THEN
144 DO 10 k = 1, nextra
145 iwork( 11+k, 1 ) = ex( k )
146 iwork( 11+k, 2 ) = expos( k )
147 10 CONTINUE
148 END IF
149 k = 11 + nextra
150
151
152
153 CALL globchk( desca( ctxt_ ), k, iwork, ldw, iwork2, info )
154
155
156
157
158 IF( info .EQ. bignum ) THEN
159 info = 0
160 ELSE IF( mod( info, descmult ) .EQ. 0 ) THEN
161 info = -info / descmult
162 ELSE
163 info = -info
164 END IF
165
166 RETURN
167
168
169
subroutine globchk(ictxt, n, x, ldx, iwork, info)