!===============================================================================
! Copyright 2005-2022 Intel Corporation.
!
! This software and the related documents are Intel copyrighted  materials,  and
! your use of  them is  governed by the  express license  under which  they were
! provided to you (License).  Unless the License provides otherwise, you may not
! use, modify, copy, publish, distribute,  disclose or transmit this software or
! the related documents without Intel's prior written permission.
!
! This software and the related documents  are provided as  is,  with no express
! or implied  warranties,  other  than those  that are  expressly stated  in the
! License.
!===============================================================================

!  Content:
!    Intel(R) oneAPI Math Kernel Library (Intel(R) oneMKL) interface for
!    preconditioners, RCI ISS and TR solvers routines
!******************************************************************************

! PARAMETERS

      INTEGER(KIND=4) TR_SUCCESS
      INTEGER(KIND=4) TR_INVALID_OPTION
      INTEGER(KIND=4) TR_OUT_OF_MEMORY
      PARAMETER (TR_SUCCESS          = 1501)
      PARAMETER (TR_INVALID_OPTION   = 1502)
      PARAMETER (TR_OUT_OF_MEMORY    = 1503)

! SUBROUTINES

      INTERFACE
       SUBROUTINE DCG(n,x,b,rci_request,ipar,dpar,tmp)
       INTEGER            n, rci_request
       DOUBLE PRECISION   x( * ), b( * ), dpar( * )
       DOUBLE PRECISION   tmp( n, * )
       INTEGER            ipar( * )
       END SUBROUTINE
      END INTERFACE

      INTERFACE
       SUBROUTINE DCG_INIT(n,x,b,rci_request,ipar,dpar,tmp)
       INTEGER            n, rci_request
       DOUBLE PRECISION   x( * ), b( * ), dpar( * )
       DOUBLE PRECISION   tmp( n, * )
       INTEGER            ipar( * )
       END SUBROUTINE
      END INTERFACE

      INTERFACE
       SUBROUTINE DCG_CHECK(n,x,b,rci_request,ipar,dpar,tmp)
       INTEGER            n, rci_request
       DOUBLE PRECISION   x( * ), b( * ), dpar( * )
       DOUBLE PRECISION   tmp( n, * )
       INTEGER            ipar( * )
       END SUBROUTINE
      END INTERFACE

      INTERFACE
       SUBROUTINE DCG_GET(n,x,b,rci_request,ipar,dpar,tmp,itercount)
       INTEGER            n, rci_request, itercount
       DOUBLE PRECISION   x( * ), b( * ), dpar( * )
       DOUBLE PRECISION   tmp( n, * )
       INTEGER            ipar( * )
       END SUBROUTINE
      END INTERFACE

      INTERFACE
       SUBROUTINE DCSRILU0(n,a,ia,ja,alu,ipar,dpar,ierr)
       INTEGER            n, ierr
       DOUBLE PRECISION   a( * ), dpar( * ), alu( * )
       INTEGER            ia( * ), ja( * ), ipar( * )
       END SUBROUTINE
      END INTERFACE

      INTERFACE
       SUBROUTINE DCSRILUT(n,a,ia,ja,alut,ialut,jalut,tol,maxfil,       &
     & ipar,dpar,ierr)
       INTEGER            n, maxfil, ierr
       DOUBLE PRECISION   tol
       DOUBLE PRECISION   a( * ), dpar( * ), alut( * )
       INTEGER            ia( * ), ja( * ), ipar( * ), ialut( * )
       INTEGER            jalut( * )
       END SUBROUTINE
      END INTERFACE

      INTERFACE
       SUBROUTINE DFGMRES(n,x,b,rci_request,ipar,dpar,tmp)
       INTEGER            n, rci_request
       DOUBLE PRECISION   x( * ), b( * ), tmp( * ), dpar( * )
       INTEGER            ipar( * )
       END SUBROUTINE
      END INTERFACE

      INTERFACE
       SUBROUTINE DFGMRES_INIT(n,x,b,rci_request,ipar,dpar,tmp)
       INTEGER            n, rci_request
       DOUBLE PRECISION   x( * ), b( * ), tmp( * ), dpar( * )
       INTEGER            ipar( * )
       END SUBROUTINE
      END INTERFACE

      INTERFACE
       SUBROUTINE DFGMRES_CHECK(n,x,b,rci_request,ipar,dpar,tmp)
       INTEGER            n, rci_request
       DOUBLE PRECISION   x( * ), b( * ), tmp( * ), dpar( * )
       INTEGER            ipar( * )
       END SUBROUTINE
      END INTERFACE

      INTERFACE
       SUBROUTINE DFGMRES_GET(n,x,b,rci_request,ipar,dpar,              &
     & tmp,itercount)
       INTEGER            n, rci_request, itercount
       DOUBLE PRECISION   x( * ), b( * ), tmp( * ), dpar( * )
       INTEGER            ipar( * )
       END SUBROUTINE
      END INTERFACE

      INTERFACE
       SUBROUTINE DCGMRHS(n,x,nRhs,b,rci_request,ipar,dpar,tmp)
       INTEGER            n, rci_request, nRhs
       DOUBLE PRECISION   x( * ), b( * ), dpar( * )
       DOUBLE PRECISION   tmp( n, * )
       INTEGER            ipar( * )
       END SUBROUTINE
      END INTERFACE

      INTERFACE
       SUBROUTINE DCGMRHS_INIT(n,x,nRhs,b,method,rci_request,           &
     & ipar,dpar,tmp)
       INTEGER            n, rci_request, nRhs, method
       DOUBLE PRECISION   x( * ), b( * ), dpar( * )
       DOUBLE PRECISION   tmp( n, * )
       INTEGER            ipar( * )
       END SUBROUTINE
      END INTERFACE

      INTERFACE
       SUBROUTINE DCGMRHS_CHECK(n,x,nRhs,b,rci_request,ipar,dpar,tmp)
       INTEGER            n, rci_request, nRhs
       DOUBLE PRECISION   x( * ), dpar( * )
       DOUBLE PRECISION   tmp( n, * ), b( nRhs, * )
       INTEGER            ipar( * )
       END SUBROUTINE
      END INTERFACE

      INTERFACE
       SUBROUTINE DCGMRHS_GET(n,x,nRhs,b,rci_request,ipar,dpar,         &
     & tmp,itercount)
       INTEGER            n, rci_request, nRhs
       DOUBLE PRECISION   x( * ), dpar( * )
       DOUBLE PRECISION   tmp( n, * ), b( nRhs, * )
       INTEGER            ipar( * ), itercount( * )
       END SUBROUTINE
      END INTERFACE

! FUNCTIONS

      INTERFACE
        INTEGER FUNCTION DTRNLSP_INIT(handle, n, m, x, eps,             &
     &  iter1, iter2, rs)
        INTEGER             n, m, iter1, iter2
        DOUBLE PRECISION    x( * ), eps( * )
        DOUBLE PRECISION    rs
        INTEGER(KIND=8)     handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION DTRNLSP_CHECK(handle, n, m, fjac, fvec,        &
     &  eps, info)
        INTEGER             n, m
        INTEGER             info( * )
        DOUBLE PRECISION    fvec( * ), eps( * )
        DOUBLE PRECISION    fjac( m, * )
        INTEGER(KIND=8)     handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION DTRNLSP_SOLVE(handle, fvec, fjac, rci_request)
        INTEGER             rci_request
        DOUBLE PRECISION    fvec( * )
        DOUBLE PRECISION    fjac( 1 , * ) ! ignore 1
        INTEGER(KIND=8)     handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION DTRNLSP_GET(handle, iter, st_cr, r1, r2)
        INTEGER             iter, st_cr
        DOUBLE PRECISION    r1, r2
        INTEGER(KIND=8)     handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION DTRNLSP_DELETE(handle)
        INTEGER(KIND=8)     handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION DTRNLSPBC_INIT(handle, n, m, x, low, up, e,    &
     &  iter1, iter2, rs)
        INTEGER                n, m, iter1, iter2
        DOUBLE PRECISION       x( * ), low( * ), up( * ), e( * )
        DOUBLE PRECISION       rs
        INTEGER(KIND=8)        handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION DTRNLSPBC_CHECK(handle, n, m, fjac, fvec,      &
     &  low, up, eps, info)
        INTEGER                n, m
        DOUBLE PRECISION       fvec( * ), low( * ), up( * )
        DOUBLE PRECISION       fjac( m, * )
        DOUBLE PRECISION       eps( * )
        INTEGER                info( * )
        INTEGER(KIND=8)        handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION DTRNLSPBC_SOLVE(handle, fjac, fvec,            &
     &  rci_request)
        INTEGER                rci_request
        DOUBLE PRECISION       fvec( * )
        DOUBLE PRECISION       fjac( 1, * ) ! ignore 1
        INTEGER(KIND=8)        handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION DTRNLSPBC_GET(handle, iter, st_cr, r1, r2)
        INTEGER                iter, st_cr
        DOUBLE PRECISION       r1, r2
        INTEGER(KIND=8)        handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION DTRNLSPBC_DELETE(handle)
        INTEGER(KIND=8)         handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION DJACOBI_INIT(handle, n, m, x, fjac, eps)
        INTEGER                    n, m
        DOUBLE PRECISION           x( * )
        DOUBLE PRECISION           fjac( m , * )
        DOUBLE PRECISION           eps
        INTEGER(KIND=8)            handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION DJACOBI_SOLVE(handle, f1, f2, rci_request)
        INTEGER                    rci_request
        DOUBLE PRECISION           f1( * ), f2( * )
        INTEGER(KIND=8)            handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION DJACOBI_DELETE(handle)
        INTEGER(KIND=8)           handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION DJACOBI(fcn, n, m, fjac, x, eps)
        INTEGER                    n, m
        DOUBLE PRECISION           eps
        DOUBLE PRECISION           x( * )
        DOUBLE PRECISION           fjac( m , * )
        INTERFACE
            SUBROUTINE fcn(m,n,x,f)
                INTEGER            n, m
                DOUBLE PRECISION   x( * ), f( * )
            END SUBROUTINE
        END INTERFACE
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION DJACOBIX(fcn, n, m, fjac, x, eps, user_data)
        USE, INTRINSIC :: ISO_C_BINDING
        INTEGER                    n, m
        DOUBLE PRECISION           eps
        DOUBLE PRECISION           x( * )
        DOUBLE PRECISION           fjac( m , * )
        INTEGER(C_INTPTR_T)        user_data
        INTERFACE
            SUBROUTINE fcn(m,n,x,f,user_data)
                USE, INTRINSIC :: ISO_C_BINDING
                INTEGER             n, m
                DOUBLE PRECISION    x( * ), f( * )
                INTEGER(C_INTPTR_T) user_data
            END SUBROUTINE
        END INTERFACE
        END FUNCTION
      END INTERFACE


      INTERFACE
        INTEGER FUNCTION STRNLSP_INIT(handle, n, m, x, eps,             &
     &  iter1, iter2, rs)
        INTEGER             n, m, iter1, iter2
        REAL                x( * ), eps( * )
        REAL                rs
        INTEGER(KIND=8)     handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION STRNLSP_CHECK(handle, n, m, fjac, fvec,        &
     &  eps, info)
        INTEGER             n, m
        INTEGER             info( * )
        REAL                fvec( * ), eps( * )
        REAL                fjac( m, * )
        INTEGER(KIND=8)     handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION STRNLSP_SOLVE(handle, fvec, fjac, rci_request)
        INTEGER             rci_request
        REAL                fvec( * )
        REAL                fjac( 1, * ) ! ignore 1
        INTEGER(KIND=8)     handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION STRNLSP_GET(handle, iter, st_cr, r1, r2)
        INTEGER             iter, st_cr
        REAL                r1, r2
        INTEGER(KIND=8)     handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION STRNLSP_DELETE(handle)
        INTEGER(KIND=8)     handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION STRNLSPBC_INIT(handle, n, m, x, low, up, e,    &
     &  iter1, iter2, rs)
        INTEGER                n, m, iter1, iter2
        REAL                   x( * ), low( * ), up( * ), e( * )
        REAL                   rs
        INTEGER(KIND=8)        handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION STRNLSPBC_CHECK(handle, n, m, fjac, fvec,      &
     &  low, up, eps, info)
        INTEGER                n, m
        REAL                   fvec( * ), low( * ), up( * )
        REAL                   fjac( m, * )
        REAL                   eps( * )
        INTEGER                info( * )
        INTEGER(KIND=8)        handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION STRNLSPBC_SOLVE(handle, fjac, fvec,            &
     &  rci_request)
        INTEGER                rci_request
        REAL                   fvec( * )
        REAL                   fjac( 1, * ) ! ignore 1
        INTEGER(KIND=8)        handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION STRNLSPBC_GET(handle, iter, st_cr, r1, r2)
        INTEGER                iter, st_cr
        REAL                   r1, r2
        INTEGER(KIND=8)        handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION STRNLSPBC_DELETE(handle)
        INTEGER(KIND=8)         handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION SJACOBI_INIT(handle, n, m, x, fjac, eps)
        INTEGER                    n, m
        REAL                       x( * )
        REAL                       fjac( m , * )
        REAL                       eps
        INTEGER(KIND=8)            handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION SJACOBI_SOLVE(handle, f1, f2, rci_request)
        INTEGER                    rci_request
        REAL                       f1( * ), f2( * )
        INTEGER(KIND=8)            handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION SJACOBI_DELETE(handle)
        INTEGER(KIND=8)            handle
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION SJACOBI(fcn, n, m, fjac, x, eps)
        INTEGER                    n, m
        REAL                       eps
        REAL                       x( * )
        REAL                       fjac( m , * )
        INTERFACE
            SUBROUTINE fcn(m,n,x,f)
                INTEGER            n, m
                REAL               x( * ), f( * )
            END SUBROUTINE
        END INTERFACE
        END FUNCTION
      END INTERFACE

      INTERFACE
        INTEGER FUNCTION SJACOBIX(fcn, n, m, fjac, x, eps, user_data)
        USE, INTRINSIC :: ISO_C_BINDING
        INTEGER                    n, m
        REAL                       eps
        REAL                       x( * )
        REAL                       fjac( m , * )
        INTEGER(C_INTPTR_T)        user_data
        INTERFACE
            SUBROUTINE fcn(m,n,x,f,user_data)
                USE, INTRINSIC :: ISO_C_BINDING
                INTEGER             n, m
                REAL                x( * ), f( * )
                INTEGER(C_INTPTR_T) user_data
            END SUBROUTINE
        END INTERFACE
        END FUNCTION
      END INTERFACE