INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

pass unlimited polymorphic subroutine as argument and other issues

pass unlimited polymorphic subroutine as argument and other issues

pass unlimited polymorphic subroutine as argument and other issues

(OP)
I am programming with FORTRAN oop features. Now I have a subroutine which takes another subroutine as its argument. But I want the subroutine takes unlimited polymorphic subroutine as the argument as well as normal subroutine. For example I have:

CODE --> Fortran

subroutine PassFunc(MyFunc, MyInput)
            class(*), intent(inout) :: MyInput
            interface
                subroutine MyFunc(A, B)
                    class(*), intent(in) :: A
                    class(*), intent(out) :: B
                endsubroutine MyFunc
            endinterface
            class(*), allocatable :: FuncRes
            
            select type(MyInput)
            type is(real(8))
                allocate(real(8)::FuncRes)
                select type(FuncRes)
                type is(real(8))
                    call MyFunc(MyInput, FuncRes)
                    MyInput = MyInput + FuncRes**2
                endselect
            type is(complex(8))
            endselect
        endsubroutine PassFunc

        !Input Functions
        subroutine Func1(A, B)
            class(*), intent(in) :: A
            class(*), intent(out) :: B

            select type(A)
            type is(real(8))
                select type(B)
                type is(real(8))
                    B = A + 1
                endselect
            type is(complex(8))
                select type(B)
                type is(complex(8))
                    B = A - 1
                endselect
            endselect
        endsubroutine Func1
        
        subroutine Func2(A, B)
            real(8), intent(in) :: A
            real(8), intent(out) :: B
            
            B =  A + 1
        endsubroutine Func2 
Questions:

  1. I am only allowed to pass an unlimited polymorphic subroutine into "PassFunc". I am not be able to pass a normal function (a function without class(*)). Is there any way to make "PassFunc" take other types of functions? (Example: Func1 works but Func2 doesn't. I got access violation with IVF, though it didn't complain when compiling. Is it possible to make it work? If it is possible, I can make use of other subroutine without modifying.)
  2. In the case, the type of "FuncRes" variable depends on "MyInput". Now the only way I know is to use a nested select type. But in fact, there is no need to do this since "FuncRes" and "MyInput will always be the same type. Is there a way to reduce the nested select type? (It would be a disaster if I have many intermediate variables.)
Thanks for any suggestions.

RE: pass unlimited polymorphic subroutine as argument and other issues

IMO, you don't need to pass the procedure MyFunc as an argument of the procedure PassFunc, because you can define MyFunc for all type of arguments using generic interface - see for example here:
http://www.tek-tips.com/viewthread.cfm?qid=1689692

RE: pass unlimited polymorphic subroutine as argument and other issues

I tried a little bit simplified example like this:

CODE

subroutine caller_proc(some_io)
  ! polymorphic argument
  class(*) :: some_io
  ...
  call my_proc(some_io, result_of_some_type)
end subroutine caller_proc
...
...
! and in the main program
call caller_proc(integer_argument)
...
call caller_proc(real_argument)
...
call caller_proc(complex_argument) 

where
1. caller_proc has one polymorphic argument
2. my_proc is defined for several argument types using generic interface

It seems to work. I will post the code soon.

RE: pass unlimited polymorphic subroutine as argument and other issues

generic_proc.f95

CODE

module procedures
  implicit none
  ! generic interface for procedures
  interface my_proc
    module procedure proc_I, proc_R, proc_C
  end interface my_proc
contains
  subroutine proc_I(a, b)
    integer :: a,b
    b = a + 1
    write(*,*) '* proc_Integer: a=', a, ', b=', b 
  endsubroutine proc_I

  subroutine proc_R(a, b)
    real :: a,b
    b = a - 1
    write(*,*) '* proc_Real: a=', a, ', b=', b 
  endsubroutine proc_R
     
  subroutine proc_C(a, b)
    complex :: a,b
    b= conjg(a)
    write(*,*) '* proc_Complex: a=', a 
    write(*,*) '                b=', b 
  endsubroutine proc_C
end module procedures

program test
  implicit none

  integer :: a
  real :: x
  complex :: z

  a = 1
  call caller_proc(a)
  write(*,*) 'Result: a = ', a
  write(*,*)

  x = 5.0
  call caller_proc(x)
  write(*,*) 'Result: x = ', x
  write(*,*)

  z = (1, 1)
  call caller_proc(z)
  write(*,*) 'Result: z = ', z
  write(*,*)  
contains
  subroutine caller_proc(some_io)
    use procedures
    ! polymorphic argument
    class(*) :: some_io
    ! possible data type results
    integer :: res_I
    real :: res_R
    complex res_C

    select type(some_io)
      type is (integer)
        call my_proc(some_io, res_I)
        some_io =  some_io + res_I * 2
        write(*,*) 'some_io = ', some_io
      type is (real)
        call my_proc(some_io, res_R)
        some_io =  some_io + res_R * 2
        write(*,*) 'some_io = ', some_io
      type is (complex)
        call my_proc(some_io, res_C)
        some_io =  some_io + res_C * 2
        write(*,*) 'some_io = ', some_io
    end select
  end subroutine caller_proc    
end program test 

Output:

CODE

$ gfortran generic_proc.f95 -o generic_proc

MIKL1071@MIKL1071 ~/fortran
$ generic_proc
 * proc_Integer: a=           1 , b=           2
 some_io =            5
 Result: a =            5

 * proc_Real: a=   5.00000000     , b=   4.00000000
 some_io =    13.0000000
 Result: x =    13.0000000

 * proc_Complex: a= (  1.00000000    ,  1.00000000    )
                 b= (  1.00000000    , -1.00000000    )
 some_io =  (  3.00000000    , -1.00000000    )
 Result: z =  (  3.00000000    , -1.00000000    ) 

RE: pass unlimited polymorphic subroutine as argument and other issues

(OP)
Thanks for your time and response mikrom. But I think there is some misunderstand here. In your example code, you shown that "a subroutine can take unlimited polymorphic types as imput parameters". My question is "Is it possible to make subroutine take unlimited polymorphic subroutines as well as normal subroutines as input parameters".
For example:

you can have

CODE --> FORTRAN

subroutine poly(A)
class(*), intent(inout) :: A 
I understand this is possible in FORTRAN. You also mentioned that one can use an interface for putting different subroutines together for processing the parameter. In fact, you can use the 3 proc subroutines without the interface as well.

But my question is: If you have

CODE --> FORTRAN

subroutine poly(another_subroutine, A)
class(*), intent(inout) :: A 
interface
subroutine another_subroutine(AA)
class(*), intent(inout) ::AA
endsubroutine
endinterface 

(please note here: the interface is used to define how the passing-in subroutine should be. Not a generic thing) This subroutine can take other subroutines (which fit the interface) as input. But it doesn't take a normal subroutine (a subroutine without unlimited polymorphic parameters) as input. I am wondering if there is a work around to it. If you have any suggestions, please let me know. Thanks again.

RE: pass unlimited polymorphic subroutine as argument and other issues

Hi FortCpp,
I only tried to get around it without passing subroutine as an argument of other subroutine, because IMO for this purpose generic interface could be used.

Quote:


This subroutine can take other subroutines (which fit the interface) as input. But it doesn't take a normal subroutine (a subroutine without unlimited polymorphic parameters) as input.
Yes it doesn't take subroutine with normal argument, because in the procedure interface you have declared, that it should only accept subroutine with polymorphic type.

RE: pass unlimited polymorphic subroutine as argument and other issues

(OP)
mikrom,

Yes, I agree. But it doesn't compile if I make interface generic. For example

CODE --> FORTRAN

subroutine poly(another_subroutine, A)
class(*), intent(inout) :: A 
interface another_subroutine
subroutine another_subroutine(AA)
class(*), intent(inout) ::AA
endsubroutine
subroutine another_subroutine(AA)
real(8), intent(inout) ::AA
endsubroutine
endinterface another_subroutine 
Is there a way to rewrite it somehow?

RE: pass unlimited polymorphic subroutine as argument and other issues

(OP)
Sorry, I made some grammar mistakes in the code, I have no idea how to edit the reply.

RE: pass unlimited polymorphic subroutine as argument and other issues

Hi FortCpp,
I tried to declare the procedure name argument without interface using the key word external.
It seems to work. Now the caller procedure calls normal procedures (integer, real, complex) and the polymorphic procedure too. However, the polymotphic procedure only prints something, because I don't know how to do some computation inside of it. Everytime when I try it I get an error: Program received signal SIGSEGV: Segmentation fault - invalid memory reference.

Here is the code:

CODE

program test
  implicit none

  integer :: a
  real :: x
  complex :: z

  a = 1
  call caller_proc(proc_I, a)
  write(*,*) 'Result: a = ', a
  write(*,*)

  x = 5.0
  call caller_proc(proc_R, x)
  write(*,*) 'Result: x = ', x
  write(*,*)

  z = (1, 1)
  call caller_proc(proc_C, z)
  write(*,*) 'Result: z = ', z
  write(*,*)

  x = 2.0
  call caller_proc(proc_P, x)
  write(*,*) 'Result: x = ', x
  write(*,*)
contains

  subroutine caller_proc(my_proc, some_io)
    implicit none
    ! my_proc is external subroutine
    external my_proc
    ! polymorphic argument
    class(*) :: some_io
    ! possible data type results
    integer :: res_I
    real :: res_R
    complex :: res_C
    class(*), allocatable :: res_P

    select type(some_io)
      type is (integer)
        call my_proc(some_io, res_I)
        some_io =  some_io + res_I * 2
        write(*,*) 'some_io = ', some_io
      type is (real)
        write(*,*) '*Type is real '
        call my_proc(some_io, res_R)
        some_io =  some_io + res_R * 2
        write(*,*) 'some_io = ', some_io
      type is (complex)
        call my_proc(some_io, res_C)
        some_io =  some_io + res_C * 2
        write(*,*) 'some_io = ', some_io
    end select
  end subroutine caller_proc

  subroutine proc_I(a, b)
    implicit none
    integer :: a,b
    b = a + 1
    write(*,*) '* proc_Integer: a=', a, ', b=', b 
  endsubroutine proc_I

  subroutine proc_R(a, b)
    implicit none
    real :: a,b
    b = a - 1
    write(*,*) '* proc_Real: a=', a, ', b=', b 
  endsubroutine proc_R
     
  subroutine proc_C(a, b)
    implicit none
    complex :: a,b
    b= conjg(a)
    write(*,*) '* proc_Complex: a=', a 
    write(*,*) '                b=', b 
  endsubroutine proc_C

  subroutine proc_P(a, b)
    implicit none
    class(*) :: a, b
    write(*,*) '** Hello from Polymorphic procedure !'
  endsubroutine proc_P
end program test 

and here is the output:

CODE

$ gfortran subroutine_arg.f95 -o subroutine_arg

$ subroutine_arg
 * proc_Integer: a=           1 , b=           2
 some_io =            5
 Result: a =            5

 *Type is real
 * proc_Real: a=   5.00000000     , b=   4.00000000
 some_io =    13.0000000
 Result: x =    13.0000000

 * proc_Complex: a= (  1.00000000    ,  1.00000000    )
                 b= (  1.00000000    , -1.00000000    )
 some_io =  (  3.00000000    , -1.00000000    )
 Result: z =  (  3.00000000    , -1.00000000    )

 *Type is real
 ** Hello from Polymorphic procedure !
 some_io =    2.00000000
 Result: x =    2.00000000 

RE: pass unlimited polymorphic subroutine as argument and other issues

(OP)
mikrom,

Thanks for the response. To me, "external" contains no information of the subroutine. My understanding is: "external" can be anything and the language leave this room for the linker. I don't know for sure why there is a seg fault. But I'd expect this is due to the FORTRAN standard doesn't define such kind of thing. So I'd say one cannot use unlimited poly and normal subroutines at the same time but "external" is a option (but the result could be wrong).

I appreciate your code and time.

RE: pass unlimited polymorphic subroutine as argument and other issues

Hi FortCpp,

I tried eveything above with gfortran compiler, but maybe the behavior with polymorphic subroutines is better implemented in other compiler.

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close