stdlib_sparse_conversion Module

Sort arrays of a COO matrix

version: experimental

Conversion from dense to coo Enables extracting the non-zero elements of a dense 2D matrix and storing those values in a COO format. The coo matrix is (re)allocated on the fly. Specifications version: experimental

Conversion from coo to dense Enables creating a dense 2D matrix from the non-zero values stored in a COO format The dense matrix can be allocated on the fly if not pre-allocated by the user. Specifications version: experimental

Conversion from coo to csr Enables transferring data from a COO matrix to a CSR matrix under the hypothesis that the COO is already ordered. Specifications version: experimental

Conversion from coo to csc Enables transferring data from a COO matrix to a CSC matrix under the hypothesis that the COO is already ordered. Specifications version: experimental

Conversion from csr to dense Enables creating a dense 2D matrix from the non-zero values stored in a CSR format The dense matrix can be allocated on the fly if not pre-allocated by the user. Specifications version: experimental

Conversion from csr to coo Enables transferring data from a CSR matrix to a COO matrix under the hypothesis that the CSR is already ordered. Specifications version: experimental

Conversion from csr to ell Enables transferring data from a CSR matrix to a ELL matrix under the hypothesis that the CSR is already ordered. Specifications version: experimental

Conversion from csr to SELL-C Enables transferring data from a CSR matrix to a SELL-C matrix It takes an optional parameter to decide the chunck size 4, 8 or 16 Specifications version: experimental

Conversion from csc to coo Enables transferring data from a CSC matrix to a COO matrix under the hypothesis that the CSC is already ordered. Specifications version: experimental

Extraction of diagonal values Specifications version: experimental

Enable creating a sparse matrix from ijv (row,col,data) triplet Specifications version: experimental

Transform COO matrix to canonical form with ordered and unique entries Specifications Diagonal extraction



Interfaces

public interface coo2csc

  • private subroutine coo2csc_sp(COO, CSC)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_sp_type), intent(in) :: COO
    type(CSC_sp_type), intent(out) :: CSC
  • private subroutine coo2csc_dp(COO, CSC)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_dp_type), intent(in) :: COO
    type(CSC_dp_type), intent(out) :: CSC
  • private subroutine coo2csc_csp(COO, CSC)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_csp_type), intent(in) :: COO
    type(CSC_csp_type), intent(out) :: CSC
  • private subroutine coo2csc_cdp(COO, CSC)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_cdp_type), intent(in) :: COO
    type(CSC_cdp_type), intent(out) :: CSC

public interface coo2csr

  • private subroutine coo2csr_sp(COO, CSR)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_sp_type), intent(in) :: COO
    type(CSR_sp_type), intent(out) :: CSR
  • private subroutine coo2csr_dp(COO, CSR)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_dp_type), intent(in) :: COO
    type(CSR_dp_type), intent(out) :: CSR
  • private subroutine coo2csr_csp(COO, CSR)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_csp_type), intent(in) :: COO
    type(CSR_csp_type), intent(out) :: CSR
  • private subroutine coo2csr_cdp(COO, CSR)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_cdp_type), intent(in) :: COO
    type(CSR_cdp_type), intent(out) :: CSR

public interface coo2dense

  • private subroutine coo2dense_sp(COO, dense)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_sp_type), intent(in) :: COO
    real(kind=sp), intent(out), allocatable :: dense(:,:)
  • private subroutine coo2dense_dp(COO, dense)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_dp_type), intent(in) :: COO
    real(kind=dp), intent(out), allocatable :: dense(:,:)
  • private subroutine coo2dense_csp(COO, dense)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_csp_type), intent(in) :: COO
    complex(kind=sp), intent(out), allocatable :: dense(:,:)
  • private subroutine coo2dense_cdp(COO, dense)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_cdp_type), intent(in) :: COO
    complex(kind=dp), intent(out), allocatable :: dense(:,:)

public interface csc2coo

  • private subroutine csc2coo_sp(CSC, COO)

    Arguments

    Type IntentOptional Attributes Name
    type(CSC_sp_type), intent(in) :: CSC
    type(COO_sp_type), intent(out) :: COO
  • private subroutine csc2coo_dp(CSC, COO)

    Arguments

    Type IntentOptional Attributes Name
    type(CSC_dp_type), intent(in) :: CSC
    type(COO_dp_type), intent(out) :: COO
  • private subroutine csc2coo_csp(CSC, COO)

    Arguments

    Type IntentOptional Attributes Name
    type(CSC_csp_type), intent(in) :: CSC
    type(COO_csp_type), intent(out) :: COO
  • private subroutine csc2coo_cdp(CSC, COO)

    Arguments

    Type IntentOptional Attributes Name
    type(CSC_cdp_type), intent(in) :: CSC
    type(COO_cdp_type), intent(out) :: COO

public interface csr2coo

  • private subroutine csr2coo_sp(CSR, COO)

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_sp_type), intent(in) :: CSR
    type(COO_sp_type), intent(out) :: COO
  • private subroutine csr2coo_dp(CSR, COO)

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_dp_type), intent(in) :: CSR
    type(COO_dp_type), intent(out) :: COO
  • private subroutine csr2coo_csp(CSR, COO)

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_csp_type), intent(in) :: CSR
    type(COO_csp_type), intent(out) :: COO
  • private subroutine csr2coo_cdp(CSR, COO)

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_cdp_type), intent(in) :: CSR
    type(COO_cdp_type), intent(out) :: COO

public interface csr2dense

  • private subroutine csr2dense_sp(CSR, dense)

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_sp_type), intent(in) :: CSR
    real(kind=sp), intent(out), allocatable :: dense(:,:)
  • private subroutine csr2dense_dp(CSR, dense)

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_dp_type), intent(in) :: CSR
    real(kind=dp), intent(out), allocatable :: dense(:,:)
  • private subroutine csr2dense_csp(CSR, dense)

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_csp_type), intent(in) :: CSR
    complex(kind=sp), intent(out), allocatable :: dense(:,:)
  • private subroutine csr2dense_cdp(CSR, dense)

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_cdp_type), intent(in) :: CSR
    complex(kind=dp), intent(out), allocatable :: dense(:,:)

public interface csr2ell

  • private subroutine csr2ell_sp(CSR, ELL, num_nz_rows)

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_sp_type), intent(in) :: CSR
    type(ELL_sp_type), intent(out) :: ELL
    integer, intent(in), optional :: num_nz_rows

    number of non zeros per row

  • private subroutine csr2ell_dp(CSR, ELL, num_nz_rows)

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_dp_type), intent(in) :: CSR
    type(ELL_dp_type), intent(out) :: ELL
    integer, intent(in), optional :: num_nz_rows

    number of non zeros per row

  • private subroutine csr2ell_csp(CSR, ELL, num_nz_rows)

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_csp_type), intent(in) :: CSR
    type(ELL_csp_type), intent(out) :: ELL
    integer, intent(in), optional :: num_nz_rows

    number of non zeros per row

  • private subroutine csr2ell_cdp(CSR, ELL, num_nz_rows)

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_cdp_type), intent(in) :: CSR
    type(ELL_cdp_type), intent(out) :: ELL
    integer, intent(in), optional :: num_nz_rows

    number of non zeros per row

public interface csr2sellc

  • private subroutine csr2sellc_sp(CSR, SELLC, chunk)

    This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_sp_type), intent(in) :: CSR
    type(SELLC_sp_type), intent(out) :: SELLC
    integer, intent(in), optional :: chunk
  • private subroutine csr2sellc_dp(CSR, SELLC, chunk)

    This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_dp_type), intent(in) :: CSR
    type(SELLC_dp_type), intent(out) :: SELLC
    integer, intent(in), optional :: chunk
  • private subroutine csr2sellc_csp(CSR, SELLC, chunk)

    This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_csp_type), intent(in) :: CSR
    type(SELLC_csp_type), intent(out) :: SELLC
    integer, intent(in), optional :: chunk
  • private subroutine csr2sellc_cdp(CSR, SELLC, chunk)

    This algorithm was gracefully provided by Ivan Privec and adapted by Jose Alves

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_cdp_type), intent(in) :: CSR
    type(SELLC_cdp_type), intent(out) :: SELLC
    integer, intent(in), optional :: chunk

public interface dense2coo

  • private subroutine dense2coo_sp(dense, COO)

    Arguments

    Type IntentOptional Attributes Name
    real(kind=sp), intent(in) :: dense(:,:)
    type(COO_sp_type), intent(out) :: COO
  • private subroutine dense2coo_dp(dense, COO)

    Arguments

    Type IntentOptional Attributes Name
    real(kind=dp), intent(in) :: dense(:,:)
    type(COO_dp_type), intent(out) :: COO
  • private subroutine dense2coo_csp(dense, COO)

    Arguments

    Type IntentOptional Attributes Name
    complex(kind=sp), intent(in) :: dense(:,:)
    type(COO_csp_type), intent(out) :: COO
  • private subroutine dense2coo_cdp(dense, COO)

    Arguments

    Type IntentOptional Attributes Name
    complex(kind=dp), intent(in) :: dense(:,:)
    type(COO_cdp_type), intent(out) :: COO

public interface diag

  • private subroutine dense2diagonal_sp(dense, diagonal)

    Arguments

    Type IntentOptional Attributes Name
    real(kind=sp), intent(in) :: dense(:,:)
    real(kind=sp), intent(inout), allocatable :: diagonal(:)
  • private subroutine coo2diagonal_sp(COO, diagonal)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_sp_type), intent(in) :: COO
    real(kind=sp), intent(inout), allocatable :: diagonal(:)
  • private subroutine csr2diagonal_sp(CSR, diagonal)

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_sp_type), intent(in) :: CSR
    real(kind=sp), intent(inout), allocatable :: diagonal(:)
  • private subroutine csc2diagonal_sp(CSC, diagonal)

    Arguments

    Type IntentOptional Attributes Name
    type(CSC_sp_type), intent(in) :: CSC
    real(kind=sp), intent(inout), allocatable :: diagonal(:)
  • private subroutine ell2diagonal_sp(ELL, diagonal)

    Arguments

    Type IntentOptional Attributes Name
    type(ELL_sp_type), intent(in) :: ELL
    real(kind=sp), intent(inout), allocatable :: diagonal(:)
  • private subroutine dense2diagonal_dp(dense, diagonal)

    Arguments

    Type IntentOptional Attributes Name
    real(kind=dp), intent(in) :: dense(:,:)
    real(kind=dp), intent(inout), allocatable :: diagonal(:)
  • private subroutine coo2diagonal_dp(COO, diagonal)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_dp_type), intent(in) :: COO
    real(kind=dp), intent(inout), allocatable :: diagonal(:)
  • private subroutine csr2diagonal_dp(CSR, diagonal)

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_dp_type), intent(in) :: CSR
    real(kind=dp), intent(inout), allocatable :: diagonal(:)
  • private subroutine csc2diagonal_dp(CSC, diagonal)

    Arguments

    Type IntentOptional Attributes Name
    type(CSC_dp_type), intent(in) :: CSC
    real(kind=dp), intent(inout), allocatable :: diagonal(:)
  • private subroutine ell2diagonal_dp(ELL, diagonal)

    Arguments

    Type IntentOptional Attributes Name
    type(ELL_dp_type), intent(in) :: ELL
    real(kind=dp), intent(inout), allocatable :: diagonal(:)
  • private subroutine dense2diagonal_csp(dense, diagonal)

    Arguments

    Type IntentOptional Attributes Name
    complex(kind=sp), intent(in) :: dense(:,:)
    complex(kind=sp), intent(inout), allocatable :: diagonal(:)
  • private subroutine coo2diagonal_csp(COO, diagonal)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_csp_type), intent(in) :: COO
    complex(kind=sp), intent(inout), allocatable :: diagonal(:)
  • private subroutine csr2diagonal_csp(CSR, diagonal)

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_csp_type), intent(in) :: CSR
    complex(kind=sp), intent(inout), allocatable :: diagonal(:)
  • private subroutine csc2diagonal_csp(CSC, diagonal)

    Arguments

    Type IntentOptional Attributes Name
    type(CSC_csp_type), intent(in) :: CSC
    complex(kind=sp), intent(inout), allocatable :: diagonal(:)
  • private subroutine ell2diagonal_csp(ELL, diagonal)

    Arguments

    Type IntentOptional Attributes Name
    type(ELL_csp_type), intent(in) :: ELL
    complex(kind=sp), intent(inout), allocatable :: diagonal(:)
  • private subroutine dense2diagonal_cdp(dense, diagonal)

    Arguments

    Type IntentOptional Attributes Name
    complex(kind=dp), intent(in) :: dense(:,:)
    complex(kind=dp), intent(inout), allocatable :: diagonal(:)
  • private subroutine coo2diagonal_cdp(COO, diagonal)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_cdp_type), intent(in) :: COO
    complex(kind=dp), intent(inout), allocatable :: diagonal(:)
  • private subroutine csr2diagonal_cdp(CSR, diagonal)

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_cdp_type), intent(in) :: CSR
    complex(kind=dp), intent(inout), allocatable :: diagonal(:)
  • private subroutine csc2diagonal_cdp(CSC, diagonal)

    Arguments

    Type IntentOptional Attributes Name
    type(CSC_cdp_type), intent(in) :: CSC
    complex(kind=dp), intent(inout), allocatable :: diagonal(:)
  • private subroutine ell2diagonal_cdp(ELL, diagonal)

    Arguments

    Type IntentOptional Attributes Name
    type(ELL_cdp_type), intent(in) :: ELL
    complex(kind=dp), intent(inout), allocatable :: diagonal(:)

public interface from_ijv

  • private subroutine coo_from_ijv_type(COO, row, col, nrows, ncols)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_type), intent(inout) :: COO
    integer(kind=ilp), intent(in) :: row(:)
    integer(kind=ilp), intent(in) :: col(:)
    integer(kind=ilp), intent(in), optional :: nrows
    integer(kind=ilp), intent(in), optional :: ncols
  • private subroutine coo_from_ijv_sp(COO, row, col, data, nrows, ncols)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_sp_type), intent(inout) :: COO
    integer(kind=ilp), intent(in) :: row(:)
    integer(kind=ilp), intent(in) :: col(:)
    real(kind=sp), intent(in), optional :: data(:)
    integer(kind=ilp), intent(in), optional :: nrows
    integer(kind=ilp), intent(in), optional :: ncols
  • private subroutine csr_from_ijv_sp(CSR, row, col, data, nrows, ncols)

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_sp_type), intent(inout) :: CSR
    integer(kind=ilp), intent(in) :: row(:)
    integer(kind=ilp), intent(in) :: col(:)
    real(kind=sp), intent(in), optional :: data(:)
    integer(kind=ilp), intent(in), optional :: nrows
    integer(kind=ilp), intent(in), optional :: ncols
  • private subroutine ell_from_ijv_sp(ELL, row, col, data, nrows, ncols, num_nz_rows)

    Arguments

    Type IntentOptional Attributes Name
    type(ELL_sp_type), intent(inout) :: ELL
    integer(kind=ilp), intent(in) :: row(:)
    integer(kind=ilp), intent(in) :: col(:)
    real(kind=sp), intent(in), optional :: data(:)
    integer(kind=ilp), intent(in), optional :: nrows
    integer(kind=ilp), intent(in), optional :: ncols
    integer, intent(in), optional :: num_nz_rows
  • private subroutine sellc_from_ijv_sp(SELLC, row, col, data, nrows, ncols, chunk)

    Arguments

    Type IntentOptional Attributes Name
    type(SELLC_sp_type), intent(inout) :: SELLC
    integer(kind=ilp), intent(in) :: row(:)
    integer(kind=ilp), intent(in) :: col(:)
    real(kind=sp), intent(in), optional :: data(:)
    integer(kind=ilp), intent(in), optional :: nrows
    integer(kind=ilp), intent(in), optional :: ncols
    integer, intent(in), optional :: chunk
  • private subroutine coo_from_ijv_dp(COO, row, col, data, nrows, ncols)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_dp_type), intent(inout) :: COO
    integer(kind=ilp), intent(in) :: row(:)
    integer(kind=ilp), intent(in) :: col(:)
    real(kind=dp), intent(in), optional :: data(:)
    integer(kind=ilp), intent(in), optional :: nrows
    integer(kind=ilp), intent(in), optional :: ncols
  • private subroutine csr_from_ijv_dp(CSR, row, col, data, nrows, ncols)

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_dp_type), intent(inout) :: CSR
    integer(kind=ilp), intent(in) :: row(:)
    integer(kind=ilp), intent(in) :: col(:)
    real(kind=dp), intent(in), optional :: data(:)
    integer(kind=ilp), intent(in), optional :: nrows
    integer(kind=ilp), intent(in), optional :: ncols
  • private subroutine ell_from_ijv_dp(ELL, row, col, data, nrows, ncols, num_nz_rows)

    Arguments

    Type IntentOptional Attributes Name
    type(ELL_dp_type), intent(inout) :: ELL
    integer(kind=ilp), intent(in) :: row(:)
    integer(kind=ilp), intent(in) :: col(:)
    real(kind=dp), intent(in), optional :: data(:)
    integer(kind=ilp), intent(in), optional :: nrows
    integer(kind=ilp), intent(in), optional :: ncols
    integer, intent(in), optional :: num_nz_rows
  • private subroutine sellc_from_ijv_dp(SELLC, row, col, data, nrows, ncols, chunk)

    Arguments

    Type IntentOptional Attributes Name
    type(SELLC_dp_type), intent(inout) :: SELLC
    integer(kind=ilp), intent(in) :: row(:)
    integer(kind=ilp), intent(in) :: col(:)
    real(kind=dp), intent(in), optional :: data(:)
    integer(kind=ilp), intent(in), optional :: nrows
    integer(kind=ilp), intent(in), optional :: ncols
    integer, intent(in), optional :: chunk
  • private subroutine coo_from_ijv_csp(COO, row, col, data, nrows, ncols)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_csp_type), intent(inout) :: COO
    integer(kind=ilp), intent(in) :: row(:)
    integer(kind=ilp), intent(in) :: col(:)
    complex(kind=sp), intent(in), optional :: data(:)
    integer(kind=ilp), intent(in), optional :: nrows
    integer(kind=ilp), intent(in), optional :: ncols
  • private subroutine csr_from_ijv_csp(CSR, row, col, data, nrows, ncols)

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_csp_type), intent(inout) :: CSR
    integer(kind=ilp), intent(in) :: row(:)
    integer(kind=ilp), intent(in) :: col(:)
    complex(kind=sp), intent(in), optional :: data(:)
    integer(kind=ilp), intent(in), optional :: nrows
    integer(kind=ilp), intent(in), optional :: ncols
  • private subroutine ell_from_ijv_csp(ELL, row, col, data, nrows, ncols, num_nz_rows)

    Arguments

    Type IntentOptional Attributes Name
    type(ELL_csp_type), intent(inout) :: ELL
    integer(kind=ilp), intent(in) :: row(:)
    integer(kind=ilp), intent(in) :: col(:)
    complex(kind=sp), intent(in), optional :: data(:)
    integer(kind=ilp), intent(in), optional :: nrows
    integer(kind=ilp), intent(in), optional :: ncols
    integer, intent(in), optional :: num_nz_rows
  • private subroutine sellc_from_ijv_csp(SELLC, row, col, data, nrows, ncols, chunk)

    Arguments

    Type IntentOptional Attributes Name
    type(SELLC_csp_type), intent(inout) :: SELLC
    integer(kind=ilp), intent(in) :: row(:)
    integer(kind=ilp), intent(in) :: col(:)
    complex(kind=sp), intent(in), optional :: data(:)
    integer(kind=ilp), intent(in), optional :: nrows
    integer(kind=ilp), intent(in), optional :: ncols
    integer, intent(in), optional :: chunk
  • private subroutine coo_from_ijv_cdp(COO, row, col, data, nrows, ncols)

    Arguments

    Type IntentOptional Attributes Name
    type(COO_cdp_type), intent(inout) :: COO
    integer(kind=ilp), intent(in) :: row(:)
    integer(kind=ilp), intent(in) :: col(:)
    complex(kind=dp), intent(in), optional :: data(:)
    integer(kind=ilp), intent(in), optional :: nrows
    integer(kind=ilp), intent(in), optional :: ncols
  • private subroutine csr_from_ijv_cdp(CSR, row, col, data, nrows, ncols)

    Arguments

    Type IntentOptional Attributes Name
    type(CSR_cdp_type), intent(inout) :: CSR
    integer(kind=ilp), intent(in) :: row(:)
    integer(kind=ilp), intent(in) :: col(:)
    complex(kind=dp), intent(in), optional :: data(:)
    integer(kind=ilp), intent(in), optional :: nrows
    integer(kind=ilp), intent(in), optional :: ncols
  • private subroutine ell_from_ijv_cdp(ELL, row, col, data, nrows, ncols, num_nz_rows)

    Arguments

    Type IntentOptional Attributes Name
    type(ELL_cdp_type), intent(inout) :: ELL
    integer(kind=ilp), intent(in) :: row(:)
    integer(kind=ilp), intent(in) :: col(:)
    complex(kind=dp), intent(in), optional :: data(:)
    integer(kind=ilp), intent(in), optional :: nrows
    integer(kind=ilp), intent(in), optional :: ncols
    integer, intent(in), optional :: num_nz_rows
  • private subroutine sellc_from_ijv_cdp(SELLC, row, col, data, nrows, ncols, chunk)

    Arguments

    Type IntentOptional Attributes Name
    type(SELLC_cdp_type), intent(inout) :: SELLC
    integer(kind=ilp), intent(in) :: row(:)
    integer(kind=ilp), intent(in) :: col(:)
    complex(kind=dp), intent(in), optional :: data(:)
    integer(kind=ilp), intent(in), optional :: nrows
    integer(kind=ilp), intent(in), optional :: ncols
    integer, intent(in), optional :: chunk

Subroutines

public subroutine coo2ordered(COO, sort_data)

Arguments

Type IntentOptional Attributes Name
class(COO_type), intent(inout) :: COO
logical, intent(in), optional :: sort_data