SUBROUTINE ZGBSV1_F95( A, B, K, IPIV, 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: ERINFO USE F77_LAPACK, ONLY: GBSV_F77 => LA_GBSV ! .. IMPLICIT STATEMENT .. IMPLICIT NONE ! .. SCALAR ARGUMENTS .. INTEGER, INTENT(IN), OPTIONAL :: K INTEGER, INTENT(OUT), OPTIONAL :: INFO ! .. ARRAY ARGUMENTS .. INTEGER, INTENT(OUT), OPTIONAL, TARGET :: IPIV(:) COMPLEX(WP), INTENT(INOUT) :: A(:,:), B(:) ! .. PARAMETERS .. CHARACTER(LEN=7), PARAMETER :: SRNAME = 'LA_GBSV' ! .. LOCAL SCALARS .. INTEGER :: LINFO, ISTAT, ISTAT1, SIPIV, LDA, N, LK, KU ! .. LOCAL POINTERS .. INTEGER, POINTER :: LPIV(:) ! .. INTRINSIC FUNCTIONS .. INTRINSIC SIZE, PRESENT ! .. EXECUTABLE STATEMENTS .. LINFO = 0; ISTAT = 0 LDA = SIZE(A,1); N = SIZE(A,2) IF( PRESENT(K) ) THEN; LK = K; ELSE; LK = (LDA-1)/3; ENDIF IF( PRESENT(IPIV) )THEN; SIPIV = SIZE(IPIV); ELSE; SIPIV = N; ENDIF ! .. TEST THE ARGUMENTS IF( LDA - 2*LK -1 < 0 .OR. LDA < 0 .OR. N < 0 ) THEN; LINFO = -1 ELSE IF( SIZE( B ) /= N ) THEN; LINFO = -2 ELSE IF( LDA - 2*LK -1 < 0 .OR. LK < 0 ) THEN; LINFO = -3 ELSE IF( SIPIV /= N )THEN; LINFO = -4 ELSE IF ( N > 0 ) THEN IF( PRESENT(IPIV) )THEN; LPIV => IPIV; ELSE ALLOCATE( LPIV(N), STAT = ISTAT ); END IF IF ( ISTAT == 0 ) THEN KU = LDA -2*LK -1 CALL GBSV_F77( N, LK, KU, 1, A, LDA, LPIV, B, N, LINFO ) ELSE LINFO = -100 END IF IF( .NOT.PRESENT(IPIV) )THEN DEALLOCATE(LPIV, STAT = ISTAT1 ) END IF END IF CALL ERINFO( LINFO, SRNAME, INFO, ISTAT ) END SUBROUTINE ZGBSV1_F95