SUBROUTINE SPTSVX1_F95(D, E, B, X, DF, EF, FACT, FERR, BERR, RCOND, INFO) ! ! -- LAPACK95 interface driver routine (version 3.0) -- ! UNI-C, Denmark; Univ. of Tennessee, USA; NAG Ltd., UK ! September, 2000 ! ! .. USE STATEMENTS .. USE LA_PRECISION, ONLY: WP => SP USE LA_AUXMOD, ONLY: LSAME, ERINFO USE F77_LAPACK, ONLY: PTSVX_F77 => LA_PTSVX ! .. IMPLICIT STATEMENT .. IMPLICIT NONE ! .. SCALAR ARGUMENTS .. CHARACTER(LEN=1), INTENT(IN), OPTIONAL :: FACT INTEGER, INTENT(OUT), OPTIONAL :: INFO REAL(WP), INTENT(OUT), OPTIONAL :: RCOND, FERR, BERR ! .. ARRAY ARGUMENTS .. REAL(WP), INTENT(IN) :: D(:) REAL(WP), INTENT(IN) :: E(:), B(:) REAL(WP), INTENT(OUT) :: X(:) REAL(WP), INTENT(INOUT), OPTIONAL, TARGET :: DF(:) REAL(WP), INTENT(INOUT), OPTIONAL, TARGET :: EF(:) ! .. PARAMETERS .. CHARACTER(LEN=8), PARAMETER :: SRNAME = 'LA_PTSVX' ! .. LOCAL SCALARS .. CHARACTER(LEN=1) :: LFACT INTEGER :: LINFO, N, ISTAT, ISTAT1, SDF, SEF REAL(WP) :: LRCOND, LFERR, LBERR ! .. LOCAL POINTERS .. REAL(WP), POINTER :: LDF(:) REAL(WP), POINTER :: WORK(:), LEF(:) ! .. INTRINSIC FUNCTIONS .. INTRINSIC PRESENT, SIZE ! .. EXECUTABLE STATEMENTS .. LINFO = 0; ISTAT = 0 N = SIZE(D) IF( PRESENT(RCOND) ) RCOND = 1.0_WP IF( PRESENT(FACT) )THEN; LFACT = FACT; ELSE; LFACT='N'; END IF IF( PRESENT(DF) )THEN; SDF = SIZE(DF); ELSE; SDF = N; END IF IF( PRESENT(EF) )THEN; SEF = SIZE(EF); ELSE; SEF = N-1; END IF ! .. TEST THE ARGUMENTS IF( N < 0 ) THEN; LINFO = -1 ELSE IF( SIZE( E ) /= N-1 .AND. N /= 0 ) THEN; LINFO = -2 ELSE IF( SIZE(B) /= N )THEN; LINFO = -3 ELSE IF( SIZE(X) /= N )THEN; LINFO = -4 ELSE IF( SDF /= N ) THEN; LINFO = -5 ELSE IF( .NOT.( PRESENT(DF).AND.PRESENT(EF) ) & .AND.( PRESENT(DF).OR.PRESENT(EF) ) )THEN; LINFO = -5 ELSE IF( SEF /= N-1 .AND. N>0 ) THEN; LINFO = -6 ELSE IF( ( .NOT.LSAME(LFACT,'F') .AND. .NOT.LSAME(LFACT,'N') ) .OR. & ( LSAME(LFACT,'F') .AND. .NOT.PRESENT(DF) ) )THEN; LINFO = -7 ELSE IF ( N > 0 )THEN IF( .NOT.PRESENT(DF) ) THEN; ALLOCATE( LDF(N), LEF(N-1), STAT=ISTAT ) ELSE; LDF => DF; LEF => EF; END IF IF( ISTAT == 0 ) ALLOCATE(WORK(2*N), STAT=ISTAT ) IF( ISTAT == 0 )THEN CALL PTSVX_F77( LFACT, N, 1, D, E, LDF, LEF, B, N, X, N, LRCOND, & LFERR, LBERR, WORK, LINFO ) ELSE; LINFO = -100; END IF IF( .NOT.PRESENT(DF) ) DEALLOCATE( LDF, LEF, STAT=ISTAT1 ) IF( PRESENT(FERR) ) FERR = LFERR IF( PRESENT(BERR) ) BERR = LBERR IF( PRESENT(RCOND) ) RCOND=LRCOND DEALLOCATE( WORK, STAT=ISTAT1 ) END IF CALL ERINFO( LINFO, SRNAME, INFO, ISTAT ) END SUBROUTINE SPTSVX1_F95