fortran cudamalloc and cublassetmatrix wrapper problem - cuda

I maybe a problem, either with "cudamalloc" or "cublassetmatrix" not appropriately called from fortran:
module cuda
interface
integer (C_INT) function cudaMallocHost(buffer, size) bind(C,name="cudaMallocHost")
use iso_c_binding
implicit none
type (C_PTR) :: buffer
integer (C_SIZE_T), value :: size
end function cudaMallocHost
integer (C_INT) function cudaFreeHost(buffer) bind(C,name="cudaFreeHost")
use iso_c_binding
implicit none
type (C_PTR), value :: buffer
end function cudaFreeHost
integer (C_INT) function cudaMalloc(buffer, size) bind(C,name="cudaMalloc")
use iso_c_binding
implicit none
type (C_PTR) :: buffer
integer (C_SIZE_T), value :: size
end function cudaMalloc
integer (C_INT) function cudaFree(buffer) bind(C,name="cudaFree")
use iso_c_binding
implicit none
type (C_PTR), value :: buffer
end function cudaFree
integer (C_INT) function cublassetmatrix(M,N,size,A_host,lda_h&
&,A_dev,lda_d) bind(C,name="cublasSetMatrix")
use iso_c_binding
implicit none
type (C_PTR) :: A_dev
type(c_ptr) :: A_host
integer (C_SIZE_T), value :: size
integer(C_Int) :: M,N,lda_h,lda_d
end function cublassetmatrix
Type(c_ptr) function cudaGetErrorString(err) bind(C,name="cudaGetErrorString")
use iso_c_binding
implicit none
integer (C_SIZE_T), value :: err
end function cudaGetErrorString
integer (C_INT) function cublasCreate(handle) bind(C,name="cublasCreate_v2")
use iso_c_binding
implicit none
Type(C_Ptr) :: handle
end function cublasCreate
end interface
end module cuda
program test
use iso_c_binding
use cuda
implicit none
integer, parameter :: fp_kind = kind(0.0)
type(C_PTR) :: cptr_A, cptr_A_D
real (fp_kind), dimension(:,:), pointer :: A=>null()
real :: time_start,time_end
integer:: i,j, res, m1
integer(c_int) :: x
type(c_ptr) :: handle
logical:: lsexit
CHARACTER(len=50), POINTER :: errchar
m1=500
res=cublasCreate(handle)
if(res/=0) Then
write(*,*) "ERROR 1 ",res;
end if
res = cudaMallocHost ( cptr_A, m1*m1*sizeof(fp_kind) )
if(res/=0) Then
write(*,*) "ERROR 2 ",res;
end if
call c_f_pointer ( cptr_A, A, (/ m1, m1 /) )
A=1._fp_kind
res = cudaMalloc ( cptr_A_D, m1*m1*sizeof(fp_kind) )
if(res/=0) Then
write(*,*) "ERROR 3 ",res;
end if
res=cublasSetMatrix (m1,m1,sizeof(fp_kind),cptr_A,m1,cptr_A_D,m1)
if(res/=0) Then
write(*,*) "ERROR 4 ",res,sizeof(fp_kind)
call c_f_pointer ( cudageterrorstring(int(res,kind=8)),&
& errchar, [ len(errchar) ] )
write(*,*) trim(adjustl(errchar))
end if
end program test
The make command is:
tmp:
ifort -O3 -o tmp $(FFLAGS) tmp.f90 -L/opt/cuda/lib64 -lcublas -lcudart
clean:
rm tmp cuda.mod
Although "cudamallochost" expects "void ** ptr" it seems to work as the fortran pointer is usable, and when put in a loop with "cudafree" does not produce memory leaks.
The code fails at "cublassetmatrix" function either with error code 7 ("too many resources") or 11 ("invalid argument").
Any idea?

Related

Fortran generic functions based on the return kind

I am trying to create a generic function in Fortran based on the value to be returned, that is, depending on if the output of the function is to be assigned to a single precision real or to a double precision real. The code is:
MODULE kk_M
USE ISO_FORTRAN_ENV
IMPLICIT NONE
INTEGER, PARAMETER :: sp = REAL32
INTEGER, PARAMETER :: dp = REAL64
INTERFACE use_func
MODULE PROCEDURE use_sp_func
MODULE PROCEDURE use_dp_func
END INTERFACE use_func
INTERFACE use_sub
MODULE PROCEDURE use_sp_sub
MODULE PROCEDURE use_dp_sub
END INTERFACE use_sub
CONTAINS
FUNCTION use_sp_func() RESULT(res)
REAL(KIND=sp) :: res
res = 5._sp
END FUNCTION use_sp_func
FUNCTION use_dp_func() RESULT(res)
REAL(KIND=dp) :: res
res = 5._dp
END FUNCTION use_dp_func
SUBROUTINE use_sp_sub(res)
REAL(KIND=sp), INTENT(OUT) :: res
res = 5._sp
END SUBROUTINE use_sp_sub
SUBROUTINE use_dp_sub(res)
REAL(KIND=dp), INTENT(OUT) :: res
res = 5._dp
END SUBROUTINE use_dp_sub
END MODULE kk_M
PROGRAM kk
USE kk_M
IMPLICIT NONE
REAL(KIND=sp) :: num_sp
REAL(KIND=dp) :: num_dp
num_sp = use_func()
WRITE(*,*) num_sp
num_dp = use_func()
WRITE(*,*) num_dp
CALL use_sub(num_sp)
WRITE(*,*) num_sp
CALL use_sub(num_dp)
WRITE(*,*) num_dp
END PROGRAM kk
With the generic subroutines the code compiles and works, but when I add the generic functions it does not compile. I get the following error message with gfortran:
kk.f90:22:3:
FUNCTION use_sp_func() RESULT(res)
1
kk.f90:27:3:
FUNCTION use_dp_func() RESULT(res)
2
Error: Ambiguous interfaces in generic interface 'use_func' for ‘use_sp_func’ at (1) and ‘use_dp_func’ at (2)
kk.f90:46:7:
USE kk_M
1
Fatal Error: Can't open module file ‘kk_m.mod’ for reading at (1): No existe el archivo o el directorio
compilation terminated.
It looks like the compiler cannot distinguish between both functions based on the value to be returned. Is there some way to achieve this?
You cannot distinguish specific functions in a generic interface by their return value. There is no way how the compiler can see what return value type is to be used. A Fortran expression is always evaluated without the surrounding context. Fortran generic disambiguation is based by TKR (type, kind, rank) resolution only using the procedure arguments, not using the return value.
When you have
use_func()
there is no way for the compiler to know which of those two functions should be called. Even when it is used directly in an assignment
x = use_func()
it is evaluated separately. In general, function calls can appear in various complicated expressions. E.g. use_func(use_func()) + use_func(), which one would be which?
This is the reason why several intrinsic functions have another argument that specifies the return type. For example, the transfer() function has a second argument that specifies which type should be returned. Otherwise the compiler would not be able to find out.
Following the advice by Vladimir F, I had a look at the transfer intrisic function and added a mold parameter to my functions to set the return type.
If any input argument to the functions were real they could be used to set the return type as High Performace Mark stated, but since this is not my case I finally used the mold variable.
Now it compiles and work. The code is:
MODULE kk_M
USE ISO_FORTRAN_ENV
IMPLICIT NONE
INTEGER, PARAMETER :: sp = REAL32
INTEGER, PARAMETER :: dp = REAL64
INTERFACE use_func
MODULE PROCEDURE use_sp_func
MODULE PROCEDURE use_dp_func
END INTERFACE use_func
INTERFACE use_sub
MODULE PROCEDURE use_sp_sub
MODULE PROCEDURE use_dp_sub
END INTERFACE use_sub
CONTAINS
FUNCTION use_sp_func(mold) RESULT(res)
REAL(KIND=sp),INTENT(IN) :: mold
REAL(KIND=sp) :: res
IF (.FALSE.) res = mold !To avoid compilation warning about unused variable
res = 5._sp
END FUNCTION use_sp_func
FUNCTION use_dp_func(mold) RESULT(res)
REAL(KIND=dp),INTENT(IN) :: mold
REAL(KIND=dp) :: res
IF (.FALSE.) res = mold !To avoid compilation warning about unused variable
res = 5._dp
END FUNCTION use_dp_func
SUBROUTINE use_sp_sub(res)
REAL(KIND=sp), INTENT(OUT) :: res
res = 5._sp
END SUBROUTINE use_sp_sub
SUBROUTINE use_dp_sub(res)
REAL(KIND=dp), INTENT(OUT) :: res
res = 5._dp
END SUBROUTINE use_dp_sub
END MODULE kk_M
PROGRAM kk
USE kk_M
IMPLICIT NONE
REAL(KIND=sp) :: num_sp
REAL(KIND=dp) :: num_dp
num_sp = use_func(1._sp)
WRITE(*,*) num_sp
num_dp = use_func(1._dp)
WRITE(*,*) num_dp
CALL use_sub(num_sp)
WRITE(*,*) num_sp
CALL use_sub(num_dp)
WRITE(*,*) num_dp
END PROGRAM kk

Using fortran to pass functions into a subroutine.

I've written a set of subroutines and compiled them into a library. These subroutines are based on some defined function(x,y). At the moment this is buried inside the library routine - however what I'd like is to be able to pass any function(x,y) into this library - is this possible? Thanks guys!
module ExampleFuncs
implicit none
abstract interface
function func (z)
real :: func
real, intent (in) :: z
end function func
end interface
contains
subroutine EvalFunc (aFunc_ptr, x)
procedure (func), pointer :: aFunc_ptr
real, intent (in) :: x
write (*, *) "answer:", aFunc_ptr (x)
end subroutine EvalFunc
function f1 (x)
real :: f1
real, intent (in) :: x
f1 = 2.0 * x
end function f1
function f2 (x)
real :: f2
real, intent (in) :: x
f2 = 3.0 * x**2
end function f2
end module ExampleFuncs
program Func_to_Sub
use ExampleFuncs
implicit none
procedure (func), pointer :: f_ptr => null ()
f_ptr => f1
call EvalFunc (f_ptr, 2.0)
f_ptr => f2
call EvalFunc (f_ptr, 2.0)
stop
end program Func_to_Sub

Fortran - Return an anonymous function from subroutine

I am trying to generalize a function call from a subroutine. So my idea is something like this
if (case1) then
call MainSubroutine1(myFun)
elseif (case2)
call MainSubroutine2(myFun)
end if
do i = 1,4
data = myFun(i)
end do
I realize this is kind of vague but I am not sure if this is possible.
Thank you,
John
edit 1/31/14 7:57 AM
I am sorry for the vague way I phrased this. I was thinking something similar to what #haraldki did but I was hoping that I could define an anonymous function within MainSubroutine1 and MainSubroutine2 and transfer that definition out to the main code.
This is because myFun depends on different stretched distribution (Gaussian and Fermi-Dirac) and I don't want to have a function that only calls a function with a constant thrown it.
Is this possible?
Thank you again.
John
The answer to you question simply is: no, you can't return an anonymous function. This is because, as #VladimirF says in the comments, there are no anonymous functions in Fortran. As the comments say, though, procedure pointers are quite passable.
Massive speculation follows which is hopefully useful as a way of avoiding the anonymous function requirement.
I infer that you would like to do something like
subroutine MainSubroutine1(fptr)
procedure(func), pointer, intent(out) :: fptr
! Calculate parameterization for your "anonymous" function
fptr => anon_parameterized
contains
real function anon_parameterized(i)
integer, intent(in) :: i
! Use the parameterization
anon_parameterized = ...
end function
end subroutine
and you don't want to do
subroutine MainSubroutine1(fptr)
procedure(func), pointer, intent(out) :: fptr
fptr => Gaussian
end subroutine
real function Gaussian(i)
integer, intent(in) :: i
! Calculate parameterization
Gaussian = Gaussian_parameterized(i, ...)
contains
function Gaussian_parameterized(i, ...)
integer, intent(in) :: i
!... other intent(in) parameters
end function
end subroutine
Note that these aren't internal, as passing pointers to things internal elsewhere is not well implemented (as an F2008 feature) yet, and is tricky. Passing a pointer to an internal procedure to get host association scares me.
If my inference is correct, then there is the possibility of using module variables to store the parameterization, again allowing the final "parameterized" call to be not internal to MainSubroutine1.
However, you may want to avoid module variables in which case you may consider passing passing the parameterization along with the function call:
procedure(func), pointer :: myFun => null()
if (case1) then
call MainSubroutine1(myFun)
else if (case2)
call MainSubroutine2(myFun)
end if
if (.not.associated(myFun)) STOP ":("
data = myFun(1, par1, par2)
Ah, but you don't know for certain what parameters the non-parameterized function myFun requires, so your interface is all broken. Isn't it?
Which then leads to polymorphism.
module dists
type, abstract :: par_type
end type par_type
type, extends(par_type) :: par_gaussian
real :: mu=5.2, sigma=1.2
end type par_gaussian
type, extends(par_type) :: par_fermi_dirac
real :: eps=11.1, mu=4.5
end type par_fermi_dirac
abstract interface
real function func(i, pars)
import par_type
integer, intent(in) :: i
class(par_type), intent(in) :: pars
end function func
end interface
contains
real function gaussian(i, pars)
integer, intent(in) :: i
class(par_type), intent(in) :: pars
select type (pars)
class is (par_gaussian)
print*, "Gaussian", pars%mu, pars%sigma
gaussian = pars%mu+pars%sigma
end select
end function gaussian
real function fermi_dirac(i, pars)
integer, intent(in) :: i
class(par_type), intent(in) :: pars
select type (pars)
class is (par_fermi_dirac)
print*, "Fermi-Dirac", pars%eps, pars%mu
fermi_dirac = pars%eps+pars%mu
end select
end function fermi_dirac
subroutine sub1(fptr, pars)
procedure(func), pointer, intent(out) :: fptr
class(par_type), intent(out), allocatable :: pars
fptr => gaussian
allocate(par_gaussian :: pars)
end subroutine sub1
subroutine sub2(fptr, pars)
procedure(func), pointer, intent(out) :: fptr
class(par_type), intent(out), allocatable :: pars
fptr => fermi_dirac
allocate(par_fermi_dirac :: pars)
end subroutine sub2
end module dists
program prog
use dists
implicit none
class(par_type), allocatable :: pars
procedure(func), pointer :: myfun
call sub1(myfun, pars)
print*, myfun(i, pars)
call sub2(myfun, pars)
print*, myfun(i, pars)
end program prog
That's all speculation, though.

Pointer to a function inside a derived type on a module in fortran

I guess I could easily use some help here, since I'm messing around with some fortran 2003 but can't seem to understand how to do things really.
The fact is that I need to write a fortran code that declares, inside a module, a new data type
that has as one of its members a pointer to a real function. Something like
module new_mod
type my_type
real*8 :: a, b
(here something that declares a real*8 function), pointer :: ptr
end type my_type
end module_new
module funcs
real*8 function function1(x)
real*8 :: x
function1 = x*x
end function function1
real*8 function function2(x)
real*8 :: x
function2 = x*x
end function function2
end module funcs
then in the main program I would like to have something like
program my_prog
use module_new
use module_funcs
implicit none
real*8 :: y, z
type(my_type) :: atom
...
atom%ptr => function1
y = atom%ptr(x)
...
atom%ptr => function2
z = atom%ptr(x)
end program my_prog
while
so the main idea is that module_new contains a type that has a pointer to a real
function. This pointer in th eobjects of the new type I must be able to point to different functions in the main program.
I have seen one can do similar things with abstract interfaces and such, but honestly, I'm in a mess here. If someone could help, I'll appreciate that.
Cheers...
Well, that is not really the type of question you would send to stackoverflow, but actually your code needs only a "slight improvement" (by appropriate definition of slight) to work:
module accuracy
implicit none
integer, parameter :: dp = kind(1.0d0)
end module accuracy
module typedef
use accuracy
implicit none
type :: mytype
real(dp) :: aa, bb
procedure(myinterface), pointer, nopass :: myfunc
end type mytype
abstract interface
function myinterface(xx)
import :: dp
real(dp), intent(in) :: xx
real(dp) :: myinterface
end function myinterface
end interface
end module typedef
module funcs
use accuracy
implicit none
contains
function func1(xx)
real(dp), intent(in) :: xx
real(dp) :: func1
func1 = xx
end function func1
function func2(xx)
real(dp), intent(in) :: xx
real(dp) :: func2
func2 = 2.0_dp * xx
end function func2
end module funcs
program test
use accuracy
use typedef
use funcs
implicit none
real(dp) :: xx
type(mytype) :: atom
xx = 12.0_dp
atom%myfunc => func1
print *, atom%myfunc(xx)
atom%myfunc => func2
print *, atom%myfunc(xx)
end program test
There are several things to be worth to mentioned:
You should use one global parameter for your accuracy (see module accuracy) and forget about real*8.
Your procedure pointer in your derived type needs an interface, which is provided within the following abstract interface block (see 'abstract interfaces' in a good F2003 book).
You need the nopass option for the procedure pointer in the derived type as otherwise Fortran will assume that the first parameter passed to the function/subroutine is the derived type itself (see 'type bound procedures' in a good F2003 book).
Finally, although rather obvious: You should definitely read a book about the Fortran 2003 features if you are serious about using them in a production code.

Elemental functions cannot be pointed to by procedure pointers

I'm trying to use a procedure pointer (new feature in Fortran 2003) to point to an elemental function but it does not work. I really need the function to be ELEMENTAL and need a pointer to it. Is it truly impossible to point to an elemental function in Fortran?
module elemfunc
implicit none
contains
elemental function fun111(x) result(y)
real*8, intent(in) :: x
real*8 :: y
y = x**2+1
end function fun111
end module elemfunc
program testptr
use elemfunc
implicit none
interface
elemental function func (z)
real*8 :: func
real*8, intent (in) :: z
end function func
end interface
procedure (func), pointer :: ptr
ptr => fun111
print *, ptr( (/1.0d0,2.0d0/) )
end program testptr
Error message:
main.f90:12.7:ptr=>fun111
1
Nonintrinstic elemental procedure pointer 'func111' is invalid in procedure pointer assignment at (1)
In paragraph 7.4.2 Pointer Assignment of the fortran 2003 standard it is explicitly stated that this is not allowed:
C728 (R742) The proc-target shall not be a nonintrinsic elemental procedure
(This constraint is still there in the fortran 2008 standard, so it hasn't been relaxed.)
I had this exact same issue and did not even realize it was an issue until I compiled with gfortran. Unfortunately, it is also forbidden to have dummy procedure arguments to elemental procedures. It is, however, still possible to achieve the functionality you want, though it is a bit kludgy.
What you can legally do is have an elemental function call a pure function. Depending on your needs, the elemental function can be type bound or not.
Option one
Put the procedure pointer and function inside a module:
module A
implicit none
procedure(func_IF), pointer :: ptr => null()
abstract interface
pure function func_IF(x)
real, intent(in) :: x
real :: func_IF
end function
end interface
contains
! Non type bound elemental
elemental function myfun1(x) result(r)
real, intent(in) :: x
real :: r
if(associated(ptr)) r = ptr(x)
end function
end module
Option two
Put both pointer and function inside a derived type:
module B
implicit none
type :: foo
procedure(func_IF), nopass, pointer :: ptr => null()
contains
procedure, pass :: myfun2
end type
abstract interface
pure function func_IF(x)
real, intent(in) :: x
real :: func_IF
end function
end interface
contains
! Type bound elemental
elemental function myfun2(this, x) result(r)
class(foo), intent(in) :: this
real, intent(in) :: x
real :: r
if(associated(this%ptr)) r = this%ptr(x)
end function
end module
A small test program:
program main
use A
use B
implicit none
type(foo) :: myfoo
myfoo%ptr => bar
ptr => bar
print*, myfun1([10., 20.])
print*, myfoo%myfun2([10., 20.])
contains
! Demo pure function with interface func_IF
pure function bar(x)
real, intent(in) :: x
real :: bar
bar = x**2
end function
end