Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

pointer of array-valued functions 2

Status
Not open for further replies.

mazkime

Technical User
Aug 1, 2012
8
FR
Hello everybody,
I am starting this thread because I encounter a problem with the pointers in Fortran.
I want to use a pointer of an array-valued function, but I get a segmentation fault error during execution (compilation is ok with gfortran).

Everything works well when the pointer aims at a function returning a real. But it fails when the function returns an array of reals. I guess there is a problem in the definition of my pointer, but I don't know what to do.
Here is a small code to illustrate my problem :

Code:
  program main
  implicit none
  real*8, external, pointer   :: p

  p => f1
  print*,p(1.0D0)    !this is ok
  p => f2
  print*,p(1.0D0)    !I get a segmentation fault
  
  contains
    function f1(x)
    implicit none
    real*8             :: f1
    real*8, intent(in) :: x
    f1 = x+2
    end function f1
    
    function f2(x)
    implicit none
    real*8              :: f2(2)
    real*8, intent(in)  :: x
    f2(1) = x+1
    f2(2) = x-1
    end function f2
  end program main

Any help would be appreciated.
Thanks.
 
Two suggestions.

First, I don't think you can use the same pointer to point to the two functions...if one of them is an array, I would suggest to create another pointer to point to f2, like this:

real*8, pointer :: ap:))

I called it 'ap' for 'array pointer'

If that alone does not work, I wonder if you should turn your f2 into a pointer itself and THEN return it:

function f2(x)
implicit none
real*8, pointer :: f2:))
real*8, intent(in) :: x
allocate(f2(2))
f2(1) = x+1
f2(2) = x-1
end function f2





 
As far as I know - but I cannot check now cause I am waz from home - you cannot use pointers to point to functions, at least f90 / 95, you can have them point at variables only (do not know about constants).

Any pointer in fortran is dereferenced at once. You decalred your pointer to point at a variable of typa real*8. A pointer to an array must be delared as array like

real*8, dimension :)), pointer :: ap



Norbert

The optimist believes we live in the best of all possible worlds - the pessimist fears this might be true.
 
Don't know why you want to use pointers on functions - but maybe it's only, because you want to use several functions in the same computation, like this:
p => f1
result = compute_something(p)
p => f2
res = compute_something(p)

In this case you can rather use functions as arguments of other functions, i.e.:
result = compute_something(f1)
result = compute_something(f2)

 
Thank you for your answers.
Here are my comments to all of your recommendations.

to Salgerman (post #1):
The problem is that I do not to point at a variable, but at a function. Therefore, I cannot declare my pointer with
Code:
real*8, pointer :: ap(:)
What I tried to do is to use the following declaration :
Code:
real*8, external, pointer :: ap(:)
but in that case I get the following error during the compilation :
Code:
Error: EXTERNAL attribute conflicts with DIMENSION attribute
However, here I do not want to declare an array of pointers, but a pointer that points to an array-valued function, which is different.
As a consequence, your second option does not work neither.

to gummibaer :
pointer of functions have been introduced in Fortran 2003. It works well when the functions are returning a single value, but I have some problems when an array is returned.

I finally found how to do this, using 2 different pointers (p and ap) and an explicit interface. Here is my code :

Code:
  module m

  contains
    function f1(x)
    implicit none
    real*8             :: f1
    real*8, intent(in) :: x
    f1 = x+2
    end function f1
    
    function f2(x)
    implicit none
    real*8              :: f2(2)
    real*8, intent(in)  :: x
    f2(1) = x+1
    f2(2) = x-1
    end function f2
  end module m



  program prog

  use m

  implicit none

  real*8, external, pointer   :: p

  pointer                     :: ap
  interface
    function ap(x)
      real*8             :: ap(2)
      real*8, intent(in) :: x
    end function ap
  end interface

  p => f1
  print*,p(1.0D0)

  ap => f2
  print*,ap(1.0D0)

  end program prog

to Salgerman (post #2):
You are right, this is exactly what I want to do, but I don't know how to declare the type of the function f passed as argument in the function 'compute_something', that returns a real*8 for f1 but an array of size 2 of real*8 for f2. I initially thought it would be easier using pointers of functions, but it appears it is not.

Here is an illustration of what I want to do, and the problem I get when calling the subroutine 'compute_something' with 2 different functions types as argument (f1 returns a real*8, f2 returns an array of real*8) :
Code:
module m2
  contains
    subroutine compute_something(f)
    implicit none
    real*8, external    :: f
    print*,f(1.0D0)
    end subroutine compute_something
end module m2

module m1
  contains
    function f1(x)
    implicit none
    real*8             :: f1
    real*8, intent(in) :: x
    f1 = x+2
    end function f1
    
    function f2(x)
    implicit none
    real*8              :: f2(2)
    real*8, intent(in)  :: x
    f2(1) = x+1
    f2(2) = x-1
    end function f2

    subroutine m1_subroutine()
    use m2
    implicit none
    call compute_something(f1)
!    call compute_something(f2)   !compilation error for this line
    end subroutine m1_subroutine

end module m1


program main
  use m1
  implicit none

  call m1_subroutine()
  
  end program main

the compilation error for the line "call compute_something(f2)" is :

Code:
    call compute_something(f2)
                           1
Error: Type/rank mismatch in argument 'f' at (1)

ps : I used two modules, m1 and m2, because I get a compilation error when including m1 in the contains part of the main program. I don't undertand why, anyway...
 
You links seem to contain interesting information.
I will look at them with great attention and come back later to tell if it works for my case.
Thank you !
 
I think you need something more special. Maybe you want one function which will operate with both types of arguments: scalars and vectors.

Simply said, I want only one function my_function with 2 arguments and I want to apply the function on scalar arguments (real function and real number) and on vector arguments (vector function and vector vector). This is possible in fortran too - we can implement function overloading suing generic interface.
Here is an example
overloading.f95
Code:
[COLOR=#a020f0]module[/color] functions
  [COLOR=#2e8b57][b]implicit[/b][/color] [COLOR=#2e8b57][b]none[/b][/color]
[COLOR=#a020f0]contains[/color]
  [COLOR=#0000ff]! scalar functions [/color]
[COLOR=#2e8b57][b]  real[/b][/color] [COLOR=#a020f0]function[/color] sf1(x)
[COLOR=#2e8b57][b]    real[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x
    sf1 [COLOR=#804040][b]=[/b][/color] x[COLOR=#804040][b]*[/b][/color]x
  [COLOR=#a020f0]end function[/color] sf1

[COLOR=#2e8b57][b]  real[/b][/color] [COLOR=#a020f0]function[/color] sf2(x)
[COLOR=#2e8b57][b]    real[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x
    sf2 [COLOR=#804040][b]=[/b][/color] x [COLOR=#804040][b]+[/b][/color] [COLOR=#ff00ff]3[/color]
  [COLOR=#a020f0]end function[/color] sf2

  [COLOR=#0000ff]! vector fuctions[/color]
  [COLOR=#a020f0]function[/color] vf1(v)
[COLOR=#2e8b57][b]    real[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color]([COLOR=#ff00ff]2[/color]), [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: v
[COLOR=#2e8b57][b]    real[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color]([COLOR=#ff00ff]2[/color]) :: vf1
    [COLOR=#0000ff]! return[/color]
    vf1([COLOR=#ff00ff]1[/color]) [COLOR=#804040][b]=[/b][/color] v([COLOR=#ff00ff]1[/color])
    vf1([COLOR=#ff00ff]2[/color]) [COLOR=#804040][b]=[/b][/color] v([COLOR=#ff00ff]2[/color])
  [COLOR=#a020f0]end function[/color] vf1

  [COLOR=#a020f0]function[/color] vf2(v)
[COLOR=#2e8b57][b]    real[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color]([COLOR=#ff00ff]2[/color]), [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: v
[COLOR=#2e8b57][b]    real[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color]([COLOR=#ff00ff]2[/color]) :: vf2
    [COLOR=#0000ff]! return[/color]
    vf2([COLOR=#ff00ff]1[/color]) [COLOR=#804040][b]=[/b][/color] v([COLOR=#ff00ff]1[/color]) [COLOR=#804040][b]+[/b][/color] v([COLOR=#ff00ff]2[/color])
    vf2([COLOR=#ff00ff]2[/color]) [COLOR=#804040][b]=[/b][/color] v([COLOR=#ff00ff]1[/color]) [COLOR=#804040][b]-[/b][/color] v([COLOR=#ff00ff]2[/color])
  [COLOR=#a020f0]end function[/color] vf2
[COLOR=#a020f0]end module[/color] functions

[COLOR=#a020f0]module[/color] methods
  [COLOR=#0000ff]! function overloading with generic interface[/color]
  [COLOR=#a020f0]interface[/color] my_function
    [COLOR=#a020f0]module[/color] [COLOR=#a020f0]procedure[/color] my_function_with_scal_args, [COLOR=#804040][b]&[/b][/color]
                     my_function_with_vec_args
  [COLOR=#a020f0]end interface[/color] my_function

[COLOR=#a020f0]contains[/color]
[COLOR=#2e8b57][b]  real[/b][/color] [COLOR=#a020f0]function[/color] my_function_with_scal_args(scal_f, x)
    [COLOR=#0000ff]! interface for functional arguments[/color]
    [COLOR=#a020f0]interface[/color]
      [COLOR=#a020f0]function[/color] scal_f(x)
[COLOR=#2e8b57][b]        real[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x
[COLOR=#2e8b57][b]        real[/b][/color] :: scal_f
      [COLOR=#a020f0]end function[/color] scal_f
    [COLOR=#a020f0]end interface[/color]
[COLOR=#2e8b57][b]    real[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x

    [COLOR=#0000ff]! compute double of the function result[/color]
    my_function_with_scal_args [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]2[/color] [COLOR=#804040][b]*[/b][/color] scal_f(x)
  [COLOR=#a020f0]end function[/color] my_function_with_scal_args

[COLOR=#2e8b57][b]  real[/b][/color] [COLOR=#a020f0]function[/color] my_function_with_vec_args(vec_f, x)
    [COLOR=#0000ff]! interface for functional arguments[/color]
    [COLOR=#a020f0]interface[/color]
      [COLOR=#a020f0]function[/color] vec_f(x)
[COLOR=#2e8b57][b]        real[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color]([COLOR=#ff00ff]2[/color]), [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x
[COLOR=#2e8b57][b]        real[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color]([COLOR=#ff00ff]2[/color]) :: vec_f
      [COLOR=#a020f0]end function[/color] vec_f
    [COLOR=#a020f0]end interface[/color]
[COLOR=#2e8b57][b]    real[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color]([COLOR=#ff00ff]2[/color]), [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x
[COLOR=#2e8b57][b]    real[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color]([COLOR=#ff00ff]2[/color]) :: reslt
    
    [COLOR=#0000ff]! compute value of the vector function applied on the vector argument[/color]
    reslt [COLOR=#804040][b]=[/b][/color] vec_f(x)

    [COLOR=#0000ff]! double the sum of vector components[/color]
    my_function_with_vec_args [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]2[/color] [COLOR=#804040][b]*[/b][/color] (reslt([COLOR=#ff00ff]1[/color]) [COLOR=#804040][b]+[/b][/color] reslt([COLOR=#ff00ff]2[/color]))
  [COLOR=#a020f0]end function[/color] my_function_with_vec_args
[COLOR=#a020f0]end module[/color] methods

[COLOR=#a020f0]program[/color] overloading
  [COLOR=#a020f0]use[/color] functions
  [COLOR=#a020f0]use[/color] methods

  [COLOR=#2e8b57][b]implicit[/b][/color] [COLOR=#2e8b57][b]none[/b][/color]
[COLOR=#2e8b57][b]  real[/b][/color] :: x
[COLOR=#2e8b57][b]  real[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color]([COLOR=#ff00ff]2[/color]) :: v
  x [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]5[/color]
  v [COLOR=#804040][b]=[/b][/color] ([COLOR=#804040][b]/[/b][/color][COLOR=#ff00ff]3[/color], [COLOR=#ff00ff]4[/color][COLOR=#804040][b]/[/b][/color])

  [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'Overloading Example:'[/color]

  [COLOR=#0000ff]! using my_function with scalar arguments[/color]
  [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'my_function (sf1, x) = '[/color], my_function (sf1, x)
  [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'my_function (sf2, x) = '[/color], my_function (sf2, x)

  [COLOR=#0000ff]! using my_function with vector arguments[/color]
  [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'my_function (vf1, v) = '[/color], my_function (vf1, v)
  [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'my_function (vf2, v) = '[/color], my_function (vf2, v)
[COLOR=#a020f0]end program[/color] overloading

You see, I need write the function my_function_with_scal_args with scalar arguments and the function my_function_with_vec_args with vector arguments.
Then implement the overloading mechanism via generic interface my_function.

Now it compiles and runs:
Code:
$ gfortran overloading.f95 -o overloading

$ overloading
 Overloading Example:
 my_function (sf1, x) =    50.000000    
 my_function (sf2, x) =    16.000000    
 my_function (vf1, v) =    14.000000    
 my_function (vf2, v) =    12.000000
 
Thank you, this is exactly what I was looking for ! I tried with my own example and it works very well.
One last question : to avoid the use of the function overloading with the general interface, I was wondering if it was possible to define, in the interface for the function passed as argument, the arguments as assumed-shape arrays. In that way, I define only once my function, that combines both 'my_function_with_scal_args' and 'my_function_with_vec_args', by writing the interface in a way like this one :
Code:
inteface
  function vec_f(x)
    real, dimension(2), intent(in) :: x
    real, dimension(:) :: vec_f           !assumed-shape array
  end function vec_f
end interface

With my (simplified) previous code, it writes :
Code:
module m2
  contains
    subroutine compute_something(f)
    implicit none
    interface
      function f(x)
        real*8, intent(in)  :: x
!	real*8              :: f(2)    !works
        real*8              :: f(:)    !does not work
      end function f      
    end interface
    print*,f(1.0D0)
    end subroutine compute_something
end module m2

module m1
  contains
    function f2(x)
    implicit none
    real*8              :: f2(2)
    real*8, intent(in)  :: x
    f2(1) = x+1
    f2(2) = x-1
    end function f2

    subroutine m1_subroutine()
    use m2
    implicit none
    call compute_something(f2)
    end subroutine m1_subroutine

end module m1


program main
  use m1
  implicit none

  call m1_subroutine()
  
  end program main

unfortunately, if it compiles without problem, I got a segmentation fault error when the line 'print*,f(1.0D0)' in the subroutine 'compute_something' is executed.
Is it possible to do such a thing ? It would be very interesting for me because, with such an approach, I can write a single function that computes, for instance, the Jacobian matrix (size m*n) of a vectorial function for any values of m and n. By using the function overloading and the general interface, I would have to write the m*n functions !
 
Here is other example
Look at the function MatrixVector(M, x) in module vector_functions. It has 2 input arguments

real, dimension:),:), intent(in) :: M
real, dimension:)), intent(in) :: x

and returns a vector

real, dimension(n) :: MatrixVector

which size depends on input argument / n=SIZE(x) /
 
Thank you for your help. I am going to look at those links and post my answer with, I hope, the solution as soon as possible.
 
I had a look on the links you provided, mikrom, but unfortunately they deal with with simple assumed-shape arrays, and not assumed-shape arrays of functions, and are helpless for my case.

Let me sum up my problem, for the readers of the forum.
I have the code given below. In this code, the function f returns an array (dimension 2) of reals. This function is passed as argument to the subroutine mysub.
What I would like to do is to be able to pass any function that returns an array of dimension n >= 1 to mysub. I tried modifying the line
Code:
      real              :: f(2)
to
Code:
      real              :: f(:)
in the interface inside mysub, to act as an assumed-shape array, but I get a segmentation fault during execution (using gfortran or f95).
Does anyone know the solution of my problem ? I searched for a long time on the Internet but didn't find any similar thing.

Code:
module m
  contains
  subroutine mysub(f)
  implicit none
  interface
    function f(x)
      real              :: f(2)
      real, intent(in)  :: x
    end function f
  end interface
  print*,f(1.0)
  end subroutine mysub
end module m


program main
  use m
  implicit none
  interface
    function f(x)
      real              :: f(2)
      real, intent(in)  :: x
    end function f
  end interface

  call mysub(f)
  
end program main
  
function f(x)
  implicit none
  real              :: f(2)
  real, intent(in)  :: x
  f(1) = x+1.0
  f(2) = x-1.0
end function f
 
I don't quite understand if what you are trying to do is to take on any one-dimensional function of any length or any-dimensional.

The code below works for me and uses mysub to take on 2 one-dimensional functions of different lengths.

Code:
      module m
        contains
        subroutine mysub(f)
        implicit none
        interface
          function f(x)
            real, allocatable, dimension(:) :: f
            real, intent(in)  :: x
          end function f
        end interface
        print*,f(1.0)
        end subroutine mysub
      end module m

      program main
        use m
        implicit none
        interface
          function f2(x)
            real, allocatable, dimension(:) :: f2
            real, intent(in)  :: x
          end function f2
          function f5(x)
            real, allocatable, dimension(:) :: f5
            real, intent(in)  :: x
          end function f5
        end interface

        call mysub(f2)
        call mysub(f5)
        
      end program main
  
      function f2(x)
        implicit none
        real, allocatable, dimension(:) :: f2
        real, intent(in)  :: x
        allocate(f2(2))
        f2(1) = x+1.0
        f2(2) = x-1.0
      end function f2 
      function f5(x)
        implicit none
        real, allocatable, dimension(:) :: f5
        real, intent(in)  :: x
        allocate(f5(2))
        f5(1) = x+1.0
        f5(2) = x-1.0
        f5(2) = 3.0
        f5(2) = 4.0
        f5(2) = 5.0
      end function f5
 
typo!!! Sorry....need to change "allocate(f5(2))" to "allocate(f5(5))" !!!
 
What you want is possible.

I modified a little bit the program:
Now the function vf1() takes a vector argument of any dimebnsion and returns the vector of the same dimesion as the input argument.
The function my_function_with_vec_args() accepts now arguments like vf1()

overloading2.f95
Code:
[COLOR=#a020f0]module[/color] functions
  [COLOR=#2e8b57][b]implicit[/b][/color] [COLOR=#2e8b57][b]none[/b][/color]
[COLOR=#a020f0]contains[/color]
  [COLOR=#0000ff]! scalar functions [/color]
[COLOR=#2e8b57][b]  real[/b][/color] [COLOR=#a020f0]function[/color] sf1(x)
[COLOR=#2e8b57][b]    real[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x
    sf1 [COLOR=#804040][b]=[/b][/color] x[COLOR=#804040][b]*[/b][/color]x
  [COLOR=#a020f0]end function[/color] sf1

[COLOR=#2e8b57][b]  real[/b][/color] [COLOR=#a020f0]function[/color] sf2(x)
[COLOR=#2e8b57][b]    real[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x
    sf2 [COLOR=#804040][b]=[/b][/color] x [COLOR=#804040][b]+[/b][/color] [COLOR=#ff00ff]3[/color]
  [COLOR=#a020f0]end function[/color] sf2

  [COLOR=#0000ff]! vector fuctions[/color]
  [COLOR=#a020f0]function[/color] vf1(v)
[COLOR=#2e8b57][b]    real[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color](:), [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: v
    [COLOR=#2e8b57][b]integer[/b][/color] :: n, j
[COLOR=#2e8b57][b]    real[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color](n) :: vf1
    n[COLOR=#804040][b]=[/b][/color][COLOR=#008080]size[/color](v)

    [COLOR=#0000ff]! return[/color]
    [COLOR=#804040][b]do[/b][/color] j[COLOR=#804040][b]=[/b][/color][COLOR=#ff00ff]1[/color], n
      vf1(j) [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]3[/color][COLOR=#804040][b]*[/b][/color]v(j)
    [COLOR=#804040][b]end do[/b][/color]  
  [COLOR=#a020f0]end function[/color] vf1

  [COLOR=#a020f0]function[/color] vf2(v)
[COLOR=#2e8b57][b]    real[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color](:), [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: v
[COLOR=#2e8b57][b]    real[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color]([COLOR=#ff00ff]2[/color]) :: vf2
    [COLOR=#0000ff]! return[/color]
    vf2([COLOR=#ff00ff]1[/color]) [COLOR=#804040][b]=[/b][/color] v([COLOR=#ff00ff]1[/color]) [COLOR=#804040][b]+[/b][/color] v([COLOR=#ff00ff]2[/color])
    vf2([COLOR=#ff00ff]2[/color]) [COLOR=#804040][b]=[/b][/color] v([COLOR=#ff00ff]1[/color]) [COLOR=#804040][b]-[/b][/color] v([COLOR=#ff00ff]2[/color])
  [COLOR=#a020f0]end function[/color] vf2
[COLOR=#a020f0]end module[/color] functions

[COLOR=#a020f0]module[/color] methods
  [COLOR=#0000ff]! function overloading with generic interface[/color]
  [COLOR=#a020f0]interface[/color] my_function
    [COLOR=#a020f0]module[/color] [COLOR=#a020f0]procedure[/color] my_function_with_scal_args, [highlight #ffff00][COLOR=#0000ff]&[/color][/highlight]
                     my_function_with_vec_args
  [COLOR=#a020f0]end interface[/color] my_function

[COLOR=#a020f0]contains[/color]
[COLOR=#2e8b57][b]  real[/b][/color] [COLOR=#a020f0]function[/color] my_function_with_scal_args(scal_f, x)
    [COLOR=#0000ff]! interface for functional arguments[/color]
    [COLOR=#a020f0]interface[/color]
      [COLOR=#a020f0]function[/color] scal_f(x)
[COLOR=#2e8b57][b]        real[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x
[COLOR=#2e8b57][b]        real[/b][/color] :: scal_f
      [COLOR=#a020f0]end function[/color] scal_f
    [COLOR=#a020f0]end interface[/color]
[COLOR=#2e8b57][b]    real[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x

    [COLOR=#0000ff]! compute double of the function result[/color]
    my_function_with_scal_args [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]2[/color] [COLOR=#804040][b]*[/b][/color] scal_f(x)
  [COLOR=#a020f0]end function[/color] my_function_with_scal_args

[COLOR=#2e8b57][b]  real[/b][/color] [COLOR=#a020f0]function[/color] my_function_with_vec_args(vec_f, x)
    [COLOR=#0000ff]! interface for functional arguments[/color]
    [COLOR=#a020f0]interface[/color]
      [COLOR=#a020f0]function[/color] vec_f(x)
[COLOR=#2e8b57][b]        real[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color](:), [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x
[COLOR=#2e8b57][b]        real[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color](:) :: vec_f
      [COLOR=#a020f0]end function[/color] vec_f
    [COLOR=#a020f0]end interface[/color]
[COLOR=#2e8b57][b]    real[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color](:), [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x
    [COLOR=#2e8b57][b]integer[/b][/color] :: n
[COLOR=#2e8b57][b]    real[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color](:), [COLOR=#2e8b57][b]allocatable[/b][/color] :: reslt
    
    n [COLOR=#804040][b]=[/b][/color] [COLOR=#008080]size[/color](x)
    [COLOR=#804040][b]allocate[/b][/color](reslt(n))
    [COLOR=#0000ff]! compute value of the vector function applied on the vector argument[/color]
    reslt [COLOR=#804040][b]=[/b][/color] vec_f(x)

    [COLOR=#0000ff]! double the sum of vector components[/color]
    my_function_with_vec_args [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]2[/color] [COLOR=#804040][b]*[/b][/color] [COLOR=#008080]sum[/color](reslt)
  [COLOR=#a020f0]end function[/color] my_function_with_vec_args
[COLOR=#a020f0]end module[/color] methods

[COLOR=#a020f0]program[/color] overloading2
  [COLOR=#a020f0]use[/color] functions
  [COLOR=#a020f0]use[/color] methods

  [COLOR=#2e8b57][b]implicit[/b][/color] [COLOR=#2e8b57][b]none[/b][/color]
[COLOR=#2e8b57][b]  real[/b][/color] :: x
[COLOR=#2e8b57][b]  real[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color]([COLOR=#ff00ff]2[/color]) :: v
[COLOR=#2e8b57][b]  real[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color]([COLOR=#ff00ff]5[/color]) :: w
  x [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]5[/color]
  v [COLOR=#804040][b]=[/b][/color] ([COLOR=#804040][b]/[/b][/color][COLOR=#ff00ff]3[/color], [COLOR=#ff00ff]4[/color][COLOR=#804040][b]/[/b][/color])
  w [COLOR=#804040][b]=[/b][/color] ([COLOR=#804040][b]/[/b][/color][COLOR=#ff00ff]1[/color], [COLOR=#ff00ff]2[/color], [COLOR=#ff00ff]3[/color], [COLOR=#ff00ff]4[/color], [COLOR=#ff00ff]5[/color][COLOR=#804040][b]/[/b][/color])

  [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'Overloading Example:'[/color]

  [COLOR=#0000ff]! using my_function with scalar arguments[/color]
  [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'my_function (sf1, x) = '[/color], my_function (sf1, x)
  [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'my_function (sf2, x) = '[/color], my_function (sf2, x)

  [COLOR=#0000ff]! using my_function with vector arguments[/color]
  [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'vector v and vector function vf1() have dimension = 2'[/color]
  [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'my_function (vf1, v) = '[/color], my_function (vf1, v)
  [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'my_function (vf2, v) = '[/color], my_function (vf2, v)
  [COLOR=#0000ff]![/color]
  [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'vector w and vector function vf1() have dimension = 5'[/color]
  [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'my_function (vf1, w) = '[/color], my_function (vf1, w) 
[COLOR=#a020f0]end program[/color] overloading2

The program a vector of length 2 and 5, the function vf1() returns in that cases a vector of length 2 or 5.
Code:
$ gfortran overloading2.f95 -o overloading2

$ overloading2
 Overloading Example:
 my_function (sf1, x) =    50.000000    
 my_function (sf2, x) =    16.000000    
 vector v and vector function vf1() have dimension = 2
 my_function (vf1, v) =    42.000000    
 my_function (vf2, v) =    12.000000    
 vector w and vector function vf1() have dimension = 5
 my_function (vf1, w) =    90.000000

But I must say you, that what I have done is compiler dependent. It compiles with gfortran, but it doesn't compile with g95, which doesn't like this declaration:
Code:
  function vf1(v)
    real, dimension(:), intent(in) :: v
    integer :: n, j
    real, dimension(n) :: vf1
    n=size(v)
....
and throws this error:
Code:
$ g95 overloading2.f95 -o overloading2
In file overloading2.f95:19

    real, dimension(n) :: vf1
                    1
Error: Variable 'n' cannot appear in restricted expression at (1)
 
That you for your answer, both showing what I want to do with different methods.

salgerman, you understood my problem welle, I wanted to take on any one-dimensional function. I am just surprised I get a segmentation fault if I do not declare f2 and f5 as allocatables. Anyway, by declaring them as allocatable it works fine and that is what I will do in the future.

mikrom, I am very impressed by your solution, where it not not necessary do declare the functions with allocatables. I need a bit more time to understand clearly what it does exactly. I tried to reproduce my example with your solution but encountered some errors. I guess I need to reread your code carefully to fully understand it.

anyway, thanks very much to both of you for your help. It is greatly appreciated.
Best regards.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top