SUBROUTINE CGERFS1_F95(A, AF, IPIV, B, X, TRANS, FERR, BERR, 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: GERFS_F77 => LA_GERFS ! .. IMPLICIT STATEMENT .. IMPLICIT NONE ! .. SCALAR ARGUMENTS .. CHARACTER(LEN=1), INTENT(IN), OPTIONAL :: TRANS INTEGER, INTENT(OUT), OPTIONAL :: INFO REAL(WP), INTENT(OUT), OPTIONAL :: FERR, BERR ! .. ARRAY ARGUMENTS .. INTEGER, INTENT(IN) :: IPIV(:) COMPLEX(WP), INTENT(IN) :: A(:,:), AF(:,:) COMPLEX(WP), INTENT(IN) :: B(:) COMPLEX(WP), INTENT(INOUT) :: X(:) ! .. PARAMETERS .. CHARACTER(LEN=8), PARAMETER :: SRNAME = 'LA_GERFS' ! .. LOCAL SCALARS .. CHARACTER(LEN=1) :: LTRANS INTEGER :: N, LINFO, ISTAT, ISTAT1, LD REAL(WP) :: LFERR, LBERR ! .. LOCAL ARRAYS .. REAL(WP), POINTER :: RWORK(:) COMPLEX(WP), POINTER :: WORK(:) ! .. INTRINSIC FUNCTIONS .. INTRINSIC MAX, PRESENT, SIZE ! .. EXECUTABLE STATEMENTS .. LINFO = 0; N = SIZE(A, 1); ISTAT = 0; LD = MAX(1,N) IF(PRESENT(TRANS))THEN; LTRANS = TRANS; ELSE; LTRANS='N'; END IF ! .. TEST THE ARGUMENTS IF( SIZE(A, 2) /= N .OR. N < 0 )THEN; LINFO = -1 ELSE IF( SIZE(AF, 1) /= N .OR. SIZE(AF, 2) /= N )THEN; LINFO = -2 ELSE IF( SIZE( IPIV ) /= N ) THEN; LINFO = -3 ELSE IF( SIZE(B) /= N ) THEN; LINFO = -4 ELSE IF( SIZE(X) /= N ) THEN; LINFO = -5 ELSE IF( .NOT.( LSAME(LTRANS,'N') .OR. LSAME(LTRANS,'T') .OR. & LSAME(LTRANS,'C') ) )THEN; LINFO = -6 ELSE IF( N > 0 )THEN ALLOCATE( WORK(2*N), RWORK(N), STAT=ISTAT ) IF( ISTAT == 0 )THEN ! .. CALL LAPACK77 ROUTINE CALL GERFS_F77( LTRANS, N, 1, A, LD, AF, LD, IPIV, & B, LD, X, LD, LFERR, LBERR, WORK, RWORK, LINFO ) IF( PRESENT(FERR) ) FERR = LFERR IF( PRESENT(BERR) ) BERR = LBERR ELSE; LINFO = -100; END IF DEALLOCATE(WORK, RWORK, STAT=ISTAT1 ) END IF CALL ERINFO( LINFO, SRNAME, INFO, ISTAT ) END SUBROUTINE CGERFS1_F95