3
4
5
6
7
8
9
10 INTEGER IA, IB, INFO, JA, JB, N, NRHS
11
12
13 INTEGER DESCA( * ), DESCB( * ), IPIV( * )
14 REAL A( * ), B( * )
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 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
157 $ LLD_, MB_, M_, NB_, N_, RSRC_
158 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
159 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
160 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
161
162
163 INTEGER IAROW, IBROW, ICOFFA, ICTXT, IROFFA, IROFFB,
164 $ MYCOL, MYROW, NPCOL, NPROW
165
166
167 INTEGER IDUM1( 1 ), IDUM2( 1 )
168
169
172
173
174 INTEGER INDXG2P
176
177
178 INTRINSIC mod
179
180
181
182
183
184 ictxt = desca( ctxt_ )
185 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
186
187
188
189 info = 0
190 IF( nprow.EQ.-1 ) THEN
191 info = -(600+ctxt_)
192 ELSE
193 CALL chk1mat( n, 1, n, 1, ia, ja, desca, 6, info )
194 CALL chk1mat( n, 1, nrhs, 2, ib, jb, descb, 11, info )
195 IF( info.EQ.0 ) THEN
196 iarow =
indxg2p( ia, desca( mb_ ), myrow, desca( rsrc_ ),
197 $ nprow )
198 ibrow =
indxg2p( ib, descb( mb_ ), myrow, descb( rsrc_ ),
199 $ nprow )
200 iroffa = mod( ia-1, desca( mb_ ) )
201 icoffa = mod( ja-1, desca( nb_ ) )
202 iroffb = mod( ib-1, descb( mb_ ) )
203 IF( iroffa.NE.0 ) THEN
204 info = -4
205 ELSE IF( icoffa.NE.0 ) THEN
206 info = -5
207 ELSE IF( desca( mb_ ).NE.desca( nb_ ) ) THEN
208 info = -(600+nb_)
209 ELSE IF( ibrow.NE.iarow .OR. icoffa.NE.iroffb ) THEN
210 info = -9
211 ELSE IF( descb( mb_ ).NE.desca( nb_ ) ) THEN
212 info = -(1100+nb_)
213 ELSE IF( ictxt.NE.descb( ctxt_ ) ) THEN
214 info = -(1100+ctxt_)
215 END IF
216 END IF
217 CALL pchk2mat( n, 1, n, 1, ia, ja, desca, 6, n, 1, nrhs, 2,
218 $ ib, jb, descb, 11, 0, idum1, idum2, info )
219 END IF
220
221 IF( info.NE.0 ) THEN
222 CALL pxerbla( ictxt,
'PSGESV', -info )
223 RETURN
224 END IF
225
226
227
228 CALL psgetrf( n, n, a, ia, ja, desca, ipiv, info )
229
230 IF( info.EQ.0 ) THEN
231
232
233
234
235 CALL psgetrs(
'No transpose', n, nrhs, a, ia, ja, desca, ipiv,
236 $ b, ib, jb, descb, info )
237
238 END IF
239
240 RETURN
241
242
243
subroutine chk1mat(ma, mapos0, na, napos0, ia, ja, desca, descapos0, info)
integer function indxg2p(indxglob, nb, iproc, isrcproc, nprocs)
subroutine pchk2mat(ma, mapos0, na, napos0, ia, ja, desca, descapos0, mb, mbpos0, nb, nbpos0, ib, jb, descb, descbpos0, nextra, ex, expos, info)
subroutine psgetrf(m, n, a, ia, ja, desca, ipiv, info)
subroutine psgetrs(trans, n, nrhs, a, ia, ja, desca, ipiv, b, ib, jb, descb, info)
subroutine pxerbla(ictxt, srname, info)