! ****************************************************************** ! TEST_DGESVXX.F90 ! Copyright(c) HiB 2000 ! ! Created: 15.02.2018 20.41.47 ! Author : SVEIN ATLE ENGESETH ! Last change: SAE 15.02.2018 21.11.09 ! ****************************************************************** PROGRAM TEST_DGESVXX ! USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : WP => REAL64 ! USE, NON_INTRINSIC :: LAPACK95, ONLY : GESVX ! USE, NON_INTRINSIC :: DGESVXX_MODULE ! IMPLICIT NONE ! INTEGER, PARAMETER :: N = 4, NRHS = 1 ! CHARACTER (LEN = 1) :: FACT ! CHARACTER (LEN = 1) :: EQUED ! CHARACTER (LEN = 1) :: TRANS ! REAL (WP), DIMENSION(N, N) :: A ! REAL (WP), DIMENSION(N, N) :: AF ! REAL (WP), DIMENSION(N, NRHS) :: B ! REAL (WP), DIMENSION(N, NRHS) :: X ! REAL (WP), DIMENSION(N) :: R, C ! REAL (WP), DIMENSION(NRHS) :: FERR, BERR ! INTEGER, DIMENSION(N) :: IPIV ! REAL (WP) :: RCOND, PIVOT_GROWTH ! CHARACTER (LEN = 64) :: MSG = "TESTING" ! CHARACTER (LEN = 1) :: USING_GESVXX ! INTEGER :: INFO, I, ERROR_FILE ! A = 1.0_WP ! DO I = 1, N ! A(I,I) = REAL(I, KIND = WP) + 0.5_WP ! B(I,NRHS) = SUM(A(I,:)) ! END DO ! ERROR_FILE = 6 ! FACT = "E" ! Equilibrate A if necessary, then factor. ! TRANS = "N" ! USING_GESVXX = "Y" ! IF((USING_GESVXX.EQ."Y").OR.(USING_GESVXX.EQ."y").OR.(USING_GESVXX.EQ."J").OR.(USING_GESVXX.EQ."j")) THEN ! CALL GESVXX(A, B, X, AF = AF, IPIV = IPIV, FACT = FACT, TRANS = TRANS, EQUED = EQUED, R = R, C = C, & FERR = FERR, BERR = BERR, RCOND = RCOND, RPVGRW = PIVOT_GROWTH, INFO = INFO) ! ELSE ! CALL GESVX(A, B, X, AF = AF, IPIV = IPIV, FACT = FACT, TRANS = TRANS, EQUED = EQUED, R = R, C = C, & FERR = FERR, BERR = BERR, RCOND = RCOND, RPVGRW = PIVOT_GROWTH, INFO = INFO) ! ENDIF ! IF(INFO .EQ. 0) THEN ! IF(RCOND .LT. SQRT(EPSILON(RCOND))) THEN ! WRITE(ERROR_FILE, '(/, 1X, A, /)') MSG ! WRITE(ERROR_FILE, 40) (1.0_WP / RCOND) ! ENDIF ! IF(PIVOT_GROWTH .LT. 1.0E-3_WP) THEN ! WRITE(ERROR_FILE, 5) MSG, PIVOT_GROWTH ! 5 FORMAT(/, 1X, A, /, 1X, "The reciprocal pivot growth factor is:", ES12.3, /) ! ENDIF ! DO I = 1, N ! WRITE(6, 123) I, X(I,NRHS) ! END DO ! 123 FORMAT(1X,I3,5X,ES21.13) ! ELSE IF(INFO .LT. 0) THEN ! WRITE(ERROR_FILE, 10) - INFO ! 10 FORMAT(/, 1X, "Argument no.", I3, " has an illegal value.", /) ! STOP ! ELSE IF(INFO.LE.N) THEN ! WRITE(ERROR_FILE, 20) MSG ! 20 FORMAT(/, 1X, "The matrix is exactly singular.", /, 1X, A, /) ! ELSE IF(INFO .GT. N) THEN ! WRITE(ERROR_FILE, 30) MSG ! 30 FORMAT(/, 1X, "The reciprocal condition number is less than machine precision.", /, 1X, A, /) ! ENDIF ! 40 FORMAT(/, 1X, "The matrix's condition number =", ES12.2, //) ! 50 FORMAT(1X, A, I3, A, ES12.3, 5X, A, I3, A, ES12.3) ! END PROGRAM TEST_DGESVXX !