#if !defined(SX) module util_mod_cpts_int use constants use helem use SystemData, only: Symmetry, assignment(=) use symdata, only: SymPairProd, assignment(=) use, intrinsic :: iso_c_binding, only: c_ptr, c_loc, c_int, c_f_pointer implicit none private public :: arr_2d_ptr, arr_2d_dims, ptr_abuse_1d public :: ptr_abuse_scalar, ptr_abuse_2d interface arr_2d_dims module procedure arr_2d_dims_int end interface interface arr_2d_ptr module procedure arr_2d_ptr_int end interface interface ptr_abuse_1d module procedure ptr_abuse_1d_int end interface interface ptr_abuse_2d module procedure ptr_abuse_2d_int end interface interface ptr_abuse_scalar module procedure ptr_abuse_scalar_int end interface contains function arr_2d_dims_int(arr) result(dims) ! Return the array dimensions of the supplied 2d array integer(kind=int32), intent(in) :: arr(:,:) integer(int64) :: dims(2) dims = [ & ubound(arr, 1) - lbound(arr, 1) + 1, & ubound(arr, 2) - lbound(arr, 2) + 1 & ] end function function arr_2d_ptr_int(arr) result(cptr) ! Return a cpointer to the specified 2d array integer(kind=int32), intent(inout), target :: arr(:,:) type(c_ptr) :: cptr integer(kind=int32), pointer :: elem1 ! Convert first to a single element, and then return the c pointer ! to keep all compilers happy that the c-interoperability ! requirements have been met. Some of them are unecessarily fragile... elem1 => arr(lbound(arr, 1), lbound(arr, 2)) cptr = c_loc(elem1) end function subroutine ptr_abuse_1d_int(arr, ptr) ! Return an int32 pointer to the target array. Ignore types. integer(kind=int32), intent(in), target :: arr(:) integer(int32), intent(inout), pointer :: ptr(:) type(c_ptr) :: cptr integer(kind=int32), pointer :: elem1 ! Convert first to a single element, then to a c pointer, and then ! the target type elem1 => arr(lbound(arr, 1)) cptr = c_loc(elem1) call c_f_pointer(cptr, ptr, [1]) end subroutine subroutine ptr_abuse_2d_int(arr, ptr) ! Return an int32 pointer to the target array. Ignore types. integer(kind=int32), intent(in), target :: arr(:,:) integer(int32), intent(inout), pointer :: ptr(:,:) type(c_ptr) :: cptr integer(kind=int32), pointer :: elem1 ! Convert first to a single element, then to a c pointer, and then ! the target type elem1 => arr(lbound(arr, 1), lbound(arr, 2)) cptr = c_loc(elem1) call c_f_pointer(cptr, ptr, [1,1]) end subroutine subroutine ptr_abuse_scalar_int(elem, ptr) ! Return an int32 pointer to the target array. Ignore types. integer(kind=int32), intent(in), target :: elem integer(int32), intent(inout), pointer :: ptr type(c_ptr) :: cptr ! Convert first to a single element, then to a c pointer, and then ! the target type cptr = c_loc(elem) call c_f_pointer(cptr, ptr) end subroutine end module #endif module util_mod_cpts_int64 use constants use helem use SystemData, only: Symmetry, assignment(=) use symdata, only: SymPairProd, assignment(=) use, intrinsic :: iso_c_binding, only: c_ptr, c_loc, c_int, c_f_pointer implicit none private public :: arr_2d_ptr, arr_2d_dims, ptr_abuse_1d public :: ptr_abuse_scalar, ptr_abuse_2d interface arr_2d_dims module procedure arr_2d_dims_int64 end interface interface arr_2d_ptr module procedure arr_2d_ptr_int64 end interface interface ptr_abuse_1d module procedure ptr_abuse_1d_int64 end interface interface ptr_abuse_2d module procedure ptr_abuse_2d_int64 end interface interface ptr_abuse_scalar module procedure ptr_abuse_scalar_int64 end interface contains function arr_2d_dims_int64(arr) result(dims) ! Return the array dimensions of the supplied 2d array integer(kind=int64), intent(in) :: arr(:,:) integer(int64) :: dims(2) dims = [ & ubound(arr, 1) - lbound(arr, 1) + 1, & ubound(arr, 2) - lbound(arr, 2) + 1 & ] end function function arr_2d_ptr_int64(arr) result(cptr) ! Return a cpointer to the specified 2d array integer(kind=int64), intent(inout), target :: arr(:,:) type(c_ptr) :: cptr integer(kind=int64), pointer :: elem1 ! Convert first to a single element, and then return the c pointer ! to keep all compilers happy that the c-interoperability ! requirements have been met. Some of them are unecessarily fragile... elem1 => arr(lbound(arr, 1), lbound(arr, 2)) cptr = c_loc(elem1) end function subroutine ptr_abuse_1d_int64(arr, ptr) ! Return an int32 pointer to the target array. Ignore types. integer(kind=int64), intent(in), target :: arr(:) integer(int32), intent(inout), pointer :: ptr(:) type(c_ptr) :: cptr integer(kind=int64), pointer :: elem1 ! Convert first to a single element, then to a c pointer, and then ! the target type elem1 => arr(lbound(arr, 1)) cptr = c_loc(elem1) call c_f_pointer(cptr, ptr, [1]) end subroutine subroutine ptr_abuse_2d_int64(arr, ptr) ! Return an int32 pointer to the target array. Ignore types. integer(kind=int64), intent(in), target :: arr(:,:) integer(int32), intent(inout), pointer :: ptr(:,:) type(c_ptr) :: cptr integer(kind=int64), pointer :: elem1 ! Convert first to a single element, then to a c pointer, and then ! the target type elem1 => arr(lbound(arr, 1), lbound(arr, 2)) cptr = c_loc(elem1) call c_f_pointer(cptr, ptr, [1,1]) end subroutine subroutine ptr_abuse_scalar_int64(elem, ptr) ! Return an int32 pointer to the target array. Ignore types. integer(kind=int64), intent(in), target :: elem integer(int32), intent(inout), pointer :: ptr type(c_ptr) :: cptr ! Convert first to a single element, then to a c pointer, and then ! the target type cptr = c_loc(elem) call c_f_pointer(cptr, ptr) end subroutine end module #if !defined(SX) module util_mod_cpts_real use constants use helem use SystemData, only: Symmetry, assignment(=) use symdata, only: SymPairProd, assignment(=) use, intrinsic :: iso_c_binding, only: c_ptr, c_loc, c_int, c_f_pointer implicit none private public :: arr_2d_ptr, arr_2d_dims, ptr_abuse_1d public :: ptr_abuse_scalar, ptr_abuse_2d interface arr_2d_dims module procedure arr_2d_dims_real end interface interface arr_2d_ptr module procedure arr_2d_ptr_real end interface interface ptr_abuse_1d module procedure ptr_abuse_1d_real end interface interface ptr_abuse_2d module procedure ptr_abuse_2d_real end interface interface ptr_abuse_scalar module procedure ptr_abuse_scalar_real end interface contains function arr_2d_dims_real(arr) result(dims) ! Return the array dimensions of the supplied 2d array real(kind=sp), intent(in) :: arr(:,:) integer(int64) :: dims(2) dims = [ & ubound(arr, 1) - lbound(arr, 1) + 1, & ubound(arr, 2) - lbound(arr, 2) + 1 & ] end function function arr_2d_ptr_real(arr) result(cptr) ! Return a cpointer to the specified 2d array real(kind=sp), intent(inout), target :: arr(:,:) type(c_ptr) :: cptr real(kind=sp), pointer :: elem1 ! Convert first to a single element, and then return the c pointer ! to keep all compilers happy that the c-interoperability ! requirements have been met. Some of them are unecessarily fragile... elem1 => arr(lbound(arr, 1), lbound(arr, 2)) cptr = c_loc(elem1) end function subroutine ptr_abuse_1d_real(arr, ptr) ! Return an int32 pointer to the target array. Ignore types. real(kind=sp), intent(in), target :: arr(:) integer(int32), intent(inout), pointer :: ptr(:) type(c_ptr) :: cptr real(kind=sp), pointer :: elem1 ! Convert first to a single element, then to a c pointer, and then ! the target type elem1 => arr(lbound(arr, 1)) cptr = c_loc(elem1) call c_f_pointer(cptr, ptr, [1]) end subroutine subroutine ptr_abuse_2d_real(arr, ptr) ! Return an int32 pointer to the target array. Ignore types. real(kind=sp), intent(in), target :: arr(:,:) integer(int32), intent(inout), pointer :: ptr(:,:) type(c_ptr) :: cptr real(kind=sp), pointer :: elem1 ! Convert first to a single element, then to a c pointer, and then ! the target type elem1 => arr(lbound(arr, 1), lbound(arr, 2)) cptr = c_loc(elem1) call c_f_pointer(cptr, ptr, [1,1]) end subroutine subroutine ptr_abuse_scalar_real(elem, ptr) ! Return an int32 pointer to the target array. Ignore types. real(kind=sp), intent(in), target :: elem integer(int32), intent(inout), pointer :: ptr type(c_ptr) :: cptr ! Convert first to a single element, then to a c pointer, and then ! the target type cptr = c_loc(elem) call c_f_pointer(cptr, ptr) end subroutine end module #endif module util_mod_cpts_doub use constants use helem use SystemData, only: Symmetry, assignment(=) use symdata, only: SymPairProd, assignment(=) use, intrinsic :: iso_c_binding, only: c_ptr, c_loc, c_int, c_f_pointer implicit none private public :: arr_2d_ptr, arr_2d_dims, ptr_abuse_1d public :: ptr_abuse_scalar, ptr_abuse_2d interface arr_2d_dims module procedure arr_2d_dims_doub end interface interface arr_2d_ptr module procedure arr_2d_ptr_doub end interface interface ptr_abuse_1d module procedure ptr_abuse_1d_doub end interface interface ptr_abuse_2d module procedure ptr_abuse_2d_doub end interface interface ptr_abuse_scalar module procedure ptr_abuse_scalar_doub end interface contains function arr_2d_dims_doub(arr) result(dims) ! Return the array dimensions of the supplied 2d array real(kind=dp), intent(in) :: arr(:,:) integer(int64) :: dims(2) dims = [ & ubound(arr, 1) - lbound(arr, 1) + 1, & ubound(arr, 2) - lbound(arr, 2) + 1 & ] end function function arr_2d_ptr_doub(arr) result(cptr) ! Return a cpointer to the specified 2d array real(kind=dp), intent(inout), target :: arr(:,:) type(c_ptr) :: cptr real(kind=dp), pointer :: elem1 ! Convert first to a single element, and then return the c pointer ! to keep all compilers happy that the c-interoperability ! requirements have been met. Some of them are unecessarily fragile... elem1 => arr(lbound(arr, 1), lbound(arr, 2)) cptr = c_loc(elem1) end function subroutine ptr_abuse_1d_doub(arr, ptr) ! Return an int32 pointer to the target array. Ignore types. real(kind=dp), intent(in), target :: arr(:) integer(int32), intent(inout), pointer :: ptr(:) type(c_ptr) :: cptr real(kind=dp), pointer :: elem1 ! Convert first to a single element, then to a c pointer, and then ! the target type elem1 => arr(lbound(arr, 1)) cptr = c_loc(elem1) call c_f_pointer(cptr, ptr, [1]) end subroutine subroutine ptr_abuse_2d_doub(arr, ptr) ! Return an int32 pointer to the target array. Ignore types. real(kind=dp), intent(in), target :: arr(:,:) integer(int32), intent(inout), pointer :: ptr(:,:) type(c_ptr) :: cptr real(kind=dp), pointer :: elem1 ! Convert first to a single element, then to a c pointer, and then ! the target type elem1 => arr(lbound(arr, 1), lbound(arr, 2)) cptr = c_loc(elem1) call c_f_pointer(cptr, ptr, [1,1]) end subroutine subroutine ptr_abuse_scalar_doub(elem, ptr) ! Return an int32 pointer to the target array. Ignore types. real(kind=dp), intent(in), target :: elem integer(int32), intent(inout), pointer :: ptr type(c_ptr) :: cptr ! Convert first to a single element, then to a c pointer, and then ! the target type cptr = c_loc(elem) call c_f_pointer(cptr, ptr) end subroutine end module module util_mod_cpts_logical use constants use helem use SystemData, only: Symmetry, assignment(=) use symdata, only: SymPairProd, assignment(=) use, intrinsic :: iso_c_binding, only: c_ptr, c_loc, c_int, c_f_pointer implicit none private public :: arr_2d_ptr, arr_2d_dims, ptr_abuse_1d public :: ptr_abuse_scalar, ptr_abuse_2d interface arr_2d_dims module procedure arr_2d_dims_logical end interface interface arr_2d_ptr module procedure arr_2d_ptr_logical end interface interface ptr_abuse_1d module procedure ptr_abuse_1d_logical end interface interface ptr_abuse_2d module procedure ptr_abuse_2d_logical end interface interface ptr_abuse_scalar module procedure ptr_abuse_scalar_logical end interface contains function arr_2d_dims_logical(arr) result(dims) ! Return the array dimensions of the supplied 2d array logical, intent(in) :: arr(:,:) integer(int64) :: dims(2) dims = [ & ubound(arr, 1) - lbound(arr, 1) + 1, & ubound(arr, 2) - lbound(arr, 2) + 1 & ] end function function arr_2d_ptr_logical(arr) result(cptr) ! Return a cpointer to the specified 2d array logical, intent(inout), target :: arr(:,:) type(c_ptr) :: cptr logical, pointer :: elem1 ! Convert first to a single element, and then return the c pointer ! to keep all compilers happy that the c-interoperability ! requirements have been met. Some of them are unecessarily fragile... elem1 => arr(lbound(arr, 1), lbound(arr, 2)) cptr = c_loc(elem1) end function subroutine ptr_abuse_1d_logical(arr, ptr) ! Return an int32 pointer to the target array. Ignore types. logical, intent(in), target :: arr(:) integer(int32), intent(inout), pointer :: ptr(:) type(c_ptr) :: cptr logical, pointer :: elem1 ! Convert first to a single element, then to a c pointer, and then ! the target type elem1 => arr(lbound(arr, 1)) cptr = c_loc(elem1) call c_f_pointer(cptr, ptr, [1]) end subroutine subroutine ptr_abuse_2d_logical(arr, ptr) ! Return an int32 pointer to the target array. Ignore types. logical, intent(in), target :: arr(:,:) integer(int32), intent(inout), pointer :: ptr(:,:) type(c_ptr) :: cptr logical, pointer :: elem1 ! Convert first to a single element, then to a c pointer, and then ! the target type elem1 => arr(lbound(arr, 1), lbound(arr, 2)) cptr = c_loc(elem1) call c_f_pointer(cptr, ptr, [1,1]) end subroutine subroutine ptr_abuse_scalar_logical(elem, ptr) ! Return an int32 pointer to the target array. Ignore types. logical, intent(in), target :: elem integer(int32), intent(inout), pointer :: ptr type(c_ptr) :: cptr ! Convert first to a single element, then to a c pointer, and then ! the target type cptr = c_loc(elem) call c_f_pointer(cptr, ptr) end subroutine end module #if !defined(SX) module util_mod_cpts_cplx use constants use helem use SystemData, only: Symmetry, assignment(=) use symdata, only: SymPairProd, assignment(=) use, intrinsic :: iso_c_binding, only: c_ptr, c_loc, c_int, c_f_pointer implicit none private public :: arr_2d_ptr, arr_2d_dims, ptr_abuse_1d public :: ptr_abuse_scalar, ptr_abuse_2d interface arr_2d_dims module procedure arr_2d_dims_cplx end interface interface arr_2d_ptr module procedure arr_2d_ptr_cplx end interface interface ptr_abuse_1d module procedure ptr_abuse_1d_cplx end interface interface ptr_abuse_2d module procedure ptr_abuse_2d_cplx end interface interface ptr_abuse_scalar module procedure ptr_abuse_scalar_cplx end interface contains function arr_2d_dims_cplx(arr) result(dims) ! Return the array dimensions of the supplied 2d array complex(kind=sp), intent(in) :: arr(:,:) integer(int64) :: dims(2) dims = [ & ubound(arr, 1) - lbound(arr, 1) + 1, & ubound(arr, 2) - lbound(arr, 2) + 1 & ] end function function arr_2d_ptr_cplx(arr) result(cptr) ! Return a cpointer to the specified 2d array complex(kind=sp), intent(inout), target :: arr(:,:) type(c_ptr) :: cptr complex(kind=sp), pointer :: elem1 ! Convert first to a single element, and then return the c pointer ! to keep all compilers happy that the c-interoperability ! requirements have been met. Some of them are unecessarily fragile... elem1 => arr(lbound(arr, 1), lbound(arr, 2)) cptr = c_loc(elem1) end function subroutine ptr_abuse_1d_cplx(arr, ptr) ! Return an int32 pointer to the target array. Ignore types. complex(kind=sp), intent(in), target :: arr(:) integer(int32), intent(inout), pointer :: ptr(:) type(c_ptr) :: cptr complex(kind=sp), pointer :: elem1 ! Convert first to a single element, then to a c pointer, and then ! the target type elem1 => arr(lbound(arr, 1)) cptr = c_loc(elem1) call c_f_pointer(cptr, ptr, [1]) end subroutine subroutine ptr_abuse_2d_cplx(arr, ptr) ! Return an int32 pointer to the target array. Ignore types. complex(kind=sp), intent(in), target :: arr(:,:) integer(int32), intent(inout), pointer :: ptr(:,:) type(c_ptr) :: cptr complex(kind=sp), pointer :: elem1 ! Convert first to a single element, then to a c pointer, and then ! the target type elem1 => arr(lbound(arr, 1), lbound(arr, 2)) cptr = c_loc(elem1) call c_f_pointer(cptr, ptr, [1,1]) end subroutine subroutine ptr_abuse_scalar_cplx(elem, ptr) ! Return an int32 pointer to the target array. Ignore types. complex(kind=sp), intent(in), target :: elem integer(int32), intent(inout), pointer :: ptr type(c_ptr) :: cptr ! Convert first to a single element, then to a c pointer, and then ! the target type cptr = c_loc(elem) call c_f_pointer(cptr, ptr) end subroutine end module #endif module util_mod_cpts_cplx_doub use constants use helem use SystemData, only: Symmetry, assignment(=) use symdata, only: SymPairProd, assignment(=) use, intrinsic :: iso_c_binding, only: c_ptr, c_loc, c_int, c_f_pointer implicit none private public :: arr_2d_ptr, arr_2d_dims, ptr_abuse_1d public :: ptr_abuse_scalar, ptr_abuse_2d interface arr_2d_dims module procedure arr_2d_dims_cplx_doub end interface interface arr_2d_ptr module procedure arr_2d_ptr_cplx_doub end interface interface ptr_abuse_1d module procedure ptr_abuse_1d_cplx_doub end interface interface ptr_abuse_2d module procedure ptr_abuse_2d_cplx_doub end interface interface ptr_abuse_scalar module procedure ptr_abuse_scalar_cplx_doub end interface contains function arr_2d_dims_cplx_doub(arr) result(dims) ! Return the array dimensions of the supplied 2d array complex(kind=dp), intent(in) :: arr(:,:) integer(int64) :: dims(2) dims = [ & ubound(arr, 1) - lbound(arr, 1) + 1, & ubound(arr, 2) - lbound(arr, 2) + 1 & ] end function function arr_2d_ptr_cplx_doub(arr) result(cptr) ! Return a cpointer to the specified 2d array complex(kind=dp), intent(inout), target :: arr(:,:) type(c_ptr) :: cptr complex(kind=dp), pointer :: elem1 ! Convert first to a single element, and then return the c pointer ! to keep all compilers happy that the c-interoperability ! requirements have been met. Some of them are unecessarily fragile... elem1 => arr(lbound(arr, 1), lbound(arr, 2)) cptr = c_loc(elem1) end function subroutine ptr_abuse_1d_cplx_doub(arr, ptr) ! Return an int32 pointer to the target array. Ignore types. complex(kind=dp), intent(in), target :: arr(:) integer(int32), intent(inout), pointer :: ptr(:) type(c_ptr) :: cptr complex(kind=dp), pointer :: elem1 ! Convert first to a single element, then to a c pointer, and then ! the target type elem1 => arr(lbound(arr, 1)) cptr = c_loc(elem1) call c_f_pointer(cptr, ptr, [1]) end subroutine subroutine ptr_abuse_2d_cplx_doub(arr, ptr) ! Return an int32 pointer to the target array. Ignore types. complex(kind=dp), intent(in), target :: arr(:,:) integer(int32), intent(inout), pointer :: ptr(:,:) type(c_ptr) :: cptr complex(kind=dp), pointer :: elem1 ! Convert first to a single element, then to a c pointer, and then ! the target type elem1 => arr(lbound(arr, 1), lbound(arr, 2)) cptr = c_loc(elem1) call c_f_pointer(cptr, ptr, [1,1]) end subroutine subroutine ptr_abuse_scalar_cplx_doub(elem, ptr) ! Return an int32 pointer to the target array. Ignore types. complex(kind=dp), intent(in), target :: elem integer(int32), intent(inout), pointer :: ptr type(c_ptr) :: cptr ! Convert first to a single element, then to a c pointer, and then ! the target type cptr = c_loc(elem) call c_f_pointer(cptr, ptr) end subroutine end module module util_mod_cpts_sym use constants use helem use SystemData, only: Symmetry, assignment(=) use symdata, only: SymPairProd, assignment(=) use, intrinsic :: iso_c_binding, only: c_ptr, c_loc, c_int, c_f_pointer implicit none private public :: arr_2d_ptr, arr_2d_dims, ptr_abuse_1d public :: ptr_abuse_scalar, ptr_abuse_2d interface arr_2d_dims module procedure arr_2d_dims_sym end interface interface arr_2d_ptr module procedure arr_2d_ptr_sym end interface interface ptr_abuse_1d module procedure ptr_abuse_1d_sym end interface interface ptr_abuse_2d module procedure ptr_abuse_2d_sym end interface interface ptr_abuse_scalar module procedure ptr_abuse_scalar_sym end interface contains function arr_2d_dims_sym(arr) result(dims) ! Return the array dimensions of the supplied 2d array type(Symmetry), intent(in) :: arr(:,:) integer(int64) :: dims(2) dims = [ & ubound(arr, 1) - lbound(arr, 1) + 1, & ubound(arr, 2) - lbound(arr, 2) + 1 & ] end function function arr_2d_ptr_sym(arr) result(cptr) ! Return a cpointer to the specified 2d array type(Symmetry), intent(inout), target :: arr(:,:) type(c_ptr) :: cptr type(Symmetry), pointer :: elem1 ! Convert first to a single element, and then return the c pointer ! to keep all compilers happy that the c-interoperability ! requirements have been met. Some of them are unecessarily fragile... elem1 => arr(lbound(arr, 1), lbound(arr, 2)) cptr = c_loc(elem1) end function subroutine ptr_abuse_1d_sym(arr, ptr) ! Return an int32 pointer to the target array. Ignore types. type(Symmetry), intent(in), target :: arr(:) integer(int32), intent(inout), pointer :: ptr(:) type(c_ptr) :: cptr type(Symmetry), pointer :: elem1 ! Convert first to a single element, then to a c pointer, and then ! the target type elem1 => arr(lbound(arr, 1)) cptr = c_loc(elem1) call c_f_pointer(cptr, ptr, [1]) end subroutine subroutine ptr_abuse_2d_sym(arr, ptr) ! Return an int32 pointer to the target array. Ignore types. type(Symmetry), intent(in), target :: arr(:,:) integer(int32), intent(inout), pointer :: ptr(:,:) type(c_ptr) :: cptr type(Symmetry), pointer :: elem1 ! Convert first to a single element, then to a c pointer, and then ! the target type elem1 => arr(lbound(arr, 1), lbound(arr, 2)) cptr = c_loc(elem1) call c_f_pointer(cptr, ptr, [1,1]) end subroutine subroutine ptr_abuse_scalar_sym(elem, ptr) ! Return an int32 pointer to the target array. Ignore types. type(Symmetry), intent(in), target :: elem integer(int32), intent(inout), pointer :: ptr type(c_ptr) :: cptr ! Convert first to a single element, then to a c pointer, and then ! the target type cptr = c_loc(elem) call c_f_pointer(cptr, ptr) end subroutine end module module util_mod_cpts_sympairprod use constants use helem use SystemData, only: Symmetry, assignment(=) use symdata, only: SymPairProd, assignment(=) use, intrinsic :: iso_c_binding, only: c_ptr, c_loc, c_int, c_f_pointer implicit none private public :: arr_2d_ptr, arr_2d_dims, ptr_abuse_1d public :: ptr_abuse_scalar, ptr_abuse_2d interface arr_2d_dims module procedure arr_2d_dims_sympairprod end interface interface arr_2d_ptr module procedure arr_2d_ptr_sympairprod end interface interface ptr_abuse_1d module procedure ptr_abuse_1d_sympairprod end interface interface ptr_abuse_2d module procedure ptr_abuse_2d_sympairprod end interface interface ptr_abuse_scalar module procedure ptr_abuse_scalar_sympairprod end interface contains function arr_2d_dims_sympairprod(arr) result(dims) ! Return the array dimensions of the supplied 2d array type(SymPairProd), intent(in) :: arr(:,:) integer(int64) :: dims(2) dims = [ & ubound(arr, 1) - lbound(arr, 1) + 1, & ubound(arr, 2) - lbound(arr, 2) + 1 & ] end function function arr_2d_ptr_sympairprod(arr) result(cptr) ! Return a cpointer to the specified 2d array type(SymPairProd), intent(inout), target :: arr(:,:) type(c_ptr) :: cptr type(SymPairProd), pointer :: elem1 ! Convert first to a single element, and then return the c pointer ! to keep all compilers happy that the c-interoperability ! requirements have been met. Some of them are unecessarily fragile... elem1 => arr(lbound(arr, 1), lbound(arr, 2)) cptr = c_loc(elem1) end function subroutine ptr_abuse_1d_sympairprod(arr, ptr) ! Return an int32 pointer to the target array. Ignore types. type(SymPairProd), intent(in), target :: arr(:) integer(int32), intent(inout), pointer :: ptr(:) type(c_ptr) :: cptr type(SymPairProd), pointer :: elem1 ! Convert first to a single element, then to a c pointer, and then ! the target type elem1 => arr(lbound(arr, 1)) cptr = c_loc(elem1) call c_f_pointer(cptr, ptr, [1]) end subroutine subroutine ptr_abuse_2d_sympairprod(arr, ptr) ! Return an int32 pointer to the target array. Ignore types. type(SymPairProd), intent(in), target :: arr(:,:) integer(int32), intent(inout), pointer :: ptr(:,:) type(c_ptr) :: cptr type(SymPairProd), pointer :: elem1 ! Convert first to a single element, then to a c pointer, and then ! the target type elem1 => arr(lbound(arr, 1), lbound(arr, 2)) cptr = c_loc(elem1) call c_f_pointer(cptr, ptr, [1,1]) end subroutine subroutine ptr_abuse_scalar_sympairprod(elem, ptr) ! Return an int32 pointer to the target array. Ignore types. type(SymPairProd), intent(in), target :: elem integer(int32), intent(inout), pointer :: ptr type(c_ptr) :: cptr ! Convert first to a single element, then to a c pointer, and then ! the target type cptr = c_loc(elem) call c_f_pointer(cptr, ptr) end subroutine end module module util_mod_cpts #if !defined(SX) use util_mod_cpts_int #endif use util_mod_cpts_int64 #if !defined(SX) use util_mod_cpts_real #endif use util_mod_cpts_doub use util_mod_cpts_logical #if !defined(SX) use util_mod_cpts_cplx #endif use util_mod_cpts_cplx_doub use util_mod_cpts_sym use util_mod_cpts_sympairprod end module