KTH framework for Nek5000 toolboxes; testing version  0.0.1
ztrsv.f
Go to the documentation of this file.
1  SUBROUTINE ztrsv ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
2 * .. Scalar Arguments ..
3  INTEGER INCX, LDA, N
4  CHARACTER*1 DIAG, TRANS, UPLO
5 * .. Array Arguments ..
6  COMPLEX*16 A( LDA, * ), X( * )
7 * ..
8 *
9 * Purpose
10 * =======
11 *
12 * ZTRSV solves one of the systems of equations
13 *
14 * A*x = b, or A'*x = b, or conjg( A' )*x = b,
15 *
16 * where b and x are n element vectors and A is an n by n unit, or
17 * non-unit, upper or lower triangular matrix.
18 *
19 * No test for singularity or near-singularity is included in this
20 * routine. Such tests must be performed before calling this routine.
21 *
22 * Parameters
23 * ==========
24 *
25 * UPLO - CHARACTER*1.
26 * On entry, UPLO specifies whether the matrix is an upper or
27 * lower triangular matrix as follows:
28 *
29 * UPLO = 'U' or 'u' A is an upper triangular matrix.
30 *
31 * UPLO = 'L' or 'l' A is a lower triangular matrix.
32 *
33 * Unchanged on exit.
34 *
35 * TRANS - CHARACTER*1.
36 * On entry, TRANS specifies the equations to be solved as
37 * follows:
38 *
39 * TRANS = 'N' or 'n' A*x = b.
40 *
41 * TRANS = 'T' or 't' A'*x = b.
42 *
43 * TRANS = 'C' or 'c' conjg( A' )*x = b.
44 *
45 * Unchanged on exit.
46 *
47 * DIAG - CHARACTER*1.
48 * On entry, DIAG specifies whether or not A is unit
49 * triangular as follows:
50 *
51 * DIAG = 'U' or 'u' A is assumed to be unit triangular.
52 *
53 * DIAG = 'N' or 'n' A is not assumed to be unit
54 * triangular.
55 *
56 * Unchanged on exit.
57 *
58 * N - INTEGER.
59 * On entry, N specifies the order of the matrix A.
60 * N must be at least zero.
61 * Unchanged on exit.
62 *
63 * A - COMPLEX*16 array of DIMENSION ( LDA, n ).
64 * Before entry with UPLO = 'U' or 'u', the leading n by n
65 * upper triangular part of the array A must contain the upper
66 * triangular matrix and the strictly lower triangular part of
67 * A is not referenced.
68 * Before entry with UPLO = 'L' or 'l', the leading n by n
69 * lower triangular part of the array A must contain the lower
70 * triangular matrix and the strictly upper triangular part of
71 * A is not referenced.
72 * Note that when DIAG = 'U' or 'u', the diagonal elements of
73 * A are not referenced either, but are assumed to be unity.
74 * Unchanged on exit.
75 *
76 * LDA - INTEGER.
77 * On entry, LDA specifies the first dimension of A as declared
78 * in the calling (sub) program. LDA must be at least
79 * max( 1, n ).
80 * Unchanged on exit.
81 *
82 * X - COMPLEX*16 array of dimension at least
83 * ( 1 + ( n - 1 )*abs( INCX ) ).
84 * Before entry, the incremented array X must contain the n
85 * element right-hand side vector b. On exit, X is overwritten
86 * with the solution vector x.
87 *
88 * INCX - INTEGER.
89 * On entry, INCX specifies the increment for the elements of
90 * X. INCX must not be zero.
91 * Unchanged on exit.
92 *
93 *
94 * Level 2 Blas routine.
95 *
96 * -- Written on 22-October-1986.
97 * Jack Dongarra, Argonne National Lab.
98 * Jeremy Du Croz, Nag Central Office.
99 * Sven Hammarling, Nag Central Office.
100 * Richard Hanson, Sandia National Labs.
101 *
102 *
103 * .. Parameters ..
104  COMPLEX*16 ZERO
105  parameter( zero = ( 0.0d+0, 0.0d+0 ) )
106 * .. Local Scalars ..
107  COMPLEX*16 TEMP
108  INTEGER I, INFO, IX, J, JX, KX
109  LOGICAL NOCONJ, NOUNIT
110 * .. External Functions ..
111  LOGICAL LSAME
112  EXTERNAL lsame
113 * .. External Subroutines ..
114  EXTERNAL xerbla
115 * .. Intrinsic Functions ..
116  INTRINSIC dconjg, max
117 * ..
118 * .. Executable Statements ..
119 *
120 * Test the input parameters.
121 *
122  info = 0
123  IF ( .NOT.lsame( uplo , 'U' ).AND.
124  $ .NOT.lsame( uplo , 'L' ) )THEN
125  info = 1
126  ELSE IF( .NOT.lsame( trans, 'N' ).AND.
127  $ .NOT.lsame( trans, 'T' ).AND.
128  $ .NOT.lsame( trans, 'C' ) )THEN
129  info = 2
130  ELSE IF( .NOT.lsame( diag , 'U' ).AND.
131  $ .NOT.lsame( diag , 'N' ) )THEN
132  info = 3
133  ELSE IF( n.LT.0 )THEN
134  info = 4
135  ELSE IF( lda.LT.max( 1, n ) )THEN
136  info = 6
137  ELSE IF( incx.EQ.0 )THEN
138  info = 8
139  END IF
140  IF( info.NE.0 )THEN
141  CALL xerbla( 'ZTRSV ', info )
142  RETURN
143  END IF
144 *
145 * Quick return if possible.
146 *
147  IF( n.EQ.0 )
148  $ RETURN
149 *
150  noconj = lsame( trans, 'T' )
151  nounit = lsame( diag , 'N' )
152 *
153 * Set up the start point in X if the increment is not unity. This
154 * will be ( N - 1 )*INCX too small for descending loops.
155 *
156  IF( incx.LE.0 )THEN
157  kx = 1 - ( n - 1 )*incx
158  ELSE IF( incx.NE.1 )THEN
159  kx = 1
160  END IF
161 *
162 * Start the operations. In this version the elements of A are
163 * accessed sequentially with one pass through A.
164 *
165  IF( lsame( trans, 'N' ) )THEN
166 *
167 * Form x := inv( A )*x.
168 *
169  IF( lsame( uplo, 'U' ) )THEN
170  IF( incx.EQ.1 )THEN
171  DO 20, j = n, 1, -1
172  IF( x( j ).NE.zero )THEN
173  IF( nounit )
174  $ x( j ) = x( j )/a( j, j )
175  temp = x( j )
176  DO 10, i = j - 1, 1, -1
177  x( i ) = x( i ) - temp*a( i, j )
178  10 CONTINUE
179  END IF
180  20 CONTINUE
181  ELSE
182  jx = kx + ( n - 1 )*incx
183  DO 40, j = n, 1, -1
184  IF( x( jx ).NE.zero )THEN
185  IF( nounit )
186  $ x( jx ) = x( jx )/a( j, j )
187  temp = x( jx )
188  ix = jx
189  DO 30, i = j - 1, 1, -1
190  ix = ix - incx
191  x( ix ) = x( ix ) - temp*a( i, j )
192  30 CONTINUE
193  END IF
194  jx = jx - incx
195  40 CONTINUE
196  END IF
197  ELSE
198  IF( incx.EQ.1 )THEN
199  DO 60, j = 1, n
200  IF( x( j ).NE.zero )THEN
201  IF( nounit )
202  $ x( j ) = x( j )/a( j, j )
203  temp = x( j )
204  DO 50, i = j + 1, n
205  x( i ) = x( i ) - temp*a( i, j )
206  50 CONTINUE
207  END IF
208  60 CONTINUE
209  ELSE
210  jx = kx
211  DO 80, j = 1, n
212  IF( x( jx ).NE.zero )THEN
213  IF( nounit )
214  $ x( jx ) = x( jx )/a( j, j )
215  temp = x( jx )
216  ix = jx
217  DO 70, i = j + 1, n
218  ix = ix + incx
219  x( ix ) = x( ix ) - temp*a( i, j )
220  70 CONTINUE
221  END IF
222  jx = jx + incx
223  80 CONTINUE
224  END IF
225  END IF
226  ELSE
227 *
228 * Form x := inv( A' )*x or x := inv( conjg( A' ) )*x.
229 *
230  IF( lsame( uplo, 'U' ) )THEN
231  IF( incx.EQ.1 )THEN
232  DO 110, j = 1, n
233  temp = x( j )
234  IF( noconj )THEN
235  DO 90, i = 1, j - 1
236  temp = temp - a( i, j )*x( i )
237  90 CONTINUE
238  IF( nounit )
239  $ temp = temp/a( j, j )
240  ELSE
241  DO 100, i = 1, j - 1
242  temp = temp - dconjg( a( i, j ) )*x( i )
243  100 CONTINUE
244  IF( nounit )
245  $ temp = temp/dconjg( a( j, j ) )
246  END IF
247  x( j ) = temp
248  110 CONTINUE
249  ELSE
250  jx = kx
251  DO 140, j = 1, n
252  ix = kx
253  temp = x( jx )
254  IF( noconj )THEN
255  DO 120, i = 1, j - 1
256  temp = temp - a( i, j )*x( ix )
257  ix = ix + incx
258  120 CONTINUE
259  IF( nounit )
260  $ temp = temp/a( j, j )
261  ELSE
262  DO 130, i = 1, j - 1
263  temp = temp - dconjg( a( i, j ) )*x( ix )
264  ix = ix + incx
265  130 CONTINUE
266  IF( nounit )
267  $ temp = temp/dconjg( a( j, j ) )
268  END IF
269  x( jx ) = temp
270  jx = jx + incx
271  140 CONTINUE
272  END IF
273  ELSE
274  IF( incx.EQ.1 )THEN
275  DO 170, j = n, 1, -1
276  temp = x( j )
277  IF( noconj )THEN
278  DO 150, i = n, j + 1, -1
279  temp = temp - a( i, j )*x( i )
280  150 CONTINUE
281  IF( nounit )
282  $ temp = temp/a( j, j )
283  ELSE
284  DO 160, i = n, j + 1, -1
285  temp = temp - dconjg( a( i, j ) )*x( i )
286  160 CONTINUE
287  IF( nounit )
288  $ temp = temp/dconjg( a( j, j ) )
289  END IF
290  x( j ) = temp
291  170 CONTINUE
292  ELSE
293  kx = kx + ( n - 1 )*incx
294  jx = kx
295  DO 200, j = n, 1, -1
296  ix = kx
297  temp = x( jx )
298  IF( noconj )THEN
299  DO 180, i = n, j + 1, -1
300  temp = temp - a( i, j )*x( ix )
301  ix = ix - incx
302  180 CONTINUE
303  IF( nounit )
304  $ temp = temp/a( j, j )
305  ELSE
306  DO 190, i = n, j + 1, -1
307  temp = temp - dconjg( a( i, j ) )*x( ix )
308  ix = ix - incx
309  190 CONTINUE
310  IF( nounit )
311  $ temp = temp/dconjg( a( j, j ) )
312  END IF
313  x( jx ) = temp
314  jx = jx - incx
315  200 CONTINUE
316  END IF
317  END IF
318  END IF
319 *
320  RETURN
321 *
322 * End of ZTRSV .
323 *
324  END
xerbla
subroutine xerbla(SRNAME, INFO)
Definition: xerbla.f:2
ztrsv
subroutine ztrsv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
Definition: ztrsv.f:2