1 SUBROUTINE DGTSV_F95( DL, D, DU, B, INFO )
2!
3!  -- LAPACK95 interface driver routine (version 3.0) --
4!     UNI-C, Denmark; Univ. of Tennessee, USA; NAG Ltd., UK
5!     September, 2000
6!
7!   .. USE STATEMENTS ..
8    USE LA_PRECISION, ONLY: WP => DP
9    USE LA_AUXMOD, ONLY: ERINFO
10    USE F77_LAPACK, ONLY: GTSV_F77 => LA_GTSV
11!   .. IMPLICIT STATEMENT ..
12    IMPLICIT NONE
13!   .. SCALAR ARGUMENTS ..
14    INTEGER, INTENT(OUT), OPTIONAL :: INFO
15!   .. ARRAY ARGUMENTS ..
16    REAL(WP), INTENT(INOUT) :: DL(:), D(:), DU(:), B(:,:)
17!----------------------------------------------------------------------
18!
19! Purpose
20! =======
21!
22!    LA_GTSV computes the solution to a real or complex linear system of
23! equations A*X = B, where A is a square tridiagonal matrix and X and B
24! are rectangular matrices or vectors. The LU decomposition is used to
25! factor the matrix A as A = L*U , where L is a product of permutation
26! and unit lower bidiagonal matrices and U is upper triangular with
27! nonzeros in only the main diagonal and first two superdiagonals.
28! The factored form of A is then used to solve the above system.
29!
30! Note: The system A^T*X = B may be solved by interchanging the order of
31! the arguments DU and DL.
32!
33! =========
34!
35!       SUBROUTINE LA_GTSV( DL, D, DU, B, INFO=info )
36!           <type>(<wp>), INTENT(INOUT) :: DL(:), D(:), DU(:), <rhs>
37!           INTEGER, INTENT(OUT), OPTIONAL :: INFO
38!       where
39!           <type> ::= REAL | COMPLEX
40!           <wp> ::= KIND(1.0) | KIND(1.0D0)
41!           <rhs> ::= B(:,:) | B(:)
42!
43! Arguments
44! =========
45!
46! DL    (input/output) REAL or COMPLEX array, shape (:) with
47!       size(DL) = n-1, where n is the order of A.
48!       On entry, the subdiagonal of A.
49!       On exit, the n-2 elements of the second superdiagonal of U in
50!       DL(1),..., DL(n-2).
51! D     (input/output) REAL or COMPLEX array, shape (:) with size(D) = n.
52!       On entry, the diagonal of A.
53!       On exit, the diagonal of U .
54! DU    (input/output) REAL or COMPLEX array, shape (:) with
55!       size(DL) = n-1.
56!       On entry, the superdiagonal of A.
57!       On exit, the first superdiagonal of U .
58! B     (input/output) REAL or COMPLEX array, shape (:,:) with
59!       size(B,1) = n or shape (:) with size(B) = n.
60!       On entry, the matrix B.
61!       On exit, the solution matrix X .
62! INFO  Optional (output) INTEGER
63!       = 0: successful exit.
64!       < 0: if INFO = -i, the i-th argument had an illegal value.
65!       > 0: if INFO = i, then U(i,i) = 0. The factorization has not been
66!       completed unless i = n. The factor U is singular, so the solution
67!       could not be computed.
68!       If INFO is not present and an error occurs, then the program is
69!       terminated with an error message.
70!----------------------------------------------------------------------
71!   .. PARAMETERS ..
72    CHARACTER(LEN=7), PARAMETER :: SRNAME = 'LA_GTSV'
73!   .. LOCAL SCALARS ..
74    INTEGER :: LINFO, N, NRHS
75!   .. INTRINSIC FUNCTIONS ..
76    INTRINSIC SIZE
77!   .. EXECUTABLE STATEMENTS ..
78    LINFO = 0
79    N = SIZE(D); NRHS = SIZE(B,2)
80!   .. TEST THE ARGUMENTS
81    IF( SIZE( DL ) /= N-1 .AND. N /= 0 ) THEN; LINFO = -1
82    ELSE IF( N < 0 ) THEN; LINFO = -2
83    ELSE IF( SIZE( DU ) /= N-1 .AND. N/=0 ) THEN; LINFO = -3
84    ELSE IF( SIZE( B, 1 ) /= N .OR. NRHS < 0 ) THEN; LINFO = -4
85    ELSE IF ( N > 0 ) THEN
86       CALL GTSV_F77( N, NRHS, DL, D, DU, B, N, LINFO )
87    END IF
88    CALL ERINFO( LINFO, SRNAME, INFO )
89 END SUBROUTINE DGTSV_F95
90