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!

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

procedure pointer to function/subroutine in derived type

Status
Not open for further replies.
zhouxian

zhouxian

Technical User
Mar 10, 2010
5
US
type has component which is a procedure pointer to function. The function will return an array. But by calling the pointer , I got trash value and when I tried to find the size of returned array from the call from the procedure pointer, the compiler showed error
" An array-valued argument is required in this context."
If I change function to the form of subroutine, there is no such a problem. Please run the following code and help me with this problem.


compiler : linux+ifort 11.1 intel ifort version. 11.1
-------source code ------------


module type_module
implicit none

type test_type
procedure(fun_interface), nopass, pointer :: fun_ptr
procedure(sub_interface), nopass, pointer :: sub_ptr

end type test_type

abstract interface
function fun_interface(n,x) result(f)
integer, intent(in) :: n
double precision, intent(in) :: x(n)
double precision :: f(n)
end function fun_interface
subroutine sub_interface(n,x,f)
integer, intent(in) :: n
double precision, intent(in) :: x(n)
double precision :: f(n)
end subroutine sub_interface
end interface

contains
subroutine test_type_constructor(test, fun,sub)

interface
function fun(n,x) result(f)
integer, intent(in) :: n
double precision, intent(in) :: x(n)
double precision :: f(n)
end function fun
subroutine sub(n,x,f)
integer, intent(in) :: n
double precision, intent(in) :: x(n)
double precision :: f(n)
end subroutine sub
end interface

type(test_type) :: test
test%fun_ptr => fun;
test%sub_ptr => sub;
end subroutine test_type_constructor
end module type_module

program main
use type_module
type(test_type) :: test
integer :: n =2 ;
double precision :: x(2), f(2)
call test_type_constructor (test, fun1,sub1)
x = (/-1.d0, 1.d0/);
f = 0.d0;
call test%sub_ptr(n,x,f)
print *, " f from call fun ", f;

f = test%fun_ptr(n,x);
print *, " f from call fun ", f;
! Why the following does not work
!print *, " size of returned value from fun_ptr ", size(test%fun_ptr(n,x));

contains

function fun1 (n,x ) result (f )
integer, intent(in) :: n
double precision, intent(in) :: x(n)
double precision :: f(n)
! try this
f = 2.0*x ;
! or this , both give WRONG results
call sub1(n,x,f)
end function fun1

subroutine sub1(n,x,f)
integer, intent(in) :: n
double precision, intent(in) :: x(n)
double precision :: f(n)
f = 2.0*x ;
end subroutine sub1


end program
 
Sort by date Sort by votes
I tried your example with gfortran and g95.
With gfortran I got errors like:
Code: 
Error: Fortran 2003: Procedure components at (1) are not yet implemented in gfortran
In g95 I got this error:
Code: 
$ g95 zhouxian.f95 -o zhouxian  -fbounds-check -g
In file zhouxian.f95:50

      call test_type_constructor (test, fun1,sub1)
                                        1
Error: Internal procedure 'fun1' at (1) cannot be used as an actual argument

so I changed your code - I defined the fun1 and sub1 in the module named funcs:
Code: 
[COLOR=#a020f0]module[/color] type_module
  [COLOR=#2e8b57][b]implicit[/b][/color] [COLOR=#2e8b57][b]none[/b][/color]

  [COLOR=#2e8b57][b]type[/b][/color] test_type
    [COLOR=#a020f0]procedure[/color](fun_interface), nopass, [COLOR=#2e8b57][b]pointer[/b][/color] :: fun_ptr
    [COLOR=#a020f0]procedure[/color](sub_interface), nopass, [COLOR=#2e8b57][b]pointer[/b][/color] :: sub_ptr    
  [COLOR=#2e8b57][b]end type[/b][/color] test_type

  abstract [COLOR=#a020f0]interface[/color]
    [COLOR=#a020f0]function[/color] fun_interface(n,x) [COLOR=#a020f0]result[/color](f)
      [COLOR=#2e8b57][b]integer[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: n
      [COLOR=#2e8b57][b]double precision[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x(n)
      [COLOR=#2e8b57][b]double precision[/b][/color] :: f(n)
    [COLOR=#a020f0]end function[/color] fun_interface
    [COLOR=#a020f0]subroutine[/color]  sub_interface(n,x,f)
      [COLOR=#2e8b57][b]integer[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: n
      [COLOR=#2e8b57][b]double precision[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x(n)
      [COLOR=#2e8b57][b]double precision[/b][/color] :: f(n)
    [COLOR=#a020f0]end subroutine[/color] sub_interface
  [COLOR=#a020f0]end interface[/color]  

  [COLOR=#a020f0]contains[/color]

  [COLOR=#a020f0]subroutine[/color]  test_type_constructor(test, fun,sub)    
    [COLOR=#a020f0]interface[/color]
      [COLOR=#a020f0]function[/color] fun(n,x) [COLOR=#a020f0]result[/color](f)
        [COLOR=#2e8b57][b]integer[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: n
        [COLOR=#2e8b57][b]double precision[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x(n)
        [COLOR=#2e8b57][b]double precision[/b][/color] :: f(n)
      [COLOR=#a020f0]end function[/color] fun
      [COLOR=#a020f0]subroutine[/color]  sub(n,x,f)
        [COLOR=#2e8b57][b]integer[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: n
        [COLOR=#2e8b57][b]double precision[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x(n)
        [COLOR=#2e8b57][b]double precision[/b][/color] :: f(n)
      [COLOR=#a020f0]end subroutine[/color] sub
    [COLOR=#a020f0]end interface[/color]  

    [COLOR=#2e8b57][b]type[/b][/color](test_type) :: test
    test%fun_ptr [COLOR=#804040][b]=>[/b][/color] fun;
    test%sub_ptr [COLOR=#804040][b]=>[/b][/color] sub;
  [COLOR=#a020f0]end subroutine[/color] test_type_constructor
[COLOR=#a020f0]end module[/color] type_module
 
[COLOR=#a020f0]module[/color] funcs
  [COLOR=#2e8b57][b]implicit[/b][/color] [COLOR=#2e8b57][b]none[/b][/color]

  [COLOR=#a020f0]contains[/color]

  [COLOR=#a020f0]function[/color] fun1 (n,x ) [COLOR=#a020f0]result[/color] (f )
    [COLOR=#2e8b57][b]integer[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: n
    [COLOR=#2e8b57][b]double precision[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x(n)
    [COLOR=#2e8b57][b]double precision[/b][/color] :: f(n)
    [COLOR=#0000ff]! try this[/color]
    f [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]2.0[/color][COLOR=#804040][b]*[/b][/color]x ;
    [COLOR=#0000ff]! or this , both give WRONG results[/color]
    [COLOR=#a020f0]call[/color]  sub1(n,x,f)
  [COLOR=#a020f0]end function[/color] fun1

  [COLOR=#a020f0]subroutine[/color] sub1(n,x,f)
    [COLOR=#2e8b57][b]integer[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: n
    [COLOR=#2e8b57][b]double precision[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x(n)
    [COLOR=#2e8b57][b]double precision[/b][/color] :: f(n)
    f [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]2.0[/color][COLOR=#804040][b]*[/b][/color]x ;
  [COLOR=#a020f0]end subroutine[/color] sub1
[COLOR=#a020f0]end module[/color] funcs

[COLOR=#a020f0]program[/color] main
  [COLOR=#a020f0]use[/color] type_module
  [COLOR=#a020f0]use[/color] funcs
  [COLOR=#2e8b57][b]type[/b][/color](test_type) :: test
  [COLOR=#2e8b57][b]integer[/b][/color] :: n [COLOR=#804040][b]=[/b][/color][COLOR=#ff00ff]2[/color] ;
  [COLOR=#2e8b57][b]double precision[/b][/color] :: x([COLOR=#ff00ff]2[/color]), f([COLOR=#ff00ff]2[/color])
  [COLOR=#a020f0]call[/color] test_type_constructor (test, fun1, sub1)
  x [COLOR=#804040][b]=[/b][/color] ([COLOR=#804040][b]/-[/b][/color][COLOR=#ff00ff]1.d0[/color], [COLOR=#ff00ff]1.d0[/color][COLOR=#804040][b]/[/b][/color]);
  f [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]0.d0[/color];
  [COLOR=#a020f0]call[/color]  test%sub_ptr(n,x,f)
  [COLOR=#804040][b]print[/b][/color] [COLOR=#804040][b]*[/b][/color], [COLOR=#ff00ff]" f from call fun "[/color], f;

  f [COLOR=#804040][b]=[/b][/color] test%fun_ptr(n,x);
  [COLOR=#804040][b]print[/b][/color] [COLOR=#804040][b]*[/b][/color], [COLOR=#ff00ff]" f from call fun "[/color], f;
  [COLOR=#0000ff]! This seems to work[/color]
  [COLOR=#804040][b]print[/b][/color] [COLOR=#804040][b]*[/b][/color], [COLOR=#ff00ff]" size of returned value from fun_ptr "[/color], [COLOR=#008080]size[/color](test%fun_ptr(n,x));
[COLOR=#a020f0]end program[/color]
Now it compiles and runs
Code: 
$ g95 zhouxian.f95 -o zhouxian

$ zhouxian
  f from call fun  -2. 2.
  f from call fun  -2. 2.
  size of returned value from fun_ptr  2
 
Upvote 0 Downvote
mikrom, I do not have g95. Only can access ifort .

The problem still exists after rewrite fun1 in the module.
Is it a problem of the compiler?
 
Upvote 0 Downvote
I installed g95 and verified mikrom's result.
Thank you, mikrom.
It is a problem of intel fortran complier.
 
Upvote 0 Downvote
Hi zhouxian,
As the above experiment shows, the procedure pointers are not yet implemented in gfortran, but only in g95.
Similar in your case, it seems to be a problem with your compiler. But I don't have Intel Fortran compilers, so I cannot help you with it.
 
Upvote 0 Downvote
It is not implemented in the Intel Fortran compilers yet.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

virk24
  • Locked
  • Question
subroutine call in a function
Replies
2
Views
328
virk24
virk24
W
  • Locked
  • Question
Failure to open a file that exists
Replies
7
Views
614
WillBryce
W
Lapantufla
  • Locked
  • Question
Gamma function in quadruple precision
Replies
1
Views
102
mikrom
mikrom
Vahid9
  • Locked
  • Question
Printing in a fortran MPI/OpenMP environment
Replies
2
Views
346
Vahid9
Vahid9
virk24
  • Locked
  • Question
Reading character up to ";" from a csv-file
Replies
3
Views
320
virk24
virk24

Part and Inventory Search

Sponsor

Back
Top