Fortran procedure pointer points to a subroutine that does nothing - pointers

I have a code like this
:
procedure(),pointer :: p
if ()
p => job1
else
p => job2
endif
do i=1,a_big_number
call x(...)
call p(i,j,k)
enddo
The subroutine 'job1' does some work, but the subroutine 'job2' does nothing. In other words, under some circumstances, I need to finish 'x' and 'job1'. Under other circumstances, I only need to do 'x'. My question is how should I define job2. It seems simply using null() does not work. What I am doing right now is like:
subroutine job2(i,j,k)
integer,intent(in) :: i,j,k
end subroutine
However, this looks silly, and I got a lot compiling warning when I compiled the code because those arguments were not used. Is there a smarter way to do this?

You could nullify the procedure pointer in the case that there was nothing useful to do, and then test the association status prior to invoking the procedure through the pointer.
PROCEDURE(interface_that_matches_job1), POINTER :: p
IF (...) THEN
p => job1
ELSE
NULLIFY(p) ! Or p => NULL()
END IF
DO i = 1, a_big_number
CALL x(...)
IF (ASSOCIATED(p)) CALL p(i,j,k)
END DO

If your concern is really about the if statement in the loop, you could just put the if statement outside of the loop:
if (condition) then
do ii = 1, big_number
call x(...)
call p(i,j,k)
end do
else
do ii = 1, big_number
call x(...)
end do
end if
Then do some timings on this version and then on a version with the if inside the loop:
do ii = 1, big_number
call x(...)
if (condition) then
call p(i,j,k)
end if
end do
I'd rather guess that you won't see any significant difference between them, as the subroutine call in the loop may already giving you an overhead much larger as the one caused by the if statement.

Related

How to have one Fortran function with different type of parameters using c_ptr?

I read the section Type Casting in Callbacks of the article Fortran Best practices.
I would like to use in my program something as described in Using type(c_ptr) Pointer
But I have a problem. I give an outline of what I try to do. I hope it will be sufficient to understand. Otherwise, let me know, I will post a full example.
I have two types and I call the same subroutine with one or the other type. The first parameter of my subroutine is an integer to indicate which is the type of the second parameter (type1_t or type2_t)
type type1_t
real :: a, b
integer :: c
end type1_t
type type2_t
real :: a,e
integer :: b,c,d
end type2_t
type(type1_t) :: type1
! ... init of type1
type(type2_t) :: type2
! ... init of type2_t
call myfoo(1,c_loc(type_1))
call myfoo(2,c_loc(type_2))
But now, I have a problem with the declaration in myfoo because the declaration must be done in fortran before instructions.
I know that the following code does not work :
subroutine myfoo(i, params)
integer, intent(in) :: i
type(c_ptr), intent(in) :: params
if (i == 1) then
type(type1_t), pointer :: pars
elseif (i ==2) then
type(type2_t), pointer :: pars
endif
call c_f_pointer(params, pars)
! do some stuff with pars (there are common parts of code either the dummy args is type_1 or type_2). For example, the line above.
end subroutine myfoo
If I use a block construct, I will have a problem because the variable disappears at the end of the block.
How can I solve it using c_ptr?
A simple way to accomplish this is to put type-specific code in two separate routines in a module, and bind them using an interface, so the compiler will pick the right subroutine based on the type of the variable provided on input:
module blabla
private
public :: foo
interface foo
module procedure foo1
module procedure foo2
end interface
contains
subroutine foo1(params)
type(t1) :: params
! Do cool stuff
end subroutine foo1
subroutine foo2(params)
type(t2) :: params
! Do type-2 cool stuff here
end subroutine foo2
end module blabla

How do I pass a variable to a macro and evaluate it before macro execution?

If I have a method
macro doarray(arr)
if in(:head, fieldnames(typeof(arr))) && arr.head == :vect
println("A Vector")
else
throw(ArgumentError("$(arr) should be a vector"))
end
end
it works if I write this
#doarray([x])
or
#doarray([:x])
but the following code rightly does not work, raising the ArgumentError(i.e. ArgumentError: alist should be a vector).
alist = [:x]
#doarray(alist)
How can I make the above to act similarly as #doarray([x])
Motivation:
I have a recursive macro(say mymacro) which takes a vector, operates on the first value and then calls recursively mymacro with the rest of the vector(say rest_vector). I can create rest_vector, print the value correctly(for debugging) but I don't know how to evaluate rest_vector when I feed it to the mymacro again.
EDIT 1:
I'm trying to implement logic programming in Julia, namely MiniKanren. In the Clojure implementation that I am basing this off, the code is such.
(defmacro fresh
[var-vec & clauses]
(if (empty? var-vec)
`(lconj+ ~#clauses)
`(call-fresh (fn [~(first var-vec)]
(fresh [~#(rest var-vec)]
~#clauses)))))
My failing Julia code based on that is below. I apologize if it does not make sense as I am trying to understand macros by implementing it.
macro fresh(varvec, clauses...)
if isempty(varvec.args)
:(lconjplus($(esc(clauses))))
else
varvecrest = varvec.args[2:end]
return quote
fn = $(esc(varvec.args[1])) -> #fresh($(varvecvest), $(esc(clauses)))
callfresh(fn)
end
end
end
The error I get when I run the code #fresh([x, y], ===(x, 42))(you can disregard ===(x, 42) for this discussion)
ERROR: LoadError: LoadError: UndefVarError: varvecvest not defined
The problem line is fn = $(esc(varvec.args[1])) -> #fresh($(varvecvest), $(esc(clauses)))
If I understand your problem correctly it is better to call a function (not a macro) inside a macro that will operate on AST passed to the macro. Here is a simple example how you could do it:
function recarray(arr)
println("head: ", popfirst!(arr.args))
isempty(arr.args) || recarray(arr)
end
macro doarray(arr)
if in(:head, fieldnames(typeof(arr))) && arr.head == :vect
println("A Vector")
recarray(arr)
else
throw(ArgumentError("$(arr) should be a vector"))
end
end
Of course in this example we do not do anything useful. If you specified what exactly you want to achieve then I might suggest something more specific.

Fortran interoperability with C pointer struct

I have a commercial C library which I want to use with Fortran. There are two functions and a pointer struct like:
struct env;
typedef struct env *ENVptr;
the two functions have the prototype:
ENVptr open(int *status_p);
int close(ENVptr **env_p);
I wrote an Fortran interface to access them:
interface
function c_open(status) bind(c, name='c_open')
use, intrinsic :: iso_c_binding
integer(kind = c_int) :: status
type(c_ptr) :: c_open
end function
function c_close(env) bind(c, name='c_close')
use, intrinsic :: iso_c_binding
type(c_ptr) :: env
integer(kind = c_int) :: c_close
end function
end interface
I use this code to use this in my Fortran program:
type(c_ptr) :: env = c_null_ptr
env = c_open(status)
if ( status .ne. 0 ) then
print *, 'Could not open environment'
stop
end if
...some more code...
if ( c_associated(env) ) then
status = c_close(env)
if ( status .ne. 0 ) then
print *, 'Could not close environment.'
end if
end if
but when I execute the program, I get an Segmentation fault error when the program reaches the c_close function.
Is this the right way to interface the C routines?
I don't see how your program could have linked because the binding name of a procedure has to agree with the name in the actual C prototype. I suppose you could square the names up with a *.def file. Also Fortran has a concept of argument keywords so it is good practice in my opinion to make the Fortran dummy arguments in the interface agree with their documented argument names. Other than that you seem to have the right level of indirection in your interface bodies, so my version would be:
interface
function c_open(status_p) bind(C,name='open')
use, intrinsic :: iso_c_binding
implicit none
type(c_ptr) :: c_open
integer(kind = c_int) status_p
end function c_open
function c_close(env_p) bind(c,name='close')
use, intrinsic :: iso_c_binding
implicit none
integer(c_int) c_close
type(c_ptr) env_p
end function c_close
end interface
Now, there is a problem with the level of indirection when you invoke c_close because the C typedef for ENVptr already makes it a pointer, so ENVptr** envp is a pointer to a pointer to a pointer. In your Fortran code you are passing a c_ptr that points at an opaque type by reference, so you are passing a pointer to a pointer. Thus you need to create an extra level of indirection to make it fly. I would accordingly attempt to modify your code to something like:
type(c_ptr) :: env = c_null_ptr, envpp = c_null_ptr
target env
integer(c_int) status
env = c_open(status)
if ( status .ne. 0 ) then
print *, 'Could not open environment'
stop
end if
!...some more code...
if ( c_associated(env) ) then
envpp = c_loc(env)
status = c_close(envpp)
if ( status .ne. 0 ) then
print *, 'Could not close environment.'
end if
end if
I can't test this obviously but at this point it's syntactically correct and has the right level of indirection according to my reading of your problem statement.

fortran 90 recursive subroutines pointer

I have a subroutine that I would like to be called recursively, but it seems that there is a memory leak when calling it. I've already posted questions on memory leaks in functions
Fortran 90 function return pointer
Fortran 90 difference between compaq visual fortran and gfortran
but now I have a new problem. I've switched all of my functions to subroutines, and now I'm having trouble with calling a subroutine recursively. Here is my code (sorry it's not short)
recursive subroutine myCurl3DRTest(d3,u,v,w,gd,n)
implicit none
type(vecField3D),intent(inout) :: d3
real(dpn),dimension(:,:,:),intent(in) :: u,v,w
type(griddata),intent(in) :: gd
integer,intent(in),optional :: n
type(vecField3D) :: temp1,temp2,temp3,temp4,temp5,temp6
real(dpn),dimension(:,:,:),allocatable :: dwdy,dvdz
real(dpn),dimension(:,:,:),allocatable :: dwdx,dudz
real(dpn),dimension(:,:,:),allocatable :: dvdx,dudy
real(dpn),dimension(:,:,:),allocatable :: curlx,curly,curlz
integer :: dummyN
integer,dimension(3) :: s
s = shape(u)
if (.not.present(n)) then
dummyN = 1
else ; dummyN = n ;endif
call nullifyField(temp1)
call nullifyField(temp2)
call nullifyField(temp3)
call nullifyField(temp4)
call nullifyField(temp5)
call nullifyField(temp6)
call myDel(temp1,w,gd,1,2)
call myDel(temp2,v,gd,1,3)
call myDel(temp3,w,gd,1,1)
call myDel(temp4,u,gd,1,3)
call myDel(temp5,v,gd,1,1)
call myDel(temp6,u,gd,1,2)
allocate(dwdy(s(1),s(2),s(3)))
allocate(dvdz(s(1),s(2),s(3)))
allocate(dwdx(s(1),s(2),s(3)))
allocate(dudz(s(1),s(2),s(3)))
allocate(dvdx(s(1),s(2),s(3)))
allocate(dudy(s(1),s(2),s(3)))
call getY(temp1,dwdy)
call getZ(temp2,dvdz)
call getX(temp3,dwdx)
call getZ(temp4,dudz)
call getX(temp5,dvdx)
call getY(temp6,dudy)
call deleteField(temp1)
call deleteField(temp2)
call deleteField(temp3)
call deleteField(temp4)
call deleteField(temp5)
call deleteField(temp6)
call setX(d3, dwdy - dvdz )
call setY(d3,-( dwdx - dudz ))
call setZ(d3, dvdx - dudy )
deallocate(dwdy)
deallocate(dvdz)
deallocate(dwdx)
deallocate(dudz)
deallocate(dvdx)
deallocate(dudy)
allocate(curlx(s(1),s(2),s(3)))
allocate(curly(s(1),s(2),s(3)))
allocate(curlz(s(1),s(2),s(3)))
call getX(d3,curlx)
call getY(d3,curly)
call getZ(d3,curlz)
if (dummyN.gt.1) then
call myCurl3DRTest(d3,curlx,curly,curlz,gd,dummyN-1)
endif
deallocate(curlx)
deallocate(curly)
deallocate(curlz)
end subroutine
And in the main program, I have
do k=1,10**4
call myCurl3DRTest(f3,u,v,w,gd,1)
! call myCurl(f3,u,v,w,gd)
enddo
This, as I mentioned in my previous questions about memory leaks, is causing a memory leak too. Is there something I'm forgetting to allocate? Or are the curlx, curly and curlz not getting deallocated from each level?
Just so it's clear, inside deleteField:
subroutine deleteField(this)
implicit none
type(vecField3D),intent(inout) :: this
if (associated(this%x)) deallocate(this%x)
if (associated(this%y)) deallocate(this%y)
if (associated(this%z)) deallocate(this%z)
this%TFx = .false.
this%TFy = .false.
this%TFz = .false.
end subroutine
and inside nullifyField:
subroutine nullifyField(this)
implicit none
type(vecField3D),intent(inout) :: this
nullify(this%x); this%TFx = .false.
nullify(this%y); this%TFy = .false.
nullify(this%z); this%TFz = .false.
this%TFNullified = .true.
end subroutine
Any help is greatly appreciated!
I'm guessing based on your previous posts that in your setX (and similar) procedures that you allocate some pointer components of the d3 object passed as the first argument. I don't see how those pointer allocations could be matched by a deallocate before the next iteration of the loop or before the nested call to myCurl3DRTest. Depending on what you are trying to do those deallocations could perhaps be provided by calls to nullifyField.
If my guess is right then without those deallocations, you would have a memory leak.
A language level of Fortran 95 plus the allocatable TR would make your life so much easier...

Fortran pointer functions: why does this code's behavior depend on the order of function calls?

Context
The toy Fortran code posted below calls two pointer functions. That is, both functions return a pointer. In fact, they're both array pointers. They both attempt to do the same thing, which is to return an integer array pointer referencing an integer array having three elements, 1, 2, and 3. The first function uses the pointer assignment operator (=>) to point the function pointer to an allocatable array that holds the data. The second function allocates a block of dynamic memory directly, via the pointer, for storing the data. The calling program just prints the elements of the returned array(s).
Here's what I find odd.
If I point a to the result of function1, the results are not correct. The first element of a appears to be "clobbered": a has 0, 2, 3.
If I point b to the result of function2, the results are correct. b gets 1, 2, 3.
Stranger still, pointing b to the result of function2 after pointing a to function1 changes a such that it becomes correct. a then has 1, 2, 3.
Question
Why does this occur? More precisely, why does a pointer function that returns a pointer to an allocatable array clobber the first element of that array for the caller? More precisely still, why does pointing one pointer (b) produce a side-effect on another pointer (a), where the targets come from different functions that are written so as not to interact with each other at all?
Caveats
I get this behavior using the GNU Fortran compiler v.4.3.3, running an Intel laptop with Ubuntu (Jaunty). Your results may vary, which might be more interesting still. Finally, as always it could be operator error on my part, which would be interesting to me at least.
Code
program main
implicit none
integer, dimension(:), pointer :: a, b
integer :: i
a => function1()
b => function2()
do i = 1, 3
print *, a(i)
end do
! do i = 1, 3
! print *, b(i)
! end do
contains
function function1 ()
integer, dimension(:), allocatable, target :: array
integer, dimension(:), pointer :: function1
allocate(array(3))
array(1) = 1
array(2) = 2
array(3) = 3
function1 => array
end function function1
function function2 ()
integer, dimension(:), pointer :: function2
allocate(function2(3))
function2(1) = 1
function2(2) = 2
function2(3) = 3
end function function2
end program main
Variable array of function1 is a local variable -- because it is declared without the "save" attribute, it is not persistent and is undefined when the function exits. You assign the address of array to function1, "keeping" this address, but the address isn't meaningful once the variable becomes undefined after exiting from the function. A likely implementation is that array of function1 will be placed on the stack, and that area of the stack will be freed for other uses when function1 returns. But this is just a guess at a likely implementation -- the key point is that you aren't allowed to use the pointer value after the variable becomes undefined. Allocatable variables are automatically deallocated when they go out of scope unless you declare them with the "save" attribute.

Resources