1SUBROUTINE SPTSVX1_F95(D, E, B, X, DF, EF, FACT, FERR, BERR, RCOND, 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 => SP
9   USE LA_AUXMOD, ONLY: LSAME, ERINFO
10   USE F77_LAPACK, ONLY: PTSVX_F77 => LA_PTSVX
11!  .. IMPLICIT STATEMENT ..
12   IMPLICIT NONE
13!  .. SCALAR ARGUMENTS ..
14   CHARACTER(LEN=1), INTENT(IN), OPTIONAL :: FACT
15   INTEGER, INTENT(OUT), OPTIONAL :: INFO
16   REAL(WP), INTENT(OUT), OPTIONAL :: RCOND, FERR, BERR
17!  .. ARRAY ARGUMENTS ..
18   REAL(WP), INTENT(IN) :: D(:)
19   REAL(WP), INTENT(IN) :: E(:), B(:)
20   REAL(WP), INTENT(OUT) :: X(:)
21   REAL(WP), INTENT(INOUT), OPTIONAL, TARGET :: DF(:)
22   REAL(WP), INTENT(INOUT), OPTIONAL, TARGET :: EF(:)
23!  .. PARAMETERS ..
24   CHARACTER(LEN=8), PARAMETER :: SRNAME = 'LA_PTSVX'
25!  .. LOCAL SCALARS ..
26   CHARACTER(LEN=1) :: LFACT
27   INTEGER :: LINFO, N, ISTAT, ISTAT1, SDF, SEF
28   REAL(WP) :: LRCOND, LFERR, LBERR
29!  .. LOCAL POINTERS ..
30   REAL(WP),  POINTER :: LDF(:)
31   REAL(WP),  POINTER :: WORK(:), LEF(:)
32!  .. INTRINSIC FUNCTIONS ..
33   INTRINSIC PRESENT, SIZE
34!  .. EXECUTABLE STATEMENTS ..
35   LINFO = 0; ISTAT = 0
36   N = SIZE(D)
37   IF( PRESENT(RCOND) ) RCOND = 1.0_WP
38   IF( PRESENT(FACT) )THEN; LFACT = FACT; ELSE; LFACT='N'; END IF
39   IF( PRESENT(DF) )THEN; SDF = SIZE(DF); ELSE; SDF = N; END IF
40   IF( PRESENT(EF) )THEN; SEF = SIZE(EF); ELSE; SEF = N-1; END IF
41!  .. TEST THE ARGUMENTS
42   IF( N < 0 ) THEN; LINFO = -1
43   ELSE IF( SIZE( E ) /= N-1 .AND. N /= 0 ) THEN; LINFO = -2
44   ELSE IF( SIZE(B) /= N )THEN; LINFO = -3
45   ELSE IF( SIZE(X) /= N )THEN; LINFO = -4
46   ELSE IF( SDF /= N ) THEN; LINFO = -5
47   ELSE IF( .NOT.( PRESENT(DF).AND.PRESENT(EF) ) &
48       .AND.( PRESENT(DF).OR.PRESENT(EF) ) )THEN; LINFO = -5
49   ELSE IF( SEF /= N-1 .AND. N>0 ) THEN; LINFO = -6
50   ELSE IF( ( .NOT.LSAME(LFACT,'F') .AND. .NOT.LSAME(LFACT,'N') ) .OR. &
51            ( LSAME(LFACT,'F') .AND. .NOT.PRESENT(DF) ) )THEN; LINFO = -7
52   ELSE IF ( N > 0 )THEN
53      IF( .NOT.PRESENT(DF) ) THEN; ALLOCATE( LDF(N), LEF(N-1), STAT=ISTAT )
54      ELSE; LDF => DF; LEF => EF; END IF
55      IF( ISTAT == 0 ) ALLOCATE(WORK(2*N), STAT=ISTAT )
56      IF( ISTAT == 0 )THEN
57         CALL PTSVX_F77( LFACT, N, 1, D, E, LDF, LEF, B, N, X, N, LRCOND, &
58                         LFERR, LBERR, WORK, LINFO )
59      ELSE; LINFO = -100; END IF
60      IF( .NOT.PRESENT(DF) ) DEALLOCATE( LDF, LEF, STAT=ISTAT1 )
61      IF( PRESENT(FERR) ) FERR = LFERR
62      IF( PRESENT(BERR) ) BERR = LBERR
63      IF( PRESENT(RCOND) ) RCOND=LRCOND
64      DEALLOCATE( WORK, STAT=ISTAT1 )
65   END IF
66   CALL ERINFO( LINFO, SRNAME, INFO, ISTAT )
67END SUBROUTINE SPTSVX1_F95
68