ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pztrti2.f
Go to the documentation of this file.
1  SUBROUTINE pztrti2( UPLO, DIAG, 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 DIAG, 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 * PZTRTI2 computes the inverse of a complex upper or lower triangular
21 * block matrix sub( A ) = A(IA:IA+N-1,JA:JA+N-1). This matrix should be
22 * contained in one and only one process memory space (local operation).
23 *
24 * Notes
25 * =====
26 *
27 * Each global data object is described by an associated description
28 * vector. This vector stores the information required to establish
29 * the mapping between an object element and its corresponding process
30 * and memory location.
31 *
32 * Let A be a generic term for any 2D block cyclicly distributed array.
33 * Such a global array has an associated description vector DESCA.
34 * In the following comments, the character _ should be read as
35 * "of the global array".
36 *
37 * NOTATION STORED IN EXPLANATION
38 * --------------- -------------- --------------------------------------
39 * DTYPE_A(global) DESCA( DTYPE_ )The descriptor type. In this case,
40 * DTYPE_A = 1.
41 * CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
42 * the BLACS process grid A is distribu-
43 * ted over. The context itself is glo-
44 * bal, but the handle (the integer
45 * value) may vary.
46 * M_A (global) DESCA( M_ ) The number of rows in the global
47 * array A.
48 * N_A (global) DESCA( N_ ) The number of columns in the global
49 * array A.
50 * MB_A (global) DESCA( MB_ ) The blocking factor used to distribute
51 * the rows of the array.
52 * NB_A (global) DESCA( NB_ ) The blocking factor used to distribute
53 * the columns of the array.
54 * RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
55 * row of the array A is distributed.
56 * CSRC_A (global) DESCA( CSRC_ ) The process column over which the
57 * first column of the array A is
58 * distributed.
59 * LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
60 * array. LLD_A >= MAX(1,LOCr(M_A)).
61 *
62 * Let K be the number of rows or columns of a distributed matrix,
63 * and assume that its process grid has dimension p x q.
64 * LOCr( K ) denotes the number of elements of K that a process
65 * would receive if K were distributed over the p processes of its
66 * process column.
67 * Similarly, LOCc( K ) denotes the number of elements of K that a
68 * process would receive if K were distributed over the q processes of
69 * its process row.
70 * The values of LOCr() and LOCc() may be determined via a call to the
71 * ScaLAPACK tool function, NUMROC:
72 * LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
73 * LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
74 * An upper bound for these quantities may be computed by:
75 * LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
76 * LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
77 *
78 * Arguments
79 * =========
80 *
81 * UPLO (global input) CHARACTER*1
82 * = 'U': sub( A ) is upper triangular;
83 * = 'L': sub( A ) is lower triangular.
84 *
85 * DIAG (global input) CHARACTER*1
86 * = 'N': sub( A ) is non-unit triangular
87 * = 'U': sub( A ) is unit triangular
88 *
89 * N (global input) INTEGER
90 * The number of rows and columns to be operated on, i.e. the
91 * order of the distributed submatrix sub( A ). N >= 0.
92 *
93 * A (local input/local output) COMPLEX*16 pointer into the
94 * local memory to an array of dimension (LLD_A,LOCc(JA+N-1)),
95 * this array contains the local pieces of the triangular matrix
96 * sub( A ). If UPLO = 'U', the leading N-by-N upper triangular
97 * part of the matrix sub( A ) contains the upper triangular
98 * matrix, and the strictly lower triangular part of sub( A )
99 * is not referenced. If UPLO = 'L', the leading N-by-N lower
100 * triangular part of the matrix sub( A ) contains the lower
101 * triangular matrix, and the strictly upper triangular part
102 * of sub( A ) is not referenced. If DIAG = 'U', the diagonal
103 * elements of sub( A ) are also not referenced and are assumed
104 * to be 1. On exit, the (triangular) inverse of the original
105 * matrix, in the same storage format.
106 *
107 * IA (global input) INTEGER
108 * The row index in the global array A indicating the first
109 * row of sub( A ).
110 *
111 * JA (global input) INTEGER
112 * The column index in the global array A indicating the
113 * first column of sub( A ).
114 *
115 * DESCA (global and local input) INTEGER array of dimension DLEN_.
116 * The array descriptor for the distributed matrix A.
117 *
118 * INFO (local output) INTEGER
119 * = 0: successful exit
120 * < 0: If the i-th argument is an array and the j-entry had
121 * an illegal value, then INFO = -(i*100+j), if the i-th
122 * argument is a scalar and had an illegal value, then
123 * INFO = -i.
124 *
125 * =====================================================================
126 *
127 * .. Parameters ..
128  INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
129  $ LLD_, MB_, M_, NB_, N_, RSRC_
130  parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
131  $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
132  $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
133  COMPLEX*16 ONE
134  parameter( one = 1.0d+0 )
135 * ..
136 * .. Local Scalars ..
137  LOGICAL NOUNIT, UPPER
138  INTEGER IACOL, IAROW, ICTXT, ICURR, IDIAG, IIA, IOFFA,
139  $ JJA, LDA, MYCOL, MYROW, NA, NPCOL, NPROW
140  COMPLEX*16 AJJ
141 * ..
142 * .. External Subroutines ..
143  EXTERNAL blacs_abort, blacs_gridinfo, chk1mat, infog2l,
144  $ pxerbla, zscal, ztrmv
145 * ..
146 * .. External Functions ..
147  LOGICAL LSAME
148  EXTERNAL lsame
149 * ..
150 * .. Executable Statements ..
151 *
152 * Get grid parameters
153 *
154  ictxt = desca( ctxt_ )
155  CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
156 *
157 * Test the input parameters
158 *
159  info = 0
160  IF( nprow.EQ.-1 ) THEN
161  info = -(700+ctxt_)
162  ELSE
163  CALL chk1mat( n, 3, n, 3, ia, ja, desca, 7, info )
164  upper = lsame( uplo, 'U' )
165  nounit = lsame( diag, 'N' )
166  IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
167  info = -1
168  ELSE IF( .NOT.nounit .AND. .NOT.lsame( diag, 'U' ) ) THEN
169  info = -2
170  END IF
171  END IF
172 *
173  IF( info.NE.0 ) THEN
174  CALL pxerbla( ictxt, 'PZTRTI2', -info )
175  CALL blacs_abort( ictxt, 1 )
176  RETURN
177  END IF
178 *
179 * Compute local indexes
180 *
181  CALL infog2l( ia, ja, desca, nprow, npcol, myrow, mycol, iia, jja,
182  $ iarow, iacol )
183 *
184  IF( myrow.EQ.iarow .AND. mycol.EQ.iacol ) THEN
185 *
186  lda = desca( lld_ )
187 *
188  IF( upper ) THEN
189 *
190  ioffa = iia + ( jja - 1 ) * lda
191  icurr = ioffa + lda
192 *
193  IF( nounit ) THEN
194 *
195 * Compute inverse of upper non-unit triangular matrix.
196 *
197  a( ioffa ) = one / a( ioffa )
198  idiag = icurr + 1
199  DO 10 na = 1, n-1
200  a( idiag ) = one / a( idiag )
201  ajj = -a( idiag )
202 *
203 * Compute elements 1:j-1 of j-th column.
204 *
205  CALL ztrmv( 'Upper', 'No transpose', diag, na,
206  $ a( ioffa ), lda, a( icurr ), 1 )
207  CALL zscal( na, ajj, a( icurr ), 1 )
208  idiag = idiag + lda + 1
209  icurr = icurr + lda
210  10 CONTINUE
211 *
212  ELSE
213 *
214 * Compute inverse of upper unit triangular matrix.
215 *
216  DO 20 na = 1, n-1
217 *
218 * Compute elements 1:j-1 of j-th column.
219 *
220  CALL ztrmv( 'Upper', 'No transpose', diag, na,
221  $ a( ioffa ), lda, a( icurr ), 1 )
222  CALL zscal( na, -one, a( icurr ), 1 )
223  icurr = icurr + lda
224  20 CONTINUE
225 *
226  END IF
227 *
228  ELSE
229 *
230  icurr = iia + n - 1 + ( jja + n - 2 ) * lda
231  ioffa = icurr - lda
232 *
233  IF( nounit ) THEN
234 *
235 * Compute inverse of lower non-unit triangular matrix.
236 *
237  a( icurr ) = one / a( icurr )
238  idiag = ioffa - 1
239  DO 30 na = 1, n-1
240  a( idiag ) = one / a( idiag )
241  ajj = -a( idiag )
242 *
243 * Compute elements j+1:n of j-th column.
244 *
245  CALL ztrmv( 'Lower', 'No transpose', diag, na,
246  $ a( icurr ), lda, a( ioffa ), 1 )
247  CALL zscal( na, ajj, a( ioffa ), 1 )
248  icurr = idiag
249  idiag = idiag - lda - 1
250  ioffa = idiag + 1
251  30 CONTINUE
252 *
253  ELSE
254 *
255 * Compute inverse of lower unit triangular matrix.
256 *
257  DO 40 na = 1, n-1
258 *
259 * Compute elements j+1:n of j-th column.
260 *
261  CALL ztrmv( 'Lower', 'No transpose', diag, na,
262  $ a( icurr ), lda, a( ioffa ), 1 )
263  CALL zscal( na, -one, a( ioffa ), 1 )
264  icurr = icurr - lda - 1
265  ioffa = icurr - lda
266  40 CONTINUE
267 *
268  END IF
269 *
270  END IF
271 *
272  END IF
273 *
274 * End of PZTRTI2
275 *
276  END
pztrti2
subroutine pztrti2(UPLO, DIAG, N, A, IA, JA, DESCA, INFO)
Definition: pztrti2.f:2
infog2l
subroutine infog2l(GRINDX, GCINDX, DESC, NPROW, NPCOL, MYROW, MYCOL, LRINDX, LCINDX, RSRC, CSRC)
Definition: infog2l.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