!     ******************************************************************
!     MODULE_DGESVXX.F90
!     Copyright(c) HiB 2000
!
!     Created: 28.05.2017 00.06.50
!     Author : SVEIN ATLE ENGESETH
!     Last change: SAE 10.02.2018 15.21.04
!     ******************************************************************
      !
      MODULE DGESVXX_MODULE
      !
      USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : WP => REAL64
      !
      IMPLICIT NONE
      !
      PRIVATE
      !
      PUBLIC :: GESVXX
      !
      CONTAINS
      !
      SUBROUTINE GESVXX(A, B, X, AF, IPIV, FACT, TRANS, EQUED, R, C, FERR, BERR, RCOND, RPVGRW, INFO)
        !
        ! The argument list is identical to the argument list of GESVX.
        !
        IMPLICIT NONE
        !
        REAL (WP), DIMENSION(:, :), INTENT(INOUT) :: A
        !
        REAL (WP), DIMENSION(:, :), INTENT(INOUT) :: B
        !
        REAL (WP), DIMENSION(:, :), INTENT(INOUT) :: X
        !
        REAL (WP), DIMENSION(:, :), INTENT(INOUT) :: AF
        !
        INTEGER, DIMENSION(:), INTENT(INOUT) :: IPIV
        !
        CHARACTER (LEN = *), INTENT(IN) :: FACT
        !
        CHARACTER (LEN = *), INTENT(IN) :: TRANS
        !
        CHARACTER (LEN = *), INTENT(INOUT) :: EQUED
        !
        REAL (WP), DIMENSION(:), INTENT(INOUT) :: R, C
        !
        REAL (WP), DIMENSION(:), INTENT(INOUT) :: FERR, BERR
        !
        REAL (WP), INTENT(INOUT) :: RCOND, RPVGRW
        !
        INTEGER, INTENT(OUT) :: INFO
        !
        INTEGER :: N, NRHS, LDA, LDAF, LDB, LDX
        !
        INTEGER, PARAMETER :: NPARAMS = 3
        !
        INTEGER, PARAMETER :: N_ERR_BNDS = 3
        !
        INTEGER, DIMENSION(SIZE(A, DIM = 1)) :: IWORK
        !
        REAL (WP), DIMENSION(5 * SIZE(A, DIM = 1)) :: WORK
        !
        REAL (WP), DIMENSION(NPARAMS) :: PARAMS
        !
        REAL (WP), DIMENSION(SIZE(B, DIM = 2), N_ERR_BNDS) :: ERR_BNDS_NORM
        !
        REAL (WP), DIMENSION(SIZE(B, DIM = 2), N_ERR_BNDS) :: ERR_BNDS_COMP
        !
        INTEGER :: I
        !
        INTERFACE
          !
          SUBROUTINE DGESVXX(FACT,TRANS,N,NRHS,A,LDA,AF,LDAF,IPIV,EQUED,R,C,&
                             B,LDB,X,LDX,RCOND,RPVGRW,BERR,N_ERR_BNDS,      &
                             ERR_BNDS_NORM,ERR_BNDS_COMP,NPARAMS,PARAMS,    &
                             WORK,IWORK,INFO)
                             !
          CHARACTER          EQUED,FACT,TRANS
          INTEGER            INFO,LDA,LDAF,LDB,LDX,N,NPARAMS,NRHS,N_ERR_BNDS
          DOUBLE PRECISION   RCOND,RPVGRW
          INTEGER            IPIV(*),IWORK(*)
          DOUBLE PRECISION   A(LDA,*),AF(LDAF,*),B(LDB,*),BERR(*),C(*),     &
                             ERR_BNDS_COMP(NRHS,*),ERR_BNDS_NORM(NRHS,*),   &
                             PARAMS(*),R(*),WORK(*),X(LDX,*)
          END SUBROUTINE DGESVXX
          !
        END INTERFACE
        !
        FERR = 0.0_WP  ! Not in use.
        !
        PARAMS(1) = 1.0_WP
        !
        PARAMS(2) = 100.0_WP
        !
        PARAMS(3) = 1.0_WP
        !
        LDA = SIZE(A, DIM = 1)
        !
        LDAF = SIZE(AF, DIM = 1)
        !
        LDB = SIZE(B, DIM = 1)
        !
        NRHS = SIZE(B, DIM = 2)
        !
        LDX = SIZE(X, DIM = 1)
        !
        N = LDA
        !
        CALL DGESVXX(FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, RPVGRW, BERR, &
        N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, INFO)
        !
        IF(INFO .LT. 0) THEN
          !
          WRITE(6,40) - INFO
          !
   40     FORMAT(/,1X,"The ",I2," parameter to DGESVXX has a wrong value.",/)
          !
        ELSE IF((INFO .GT. 0) .AND. (INFO .LE. N)) THEN
          !
          WRITE(6,30) INFO, INFO
          !
   30     FORMAT(/,1X,"U(",I3,",",I3,") = 0.0",/)
          !
        ELSE IF(INFO .GT. N) THEN  ! Solution not guaranteed.
          !
          WRITE(6,10) RCOND, RPVGRW
          !
   10     FORMAT(/,1X,"Reciprocal condition number = ",ES12.3,5X,"Reciprocal pivot growth factor = ",ES12.3,/)
          !
          DO I = 1, NRHS
            !
            WRITE(6,20) ERR_BNDS_NORM(I,1), ERR_BNDS_COMP(I,1)
            !
          END DO
          !
   20     FORMAT(1X,2ES15.3)
          !
          WRITE(6,'(//)')
          !
        ENDIF
        !
      END SUBROUTINE GESVXX
      !
      END MODULE DGESVXX_MODULE
      !
