2
3
4
5
6
7
8
9 CHARACTER UPLO
10 INTEGER IA, INFO, JA, N
11
12
13 INTEGER DESCA( * )
14 REAL A( * )
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 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
123 $ LLD_, MB_, M_, NB_, N_, RSRC_
124 parameter( block_cyclic_2d
125 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
126 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
127
128
129 LOGICAL UPPER
130 INTEGER ICOFF, ICTXT, IROFF, MYCOL, MYROW, NPCOL, NPROW
131
132
133 INTEGER IDUM1( 1 ), IDUM2( 1 )
134
135
138
139
140 LOGICAL LSAME
142
143
144 INTRINSIC ichar, mod
145
146
147
148
149
150 ictxt = desca( ctxt_ )
152
153
154
155 info = 0
156 IF( nprow.EQ.-1 ) THEN
157 info = -(600+ctxt_)
158 ELSE
159 upper =
lsame( uplo,
'U' )
160 CALL chk1mat( n, 2, n, 2, ia, ja, desca, 6, info )
161 IF( info.NE.0 ) THEN
162 iroff = mod( ia-1, desca( mb_ ) )
163 icoff = mod( ja-1, desca( nb_ ) )
164 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
165 info = -1
166 ELSE IF( iroff.NE.icoff .OR. iroff.NE.0 ) THEN
167 info = -5
168 ELSE IF( desca( mb_ ).NE.desca( nb_ ) ) THEN
169 info = -(600+nb_)
170 END IF
171 END IF
172
173 IF( upper ) THEN
174 idum1( 1 ) = ichar( 'U' )
175 ELSE
176 idum1( 1 ) = ichar( 'L' )
177 END IF
178 idum2( 1 ) = 1
179 CALL pchk1mat( n, 2, n, 2, ia, ja, desca, 6, 1, idum1, idum2,
180 $ info )
181 END IF
182
183 IF( info.NE.0 ) THEN
184 CALL pxerbla( ictxt,
'PSPOTRI', -info )
185 RETURN
186 END IF
187
188
189
190 IF( n.EQ.0 )
191 $ RETURN
192
193
194
195 CALL pstrtri( uplo,
'Non-unit', n, a, ia, ja, desca, info )
196
197 IF( info.GT.0 )
198 $ RETURN
199
200
201
202 CALL pslauum( uplo, n, a, ia, ja, desca )
203
204 RETURN
205
206
207
logical function lsame(ca, cb)
LSAME
subroutine chk1mat(ma, mapos0, na, napos0, ia, ja, desca, descapos0, info)
subroutine pxerbla(contxt, srname, info)
subroutine blacs_gridinfo(cntxt, nprow, npcol, myrow, mycol)
subroutine pchk1mat(ma, mapos0, na, napos0, ia, ja, desca, descapos0, nextra, ex, expos, info)
subroutine pslauum(uplo, n, a, ia, ja, desca)
subroutine pstrtri(uplo, diag, n, a, ia, ja, desca, info)