3
4
5
6
7
8
9
10 CHARACTER UPLO
11 INTEGER IA, IB, INFO, JA, JB, N, NRHS
12
13
14 INTEGER DESCA( * ), DESCB( * )
15 COMPLEX A( * ), B( * )
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 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
168 $ LLD_, MB_, M_, NB_, N_, RSRC_
169 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
170 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
171 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
172
173
174 LOGICAL UPPER
175 INTEGER IAROW, IBROW, ICOFFA, ICTXT, IROFFA, IROFFB,
176 $ MYCOL, MYROW, NPCOL, NPROW
177
178
179 INTEGER IDUM1( 1 ), IDUM2( 1 )
180
181
184
185
186 LOGICAL LSAME
187 INTEGER INDXG2P
189
190
191 INTRINSIC ichar, mod
192
193
194
195
196
197 ictxt = desca( ctxt_ )
198 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
199
200
201
202 info = 0
203 IF( nprow.EQ.-1 ) THEN
204 info = -(700+ctxt_)
205 ELSE
206 upper =
lsame( uplo,
'U' )
207 CALL chk1mat( n, 2, n, 2, ia, ja, desca, 7, info )
208 IF( info.EQ.0 ) THEN
209 iarow =
indxg2p( ia, desca( mb_ ), myrow, desca( rsrc_ ),
210 $ nprow )
211 ibrow =
indxg2p( ib, descb( mb_ ), myrow, descb( rsrc_ ),
212 $ nprow )
213 iroffa = mod( ia-1, desca( mb_ ) )
214 iroffb = mod( ib-1, descb( mb_ ) )
215 icoffa = mod( ja-1, desca( nb_ ) )
216 IF ( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
217 info = -1
218 ELSE IF( iroffa.NE.0 ) THEN
219 info = -5
220 ELSE IF( icoffa.NE.0 ) THEN
221 info = -6
222 ELSE IF( desca( mb_ ).NE.desca( nb_ ) ) THEN
223 info = -(700+nb_)
224 ELSE IF( iroffb.NE.0 .OR. ibrow.NE.iarow ) THEN
225 info = -9
226 ELSE IF( descb( mb_ ).NE.desca( nb_ ) ) THEN
227 info = -(1000+nb_)
228 END IF
229 END IF
230 IF( upper ) THEN
231 idum1( 1 ) = ichar( 'U' )
232 ELSE
233 idum1( 1 ) = ichar( 'L' )
234 END IF
235 idum2( 1 ) = 1
236 CALL pchk2mat( n, 2, n, 2, ia, ja, desca, 7, n, 2, nrhs,
237 $ 3, ib, jb, descb, 11, 1, idum1, idum2, info )
238 END IF
239
240 IF( info.NE.0 ) THEN
241 CALL pxerbla( ictxt,
'PCPOSV', -info )
242 RETURN
243 END IF
244
245
246
247 CALL pcpotrf( uplo, n, a, ia, ja, desca, info )
248
249 IF( info.EQ.0 ) THEN
250
251
252
253
254 CALL pcpotrs( uplo, n, nrhs, a, ia, ja, desca, b, ib, jb,
255 $ descb, info )
256
257 END IF
258
259 RETURN
260
261
262
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 pcpotrf(uplo, n, a, ia, ja, desca, info)
subroutine pcpotrs(uplo, n, nrhs, a, ia, ja, desca, b, ib, jb, descb, info)
subroutine pxerbla(ictxt, srname, info)