← Back to branch summary

~ubuntu-branches/debian/sid/octave3.0/sid

« back to all changes in this revision

Viewing changes to libcruft/lapack/zgetrs.f

  • Committer: Bazaar Package Importer
  • Author(s): Rafael Laboissiere
  • Date: 2007-12-23 16:04:15 UTC
  • Revision ID: james.westby@ubuntu.com-20071223160415-n4gk468dihy22e9v
Tags: upstream-3.0.0
Import upstream version 3.0.0

Show diffs side-by-side

added added

removed removed

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