SUBROUTINE ZGTSVX1_F95(DL, D, DU, B, X, DLF, DF, DUF, DU2, & IPIV, FACT, TRANS, 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 => DP USE LA_AUXMOD, ONLY: LSAME, ERINFO USE F77_LAPACK, ONLY: GTSVX_F77 => LA_GTSVX ! .. IMPLICIT STATEMENT .. IMPLICIT NONE ! .. SCALAR ARGUMENTS .. CHARACTER(LEN=1), INTENT(IN), OPTIONAL :: TRANS, FACT INTEGER, INTENT(OUT), OPTIONAL :: INFO REAL(WP), INTENT(OUT), OPTIONAL :: RCOND, FERR, BERR ! .. ARRAY ARGUMENTS .. COMPLEX(WP), INTENT(IN) :: DL(:), D(:), DU(:), B(:) INTEGER, INTENT(INOUT), OPTIONAL, TARGET :: IPIV(:) COMPLEX(WP), INTENT(INOUT), OPTIONAL, TARGET :: DLF(:), DF(:), DUF(:), DU2(:) COMPLEX(WP), INTENT(OUT) :: X(:) ! .. PARAMETERS .. CHARACTER(LEN=8), PARAMETER :: SRNAME = 'LA_GTSVX' ! .. LOCAL SCALARS .. CHARACTER(LEN=1) :: LFACT, LTRANS INTEGER :: LINFO, N, ISTAT, ISTAT1, SIPIV, SDLF, SDF, SDUF, SDU2 REAL(WP) :: LRCOND, LFERR, LBERR ! .. LOCAL POINTERS .. INTEGER, POINTER :: LPIV(:) REAL(WP), POINTER :: RWORK(:) COMPLEX(WP), POINTER :: WORK(:), LDLF(:), LDF(:), LDUF(:), LDU2(:) ! .. 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(IPIV) )THEN; SIPIV = SIZE(IPIV); ELSE; SIPIV = N; END IF IF( PRESENT(DLF) )THEN; SDLF = SIZE(DLF); ELSE; SDLF = N-1; END IF IF( PRESENT(DF) )THEN; SDF = SIZE(DF); ELSE; SDF = N; END IF IF( PRESENT(DUF) )THEN; SDUF = SIZE(DUF); ELSE; SDUF = N-1; END IF IF( PRESENT(DU2) )THEN; SDU2 = SIZE(DU2); ELSE; SDU2 = N-2; END IF IF(PRESENT(TRANS))THEN; LTRANS = TRANS; ELSE; LTRANS='N'; END IF ! .. TEST THE ARGUMENTS IF( SIZE( DL ) /= N-1 .AND. N/=0 ) THEN; LINFO = -1 ELSE IF( N < 0 ) THEN; LINFO = -2 ELSE IF( SIZE( DU ) /= N-1 .AND. N/=0 ) THEN; LINFO = -3 ELSE IF( SIZE(B) /= N )THEN; LINFO = -4 ELSE IF( SIZE(X) /= N )THEN; LINFO = -5 ELSE IF( SDLF /= N-1 .AND. N/=0 ) THEN; LINFO = -6 ELSE IF( SDF /= N ) THEN; LINFO = -7 ELSE IF( SDUF /= N-1 .AND. N/=0 ) THEN; LINFO = -8 ELSE IF( SDU2 /= N-2 .AND. N>1 ) THEN; LINFO = -9 ELSE IF( SIPIV /= N )THEN; LINFO = -10 ELSE IF( ( .NOT. ( LSAME(LFACT,'F') .OR. LSAME(LFACT,'N') ) ) .OR. & ( LSAME(LFACT,'F') .AND. .NOT.( PRESENT(DF) .AND. PRESENT(IPIV) ) ) )THEN LINFO = -11 ELSE IF( .NOT.( LSAME(LTRANS,'N') .OR. LSAME(LTRANS,'T') .OR. & LSAME(LTRANS,'C') ) )THEN; LINFO = -12 ELSE IF ( N > 0 )THEN IF( .NOT.PRESENT(DF) ) THEN ALLOCATE( LDLF(N-1),LDF(N),LDUF(N-1),LDU2(N-2), STAT=ISTAT ) ELSE; LDLF => DLF; LDF => DF; LDUF => DUF; LDU2 => DU2; END IF IF( ISTAT == 0 )THEN IF( .NOT.PRESENT(IPIV) )THEN; ALLOCATE( LPIV(N), STAT=ISTAT ) ELSE; LPIV => IPIV; END IF END IF IF( ISTAT == 0 ) ALLOCATE( WORK(2*N), RWORK(N), STAT=ISTAT ) IF( ISTAT == 0 )THEN CALL GTSVX_F77( LFACT, LTRANS, N, 1, DL, D, DU, LDLF, LDF, LDUF, & LDU2, LPIV, B, N, X, N, LRCOND, LFERR, LBERR, & WORK, RWORK, LINFO ) ELSE; LINFO = -100; END IF IF( .NOT.PRESENT(DLF) ) DEALLOCATE( LDLF, LDF, LDUF, LDU2, STAT=ISTAT1 ) IF( .NOT.PRESENT(IPIV) ) DEALLOCATE( LPIV, STAT=ISTAT1 ) IF( PRESENT(FERR) ) FERR = LFERR IF( PRESENT(BERR) ) BERR = LBERR IF( PRESENT(RCOND) ) RCOND=LRCOND DEALLOCATE( WORK, RWORK, STAT=ISTAT1 ) END IF CALL ERINFO( LINFO, SRNAME, INFO, ISTAT ) END SUBROUTINE ZGTSVX1_F95