!> \file
!> \copyright 2016 The Science and Technology Facilities Council (STFC)
!> \licence   BSD licence, see LICENCE file for details
!> \author    Jonathan Hogg
module spral_ssids_cpu_subtree
  use, intrinsic :: iso_c_binding
  use spral_ssids_contrib, only : contrib_type
  use spral_ssids_cpu_iface ! fixme only
  use spral_ssids_datatypes
  use spral_ssids_inform, only : ssids_inform
  use spral_ssids_subtree, only : symbolic_subtree_base, numeric_subtree_base
  implicit none

  private
  public :: cpu_symbolic_subtree, construct_cpu_symbolic_subtree
  public :: cpu_numeric_subtree, cpu_free_contrib

  type, extends(symbolic_subtree_base) :: cpu_symbolic_subtree
     integer :: n
     type(C_PTR) :: csubtree
   contains
     procedure :: factor
     procedure :: cleanup => symbolic_cleanup
  end type cpu_symbolic_subtree

  type, extends(numeric_subtree_base) :: cpu_numeric_subtree
     logical(C_BOOL) :: posdef
     type(cpu_symbolic_subtree), pointer :: symbolic
     type(C_PTR) :: csubtree
   contains
     procedure :: get_contrib
     procedure :: solve_fwd
     procedure :: solve_diag
     procedure :: solve_diag_bwd
     procedure :: solve_bwd
     procedure :: enquire_posdef
     procedure :: enquire_indef
     procedure :: alter
     procedure :: cleanup => numeric_cleanup
  end type cpu_numeric_subtree

  interface
     type(C_PTR) function c_create_symbolic_subtree(n, sa, en, sptr, sparent, &
          rptr, rlist, nptr, nlist, ncontrib, contrib_idx, options) &
          bind(C, name="spral_ssids_cpu_create_symbolic_subtree")
       use, intrinsic :: iso_c_binding
       import :: cpu_factor_options
       implicit none
       integer(C_INT), value :: n
       integer(C_INT), value :: sa
       integer(C_INT), value :: en
       integer(C_INT), dimension(*), intent(in) :: sptr
       integer(C_INT), dimension(*), intent(in) :: sparent
       integer(C_LONG), dimension(*), intent(in) :: rptr
       integer(C_INT), dimension(*), intent(in) :: rlist
       integer(C_LONG), dimension(*), intent(in) :: nptr
       integer(C_LONG), dimension(*), intent(in) :: nlist
       integer(C_INT), value :: ncontrib
       integer(C_INT), dimension(*), intent(in) :: contrib_idx
       type(cpu_factor_options), intent(in) :: options
     end function c_create_symbolic_subtree

     subroutine c_destroy_symbolic_subtree(subtree) &
          bind(C, name="spral_ssids_cpu_destroy_symbolic_subtree")
       use, intrinsic :: iso_c_binding
       implicit none
       type(C_PTR), value :: subtree
     end subroutine c_destroy_symbolic_subtree

     type(C_PTR) function c_create_numeric_subtree(posdef, symbolic_subtree, &
          aval, scaling, child_contrib, options, stats) &
          bind(C, name="spral_ssids_cpu_create_num_subtree_dbl")
       use, intrinsic :: iso_c_binding
       import :: cpu_factor_options, cpu_factor_stats
       implicit none
       logical(C_BOOL), value :: posdef
       type(C_PTR), value :: symbolic_subtree
       real(C_DOUBLE), dimension(*), intent(in) :: aval
       type(C_PTR), value :: scaling
       type(C_PTR), dimension(*), intent(inout) :: child_contrib
       type(cpu_factor_options), intent(in) :: options
       type(cpu_factor_stats), intent(out) :: stats
     end function c_create_numeric_subtree

     subroutine c_destroy_numeric_subtree(posdef, subtree) &
          bind(C, name="spral_ssids_cpu_destroy_num_subtree_dbl")
       use, intrinsic :: iso_c_binding
       implicit none
       logical(C_BOOL), value :: posdef
       type(C_PTR), value :: subtree
     end subroutine c_destroy_numeric_subtree

     integer(C_INT) function c_subtree_solve_fwd(posdef, subtree, nrhs, x, &
          ldx) &
          bind(C, name="spral_ssids_cpu_subtree_solve_fwd_dbl")
       use, intrinsic :: iso_c_binding
       implicit none
       logical(C_BOOL), value :: posdef
       type(C_PTR), value :: subtree
       integer(C_INT), value :: nrhs
       real(C_DOUBLE), dimension(*), intent(inout) :: x
       integer(C_INT), value :: ldx
     end function c_subtree_solve_fwd

     integer(C_INT) function c_subtree_solve_diag(posdef, subtree, nrhs, x, &
          ldx) &
          bind(C, name="spral_ssids_cpu_subtree_solve_diag_dbl")
       use, intrinsic :: iso_c_binding
       implicit none
       logical(C_BOOL), value :: posdef
       type(C_PTR), value :: subtree
       integer(C_INT), value :: nrhs
       real(C_DOUBLE), dimension(*), intent(inout) :: x
       integer(C_INT), value :: ldx
     end function c_subtree_solve_diag

     integer(C_INT) function c_subtree_solve_diag_bwd(posdef, subtree, nrhs, &
          x, ldx) &
          bind(C, name="spral_ssids_cpu_subtree_solve_diag_bwd_dbl")
       use, intrinsic :: iso_c_binding
       implicit none
       logical(C_BOOL), value :: posdef
       type(C_PTR), value :: subtree
       integer(C_INT), value :: nrhs
       real(C_DOUBLE), dimension(*), intent(inout) :: x
       integer(C_INT), value :: ldx
     end function c_subtree_solve_diag_bwd

     integer(C_INT) function c_subtree_solve_bwd(posdef, subtree, nrhs, x, &
          ldx) &
          bind(C, name="spral_ssids_cpu_subtree_solve_bwd_dbl")
       use, intrinsic :: iso_c_binding
       implicit none
       logical(C_BOOL), value :: posdef
       type(C_PTR), value :: subtree
       integer(C_INT), value :: nrhs
       real(C_DOUBLE), dimension(*), intent(inout) :: x
       integer(C_INT), value :: ldx
     end function c_subtree_solve_bwd

     subroutine c_subtree_enquire(posdef, subtree, piv_order, d) &
          bind(C, name="spral_ssids_cpu_subtree_enquire_dbl")
       use, intrinsic :: iso_c_binding
       implicit none
       logical(C_BOOL), value :: posdef
       type(C_PTR), value :: subtree
       type(C_PTR), value :: piv_order
       type(C_PTR), value :: d
     end subroutine c_subtree_enquire

     subroutine c_subtree_alter(posdef, subtree, d) &
          bind(C, name="spral_ssids_cpu_subtree_alter_dbl")
       use, intrinsic :: iso_c_binding
       implicit none
       logical(C_BOOL), value :: posdef
       type(C_PTR), value :: subtree
       real(C_DOUBLE), dimension(*), intent(in) :: d
     end subroutine c_subtree_alter

     subroutine c_get_contrib(posdef, subtree, n, val, ldval, rlist, ndelay, &
          delay_perm, delay_val, lddelay) &
          bind(C, name="spral_ssids_cpu_subtree_get_contrib_dbl")
       use, intrinsic :: iso_c_binding
       implicit none
       logical(C_BOOL), value :: posdef
       type(C_PTR), value :: subtree
       integer(C_INT) :: n
       type(C_PTR) :: val
       integer(C_INT) :: ldval
       type(C_PTR) :: rlist
       integer(C_INT) :: ndelay
       type(C_PTR) :: delay_perm
       type(C_PTR) :: delay_val
       integer(C_INT) :: lddelay
     end subroutine c_get_contrib

     subroutine c_free_contrib(posdef, subtree) &
          bind(C, name="spral_ssids_cpu_subtree_free_contrib_dbl")
       use, intrinsic :: iso_c_binding
       implicit none
       logical(C_BOOL), value :: posdef
       type(C_PTR), value :: subtree
     end subroutine c_free_contrib
  end interface

contains

  function construct_cpu_symbolic_subtree(n, sa, en, sptr, sparent, rptr, &
       rlist, nptr, nlist, contrib_idx, options) result(this)
    implicit none
    class(cpu_symbolic_subtree), pointer :: this
    integer, intent(in) :: n
    integer, intent(in) :: sa
    integer, intent(in) :: en
    integer, dimension(*), target, intent(in) :: sptr
    integer, dimension(*), intent(in) :: sparent
    integer(long), dimension(*), target, intent(in) :: rptr
    integer, dimension(*), target, intent(in) :: rlist
    integer(long), dimension(*), target, intent(in) :: nptr
    integer(long), dimension(2,*), target, intent(in) :: nlist
    integer, dimension(:), intent(in) :: contrib_idx
    class(ssids_options), intent(in) :: options

    integer :: st
    type(cpu_factor_options) :: coptions

    nullify(this)

    ! Allocate output
    allocate(this, stat=st)
    if (st .ne. 0) return

    ! Store basic details
    this%n = n

    ! Call C++ subtree analyse
    call cpu_copy_options_in(options, coptions)
    this%csubtree = &
         c_create_symbolic_subtree(n, sa, en, sptr, sparent, rptr, rlist, nptr, &
         nlist, size(contrib_idx), contrib_idx, coptions)
  end function construct_cpu_symbolic_subtree

  subroutine symbolic_cleanup(this)
    implicit none
    class(cpu_symbolic_subtree), intent(inout) :: this

    call c_destroy_symbolic_subtree(this%csubtree)
  end subroutine symbolic_cleanup

  function factor(this, posdef, aval, child_contrib, options, inform, scaling)
    implicit none
    class(numeric_subtree_base), pointer :: factor
    class(cpu_symbolic_subtree), target, intent(inout) :: this
    logical, intent(in) :: posdef
    real(wp), dimension(*), target, intent(in) :: aval
    type(contrib_type), dimension(:), target, intent(inout) :: child_contrib
    type(ssids_options), intent(in) :: options
    type(ssids_inform), intent(inout) :: inform
    real(wp), dimension(*), target, optional, intent(in) :: scaling

    type(cpu_numeric_subtree), pointer :: cpu_factor
    type(cpu_factor_options) :: coptions
    type(cpu_factor_stats) :: cstats
    type(C_PTR) :: cscaling
    integer :: i
    type(C_PTR), dimension(:), allocatable :: contrib_ptr
    integer :: st

    ! Leave output as null until successful exit
    nullify(factor)

    ! Allocate cpu_factor for output
    allocate(cpu_factor, stat=st)
    if (st .ne. 0) goto 10
    cpu_factor%symbolic => this

    ! Convert child_contrib to contrib_ptr
    allocate(contrib_ptr(size(child_contrib)), stat=st)
    if (st .ne. 0) goto 10
    do i = 1, size(child_contrib)
       contrib_ptr(i) = C_LOC(child_contrib(i))
    end do

    ! Call C++ factor routine
    cpu_factor%posdef = posdef
    cscaling = C_NULL_PTR
    if (present(scaling)) cscaling = C_LOC(scaling)
    call cpu_copy_options_in(options, coptions)
    cpu_factor%csubtree = &
         c_create_numeric_subtree(cpu_factor%posdef, this%csubtree, &
         aval, cscaling, contrib_ptr, coptions, cstats)
    if (cstats%flag .lt. 0) then
       call c_destroy_numeric_subtree(cpu_factor%posdef, cpu_factor%csubtree)
       deallocate(cpu_factor, stat=st)
       inform%flag = cstats%flag
       return
    end if

    ! Extract to Fortran data structures
    call cpu_copy_stats_out(cstats, inform)

    ! Success, set result and return
    factor => cpu_factor
    return

    ! Allocation error handler
10  continue
    inform%flag = SSIDS_ERROR_ALLOCATION
    inform%stat = st
    deallocate(cpu_factor, stat=st)
    return
  end function factor

  subroutine numeric_cleanup(this)
    implicit none
    class(cpu_numeric_subtree), intent(inout) :: this

    call c_destroy_numeric_subtree(this%posdef, this%csubtree)
  end subroutine numeric_cleanup

  function get_contrib(this)
    implicit none
    type(contrib_type) :: get_contrib
    class(cpu_numeric_subtree), intent(in) :: this

    type(C_PTR) :: cval, crlist, delay_perm, delay_val

    call c_get_contrib(this%posdef, this%csubtree, get_contrib%n, cval,        &
         get_contrib%ldval, crlist, get_contrib%ndelay, delay_perm, delay_val, &
         get_contrib%lddelay)
    call c_f_pointer(cval, get_contrib%val, shape = (/ get_contrib%n**2 /))
    call c_f_pointer(crlist, get_contrib%rlist, shape = (/ get_contrib%n /))
    if (c_associated(delay_val)) then
       call c_f_pointer(delay_perm, get_contrib%delay_perm, &
            shape = (/ get_contrib%ndelay /))
       call c_f_pointer(delay_val, get_contrib%delay_val, &
            shape = (/ get_contrib%ndelay*get_contrib%lddelay /))
    else
       nullify(get_contrib%delay_perm)
       nullify(get_contrib%delay_val)
    end if
    get_contrib%owner = 0 ! cpu
    get_contrib%posdef = this%posdef
    get_contrib%owner_ptr = this%csubtree
  end function get_contrib

  subroutine solve_fwd(this, nrhs, x, ldx, inform)
    implicit none
    class(cpu_numeric_subtree), intent(inout) :: this
    integer, intent(in) :: nrhs
    real(wp), dimension(*), intent(inout) :: x
    integer, intent(in) :: ldx
    type(ssids_inform), intent(inout) :: inform

    integer(C_INT) :: flag

    flag = c_subtree_solve_fwd(this%posdef, this%csubtree, nrhs, x, ldx)
    if (flag .ne. SSIDS_SUCCESS) inform%flag = flag
  end subroutine solve_fwd

  subroutine solve_diag(this, nrhs, x, ldx, inform)
    implicit none
    class(cpu_numeric_subtree), intent(inout) :: this
    integer, intent(in) :: nrhs
    real(wp), dimension(*), intent(inout) :: x
    integer, intent(in) :: ldx
    type(ssids_inform), intent(inout) :: inform

    integer(C_INT) :: flag

    flag = c_subtree_solve_diag(this%posdef, this%csubtree, nrhs, x, ldx)
    if (flag .ne. SSIDS_SUCCESS) inform%flag = flag
  end subroutine solve_diag

  subroutine solve_diag_bwd(this, nrhs, x, ldx, inform)
    implicit none
    class(cpu_numeric_subtree), intent(inout) :: this
    integer, intent(in) :: nrhs
    real(wp), dimension(*), intent(inout) :: x
    integer, intent(in) :: ldx
    type(ssids_inform), intent(inout) :: inform

    integer(C_INT) :: flag

    flag = c_subtree_solve_diag_bwd(this%posdef, this%csubtree, nrhs, x, ldx)
    if (flag .ne. SSIDS_SUCCESS) inform%flag = flag
  end subroutine solve_diag_bwd

  subroutine solve_bwd(this, nrhs, x, ldx, inform)
    implicit none
    class(cpu_numeric_subtree), intent(inout) :: this
    integer, intent(in) :: nrhs
    real(wp), dimension(*), intent(inout) :: x
    integer, intent(in) :: ldx
    type(ssids_inform), intent(inout) :: inform

    integer(C_INT) :: flag

    flag = c_subtree_solve_bwd(this%posdef, this%csubtree, nrhs, x, ldx)
    if (flag .ne. SSIDS_SUCCESS) inform%flag = flag
  end subroutine solve_bwd

  subroutine enquire_posdef(this, d)
    implicit none
    class(cpu_numeric_subtree), intent(in) :: this
    real(wp), dimension(*), target, intent(out) :: d

    call c_subtree_enquire(this%posdef, this%csubtree, C_NULL_PTR, C_LOC(d))
  end subroutine enquire_posdef

  subroutine enquire_indef(this, piv_order, d)
    implicit none
    class(cpu_numeric_subtree), intent(in) :: this
    integer, dimension(*), target, optional, intent(out) :: piv_order
    real(wp), dimension(2,*), target, optional, intent(out) :: d

    type(C_PTR) :: dptr, poptr

    ! Setup pointers
    poptr = C_NULL_PTR
    if (present(piv_order)) poptr = C_LOC(piv_order)
    dptr = C_NULL_PTR
    if (present(d)) dptr = C_LOC(d)

    ! Call C++ routine
    call c_subtree_enquire(this%posdef, this%csubtree, poptr, dptr)
  end subroutine enquire_indef

  subroutine alter(this, d)
    implicit none
    class(cpu_numeric_subtree), target, intent(inout) :: this
    real(wp), dimension(2,*), intent(in) :: d

    call c_subtree_alter(this%posdef, this%csubtree, d)
  end subroutine alter

  subroutine cpu_free_contrib(posdef, csubtree)
    implicit none
    logical(C_BOOL), intent(in) :: posdef
    type(C_PTR), intent(inout) :: csubtree

    call c_free_contrib(posdef, csubtree)
  end subroutine cpu_free_contrib

end module spral_ssids_cpu_subtree


        SUBROUTINE MA_SC1B ( marrpt, ipt, iret )
C************************************************************************
C* MA_SC1B							        *
C*								        *
C* This subroutine decodes the groups in section 1 of the WMO FM13 or   *
C* CMAN bulletin report.  If the i(r)i(x)hVV or Nddff groups are        *
C* missing or garbled, then the report is considered invalid.  These    *
C* two groups need to be included in the report, but the other          *
C* section 1 groups may or may not be included.                         *
C*								        *
C* MA_SC1B  ( MARRPT, IPT, IRET )   	          		        *
C*							                *
C* Input parameters:						        *
C*      MARRPT          CHAR*           Report array                    *
C*	LSEC1           INTEGER         Length of section 1 in report   *
C*      ISEC1           INTEGER         Pointer to start of section 1   *
C*	IRPTDT (*)	INTEGER		Report date-time                *
C*					(YYYY, MM, DD, HH, MM)          *
C*								        *
C* Input and Output parameters:					        *
C*	IPT		INTEGER		Pointer to groups in report     *
C*								        *
C* Output parameters:						        *
C*	IRET		INTEGER		Return code		        *
C*				   	  0 = Normal return 	        *
C*                                        1 = Problems                  *
C**								        *
C* Log:								        *
C* R. Hollern/NCEP      6/96                                            *
C* D. Kidwell/NCEP	4/97	Changed interface, reorganized header   *
C*				and comments				*
C* D. Kidwell/NCEP	4/97	Added check for 0 index value           *
C* D. Kidwell/NCEP     10/97	Changed interface                       *
C************************************************************************
        INCLUDE  	'macmn.cmn'
C*
        CHARACTER*(*)   marrpt
C*
        INTEGER   	jflg (10)
C------------------------------------------------------------------------
        iret = 0
C
C*      A group should only appear once in a section.  This array will
C*      be used to flag those groups that are decoded in the section.
C
        DO i = 1, 10
            jflg ( i ) = 0
        END DO
C
C*      Decode i(r)i(x)hVV group.
C
        CALL  MA_IIHV ( marrpt, ipt, iret )
C
        IF ( iret .eq. 1 ) RETURN
C
C*      Decode the Nddff group.
C
        CALL  MA_NDDF ( marrpt, ipt, iret )
C
        IF ( iret .eq. 1 ) RETURN
C
        iend = isec1 + lsec1 - 1
        ist = ipt + 1
C
        DO WHILE ( ipt .lt. iend )
C
            ipt = ipt + 1
C
            IF ( marrpt ( ipt:ipt+1 ) .eq. ' 1' .and.
     +           jflg ( 1 ) .eq. 0 ) THEN
C
C*              Decode air temperature group.
C
                ipt   = ipt + 2
                iparm = 1
                CALL  MA_TEMP ( marrpt, iparm, ipt, jret )
                jflg ( 1 ) = 1
              ELSE IF ( marrpt ( ipt:ipt+2 ) .eq. ' 29' .and.
     +                  jflg ( 2 ) .eq. 0 ) THEN
C
C*              Decode relative humidity group.
C
                ipt = ipt + 3
                CALL  MA_RELH ( marrpt, ipt, jret )
                jflg ( 2 ) = 1
              ELSE IF ( marrpt ( ipt:ipt+1 ) .eq. ' 2' .and.
     +                  jflg ( 3 ) .eq. 0 ) THEN
C
C*              Decode dew point temperature group.
C
                ipt   = ipt + 2
                iparm = 2
                CALL  MA_TEMP ( marrpt, iparm, ipt, jret )
                jflg ( 3 ) = 1
              ELSE IF ( marrpt ( ipt:ipt+1 ) .eq. ' 3' .and.
     +                  jflg ( 4 ) .eq. 0 ) THEN
C
C*              Decode the station pressure group.
C
                iparm = 0
                ipt   = ipt + 2
                CALL  MA_PRES ( marrpt, iparm, ipt, jret )
                jflg ( 4 ) = 1
              ELSE IF ( marrpt ( ipt:ipt+1 ) .eq. ' 4' .and.
     +                  jflg ( 5 ) .eq. 0 ) THEN
C
C*              Decode the mean sea level pressure group.
C
                iparm = 1
                ipt   = ipt + 2
                CALL  MA_PRES ( marrpt, iparm, ipt, jret )
                jflg ( 5 ) = 1
              ELSE IF ( marrpt ( ipt:ipt+1 ) .eq. ' 5' .and.
     +                  jflg ( 6 ) .eq. 0 ) THEN
C
C*              Decode the station 3 hourly pressure change.
C
                ipt = ipt + 2
                CALL  MA_PRS3 ( marrpt, ipt, jret )
                jflg ( 6 ) = 1
              ELSE IF ( marrpt ( ipt:ipt+1 ) .eq. ' 6' .and.
     +                  jflg ( 7 ) .eq. 0 ) THEN
C
C*              Decode the precipitation group.
C
                ipt   = ipt + 2
                iparm = 0
                CALL  MA_PREC ( marrpt, iparm, ipt, jret )
                jflg ( 7 ) = 1
              ELSE IF ( marrpt ( ipt:ipt+1 ) .eq. ' 7' .and.
     +               jflg ( 8 ) .eq. 0 ) THEN
C
C*              Decode the present and past weather group.
C
                ipt = ipt + 2
                CALL  MA_MAWX ( marrpt, ipt, jret )
                jflg ( 8 ) = 1
              ELSE IF ( marrpt ( ipt:ipt+1 ) .eq. ' 8' .and.
     +                  jflg ( 9 ) .eq. 0 ) THEN
C
C*              Decode the cloud group.
C
                ipt = ipt + 2
                CALL  MA_CLD1 ( marrpt, ipt, jret )
                jflg ( 9 ) = 1
              ELSE IF ( marrpt ( ipt:ipt+1 ) .eq. ' 9' .and.
     +                  jflg ( 10 ) .eq. 0 ) THEN
C
C*              Decode the obs time group.
C
                ipt = ipt + 2
                CALL  MA_OBST ( marrpt, ipt, jret )
                jflg ( 10 ) = 1
            END IF
        END DO
C*
	RETURN
        END


program test_isccp_cloud_types
  USE COSP_KINDS, ONLY: wp

  ! *****************************COPYRIGHT****************************
  ! (c) British Crown Copyright 2009, the Met Office.
  ! All rights reserved.
  ! $Revision: 23 $, $Date: 2011-03-31 07:41:37 -0600 (Thu, 31 Mar 2011) $
  ! $URL: https://cfmip-obs-sim.googlecode.com/svn/devel/branches/dustinswales/icarus-scops-4.1-bsd/test_isccp_cloud_types.f $
  !
  ! Redistribution and use in source and binary forms, with or without
  ! modification, are permitted provided that the
  ! following conditions are met:
  !
  !     * Redistributions of source code must retain the above
  !       copyright  notice, this list of conditions and the following
  !       disclaimer.
  !     * Redistributions in binary form must reproduce the above
  !       copyright notice, this list of conditions and the following
  !       disclaimer in the documentation and/or other materials
  !       provided with the distribution.
  !     * Neither the name of the Met Office nor the names of its
  !       contributors may be used to endorse or promote products
  !       derived from this software without specific prior written
  !       permission.
  !
  ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  ! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  ! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
  ! A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
  ! OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  ! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  ! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  ! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  ! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  ! (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  ! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  !
  ! *****************************COPYRIGHT*******************************
  ! *****************************COPYRIGHT*******************************
  ! *****************************COPYRIGHT*******************************
  implicit none
  real(wp),parameter :: emsfc_lw = 0.99     ! LW emissivity of surface at 10.5 microns
  integer, parameter :: npoints  = 24,    & ! Number of model points in horizontal.
			nlev     = 6,     & ! Number of model levels.
                        ncol     = 40,    & ! Number of columns grid box is divided into.
                        ntau     = 7,     &
                        npres    = 7
  integer                                :: i,j,k,itau,top_height,top_height_direction, &
    					    overlap,ibox,debug,debugcol,ncolprint
  integer, dimension(npoints)            :: seed,sunlit
  real(wp)                                   :: lastboxptop
  real(wp),    dimension(npoints)            :: skt,totalcldarea,meantaucld,meanalbedocld, &
                                            meanptop,meantb,meantbclr
  real(wp),    dimension(npoints,nlev)       :: pfull,at,qv,cc,conv,dtau_s,dtau_c,dem_s,dem_c
  real(wp),    dimension(npoints,nlev+1)     :: phalf
  real(wp),    dimension(npoints,ncol)       :: boxtau,boxptop,tb
  real(wp),    dimension(npoints,ntau,npres) :: fq_isccp
  real(wp),    dimension(npoints,ncol,nlev)  :: frac_out

  ! Get user supplied configuration
  write(6,*) 'Please enter top_height: '
  write(6,*) ' 1 = adjusted top IR+VIS '
  write(6,*) ' 2 = real top '
  write(6,*) ' 3 = adjusted top IR only'
  read(5,*) top_height
  write(6,'(i2)') top_height
  write(6,*) 'Please enter overlap type (1=max,2=rand,3=max/rand)'
  read(5,*) overlap
  write(6,'(i2)') overlap
  write(6,*) 'Please enter top_height_direction (1=original method,2=new method)'
  read(5,*) top_height_direction
  write(6,'(i2)') top_height_direction

  ncolprint=0
  do j=1,npoints

     ! Open sample data files
     open(1,file='data/input/input.data',form='formatted')
     open(2,file='data/input/input.data.halved',form='formatted')

     if (j .lt. 13) then
        sunlit(j)=1
     else
        sunlit(j)=0
     endif

     k=mod(j-1,12) + 1
     if (k.eq.2) then
        read(1,*) skt(j)
        read(2,*) skt(j)
     else
        read(2,*) skt(j)
        read(1,*) skt(j)
     endif
     !        write(6,'(12X,3(f12.3,4X))') skt(j)

     if (k.eq.3) then
        read(1,*) (pfull(j,i),i=1,nlev)
        read(2,*) (pfull(j,i),i=1,nlev)
     else
        read(2,*) (pfull(j,i),i=1,nlev)
        read(1,*) (pfull(j,i),i=1,nlev)
     endif
     !        write(6,'(12X,3(f12.3,4X))') (pfull(j,i),i=1,nlev)

     if (k.eq.4) then
        read(1,*) (at(j,i),i=1,nlev)
        read(2,*) (at(j,i),i=1,nlev)
     else
        read(2,*) (at(j,i),i=1,nlev)
        read(1,*) (at(j,i),i=1,nlev)
     endif
     !        write(6,'(12X,3(f12.3,4X))') (at(j,i),i=1,nlev)

     if (k.eq.5) then
        read(1,*) (qv(j,i),i=1,nlev)
        read(2,*) (qv(j,i),i=1,nlev)
     else
        read(2,*) (qv(j,i),i=1,nlev)
        read(1,*) (qv(j,i),i=1,nlev)
     endif
     !        write(6,'(12X,3(f12.3,4X))') (qv(j,i),i=1,nlev)

     if (k.eq.6) then
        read(1,*) (cc(j,i),i=1,nlev)
        read(2,*) (cc(j,i),i=1,nlev)
     else
        read(2,*) (cc(j,i),i=1,nlev)
        read(1,*) (cc(j,i),i=1,nlev)
     endif
     !        write(6,'(12X,3(f12.3,4X))') (cc(j,i),i=1,nlev)

     if (k.eq.7) then
        read(1,*) (conv(j,i),i=1,nlev)
        read(2,*) (conv(j,i),i=1,nlev)
     else
        read(2,*) (conv(j,i),i=1,nlev)
        read(1,*) (conv(j,i),i=1,nlev)
     endif
     !        write(6,'(12X,3(f12.3,4X))') (conv(j,i),i=1,nlev)

     if (k.eq.8) then
        read(1,*) (dtau_s(j,i),i=1,nlev)
        read(2,*) (dtau_s(j,i),i=1,nlev)
     else
        read(2,*) (dtau_s(j,i),i=1,nlev)
        read(1,*) (dtau_s(j,i),i=1,nlev)
     endif
     !        write(6,'(12X,3(f12.3,4X))') (dtau_s(j,i),i=1,nlev)

     if (k.eq.9) then
        read(1,*) (dtau_c(j,i),i=1,nlev)
        read(2,*) (dtau_c(j,i),i=1,nlev)
     else
        read(2,*) (dtau_c(j,i),i=1,nlev)
        read(1,*) (dtau_c(j,i),i=1,nlev)
     endif
     !        write(6,'(12X,3(f12.3,4X))') (dtau_c(j,i),i=1,nlev)

     if (k.eq.10) then
        read(1,*) (dem_s(j,i),i=1,nlev)
        read(2,*) (dem_s(j,i),i=1,nlev)
     else
        read(2,*) (dem_s(j,i),i=1,nlev)
        read(1,*) (dem_s(j,i),i=1,nlev)
     endif
     !        write(6,'(12X,3(f12.3,4X))') (dem_s(j,i),i=1,nlev)

     if (k.eq.11) then
        read(1,*) (dem_c(j,i),i=1,nlev)
        read(2,*) (dem_c(j,i),i=1,nlev)
     else
        read(2,*) (dem_c(j,i),i=1,nlev)
        read(1,*) (dem_c(j,i),i=1,nlev)
     endif
     !        write(6,'(12X,3(f12.3,4X))') (dem_c(j,i),i=1,nlev)

     if (k.eq.12) then
        read(1,*) (phalf(j,i),i=1,nlev+1)
        read(2,*) (phalf(j,i),i=1,nlev+1)
     else
        read(2,*) (phalf(j,i),i=1,nlev+1)
        read(1,*) (phalf(j,i),i=1,nlev+1)
     endif
     !        write(6,'(12X,3(f12.3,4X))') (phalf(j,i),i=1,nlev+1)

     ! Close files
     close(1)
     close(2)

     seed(j)=50  ! Note you want this to vary in a GCM - see the README file
  enddo

  debug=1     !  These should be zero when running for real
  debugcol=1  !  1 is required in the test suite, but you might want
              !  something like 1000 if debugging in a GCM

  call ISCCP_CLOUD_TYPES(debug, debugcol, npoints, sunlit, nlev, ncol, seed, pfull, &
                         phalf, qv, cc, conv, dtau_s, dtau_c, top_height,           &
                         top_height_direction, overlap, frac_out, skt, emsfc_lw,    &
                         at, dem_s, dem_c, fq_isccp, totalcldarea, meanptop,        &
                         meantaucld, meanalbedocld, meantb, meantbclr, boxtau, boxptop)
  write(6,*) 'START'
  do j=1,npoints
     write (6,'(a5)') "j="
     write (6,'(I3)') j
     write(6,'(12X,3(f12.3,4X))') skt(j)
     write(6,'(12X,3(f12.3,4X))') (pfull(j,i),i=1,nlev)
     write(6,'(12X,3(f12.3,4X))') (at(j,i),i=1,nlev)
     write(6,'(12X,3(f12.3,4X))') (qv(j,i),i=1,nlev)
     write(6,'(12X,3(f12.3,4X))') (cc(j,i),i=1,nlev)
     write(6,'(12X,3(f12.3,4X))') (conv(j,i),i=1,nlev)
     write(6,'(12X,3(f12.3,4X))') (dtau_s(j,i),i=1,nlev)
     write(6,'(12X,3(f12.3,4X))') (dtau_c(j,i),i=1,nlev)
     write(6,'(12X,3(f12.3,4X))') (dem_s(j,i),i=1,nlev)
     write(6,'(12X,3(f12.3,4X))') (dem_c(j,i),i=1,nlev)
     write(6,'(12X,3(f12.3,4X))') (phalf(j,i),i=1,nlev+1)

     ! Print results
     if (top_height .eq. 1) then
        print *, '      ISCCP PCTAU DIAGRAM WITH IR-VIS CLOUD TOP HEIGHT ADJUSTMENT'
     else if (top_height .eq. 2) then
        print *, '      ISCCP PCTAU DIAGRAM WITHOUT CLOUD TOP HEIGHT ADJUSTMENT'
     else if (top_height .eq. 3) then
        print *, '      ISCCP PCTAU DIAGRAM WITH IR ONLY CLOUD TOP HEIGHT ADJUSTMENT'
     end if
     print *, ' '
     print *, '                            TAU '
     print *, ' '
     print *, '              taumin    1.3     3.6     9.4     23.     60.'
     print *, ' '
     if (totalcldarea(j) .ge. 0.) then
        print *, '     50 '
        write(6,'(12X,7(f12.3,4X))') (fq_isccp(j,itau,1),itau=1,7)
        print *, '    180 '
        write(6,'(12X,7(f12.3,4X))') (fq_isccp(j,itau,2),itau=1,7)
        print *, '    310 '
        write(6,'(12X,7(f12.3,4X))') (fq_isccp(j,itau,3),itau=1,7)
        print *, 'PC  440 '
        write(6,'(12X,7(f12.3,4X))') (fq_isccp(j,itau,4),itau=1,7)
        print *, '    560 '
        write(6,'(12X,7(f12.3,4X))') (fq_isccp(j,itau,5),itau=1,7)
        print *, '    680 '
        write(6,'(12X,7(f12.3,4X))') (fq_isccp(j,itau,6),itau=1,7)
        print *, '    800 '
        write(6,'(12X,7(f12.3,4X))') (fq_isccp(j,itau,7),itau=1,7)
        print *, '    sfc '
        print *, ' '
     else
        print *, '     50 '
        write(6,'(12X,7(e12.3,4X))') (fq_isccp(j,itau,1),itau=1,7)
        print *, '    180 '
        write(6,'(12X,7(e12.3,4X))') (fq_isccp(j,itau,2),itau=1,7)
        print *, '    310 '
        write(6,'(12X,7(e12.3,4X))') (fq_isccp(j,itau,3),itau=1,7)
        print *, 'PC  440 '
        write(6,'(12X,7(e12.3,4X))') (fq_isccp(j,itau,4),itau=1,7)
        print *, '    560 '
        write(6,'(12X,7(e12.3,4X))') (fq_isccp(j,itau,5),itau=1,7)
        print *, '    680 '
        write(6,'(12X,7(e12.3,4X))') (fq_isccp(j,itau,6),itau=1,7)
        print *, '    800 '
        write(6,'(12X,7(e12.3,4X))') (fq_isccp(j,itau,7),itau=1,7)
        print *, '    sfc '
        print *, ' '
     endif
     if (top_height .ne. 2. .and. top_height_direction .eq. 1) then
        print *, 'TOP HEIGHT IDENTIFIED AS LOWEST ALTITUDE OR HIGHEST'
        print *, 'PRESSURE WITH MATCHING CLOUD TOP TEMPERATURE'
     end if
     if (top_height .ne. 2. .and. top_height_direction .eq. 2) then
        print *, 'TOP HEIGHT IDENTIFIED AS HIGHEST ALTITUDE OR LOWEST'
        print *, 'PRESSURE WITH MATCHING CLOUD TOP TEMPERATURE'
     end if
     print *, ' '
     print *, ' '
     if (totalcldarea(j) .ge. 0.) then
        write (6,'(a,f10.3)') 'totalcldarea = ', totalcldarea(j)
     else
        write (6,'(a,e10.3)') 'totalcldarea = ', totalcldarea(j)
     end if
     if (totalcldarea(j) .gt. 0.) then
        write (6,'(a,f10.3)') 'meanptop     = ', meanptop(j)
        write (6,'(a,f10.3)') 'meantaucld   = ', meantaucld(j)
        write (6,'(a,f10.3)') 'meanalbedocld   = ', meanalbedocld(j)
     else
        write (6,'(a,e10.3)') 'meanptop     = ', meanptop(j)
        write (6,'(a,e10.3)') 'meantaucld   = ', meantaucld(j)
        write (6,'(a,e10.3)') 'meanalbedocld   = ', meanalbedocld(j)
     end if
     if (top_height .ne. 2.) then
        write (6,'(a,f10.3)') 'meantb = ', meantb(j)
        write (6,'(a,f10.3)') 'meantbclr = ', meantbclr(j)
     end if
     print *, '  box #         ptop           tau  '
     print *, ' -------       -------       -------'

     lastboxptop=-1
     do ibox = 1, ncol
        if (boxptop(j,ibox) .ne. lastboxptop) then
           if (boxptop(j,ibox) .gt. 0. .or. boxtau(j,ibox) .gt. 0.) then
              write(6,'(2X,i4,a,9X,f7.2,7X,f7.1)') ibox,' - ',boxptop(j,ibox),boxtau(j,ibox)
           else
              write(6,'(2X,i4,a,9X,e10.3,7X,e10.3)') ibox,' - ',boxptop(j,ibox),boxtau(j,ibox)
           end if
        end if
        lastboxptop=boxptop(j,ibox)
     enddo
     print *, ' '
     print *, ' '
     print *, ' '
  enddo

  ! END PROGRAM
end program test_isccp_cloud_types


 module module_cam_mam_drydep

 contains

 subroutine cam_mam_drydep_driver( &
  id, curr_secs, ktau, dtstep, config_flags, &
  gmt, julday, &
  t_phy, rho_phy, p_phy, &
  ust, aer_res, &
  moist, chem, ddvel, &
  ids,ide, jds,jde, kds,kde, &
  ims,ime, jms,jme, kms,kme, &
  its,ite, jts,jte, kts,kte )

 use module_configure, only: grid_config_rec_type, num_moist, num_chem
 use module_state_description, only: param_first_scalar

 USE modal_aero_data, only: ntot_amode_cam_mam => ntot_amode
 USE module_data_cam_mam_asect, only: ai_phase, &
     massptr_aer, maxd_aphase, maxd_asize, maxd_atype, &
     ncomp_aer, nphase_aer, nsize_aer, ntype_aer, numptr_aer, &
     waterptr_aer

 implicit none

 integer, intent(in) :: &
  id, ktau, julday

 integer, intent(in) :: &
  ids, ide, jds, jde, kds, kde, &
  ims, ime, jms, jme, kms, kme, &
  its, ite, jts, jte, kts, kte

    real(kind=8), intent(in) :: curr_secs

 real, intent(in) :: dtstep, gmt

 real, intent(in), &
  dimension( ims:ime, kms:kme, jms:jme ) :: &
  t_phy, rho_phy, p_phy

 real, intent(in), &
  dimension( ims:ime, jms:jme ) :: &
  ust

 real, intent(in), &
  dimension( its:ite, jts:jte ) :: &
  aer_res

 real, intent(in), &
  dimension( ims:ime, kms:kme, jms:jme, 1:num_moist ) :: &
  moist

 real, intent(inout), &
  dimension( ims:ime, kms:kme, jms:jme, 1:num_chem ) :: &
  chem

 real, intent(inout), &
  dimension( its:ite, jts:jte, 1:num_chem ) :: &
  ddvel

 type(grid_config_rec_type), intent(in) :: config_flags

 integer idum, jdum
 integer i, j
 integer iphase, itype
 integer ktmaps, ktmape
 integer ll, l1, n
 integer levdbg_err, levdbg_info

 integer idiagaa_dum, ijcount_dum

 real dum
 real vdep_aer(maxd_asize,maxd_atype,maxd_aphase)

 character*100 msg

main_j_loop: &
 do j = jts, jte
main_i_loop: &
 do i = its, ite

 idiagaa_dum = 1
 idiagaa_dum = 0
 if ((j.ne.jts) .and. (j.ne.jte) .and. &
   (j.ne.(jts+jte)/2)) idiagaa_dum = 0
 if ((i.ne.its) .and. (i.ne.ite) .and. &
   (i.ne.(its+ite)/2)) idiagaa_dum = 0

 vdep_aer(:,:,:) = 0.0

 do iphase = 1, nphase_aer
 do itype = 1, ntype_aer
 do n = 1, nsize_aer(itype)
     do ll = -1, ncomp_aer(itype)
  if (ll .eq. -1) then
             l1 = numptr_aer(n,itype,iphase)
  else if (ll .eq. 0) then
      l1 = -1
      if (iphase .eq. ai_phase) l1 = waterptr_aer(n,itype)
  else
      l1 = massptr_aer(ll,n,itype,iphase)
  end if
  if ((l1 .ge. param_first_scalar) .and. (l1 .le. num_chem)) then
      ddvel(i,j,l1) = vdep_aer(n,itype,iphase)
  end if
     end do
 end do
 end do
 end do

 end do main_i_loop
 end do main_j_loop

 return
 end subroutine cam_mam_drydep_driver

 end module module_cam_mam_drydep


!-----------------------------------------------------------------------
!     Subroutine:    stellopt_coiloptpp
!     Authors:       S. Lazerson (lazerson@pppl.gov)
!     Date:          01/19/15
!     Description:   This subroutine is called to invoke the
!                    coilopt++ code.
!-----------------------------------------------------------------------
      SUBROUTINE stellopt_coiloptpp(file_str,lscreen)
!-----------------------------------------------------------------------
!     Libraries
!-----------------------------------------------------------------------
      USE stellopt_runtime
      USE stellopt_input_mod
      USE stellopt_vars
      USE iso_c_binding
      USE neswrite, ONLY: coil_separation
      USE mpi_params
      USE mpi_inc

!-----------------------------------------------------------------------
!     Subroutine Parameters
!----------------------------------------------------------------------
      IMPLICIT NONE
      CHARACTER(256), INTENT(inout)    :: file_str
      LOGICAL, INTENT(inout)        :: lscreen
!DEC$ IF DEFINED (COILOPTPP)
      INCLUDE 'coilopt_f.h'
!DEC$ ENDIF
!-----------------------------------------------------------------------
!     Local Variables
!        iverb         Coilopt++ screen control
!        istat         Error status
!        iunit         File unit number
!----------------------------------------------------------------------
      LOGICAL :: lexists
      INTEGER :: iverb, istat, nu, nv, iunit, m, n, &
                 ivmec, ispline_file
      CHARACTER(8)   :: temp_str
      CHARACTER(256) :: copt_fext

!----------------------------------------------------------------------
!     BEGIN SUBROUTINE
!----------------------------------------------------------------------
!DEC$ IF DEFINED(COILOPTPP)
      ! reset the params file
      copt_fext = 'coilopt_params'//CHAR(0)
      CALL init_settings(MPI_COMM_MYWORLD,copt_fext)
      ! initialize
      iverb = 0
      ivmec = 0
      ispline_file = 0
      copt_fext = 'coilopt_params.'//TRIM(file_str)
      ! Have master run bnorm
      coil_separation = 0.33;
      IF (myworkid == master) THEN
         IF (lscreen) WRITE(6,'(a)') ' ---------------------------  COILOPT++ OPTIMIZATION  -------------------------'
         ! Run BNORM code
         call stellopt_bnorm(file_str,lscreen)
         ! Turn on screen output
         IF (lscreen) iverb = 1
      END IF
      CALL MPI_BCAST(iverb,1,MPI_INTEGER, master, MPI_COMM_MYWORLD,ierr_mpi)
      IF (ierr_mpi /= MPI_SUCCESS) CALL handle_err(MPI_ERR,'stellopt_coiloptpp1',ierr_mpi)
      ! Update file names
      INQUIRE(FILE='wout_'//TRIM(file_str)//'.nc',EXIST=lexists)
      IF (lexists) ivmec = 1
      DO m = 0, numws-1
          ispline_file = 0
          WRITE(temp_str,'(I3.3)') m
          INQUIRE(FILE='coil_spline'//TRIM(temp_str)//'_reset_file.out',EXIST=lexists)
          IF (lexists) ispline_file = 1
      END DO
      CALL coilopt_update_parameters(nu,nv,ivmec,ispline_file,iverb,TRIM(file_str))
      CALL MPI_BARRIER(MPI_COMM_MYWORLD,ierr_mpi)
      IF (ierr_mpi /= MPI_SUCCESS) CALL handle_err(MPI_ERR,'stellopt_coiloptpp2',ierr_mpi)
      ! Output the file
      CALL coilopt_writeparams(MPI_COMM_MYWORLD,TRIM(copt_fext))
      ! Run init
      CALL MPI_BARRIER(MPI_COMM_MYWORLD,ierr_mpi)
      IF (ierr_mpi /= MPI_SUCCESS) CALL handle_err(MPI_ERR,'stellopt_coiloptpp3',ierr_mpi)
      IF (lscreen) WRITE(6,"(A)") '   - Initializing COILOPT++ '
      CALL coilopt_init(MPI_COMM_MYWORLD,TRIM(copt_fext))
      ! Run Coilopt++
      IF (lscreen) WRITE(6,"(A)") '   - Executing COILOPT++ '
      CALL coilopt_run(MPI_COMM_MYWORLD,iverb,TRIM(file_str))
      ! Write Output
      CALL coilopt_writeoutput(MPI_COMM_MYWORLD,TRIM(file_str))
      CALL MPI_BARRIER(MPI_COMM_MYWORLD,ierr_mpi)
      IF (lscreen) WRITE(6,'(a)') ' ---------------------------      COILOPT++ DONE      -------------------------'
!DEC$ ENDIF
      RETURN
!----------------------------------------------------------------------
!     END SUBROUTINE
!----------------------------------------------------------------------
      END SUBROUTINE stellopt_coiloptpp


!===============================================================================
! Copyright 2014-2016 Intel Corporation All Rights Reserved.
!
! The source code,  information  and material  ("Material") contained  herein is
! owned by Intel Corporation or its  suppliers or licensors,  and  title to such
! Material remains with Intel  Corporation or its  suppliers or  licensors.  The
! Material  contains  proprietary  information  of  Intel or  its suppliers  and
! licensors.  The Material is protected by  worldwide copyright  laws and treaty
! provisions.  No part  of  the  Material   may  be  used,  copied,  reproduced,
! modified, published,  uploaded, posted, transmitted,  distributed or disclosed
! in any way without Intel's prior express written permission.  No license under
! any patent,  copyright or other  intellectual property rights  in the Material
! is granted to  or  conferred  upon  you,  either   expressly,  by implication,
! inducement,  estoppel  or  otherwise.  Any  license   under such  intellectual
! property rights must be express and approved by Intel in writing.
!
! Unless otherwise agreed by Intel in writing,  you may not remove or alter this
! notice or  any  other  notice   embedded  in  Materials  by  Intel  or Intel's
! suppliers or licensors in any way.
!===============================================================================

!
!   This file contains preliminary version of new SpBLAS API which supports
!   two-step execution (inspector-executor) model.
!
!*******************************************************************************

!*******************************************************************************
!*********************************** Basic types and constants *****************
!*******************************************************************************

    MODULE MKL_SPBLAS

    USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INTPTR_T, C_INT

!   status of the routines
    ENUM, BIND(C)
        ENUMERATOR :: SPARSE_STATUS_SUCCESS               = 0,  &  !
                      SPARSE_STATUS_NOT_INITIALIZED       = 1,  &  ! empty handle or matrix arrays
                      SPARSE_STATUS_ALLOC_FAILED          = 2,  &  ! internal error: memory allocation failed
                      SPARSE_STATUS_INVALID_VALUE         = 3,  &  ! invalid input value
                      SPARSE_STATUS_EXECUTION_FAILED      = 4,  &  ! e.g. 0-diagonal element for triangular solver, etc
                      SPARSE_STATUS_INTERNAL_ERROR        = 5,  &  !
                      SPARSE_STATUS_NOT_SUPPORTED         = 6      ! e.g. operation for double precision don't support other types
    END ENUM

!   sparse matrix operations
    ENUM, BIND(C)
        ENUMERATOR :: SPARSE_OPERATION_NON_TRANSPOSE      = 10, &  !
                      SPARSE_OPERATION_TRANSPOSE          = 11, &  !
                      SPARSE_OPERATION_CONJUGATE_TRANSPOSE= 12     !
    END ENUM

!   supported matrix types
    ENUM, BIND(C)
        ENUMERATOR :: SPARSE_MATRIX_TYPE_GENERAL          = 20, &  ! general case
                      SPARSE_MATRIX_TYPE_SYMMETRIC        = 21, &  ! triangular part of
                      SPARSE_MATRIX_TYPE_HERMITIAN        = 22, &  ! the matrix is to be processed
                      SPARSE_MATRIX_TYPE_TRIANGULAR       = 23, &  !
                      SPARSE_MATRIX_TYPE_DIAGONAL         = 24     ! diagonal matrix; only diagonal elements should be processed
    END ENUM

!   sparse matrix indexing: C-style or Fortran-style
    ENUM, BIND(C)
        ENUMERATOR :: SPARSE_INDEX_BASE_ZERO              = 0,  &  ! C-style
                      SPARSE_INDEX_BASE_ONE               = 1      ! Fortran-style
    END ENUM

!   makes sense for triangular matrices only
!       ( SPARSE_MATRIX_TYPE_SYMMETRIC, SPARSE_MATRIX_TYPE_HERMITIAN, SPARSE_MATRIX_TYPE_TRIANGULAR )
    ENUM, BIND(C)
        ENUMERATOR :: SPARSE_FILL_MODE_LOWER              = 40, &  ! lower triangular part of the matrix is stored
                      SPARSE_FILL_MODE_UPPER              = 41     ! upper triangular part of the matrix is stored
    END ENUM

!   makes sense for triangular matrices only
!       ( SPARSE_MATRIX_TYPE_SYMMETRIC, SPARSE_MATRIX_TYPE_HERMITIAN, SPARSE_MATRIX_TYPE_TRIANGULAR )
    ENUM, BIND(C)
        ENUMERATOR :: SPARSE_DIAG_NON_UNIT                = 50, &  ! triangular matrix with non-unit diagonal
                      SPARSE_DIAG_UNIT                    = 51     ! triangular matrix with unit     diagonal
    END ENUM

!   applicable for Level 3 operations with dense matrices; describes storage scheme for dense matrix (row major or column major)
    ENUM, BIND(C)
        ENUMERATOR :: SPARSE_LAYOUT_ROW_MAJOR             = 60, &  ! C-style
                      SPARSE_LAYOUT_COLUMN_MAJOR          = 61     ! Fortran-style
    END ENUM

!   verbose mode; if verbose mode activated, handle should collect and report profiling / optimization info
    ENUM, BIND(C)
        ENUMERATOR :: SPARSE_VERBOSE_OFF                  = 70, &  !
                      SPARSE_VERBOSE_BASIC                = 71, &  ! report high-level info about optimization algorithms, issues, etc.
                      SPARSE_VERBOSE_EXTENDED             = 72     ! provide detailed information
    END ENUM

!   memory optimization hints from customer: describe how much memory could be used on optimization stage
    ENUM, BIND(C)
        ENUMERATOR :: SPARSE_MEMORY_NONE                  = 80, &  ! no memory should be allocated for matrix values and structures
                                                                   ! auxiliary structures could be created only for workload balancing,
                                                                   ! parallelization, etc.
                      PARSE_MEMORY_AGGRESSIVE             = 81     ! matrix could be converted to any internal format
    END ENUM

!*************************************************************************************************
!*** Opaque structure for sparse matrix in internal format, further D - means double precision ***
!*************************************************************************************************

!    struct  sparse_matrix;
!    typedef struct sparse_matrix *sparse_matrix_t;

    TYPE, BIND(C) :: SPARSE_MATRIX_T
        INTEGER(C_INTPTR_T) :: PTR
    END TYPE SPARSE_MATRIX_T

!   descriptor of main sparse matrix properties
    TYPE, BIND(C) :: MATRIX_DESCR
        INTEGER(C_INT) :: TYPE
        INTEGER(C_INT) :: MODE
        INTEGER(C_INT) :: DIAG
    END TYPE MATRIX_DESCR

!*****************************************************************************************
!*************************************** Creation routines *******************************
!*****************************************************************************************

    INTERFACE

!   Matrix handle is used for storing information about the matrix and matrix values

!   Create matrix from one of the existing sparse formats, just create the handle with matrix info and copy matrix values if
!   requested
!   Collect high-level info about the matrix. Need to use this interface for the case with several calls in program for
!   performance reasons, where optimizations are not required

!   coordinate format,
!   SPARSE_MATRIX_TYPE_GENERAL by default, pointers to input arrays are stored in the handle
        FUNCTION MKL_SPARSE_S_CREATE_COO(A,indexing,rows,cols,nnz,row_indx,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_S_CREATE_COO')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT), INTENT(IN) :: indexing
            INTEGER, INTENT(IN) :: rows
            INTEGER, INTENT(IN) :: cols
            INTEGER, INTENT(IN) :: nnz
            INTEGER, INTENT(IN), DIMENSION(*) :: row_indx
            INTEGER, INTENT(IN), DIMENSION(*) :: col_indx
            REAL(C_FLOAT), INTENT(IN), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_S_CREATE_COO
        END FUNCTION
        FUNCTION MKL_SPARSE_D_CREATE_COO(A,indexing,rows,cols,nnz,row_indx,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_D_CREATE_COO')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT), INTENT(IN) :: indexing
            INTEGER, INTENT(IN) :: rows
            INTEGER, INTENT(IN) :: cols
            INTEGER, INTENT(IN) :: nnz
            INTEGER, INTENT(IN), DIMENSION(*) :: row_indx
            INTEGER, INTENT(IN), DIMENSION(*) :: col_indx
            REAL(C_DOUBLE), INTENT(IN), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_D_CREATE_COO
        END FUNCTION
        FUNCTION MKL_SPARSE_C_CREATE_COO(A,indexing,rows,cols,nnz,row_indx,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_C_CREATE_COO')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT_COMPLEX
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT), INTENT(IN) :: indexing
            INTEGER, INTENT(IN) :: rows
            INTEGER, INTENT(IN) :: cols
            INTEGER, INTENT(IN) :: nnz
            INTEGER, INTENT(IN), DIMENSION(*) :: row_indx
            INTEGER, INTENT(IN), DIMENSION(*) :: col_indx
            COMPLEX(C_FLOAT_COMPLEX), INTENT(IN), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_C_CREATE_COO
        END FUNCTION
        FUNCTION MKL_SPARSE_Z_CREATE_COO(A,indexing,rows,cols,nnz,row_indx,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_Z_CREATE_COO')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE_COMPLEX
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT), INTENT(IN) :: indexing
            INTEGER, INTENT(IN) :: rows
            INTEGER, INTENT(IN) :: cols
            INTEGER, INTENT(IN) :: nnz
            INTEGER, INTENT(IN), DIMENSION(*) :: row_indx
            INTEGER, INTENT(IN), DIMENSION(*) :: col_indx
            COMPLEX(C_DOUBLE_COMPLEX), INTENT(IN), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_Z_CREATE_COO
        END FUNCTION

!   compressed sparse row format (4-arrays version),
!   SPARSE_MATRIX_TYPE_GENERAL by default, pointers to input arrays are stored in the handle
        FUNCTION MKL_SPARSE_S_CREATE_CSR(A,indexing,rows,cols,rows_start,rows_end,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_S_CREATE_CSR')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT), INTENT(IN) :: indexing
            INTEGER, INTENT(IN) :: rows
            INTEGER, INTENT(IN) :: cols
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_start
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_end
            INTEGER, INTENT(IN), DIMENSION(*) :: col_indx
            REAL(C_FLOAT), INTENT(IN), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_S_CREATE_CSR
        END FUNCTION
        FUNCTION MKL_SPARSE_D_CREATE_CSR(A,indexing,rows,cols,rows_start,rows_end,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_D_CREATE_CSR')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT), INTENT(IN) :: indexing
            INTEGER, INTENT(IN) :: rows
            INTEGER, INTENT(IN) :: cols
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_start
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_end
            INTEGER, INTENT(IN), DIMENSION(*) :: col_indx
            REAL(C_DOUBLE), INTENT(IN), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_D_CREATE_CSR
        END FUNCTION
        FUNCTION MKL_SPARSE_C_CREATE_CSR(A,indexing,rows,cols,rows_start,rows_end,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_C_CREATE_CSR')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT_COMPLEX
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT), INTENT(IN) :: indexing
            INTEGER, INTENT(IN) :: rows
            INTEGER, INTENT(IN) :: cols
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_start
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_end
            INTEGER, INTENT(IN), DIMENSION(*) :: col_indx
            COMPLEX(C_FLOAT_COMPLEX), INTENT(IN), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_C_CREATE_CSR
        END FUNCTION
        FUNCTION MKL_SPARSE_Z_CREATE_CSR(A,indexing,rows,cols,rows_start,rows_end,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_Z_CREATE_CSR')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE_COMPLEX
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT), INTENT(IN) :: indexing
            INTEGER, INTENT(IN) :: rows
            INTEGER, INTENT(IN) :: cols
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_start
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_end
            INTEGER, INTENT(IN), DIMENSION(*) :: col_indx
            COMPLEX(C_DOUBLE_COMPLEX), INTENT(IN), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_Z_CREATE_CSR
        END FUNCTION

!   compressed sparse column format (4-arrays version),
!   SPARSE_MATRIX_TYPE_GENERAL by default, pointers to input arrays are stored in the handle
        FUNCTION MKL_SPARSE_S_CREATE_CSC(A,indexing,rows,cols,rows_start,rows_end,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_S_CREATE_CSC')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT), INTENT(IN) :: indexing
            INTEGER, INTENT(IN) :: rows
            INTEGER, INTENT(IN) :: cols
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_start
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_end
            INTEGER, INTENT(IN), DIMENSION(*) :: col_indx
            REAL(C_FLOAT), INTENT(IN), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_S_CREATE_CSC
        END FUNCTION
        FUNCTION MKL_SPARSE_D_CREATE_CSC(A,indexing,rows,cols,rows_start,rows_end,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_D_CREATE_CSC')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT), INTENT(IN) :: indexing
            INTEGER, INTENT(IN) :: rows
            INTEGER, INTENT(IN) :: cols
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_start
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_end
            INTEGER, INTENT(IN), DIMENSION(*) :: col_indx
            REAL(C_DOUBLE), INTENT(IN), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_D_CREATE_CSC
        END FUNCTION
        FUNCTION MKL_SPARSE_C_CREATE_CSC(A,indexing,rows,cols,rows_start,rows_end,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_C_CREATE_CSC')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT_COMPLEX
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT), INTENT(IN) :: indexing
            INTEGER, INTENT(IN) :: rows
            INTEGER, INTENT(IN) :: cols
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_start
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_end
            INTEGER, INTENT(IN), DIMENSION(*) :: col_indx
            COMPLEX(C_FLOAT_COMPLEX), INTENT(IN), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_C_CREATE_CSC
        END FUNCTION
        FUNCTION MKL_SPARSE_Z_CREATE_CSC(A,indexing,rows,cols,rows_start,rows_end,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_Z_CREATE_CSC')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE_COMPLEX
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT), INTENT(IN) :: indexing
            INTEGER, INTENT(IN) :: rows
            INTEGER, INTENT(IN) :: cols
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_start
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_end
            INTEGER, INTENT(IN), DIMENSION(*) :: col_indx
            COMPLEX(C_DOUBLE_COMPLEX), INTENT(IN), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_Z_CREATE_CSC
        END FUNCTION

!   compressed block sparse row format (4-arrays version, square blocks),
!   SPARSE_MATRIX_TYPE_GENERAL by default, pointers to input arrays are stored in the handle
        FUNCTION MKL_SPARSE_S_CREATE_BSR(A,indexing,block_layout,rows,cols,block_size,rows_start,rows_end,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_S_CREATE_BSR')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT), INTENT(IN) :: indexing
            INTEGER(C_INT), INTENT(IN) :: block_layout
            INTEGER, INTENT(IN) :: rows
            INTEGER, INTENT(IN) :: cols
            INTEGER, INTENT(IN) :: block_size
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_start
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_end
            INTEGER, INTENT(IN), DIMENSION(*) :: col_indx
            REAL(C_FLOAT), INTENT(IN), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_S_CREATE_BSR
        END FUNCTION
        FUNCTION MKL_SPARSE_D_CREATE_BSR(A,indexing,block_layout,rows,cols,block_size,rows_start,rows_end,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_D_CREATE_BSR')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT), INTENT(IN) :: indexing
            INTEGER(C_INT), INTENT(IN) :: block_layout
            INTEGER, INTENT(IN) :: rows
            INTEGER, INTENT(IN) :: cols
            INTEGER, INTENT(IN) :: block_size
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_start
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_end
            INTEGER, INTENT(IN), DIMENSION(*) :: col_indx
            REAL(C_DOUBLE), INTENT(IN), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_D_CREATE_BSR
        END FUNCTION
        FUNCTION MKL_SPARSE_C_CREATE_BSR(A,indexing,block_layout,rows,cols,block_size,rows_start,rows_end,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_C_CREATE_BSR')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT_COMPLEX
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT), INTENT(IN) :: indexing
            INTEGER(C_INT), INTENT(IN) :: block_layout
            INTEGER, INTENT(IN) :: rows
            INTEGER, INTENT(IN) :: cols
            INTEGER, INTENT(IN) :: block_size
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_start
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_end
            INTEGER, INTENT(IN), DIMENSION(*) :: col_indx
            COMPLEX(C_FLOAT_COMPLEX), INTENT(IN), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_C_CREATE_BSR
        END FUNCTION
        FUNCTION MKL_SPARSE_Z_CREATE_BSR(A,indexing,block_layout,rows,cols,block_size,rows_start,rows_end,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_Z_CREATE_BSR')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE_COMPLEX
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT), INTENT(IN) :: indexing
            INTEGER(C_INT), INTENT(IN) :: block_layout
            INTEGER, INTENT(IN) :: rows
            INTEGER, INTENT(IN) :: cols
            INTEGER, INTENT(IN) :: block_size
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_start
            INTEGER, INTENT(IN), DIMENSION(*) :: rows_end
            INTEGER, INTENT(IN), DIMENSION(*) :: col_indx
            COMPLEX(C_DOUBLE_COMPLEX), INTENT(IN), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_Z_CREATE_BSR
        END FUNCTION

!   Create copy of the existing handle; matrix properties could be changed.
!   For example it could be used for extracting triangular or diagonal parts from existing matrix.
        FUNCTION MKL_SPARSE_COPY(source,descr,dest) &
                 BIND(C, name='MKL_SPARSE_COPY')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: source
            TYPE(MATRIX_DESCR)   , INTENT(IN) :: descr
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: dest
            INTEGER(C_INT) MKL_SPARSE_COPY
        END FUNCTION

!   destroy matrix handle; if sparse matrix was stored inside the handle it also deallocates the matrix
!   It is customer responsibility not to delete the handle with the matrix, if this matrix is shared with other handles
        FUNCTION MKL_SPARSE_DESTROY(A) &
                 BIND(C, name='MKL_SPARSE_DESTROY')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT) MKL_SPARSE_DESTROY
        END FUNCTION

!   return extended error information from last operation;
!   eg. info about wrong input parameter, memory sizes that couldn't be allocated, etc.
        FUNCTION MKL_SPARSE_GET_ERROR_INFO(A,info) &
                 BIND(C, name='MKL_SPARSE_GET_ERROR_INFO')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER, INTENT(IN), DIMENSION(*) :: info
            INTEGER(C_INT) MKL_SPARSE_GET_ERROR_INFO
        END FUNCTION

!****************************************************************************************
!************************ Converters of internal representation  ************************
!****************************************************************************************

!   converters from current format to another

        ! convert original matrix to CSR representation
        FUNCTION MKL_SPARSE_CONVERT_CSR(source,operation,dest) &
                 BIND(C, name='MKL_SPARSE_CONVERT_CSR')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: source
            INTEGER(C_INT)       , INTENT(IN) :: operation     ! as is, transposed or conjugate transposed
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: dest
            INTEGER(C_INT) MKL_SPARSE_CONVERT_CSR
        END FUNCTION

        ! convert original matrix to BSR representation
        FUNCTION MKL_SPARSE_CONVERT_BSR(source,block_size,block_layout,operation,dest) &
                 BIND(C, name='MKL_SPARSE_CONVERT_BSR')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: source
            INTEGER        , INTENT(IN) :: block_size
            INTEGER(C_INT)       , INTENT(IN) :: block_layout    ! block storage: row-major or column-major
            INTEGER(C_INT)       , INTENT(IN) :: operation     ! as is, transposed or conjugate transposed
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: dest
            INTEGER(C_INT) MKL_SPARSE_CONVERT_BSR
        END FUNCTION

        FUNCTION MKL_SPARSE_S_EXPORT_BSR(source,indexing,block_layout,rows,cols,block_size,rows_start,rows_end,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_S_EXPORT_BSR')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: source
            INTEGER(C_INT)       , INTENT(INOUT) :: indexing
            INTEGER(C_INT)       , INTENT(INOUT) :: block_layout
            INTEGER(C_INT)       , INTENT(INOUT) :: rows
            INTEGER(C_INT)       , INTENT(INOUT) :: cols
            INTEGER(C_INT)       , INTENT(INOUT) :: block_size
            INTEGER, INTENT(INOUT), DIMENSION(*) :: rows_start
            INTEGER, INTENT(INOUT), DIMENSION(*) :: rows_end
            INTEGER, INTENT(INOUT), DIMENSION(*) :: col_indx
            REAL(C_FLOAT), INTENT(INOUT), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_S_EXPORT_BSR
        END FUNCTION
        FUNCTION MKL_SPARSE_D_EXPORT_BSR(source,indexing,block_layout,rows,cols,block_size,rows_start,rows_end,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_D_EXPORT_BSR')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T) , INTENT(IN) :: source
            INTEGER(C_INT)        , INTENT(INOUT) :: indexing
            INTEGER(C_INT)        , INTENT(INOUT) :: block_layout
            INTEGER(C_INT)        , INTENT(INOUT) :: rows
            INTEGER(C_INT)        , INTENT(INOUT) :: cols
            INTEGER(C_INT)        , INTENT(INOUT) :: block_size
            INTEGER, INTENT(INOUT), DIMENSION(*) :: rows_start
            INTEGER, INTENT(INOUT), DIMENSION(*) :: rows_end
            INTEGER, INTENT(INOUT), DIMENSION(*) :: col_indx
            REAL(C_DOUBLE), INTENT(INOUT), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_D_EXPORT_BSR
        END FUNCTION
        FUNCTION MKL_SPARSE_C_EXPORT_BSR(source,indexing,block_layout,rows,cols,block_size,rows_start,rows_end,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_C_EXPORT_BSR')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT_COMPLEX
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T) , INTENT(IN) :: source
            INTEGER(C_INT)        , INTENT(INOUT) :: indexing
            INTEGER(C_INT)        , INTENT(INOUT) :: block_layout
            INTEGER(C_INT)        , INTENT(INOUT) :: rows
            INTEGER(C_INT)        , INTENT(INOUT) :: cols
            INTEGER(C_INT)        , INTENT(INOUT) :: block_size
            INTEGER, INTENT(INOUT), DIMENSION(*) :: rows_start
            INTEGER, INTENT(INOUT), DIMENSION(*) :: rows_end
            INTEGER, INTENT(INOUT), DIMENSION(*) :: col_indx
            COMPLEX(C_FLOAT_COMPLEX), INTENT(INOUT), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_C_EXPORT_BSR
        END FUNCTION
        FUNCTION MKL_SPARSE_Z_EXPORT_BSR(source,indexing,block_layout,rows,cols,block_size,rows_start,rows_end,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_Z_EXPORT_BSR')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE_COMPLEX
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T) , INTENT(IN) :: source
            INTEGER(C_INT)        , INTENT(INOUT) :: indexing
            INTEGER(C_INT)        , INTENT(INOUT) :: block_layout
            INTEGER(C_INT)        , INTENT(INOUT) :: rows
            INTEGER(C_INT)        , INTENT(INOUT) :: cols
            INTEGER(C_INT)        , INTENT(INOUT) :: block_size
            INTEGER, INTENT(INOUT), DIMENSION(*) :: rows_start
            INTEGER, INTENT(INOUT), DIMENSION(*) :: rows_end
            INTEGER, INTENT(INOUT), DIMENSION(*) :: col_indx
            COMPLEX(C_DOUBLE_COMPLEX), INTENT(INOUT), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_Z_EXPORT_BSR
        END FUNCTION

        FUNCTION MKL_SPARSE_S_EXPORT_CSR(source,indexing,rows,cols,rows_start,rows_end,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_S_EXPORT_CSR')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: source
            INTEGER(C_INT)      , INTENT(INOUT) :: indexing
            INTEGER(C_INT)      , INTENT(INOUT) :: rows
            INTEGER(C_INT)      , INTENT(INOUT) :: cols
            INTEGER, INTENT(INOUT), DIMENSION(*) :: rows_start
            INTEGER, INTENT(INOUT), DIMENSION(*) :: rows_end
            INTEGER, INTENT(INOUT), DIMENSION(*) :: col_indx
            REAL(C_FLOAT), INTENT(INOUT), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_S_EXPORT_CSR
        END FUNCTION
        FUNCTION MKL_SPARSE_D_EXPORT_CSR(source,indexing,rows,cols,rows_start,rows_end,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_D_EXPORT_CSR')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: source
            INTEGER(C_INT)      , INTENT(INOUT) :: indexing
            INTEGER(C_INT)      , INTENT(INOUT) :: rows
            INTEGER(C_INT)      , INTENT(INOUT) :: cols
            INTEGER, INTENT(INOUT), DIMENSION(*) :: rows_start
            INTEGER, INTENT(INOUT), DIMENSION(*) :: rows_end
            INTEGER, INTENT(INOUT), DIMENSION(*) :: col_indx
            REAL(C_DOUBLE), INTENT(INOUT), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_D_EXPORT_CSR
        END FUNCTION
        FUNCTION MKL_SPARSE_C_EXPORT_CSR(source,indexing,rows,cols,rows_start,rows_end,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_C_EXPORT_CSR')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT_COMPLEX
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: source
            INTEGER(C_INT)      , INTENT(INOUT) :: indexing
            INTEGER(C_INT)      , INTENT(INOUT) :: rows
            INTEGER(C_INT)      , INTENT(INOUT) :: cols
            INTEGER, INTENT(INOUT), DIMENSION(*) :: rows_start
            INTEGER, INTENT(INOUT), DIMENSION(*) :: rows_end
            INTEGER, INTENT(INOUT), DIMENSION(*) :: col_indx
            COMPLEX(C_FLOAT_COMPLEX), INTENT(INOUT), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_C_EXPORT_CSR
        END FUNCTION
        FUNCTION MKL_SPARSE_Z_EXPORT_CSR(source,indexing,rows,cols,rows_start,rows_end,col_indx,values) &
                 BIND(C, name='MKL_SPARSE_Z_EXPORT_CSR')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE_COMPLEX
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T) , INTENT(IN) :: source
            INTEGER(C_INT)        , INTENT(INOUT) :: indexing
            INTEGER(C_INT)        , INTENT(INOUT) :: rows
            INTEGER(C_INT)        , INTENT(INOUT) :: cols
            INTEGER, INTENT(INOUT), DIMENSION(*) :: rows_start
            INTEGER, INTENT(INOUT), DIMENSION(*) :: rows_end
            INTEGER, INTENT(INOUT), DIMENSION(*) :: col_indx
            COMPLEX(C_DOUBLE_COMPLEX), INTENT(INOUT), DIMENSION(*) :: values
            INTEGER(C_INT) MKL_SPARSE_Z_EXPORT_CSR
        END FUNCTION

!****************************************************************************************
!************************** Step-by-step modification routines **************************
!****************************************************************************************

!   update existing value in the matrix
!   ( for internal storage only, should not work with customer-allocated matrices)
        FUNCTION MKL_SPARSE_S_SET_VALUE(A,row,col,value) &
                 BIND(C, name='MKL_SPARSE_S_SET_VALUE')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER, INTENT(IN) :: row
            INTEGER, INTENT(IN) :: col
            REAL(C_FLOAT) , INTENT(IN) :: value
            INTEGER(C_INT) MKL_SPARSE_S_SET_VALUE
        END FUNCTION
        FUNCTION MKL_SPARSE_D_SET_VALUE(A,row,col,value) &
                 BIND(C, name='MKL_SPARSE_D_SET_VALUE')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER, INTENT(IN) :: row
            INTEGER, INTENT(IN) :: col
            REAL(C_DOUBLE) , INTENT(IN) :: value
            INTEGER(C_INT) MKL_SPARSE_D_SET_VALUE
        END FUNCTION
        FUNCTION MKL_SPARSE_C_SET_VALUE(A,row,col,value) &
                 BIND(C, name='MKL_SPARSE_C_SET_VALUE')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT_COMPLEX
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER, INTENT(IN) :: row
            INTEGER, INTENT(IN) :: col
            COMPLEX(C_FLOAT_COMPLEX) , INTENT(IN) :: value
            INTEGER(C_INT) MKL_SPARSE_C_SET_VALUE
        END FUNCTION
        FUNCTION MKL_SPARSE_Z_SET_VALUE(A,row,col,value) &
                 BIND(C, name='MKL_SPARSE_Z_SET_VALUE')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE_COMPLEX
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER, INTENT(IN) :: row
            INTEGER, INTENT(IN) :: col
            COMPLEX(C_DOUBLE_COMPLEX) , INTENT(IN) :: value
            INTEGER(C_INT) MKL_SPARSE_Z_SET_VALUE
        END FUNCTION

!****************************************************************************************
!****************************** Verbose mode routine ************************************
!****************************************************************************************

!   allow to switch on/off verbose mode
        FUNCTION MKL_SPARSE_SET_VERBOSE_MODE(verbose) &
                 BIND(C, name='MKL_SPARSE_SET_VERBOSE_MODE')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT
            INTEGER(C_INT), INTENT(IN) :: verbose
            INTEGER(C_INT) MKL_SPARSE_SET_VERBOSE_MODE
        END FUNCTION

!****************************************************************************************
!****************************** Optimization routines ***********************************
!****************************************************************************************

!   Describe expected operations with amount of iterations
        FUNCTION MKL_SPARSE_SET_MV_HINT(A,operation,descr,expected_calls) &
                 BIND(C, name='MKL_SPARSE_SET_MV_HINT')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT)      , INTENT(IN) :: operation     ! SPARSE_OPERATION_NON_TRANSPOSE is default value for
                                                               ! infinite amount of calls
            TYPE(MATRIX_DESCR)   , INTENT(IN) :: descr         ! sparse_matrix_type_t + sparse_fill_mode_t + sparse_diag_type_t
            INTEGER              , INTENT(IN) :: expected_calls
            INTEGER(C_INT) MKL_SPARSE_SET_MV_HINT
        END FUNCTION

        FUNCTION MKL_SPARSE_SET_MM_HINT(A,operation,descr,layout,dense_matrix_size,expected_calls) &
                 BIND(C, name='MKL_SPARSE_SET_MM_HINT')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT)      , INTENT(IN) :: operation
            TYPE(MATRIX_DESCR)   , INTENT(IN) :: descr           ! sparse_matrix_type_t + sparse_fill_mode_t + sparse_diag_type_t
            INTEGER(C_INT)      , INTENT(IN) :: layout           ! storage scheme for the dense matrix: C-style or Fortran-style
            INTEGER              , INTENT(IN) :: dense_matrix_size ! amount of columns in dense matrix
            INTEGER              , INTENT(IN) :: expected_calls
            INTEGER(C_INT) MKL_SPARSE_SET_MM_HINT
        END FUNCTION

        FUNCTION MKL_SPARSE_SET_SV_HINT(A,operation,descr,expected_calls) &
                 BIND(C, name='MKL_SPARSE_SET_SV_HINT')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT)      , INTENT(IN) :: operation     ! SPARSE_OPERATION_NON_TRANSPOSE is default value for
                                                               ! infinite amount of calls
            TYPE(MATRIX_DESCR)   , INTENT(IN) :: descr         ! sparse_matrix_type_t + sparse_fill_mode_t + sparse_diag_type_t
            INTEGER              , INTENT(IN) :: expected_calls
            INTEGER(C_INT) MKL_SPARSE_SET_SV_HINT
        END FUNCTION

        FUNCTION MKL_SPARSE_SET_SM_HINT(A,operation,descr,layout,dense_matrix_size,expected_calls) &
                 BIND(C, name='MKL_SPARSE_SET_SM_HINT')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT)      , INTENT(IN) :: operation
            TYPE(MATRIX_DESCR)   , INTENT(IN) :: descr           ! sparse_matrix_type_t + sparse_fill_mode_t + sparse_diag_type_t
            INTEGER(C_INT)      , INTENT(IN) :: layout           ! storage scheme for the dense matrix: C-style or Fortran-style
            INTEGER              , INTENT(IN) :: dense_matrix_size ! amount of columns in dense matrix
            INTEGER              , INTENT(IN) :: expected_calls
            INTEGER(C_INT) MKL_SPARSE_SET_SM_HINT
        END FUNCTION

        FUNCTION MKL_SPARSE_SET_MEMORY_HINT(A,policy) &
                 BIND(C, name='MKL_SPARSE_SET_MEMORY_HINT')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT)      , INTENT(IN) :: policy          ! SPARSE_MEMORY_AGGRESSIVE is default value
            INTEGER(C_INT) MKL_SPARSE_SET_MEMORY_HINT
        END FUNCTION

!   optimize matrix described by the handle. It uses hints (optimization and memory) that should be set up before this call.
!   if hints were not explicitly defined, default vales are:
!   SPARSE_OPERATION_NON_TRANSPOSE for matrix-vector multiply with infinite amount of expected iterations
        FUNCTION MKL_SPARSE_OPTIMIZE(A) &
                 BIND(C, name='MKL_SPARSE_OPTIMIZE')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT
            IMPORT SPARSE_MATRIX_T
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: A
            INTEGER(C_INT) MKL_SPARSE_OPTIMIZE
        END FUNCTION

!****************************************************************************************
!****************************** Computational routines **********************************
!****************************************************************************************

!   Perform computations based on created matrix handle

!   Level 2

!   Computes y = alpha * A * x + beta * y
        FUNCTION MKL_SPARSE_S_MV(operation,alpha,A,descr,x,beta,y) &
                 BIND(C, name='MKL_SPARSE_S_MV')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            INTEGER(C_INT)       , INTENT(IN) :: operation
            REAL(C_FLOAT)        , INTENT(IN) :: alpha
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: A
            TYPE(MATRIX_DESCR)   , INTENT(IN) :: descr          ! sparse_matrix_type_t + sparse_fill_mode_t + sparse_diag_type_t
            REAL(C_FLOAT), INTENT(IN), DIMENSION(*) :: x
            REAL(C_FLOAT)        , INTENT(IN) :: beta
            REAL(C_FLOAT), INTENT(INOUT), DIMENSION(*) :: y
            INTEGER(C_INT) MKL_SPARSE_S_MV
        END FUNCTION
        FUNCTION MKL_SPARSE_D_MV(operation,alpha,A,descr,x,beta,y) &
                 BIND(C, name='MKL_SPARSE_D_MV')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            INTEGER(C_INT)       , INTENT(IN) :: operation
            REAL(C_DOUBLE)       , INTENT(IN) :: alpha
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: A
            TYPE(MATRIX_DESCR)   , INTENT(IN) :: descr          ! sparse_matrix_type_t + sparse_fill_mode_t + sparse_diag_type_t
            REAL(C_DOUBLE), INTENT(IN), DIMENSION(*) :: x
            REAL(C_DOUBLE)       , INTENT(IN) :: beta
            REAL(C_DOUBLE), INTENT(INOUT), DIMENSION(*) :: y
            INTEGER(C_INT) MKL_SPARSE_D_MV
        END FUNCTION
        FUNCTION MKL_SPARSE_C_MV(operation,alpha,A,descr,x,beta,y) &
                 BIND(C, name='MKL_SPARSE_C_MV')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT, C_FLOAT_COMPLEX
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            INTEGER(C_INT)          , INTENT(IN) :: operation
            COMPLEX(C_FLOAT_COMPLEX), INTENT(IN) :: alpha
            TYPE(SPARSE_MATRIX_T)   , INTENT(IN) :: A
            TYPE(MATRIX_DESCR)      , INTENT(IN) :: descr          ! sparse_matrix_type_t + sparse_fill_mode_t + sparse_diag_type_t
            COMPLEX(C_FLOAT_COMPLEX), INTENT(IN), DIMENSION(*) :: x
            COMPLEX(C_FLOAT_COMPLEX), INTENT(IN) :: beta
            COMPLEX(C_FLOAT_COMPLEX), INTENT(INOUT), DIMENSION(*) :: y
            INTEGER(C_INT) MKL_SPARSE_C_MV
        END FUNCTION
        FUNCTION MKL_SPARSE_Z_MV(operation,alpha,A,descr,x,beta,y) &
                 BIND(C, name='MKL_SPARSE_Z_MV')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE_COMPLEX
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            INTEGER(C_INT)       , INTENT(IN) :: operation
            COMPLEX(C_DOUBLE_COMPLEX), INTENT(IN) :: alpha
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: A
            TYPE(MATRIX_DESCR)   , INTENT(IN) :: descr          ! sparse_matrix_type_t + sparse_fill_mode_t + sparse_diag_type_t
            COMPLEX(C_DOUBLE_COMPLEX), INTENT(IN), DIMENSION(*) :: x
            COMPLEX(C_DOUBLE_COMPLEX), INTENT(IN) :: beta
            COMPLEX(C_DOUBLE_COMPLEX), INTENT(INOUT), DIMENSION(*) :: y
            INTEGER(C_INT) MKL_SPARSE_Z_MV
        END FUNCTION

!   Solves triangular system y = alpha * A^{-1} * x
        FUNCTION MKL_SPARSE_S_TRSV(operation,alpha,A,descr,x,y) &
                 BIND(C, name='MKL_SPARSE_S_TRSV')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            INTEGER(C_INT)       , INTENT(IN) :: operation
            REAL(C_FLOAT)        , INTENT(IN) :: alpha
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: A
            TYPE(MATRIX_DESCR)   , INTENT(IN) :: descr          ! sparse_matrix_type_t + sparse_fill_mode_t + sparse_diag_type_t
            REAL(C_FLOAT), INTENT(IN), DIMENSION(*) :: x
            REAL(C_FLOAT), INTENT(INOUT), DIMENSION(*) :: y
            INTEGER(C_INT) MKL_SPARSE_S_TRSV
        END FUNCTION
        FUNCTION MKL_SPARSE_D_TRSV(operation,alpha,A,descr,x,y) &
                 BIND(C, name='MKL_SPARSE_D_TRSV')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            INTEGER(C_INT)       , INTENT(IN) :: operation
            REAL(C_DOUBLE)       , INTENT(IN) :: alpha
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: A
            TYPE(MATRIX_DESCR)   , INTENT(IN) :: descr          ! sparse_matrix_type_t + sparse_fill_mode_t + sparse_diag_type_t
            REAL(C_DOUBLE), INTENT(IN), DIMENSION(*) :: x
            REAL(C_DOUBLE), INTENT(INOUT), DIMENSION(*) :: y
            INTEGER(C_INT) MKL_SPARSE_D_TRSV
        END FUNCTION
        FUNCTION MKL_SPARSE_C_TRSV(operation,alpha,A,descr,x,y) &
                 BIND(C, name='MKL_SPARSE_C_TRSV')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT_COMPLEX
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            INTEGER(C_INT)          , INTENT(IN) :: operation
            COMPLEX(C_FLOAT_COMPLEX), INTENT(IN) :: alpha
            TYPE(SPARSE_MATRIX_T)   , INTENT(IN) :: A
            TYPE(MATRIX_DESCR)      , INTENT(IN) :: descr          ! sparse_matrix_type_t + sparse_fill_mode_t + sparse_diag_type_t
            COMPLEX(C_FLOAT_COMPLEX), INTENT(IN), DIMENSION(*) :: x
            COMPLEX(C_FLOAT_COMPLEX), INTENT(INOUT), DIMENSION(*) :: y
            INTEGER(C_INT) MKL_SPARSE_C_TRSV
        END FUNCTION
        FUNCTION MKL_SPARSE_Z_TRSV(operation,alpha,A,descr,x,y) &
                 BIND(C, name='MKL_SPARSE_Z_TRSV')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE_COMPLEX
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            INTEGER(C_INT)           , INTENT(IN) :: operation
            COMPLEX(C_DOUBLE_COMPLEX), INTENT(IN) :: alpha
            TYPE(SPARSE_MATRIX_T)    , INTENT(IN) :: A
            TYPE(MATRIX_DESCR)       , INTENT(IN) :: descr          ! sparse_matrix_type_t + sparse_fill_mode_t + sparse_diag_type_t
            COMPLEX(C_DOUBLE_COMPLEX), INTENT(IN), DIMENSION(*) :: x
            COMPLEX(C_DOUBLE_COMPLEX), INTENT(INOUT), DIMENSION(*) :: y
            INTEGER(C_INT) MKL_SPARSE_Z_TRSV
        END FUNCTION

!   Level 3

!   Computes y = alpha * A * x + beta * y
        FUNCTION MKL_SPARSE_S_MM(operation,alpha,A,descr,layout,x,columns,ldx,beta,y,ldy) &
                 BIND(C, name='MKL_SPARSE_S_MM')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            INTEGER(C_INT)       , INTENT(IN) :: operation
            REAL(C_FLOAT)        , INTENT(IN) :: alpha
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: A
            TYPE(MATRIX_DESCR)   , INTENT(IN) :: descr          ! sparse_matrix_type_t + sparse_fill_mode_t + sparse_diag_type_t
            INTEGER(C_INT)       , INTENT(IN) :: layout          ! storage scheme for the dense matrix: C-style or Fortran-style
            REAL(C_FLOAT), INTENT(IN), DIMENSION(*) :: x
            INTEGER              , INTENT(IN) :: columns
            INTEGER              , INTENT(IN) :: ldx
            REAL(C_FLOAT)        , INTENT(IN) :: beta
            REAL(C_FLOAT), INTENT(INOUT), DIMENSION(*) :: y
            INTEGER              , INTENT(IN) :: ldy
            INTEGER(C_INT) MKL_SPARSE_S_MM
        END FUNCTION
        FUNCTION MKL_SPARSE_D_MM(operation,alpha,A,descr,layout,x,columns,ldx,beta,y,ldy) &
                 BIND(C, name='MKL_SPARSE_D_MM')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            INTEGER(C_INT)       , INTENT(IN) :: operation
            REAL(C_DOUBLE)       , INTENT(IN) :: alpha
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: A
            TYPE(MATRIX_DESCR)   , INTENT(IN) :: descr          ! sparse_matrix_type_t + sparse_fill_mode_t + sparse_diag_type_t
            INTEGER(C_INT)       , INTENT(IN) :: layout          ! storage scheme for the dense matrix: C-style or Fortran-style
            REAL(C_DOUBLE), INTENT(IN), DIMENSION(*) :: x
            INTEGER              , INTENT(IN) :: columns
            INTEGER              , INTENT(IN) :: ldx
            REAL(C_DOUBLE)       , INTENT(IN) :: beta
            REAL(C_DOUBLE), INTENT(INOUT), DIMENSION(*) :: y
            INTEGER              , INTENT(IN) :: ldy
            INTEGER(C_INT) MKL_SPARSE_D_MM
        END FUNCTION
        FUNCTION MKL_SPARSE_C_MM(operation,alpha,A,descr,layout,x,columns,ldx,beta,y,ldy) &
                 BIND(C, name='MKL_SPARSE_C_MM')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT_COMPLEX
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            INTEGER(C_INT)       , INTENT(IN) :: operation
            COMPLEX(C_FLOAT_COMPLEX)               , INTENT(IN) :: alpha
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: A
            TYPE(MATRIX_DESCR)   , INTENT(IN) :: descr          ! sparse_matrix_type_t + sparse_fill_mode_t + sparse_diag_type_t
            INTEGER(C_INT)       , INTENT(IN) :: layout          ! storage scheme for the dense matrix: C-style or Fortran-style
            COMPLEX(C_FLOAT_COMPLEX), INTENT(IN), DIMENSION(*) :: x
            INTEGER              , INTENT(IN) :: columns
            INTEGER              , INTENT(IN) :: ldx
            COMPLEX(C_FLOAT_COMPLEX)               , INTENT(IN) :: beta
            COMPLEX(C_FLOAT_COMPLEX), INTENT(INOUT), DIMENSION(*) :: y
            INTEGER              , INTENT(IN) :: ldy
            INTEGER(C_INT) MKL_SPARSE_C_MM
        END FUNCTION
        FUNCTION MKL_SPARSE_Z_MM(operation,alpha,A,descr,layout,x,columns,ldx,beta,y,ldy) &
                 BIND(C, name='MKL_SPARSE_Z_MM')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE_COMPLEX
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            INTEGER(C_INT)       , INTENT(IN) :: operation
            COMPLEX(C_DOUBLE_COMPLEX)               , INTENT(IN) :: alpha
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: A
            TYPE(MATRIX_DESCR)   , INTENT(IN) :: descr          ! sparse_matrix_type_t + sparse_fill_mode_t + sparse_diag_type_t
            INTEGER(C_INT)       , INTENT(IN) :: layout          ! storage scheme for the dense matrix: C-style or Fortran-style
            COMPLEX(C_DOUBLE_COMPLEX), INTENT(IN), DIMENSION(*) :: x
            INTEGER              , INTENT(IN) :: columns
            INTEGER              , INTENT(IN) :: ldx
            COMPLEX(C_DOUBLE_COMPLEX)               , INTENT(IN) :: beta
            COMPLEX(C_DOUBLE_COMPLEX), INTENT(INOUT), DIMENSION(*) :: y
            INTEGER              , INTENT(IN) :: ldy
            INTEGER(C_INT) MKL_SPARSE_Z_MM
        END FUNCTION

!   Solves triangular system y = alpha * A^{-1} * x
        FUNCTION MKL_SPARSE_S_TRSM(operation,alpha,A,descr,layout,x,columns,ldx,y,ldy) &
                 BIND(C, name='MKL_SPARSE_S_TRSM')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            INTEGER(C_INT)       , INTENT(IN) :: operation
            REAL(C_FLOAT)        , INTENT(IN) :: alpha
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: A
            TYPE(MATRIX_DESCR)   , INTENT(IN) :: descr          ! sparse_matrix_type_t + sparse_fill_mode_t + sparse_diag_type_t
            INTEGER(C_INT)       , INTENT(IN) :: layout          ! storage scheme for the dense matrix: C-style or Fortran-style
            REAL(C_FLOAT), INTENT(IN), DIMENSION(*) :: x
            INTEGER              , INTENT(IN) :: columns
            INTEGER              , INTENT(IN) :: ldx
            REAL(C_FLOAT), INTENT(INOUT), DIMENSION(*) :: y
            INTEGER              , INTENT(IN) :: ldy
            INTEGER(C_INT) MKL_SPARSE_S_TRSM
        END FUNCTION
        FUNCTION MKL_SPARSE_D_TRSM(operation,alpha,A,descr,layout,x,columns,ldx,y,ldy) &
                 BIND(C, name='MKL_SPARSE_D_TRSM')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            INTEGER(C_INT)       , INTENT(IN) :: operation
            REAL(C_DOUBLE)       , INTENT(IN) :: alpha
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: A
            TYPE(MATRIX_DESCR)   , INTENT(IN) :: descr          ! sparse_matrix_type_t + sparse_fill_mode_t + sparse_diag_type_t
            INTEGER(C_INT)       , INTENT(IN) :: layout          ! storage scheme for the dense matrix: C-style or Fortran-style
            REAL(C_DOUBLE), INTENT(IN), DIMENSION(*) :: x
            INTEGER              , INTENT(IN) :: columns
            INTEGER              , INTENT(IN) :: ldx
            REAL(C_DOUBLE), INTENT(INOUT), DIMENSION(*) :: y
            INTEGER              , INTENT(IN) :: ldy
            INTEGER(C_INT) MKL_SPARSE_D_TRSM
        END FUNCTION
        FUNCTION MKL_SPARSE_C_TRSM(operation,alpha,A,descr,layout,x,columns,ldx,y,ldy) &
                 BIND(C, name='MKL_SPARSE_C_TRSM')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT_COMPLEX
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            INTEGER(C_INT)          , INTENT(IN) :: operation
            COMPLEX(C_FLOAT_COMPLEX), INTENT(IN) :: alpha
            TYPE(SPARSE_MATRIX_T)   , INTENT(IN) :: A
            TYPE(MATRIX_DESCR)      , INTENT(IN) :: descr          ! sparse_matrix_type_t + sparse_fill_mode_t + sparse_diag_type_t
            INTEGER(C_INT)          , INTENT(IN) :: layout          ! storage scheme for the dense matrix: C-style or Fortran-style
            COMPLEX(C_FLOAT_COMPLEX), INTENT(IN), DIMENSION(*) :: x
            INTEGER                 , INTENT(IN) :: columns
            INTEGER                 , INTENT(IN) :: ldx
            COMPLEX(C_FLOAT_COMPLEX), INTENT(INOUT), DIMENSION(*) :: y
            INTEGER                 , INTENT(IN) :: ldy
            INTEGER(C_INT) MKL_SPARSE_C_TRSM
        END FUNCTION
        FUNCTION MKL_SPARSE_Z_TRSM(operation,alpha,A,descr,layout,x,columns,ldx,y,ldy) &
                 BIND(C, name='MKL_SPARSE_Z_TRSM')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE_COMPLEX
            IMPORT SPARSE_MATRIX_T
            IMPORT MATRIX_DESCR
            INTEGER(C_INT)           , INTENT(IN) :: operation
            COMPLEX(C_DOUBLE_COMPLEX), INTENT(IN) :: alpha
            TYPE(SPARSE_MATRIX_T)    , INTENT(IN) :: A
            TYPE(MATRIX_DESCR)       , INTENT(IN) :: descr          ! sparse_matrix_type_t + sparse_fill_mode_t + sparse_diag_type_t
            INTEGER(C_INT)           , INTENT(IN) :: layout          ! storage scheme for the dense matrix: C-style or Fortran-style
            COMPLEX(C_DOUBLE_COMPLEX), INTENT(IN), DIMENSION(*) :: x
            INTEGER                  , INTENT(IN) :: columns
            INTEGER                  , INTENT(IN) :: ldx
            COMPLEX(C_DOUBLE_COMPLEX), INTENT(INOUT), DIMENSION(*) :: y
            INTEGER                  , INTENT(IN) :: ldy
            INTEGER(C_INT) MKL_SPARSE_Z_TRSM
        END FUNCTION

!   Sparse-sparse functionality

!   Computes addition of sparse matrices: C = alpha * op(A) + B, result is sparse
        FUNCTION MKL_SPARSE_S_ADD(operation,A,alpha,B,C) &
                 BIND(C, name='MKL_SPARSE_S_ADD')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT
            IMPORT SPARSE_MATRIX_T
            INTEGER(C_INT)       , INTENT(IN) :: operation
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: A
            REAL(C_FLOAT)        , INTENT(IN) :: alpha
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: B
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: C
            INTEGER(C_INT) MKL_SPARSE_S_ADD
        END FUNCTION
        FUNCTION MKL_SPARSE_D_ADD(operation,A,alpha,B,C) &
                 BIND(C, name='MKL_SPARSE_D_ADD')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE
            IMPORT SPARSE_MATRIX_T
            INTEGER(C_INT)       , INTENT(IN) :: operation
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: A
            REAL(C_DOUBLE)       , INTENT(IN) :: alpha
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: B
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: C
            INTEGER(C_INT) MKL_SPARSE_D_ADD
        END FUNCTION
        FUNCTION MKL_SPARSE_C_ADD(operation,A,alpha,B,C) &
                 BIND(C, name='MKL_SPARSE_C_ADD')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT_COMPLEX
            IMPORT SPARSE_MATRIX_T
            INTEGER(C_INT)          , INTENT(IN) :: operation
            TYPE(SPARSE_MATRIX_T)   , INTENT(IN) :: A
            COMPLEX(C_FLOAT_COMPLEX), INTENT(IN) :: alpha
            TYPE(SPARSE_MATRIX_T)   , INTENT(IN) :: B
            TYPE(SPARSE_MATRIX_T)   , INTENT(INOUT) :: C
            INTEGER(C_INT) MKL_SPARSE_C_ADD
        END FUNCTION
        FUNCTION MKL_SPARSE_Z_ADD(operation,A,alpha,B,C) &
                 BIND(C, name='MKL_SPARSE_Z_ADD')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE_COMPLEX
            IMPORT SPARSE_MATRIX_T
            INTEGER(C_INT)       , INTENT(IN) :: operation
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: A
            COMPLEX(C_DOUBLE_COMPLEX)               , INTENT(IN) :: alpha
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: B
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: C
            INTEGER(C_INT) MKL_SPARSE_Z_ADD
        END FUNCTION

!   Computes multiplication of sparse matrices: C = op(A) * B, result is sparse
        FUNCTION MKL_SPARSE_SPMM(operation,A,B,C) &
                 BIND(C, name='MKL_SPARSE_SPMM')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT
            IMPORT SPARSE_MATRIX_T
            INTEGER(C_INT)       , INTENT(IN) :: operation
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: A
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: B
            TYPE(SPARSE_MATRIX_T), INTENT(INOUT) :: C
            INTEGER(C_INT) MKL_SPARSE_SPMM
        END FUNCTION

!   Computes multiplication of sparse matrices: C = op(A) * B, result is dense
        FUNCTION MKL_SPARSE_S_SPMMD(operation,A,B,layout,C,ldc) &
                 BIND(C, name='MKL_SPARSE_S_SPMMD')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT
            IMPORT SPARSE_MATRIX_T
            INTEGER(C_INT)       , INTENT(IN) :: operation
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: A
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: B
            INTEGER(C_INT)       , INTENT(IN) :: layout
            REAL(C_FLOAT), INTENT(INOUT), DIMENSION(*) :: C
            INTEGER              , INTENT(IN) :: ldc
            INTEGER(C_INT) MKL_SPARSE_S_SPMMD
        END FUNCTION
        FUNCTION MKL_SPARSE_D_SPMMD(operation,A,B,layout,C,ldc) &
                 BIND(C, name='MKL_SPARSE_D_SPMMD')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE
            IMPORT SPARSE_MATRIX_T
            INTEGER(C_INT)      , INTENT(IN) :: operation
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: A
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: B
            INTEGER(C_INT)      , INTENT(IN) :: layout
            REAL(C_DOUBLE), INTENT(INOUT), DIMENSION(*) :: C
            INTEGER              , INTENT(IN) :: ldc
            INTEGER(C_INT) MKL_SPARSE_D_SPMMD
        END FUNCTION
        FUNCTION MKL_SPARSE_C_SPMMD(operation,A,B,layout,C,ldc) &
                 BIND(C, name='MKL_SPARSE_C_SPMMD')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_FLOAT_COMPLEX
            IMPORT SPARSE_MATRIX_T
            INTEGER(C_INT)      , INTENT(IN) :: operation
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: A
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: B
            INTEGER(C_INT)      , INTENT(IN) :: layout
            COMPLEX(C_FLOAT_COMPLEX), INTENT(INOUT), DIMENSION(*) :: C
            INTEGER             , INTENT(IN) :: ldc
            INTEGER(C_INT) MKL_SPARSE_C_SPMMD
        END FUNCTION
        FUNCTION MKL_SPARSE_Z_SPMMD(operation,A,B,layout,C,ldc) &
                 BIND(C, name='MKL_SPARSE_Z_SPMMD')
            USE, INTRINSIC :: ISO_C_BINDING , ONLY : C_INT, C_DOUBLE_COMPLEX
            IMPORT SPARSE_MATRIX_T
            INTEGER(C_INT)      , INTENT(IN) :: operation
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: A
            TYPE(SPARSE_MATRIX_T), INTENT(IN) :: B
            INTEGER(C_INT)      , INTENT(IN) :: layout
            COMPLEX(C_DOUBLE_COMPLEX), INTENT(INOUT), DIMENSION(*) :: C
            INTEGER              , INTENT(IN) :: ldc
            INTEGER(C_INT) MKL_SPARSE_Z_SPMMD
        END FUNCTION

    END INTERFACE

    END MODULE MKL_SPBLAS