ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pzpotri.f
Go to the documentation of this file.
1  SUBROUTINE pzpotri( UPLO, N, A, IA, JA, DESCA, INFO )
2 *
3 * -- ScaLAPACK routine (version 1.7) --
4 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
5 * and University of California, Berkeley.
6 * May 1, 1997
7 *
8 * .. Scalar Arguments ..
9  CHARACTER UPLO
10  INTEGER IA, INFO, JA, N
11 * ..
12 * .. Array Arguments ..
13  INTEGER DESCA( * )
14  COMPLEX*16 A( * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * PZPOTRI computes the inverse of a complex Hermitian positive definite
21 * distributed matrix sub( A ) = A(IA:IA+N-1,JA:JA+N-1) using the
22 * Cholesky factorization sub( A ) = U**H*U or L*L**H computed by
23 * PZPOTRF.
24 *
25 * Notes
26 * =====
27 *
28 * Each global data object is described by an associated description
29 * vector. This vector stores the information required to establish
30 * the mapping between an object element and its corresponding process
31 * and memory location.
32 *
33 * Let A be a generic term for any 2D block cyclicly distributed array.
34 * Such a global array has an associated description vector DESCA.
35 * In the following comments, the character _ should be read as
36 * "of the global array".
37 *
38 * NOTATION STORED IN EXPLANATION
39 * --------------- -------------- --------------------------------------
40 * DTYPE_A(global) DESCA( DTYPE_ )The descriptor type. In this case,
41 * DTYPE_A = 1.
42 * CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
43 * the BLACS process grid A is distribu-
44 * ted over. The context itself is glo-
45 * bal, but the handle (the integer
46 * value) may vary.
47 * M_A (global) DESCA( M_ ) The number of rows in the global
48 * array A.
49 * N_A (global) DESCA( N_ ) The number of columns in the global
50 * array A.
51 * MB_A (global) DESCA( MB_ ) The blocking factor used to distribute
52 * the rows of the array.
53 * NB_A (global) DESCA( NB_ ) The blocking factor used to distribute
54 * the columns of the array.
55 * RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
56 * row of the array A is distributed.
57 * CSRC_A (global) DESCA( CSRC_ ) The process column over which the
58 * first column of the array A is
59 * distributed.
60 * LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
61 * array. LLD_A >= MAX(1,LOCr(M_A)).
62 *
63 * Let K be the number of rows or columns of a distributed matrix,
64 * and assume that its process grid has dimension p x q.
65 * LOCr( K ) denotes the number of elements of K that a process
66 * would receive if K were distributed over the p processes of its
67 * process column.
68 * Similarly, LOCc( K ) denotes the number of elements of K that a
69 * process would receive if K were distributed over the q processes of
70 * its process row.
71 * The values of LOCr() and LOCc() may be determined via a call to the
72 * ScaLAPACK tool function, NUMROC:
73 * LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
74 * LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
75 * An upper bound for these quantities may be computed by:
76 * LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
77 * LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
78 *
79 * Arguments
80 * =========
81 *
82 * UPLO (global input) CHARACTER*1
83 * = 'U': Upper triangle of sub( A ) is stored;
84 * = 'L': Lower triangle of sub( A ) is stored.
85 *
86 * N (global input) INTEGER
87 * The number of rows and columns to be operated on, i.e. the
88 * order of the distributed submatrix sub( A ). N >= 0.
89 *
90 * A (local input/local output) COMPLEX*16 pointer into the
91 * local memory to an array of dimension (LLD_A, LOCc(JA+N-1)).
92 * On entry, the local pieces of the triangular factor U or L
93 * from the Cholesky factorization of the distributed matrix
94 * sub( A ) = U**H*U or L*L**H, as computed by PZPOTRF.
95 * On exit, the local pieces of the upper or lower triangle of
96 * the (Hermitian) inverse of sub( A ), overwriting the input
97 * factor U or L.
98 *
99 * IA (global input) INTEGER
100 * The row index in the global array A indicating the first
101 * row of sub( A ).
102 *
103 * JA (global input) INTEGER
104 * The column index in the global array A indicating the
105 * first column of sub( A ).
106 *
107 * DESCA (global and local input) INTEGER array of dimension DLEN_.
108 * The array descriptor for the distributed matrix A.
109 *
110 * INFO (global output) INTEGER
111 * = 0: successful exit
112 * < 0: If the i-th argument is an array and the j-entry had
113 * an illegal value, then INFO = -(i*100+j), if the i-th
114 * argument is a scalar and had an illegal value, then
115 * INFO = -i.
116 * > 0: If INFO = i, the (i,i) element of the factor U or L is
117 * zero, and the inverse could not be computed.
118 *
119 * =====================================================================
120 *
121 * .. Parameters ..
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 * .. Local Scalars ..
129  LOGICAL UPPER
130  INTEGER ICOFF, ICTXT, IROFF, MYCOL, MYROW, NPCOL, NPROW
131 * ..
132 * .. Local Arrays ..
133  INTEGER IDUM1( 1 ), IDUM2( 1 )
134 * ..
135 * .. External Subroutines ..
136  EXTERNAL blacs_gridinfo, chk1mat, pchk1mat, pxerbla,
137  $ pzlauum, pztrtri
138 * ..
139 * .. External Functions ..
140  LOGICAL LSAME
141  EXTERNAL lsame
142 * ..
143 * .. Intrinsic Functions ..
144  INTRINSIC ichar, mod
145 * ..
146 * .. Executable Statements ..
147 *
148 * Get grid parameters
149 *
150  ictxt = desca( ctxt_ )
151  CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
152 *
153 * Test the input parameters
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, 'PZPOTRI', -info )
185  RETURN
186  END IF
187 *
188 * Quick return if possible
189 *
190  IF( n.EQ.0 )
191  $ RETURN
192 *
193 * Invert the triangular Cholesky factor U or L.
194 *
195  CALL pztrtri( uplo, 'Non-unit', n, a, ia, ja, desca, info )
196 *
197  IF( info.GT.0 )
198  $ RETURN
199 *
200 * Form inv(U)*inv(U)' or inv(L)'*inv(L).
201 *
202  CALL pzlauum( uplo, n, a, ia, ja, desca )
203 *
204  RETURN
205 *
206 * End of PZPOTRI
207 *
208  END
pzlauum
subroutine pzlauum(UPLO, N, A, IA, JA, DESCA)
Definition: pzlauum.f:2
pzpotri
subroutine pzpotri(UPLO, N, A, IA, JA, DESCA, INFO)
Definition: pzpotri.f:2
pchk1mat
subroutine pchk1mat(MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA, DESCAPOS0, NEXTRA, EX, EXPOS, INFO)
Definition: pchkxmat.f:3
chk1mat
subroutine chk1mat(MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA, DESCAPOS0, INFO)
Definition: chk1mat.f:3
pxerbla
subroutine pxerbla(ICTXT, SRNAME, INFO)
Definition: pxerbla.f:2
pztrtri
subroutine pztrtri(UPLO, DIAG, N, A, IA, JA, DESCA, INFO)
Definition: pztrtri.f:2