1 SUBROUTINE ZGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
2 *
3 * -- LAPACK routine (version 3.3.1) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * -- April 2011 --
7 *
8 * .. Scalar Arguments ..
9 CHARACTER TRANS
10 INTEGER INFO, LDA, LDB, N, NRHS
11 * ..
12 * .. Array Arguments ..
13 INTEGER IPIV( * )
14 COMPLEX*16 A( LDA, * ), B( LDB, * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * ZGETRS solves a system of linear equations
21 * A * X = B, A**T * X = B, or A**H * X = B
22 * with a general N-by-N matrix A using the LU factorization computed
23 * by ZGETRF.
24 *
25 * Arguments
26 * =========
27 *
28 * TRANS (input) CHARACTER*1
29 * Specifies the form of the system of equations:
30 * = 'N': A * X = B (No transpose)
31 * = 'T': A**T * X = B (Transpose)
32 * = 'C': A**H * X = B (Conjugate transpose)
33 *
34 * N (input) INTEGER
35 * The order of the matrix A. N >= 0.
36 *
37 * NRHS (input) INTEGER
38 * The number of right hand sides, i.e., the number of columns
39 * of the matrix B. NRHS >= 0.
40 *
41 * A (input) COMPLEX*16 array, dimension (LDA,N)
42 * The factors L and U from the factorization A = P*L*U
43 * as computed by ZGETRF.
44 *
45 * LDA (input) INTEGER
46 * The leading dimension of the array A. LDA >= max(1,N).
47 *
48 * IPIV (input) INTEGER array, dimension (N)
49 * The pivot indices from ZGETRF; for 1<=i<=N, row i of the
50 * matrix was interchanged with row IPIV(i).
51 *
52 * B (input/output) COMPLEX*16 array, dimension (LDB,NRHS)
53 * On entry, the right hand side matrix B.
54 * On exit, the solution matrix X.
55 *
56 * LDB (input) INTEGER
57 * The leading dimension of the array B. LDB >= max(1,N).
58 *
59 * INFO (output) INTEGER
60 * = 0: successful exit
61 * < 0: if INFO = -i, the i-th argument had an illegal value
62 *
63 * =====================================================================
64 *
65 * .. Parameters ..
66 COMPLEX*16 ONE
67 PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
68 * ..
69 * .. Local Scalars ..
70 LOGICAL NOTRAN
71 * ..
72 * .. External Functions ..
73 LOGICAL LSAME
74 EXTERNAL LSAME
75 * ..
76 * .. External Subroutines ..
77 EXTERNAL XERBLA, ZLASWP, ZTRSM
78 * ..
79 * .. Intrinsic Functions ..
80 INTRINSIC MAX
81 * ..
82 * .. Executable Statements ..
83 *
84 * Test the input parameters.
85 *
86 INFO = 0
87 NOTRAN = LSAME( TRANS, 'N' )
88 IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
89 $ LSAME( TRANS, 'C' ) ) THEN
90 INFO = -1
91 ELSE IF( N.LT.0 ) THEN
92 INFO = -2
93 ELSE IF( NRHS.LT.0 ) THEN
94 INFO = -3
95 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
96 INFO = -5
97 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
98 INFO = -8
99 END IF
100 IF( INFO.NE.0 ) THEN
101 CALL XERBLA( 'ZGETRS', -INFO )
102 RETURN
103 END IF
104 *
105 * Quick return if possible
106 *
107 IF( N.EQ.0 .OR. NRHS.EQ.0 )
108 $ RETURN
109 *
110 IF( NOTRAN ) THEN
111 *
112 * Solve A * X = B.
113 *
114 * Apply row interchanges to the right hand sides.
115 *
116 CALL ZLASWP( NRHS, B, LDB, 1, N, IPIV, 1 )
117 *
118 * Solve L*X = B, overwriting B with X.
119 *
120 CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS,
121 $ ONE, A, LDA, B, LDB )
122 *
123 * Solve U*X = B, overwriting B with X.
124 *
125 CALL ZTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
126 $ NRHS, ONE, A, LDA, B, LDB )
127 ELSE
128 *
129 * Solve A**T * X = B or A**H * X = B.
130 *
131 * Solve U**T *X = B or U**H *X = B, overwriting B with X.
132 *
133 CALL ZTRSM( 'Left', 'Upper', TRANS, 'Non-unit', N, NRHS, ONE,
134 $ A, LDA, B, LDB )
135 *
136 * Solve L**T *X = B, or L**H *X = B overwriting B with X.
137 *
138 CALL ZTRSM( 'Left', 'Lower', TRANS, 'Unit', N, NRHS, ONE, A,
139 $ LDA, B, LDB )
140 *
141 * Apply row interchanges to the solution vectors.
142 *
143 CALL ZLASWP( NRHS, B, LDB, 1, N, IPIV, -1 )
144 END IF
145 *
146 RETURN
147 *
148 * End of ZGETRS
149 *
150 END
2 *
3 * -- LAPACK routine (version 3.3.1) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * -- April 2011 --
7 *
8 * .. Scalar Arguments ..
9 CHARACTER TRANS
10 INTEGER INFO, LDA, LDB, N, NRHS
11 * ..
12 * .. Array Arguments ..
13 INTEGER IPIV( * )
14 COMPLEX*16 A( LDA, * ), B( LDB, * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * ZGETRS solves a system of linear equations
21 * A * X = B, A**T * X = B, or A**H * X = B
22 * with a general N-by-N matrix A using the LU factorization computed
23 * by ZGETRF.
24 *
25 * Arguments
26 * =========
27 *
28 * TRANS (input) CHARACTER*1
29 * Specifies the form of the system of equations:
30 * = 'N': A * X = B (No transpose)
31 * = 'T': A**T * X = B (Transpose)
32 * = 'C': A**H * X = B (Conjugate transpose)
33 *
34 * N (input) INTEGER
35 * The order of the matrix A. N >= 0.
36 *
37 * NRHS (input) INTEGER
38 * The number of right hand sides, i.e., the number of columns
39 * of the matrix B. NRHS >= 0.
40 *
41 * A (input) COMPLEX*16 array, dimension (LDA,N)
42 * The factors L and U from the factorization A = P*L*U
43 * as computed by ZGETRF.
44 *
45 * LDA (input) INTEGER
46 * The leading dimension of the array A. LDA >= max(1,N).
47 *
48 * IPIV (input) INTEGER array, dimension (N)
49 * The pivot indices from ZGETRF; for 1<=i<=N, row i of the
50 * matrix was interchanged with row IPIV(i).
51 *
52 * B (input/output) COMPLEX*16 array, dimension (LDB,NRHS)
53 * On entry, the right hand side matrix B.
54 * On exit, the solution matrix X.
55 *
56 * LDB (input) INTEGER
57 * The leading dimension of the array B. LDB >= max(1,N).
58 *
59 * INFO (output) INTEGER
60 * = 0: successful exit
61 * < 0: if INFO = -i, the i-th argument had an illegal value
62 *
63 * =====================================================================
64 *
65 * .. Parameters ..
66 COMPLEX*16 ONE
67 PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
68 * ..
69 * .. Local Scalars ..
70 LOGICAL NOTRAN
71 * ..
72 * .. External Functions ..
73 LOGICAL LSAME
74 EXTERNAL LSAME
75 * ..
76 * .. External Subroutines ..
77 EXTERNAL XERBLA, ZLASWP, ZTRSM
78 * ..
79 * .. Intrinsic Functions ..
80 INTRINSIC MAX
81 * ..
82 * .. Executable Statements ..
83 *
84 * Test the input parameters.
85 *
86 INFO = 0
87 NOTRAN = LSAME( TRANS, 'N' )
88 IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
89 $ LSAME( TRANS, 'C' ) ) THEN
90 INFO = -1
91 ELSE IF( N.LT.0 ) THEN
92 INFO = -2
93 ELSE IF( NRHS.LT.0 ) THEN
94 INFO = -3
95 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
96 INFO = -5
97 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
98 INFO = -8
99 END IF
100 IF( INFO.NE.0 ) THEN
101 CALL XERBLA( 'ZGETRS', -INFO )
102 RETURN
103 END IF
104 *
105 * Quick return if possible
106 *
107 IF( N.EQ.0 .OR. NRHS.EQ.0 )
108 $ RETURN
109 *
110 IF( NOTRAN ) THEN
111 *
112 * Solve A * X = B.
113 *
114 * Apply row interchanges to the right hand sides.
115 *
116 CALL ZLASWP( NRHS, B, LDB, 1, N, IPIV, 1 )
117 *
118 * Solve L*X = B, overwriting B with X.
119 *
120 CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS,
121 $ ONE, A, LDA, B, LDB )
122 *
123 * Solve U*X = B, overwriting B with X.
124 *
125 CALL ZTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
126 $ NRHS, ONE, A, LDA, B, LDB )
127 ELSE
128 *
129 * Solve A**T * X = B or A**H * X = B.
130 *
131 * Solve U**T *X = B or U**H *X = B, overwriting B with X.
132 *
133 CALL ZTRSM( 'Left', 'Upper', TRANS, 'Non-unit', N, NRHS, ONE,
134 $ A, LDA, B, LDB )
135 *
136 * Solve L**T *X = B, or L**H *X = B overwriting B with X.
137 *
138 CALL ZTRSM( 'Left', 'Lower', TRANS, 'Unit', N, NRHS, ONE, A,
139 $ LDA, B, LDB )
140 *
141 * Apply row interchanges to the solution vectors.
142 *
143 CALL ZLASWP( NRHS, B, LDB, 1, N, IPIV, -1 )
144 END IF
145 *
146 RETURN
147 *
148 * End of ZGETRS
149 *
150 END