2
3
4
5
6
7
8
9 CHARACTER UPLO
10 INTEGER IA, INFO, JA, N
11
12
13 INTEGER DESCA( * )
14 DOUBLE PRECISION 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 = 1, dlen_ = 9, dtype_ = 1,
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_ )
151 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
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.EQ.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,
'PDPOTRI', -info )
185 RETURN
186 END IF
187
188
189
190 IF( n.EQ.0 )
191 $ RETURN
192
193
194
195 CALL pdtrtri( uplo,
'Non-unit', n, a, ia, ja, desca, info )
196
197 IF( info.GT.0 )
198 $ RETURN
199
200
201
202 CALL pdlauum( uplo, n, a, ia, ja, desca )
203
204 RETURN
205
206
207
subroutine chk1mat(ma, mapos0, na, napos0, ia, ja, desca, descapos0, info)
subroutine pchk1mat(ma, mapos0, na, napos0, ia, ja, desca, descapos0, nextra, ex, expos, info)
subroutine pdlauum(uplo, n, a, ia, ja, desca)
subroutine pdtrtri(uplo, diag, n, a, ia, ja, desca, info)
subroutine pxerbla(ictxt, srname, info)