×
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!
  • Students Click Here

*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.

Students Click Here

Jobs

Polymorphism / Dynamic dispatch? Fortran 90.

Polymorphism / Dynamic dispatch? Fortran 90.

Polymorphism / Dynamic dispatch? Fortran 90.

(OP)
Hello all,

I need to do the following in Fortran 90.

I have two subroutines that perform similar tasks, lets call them subroutine ALPHA and subroutine BRAVO. Lets say they have SAME dummy argument list, same sequence ranks, same kinds to all args.

So.. SUBROUTINE ALPHA(dummy_arg1,dummy_arg2,...)
SUBROUTINE BRAVO(dummy_arg1,dummy_arg2,...)

They are called from a MAIN program like so.

CALL ALPHA(arg_1,arg2,...) etc...

What I need to do is to make ONE call from the main and to make the switch between calling ALPHA or BRAVO depending on some logic in the main.

What I DO NOT WANT TO DO is the following
SELECT CASE(TEST)
CASE(1)
CALL ALPHA(arg1,arg2,...)
CASE(2)
CALL BRAVO(arg1,arg2,...)
END SELECT

or similar with an IF-ELSE-ENDIF

I want a single (ONE) subroutine call from the MAIN which will access either ALPHA or BRAVO depending on the logic in main, but again with a SINGLE call.

I understand this CAN be done with polymorphism / dynamic dispatch. Fortran 95 and beyond can do it relatively easily but it's much more complicated with earlier versions and I MUST basically use Fortran 90.

I've racked my brain and coded and just can't get this to work.

Anyone know how to do this???

Regards,


Frank

RE: Polymorphism / Dynamic dispatch? Fortran 90.

How do you decide which one to call? Is it determined by one of the parameter types? If all the parameters are of the same type then you could do something like this

CODE

! Declare a generic interface
MODULE POLYMOD

! Define two different types
TYPE atype
    SEQUENCE
    INTEGER kode
END TYPE

TYPE btype
    SEQUENCE
    INTEGER kode
END TYPE

! This is the polymorphic call
INTERFACE GREEK
    SUBROUTINE ALPHA(param, val)
        TYPE (atype), INTENT(INOUT):: param
        INTEGER, INTENT(IN):: val
    END SUBROUTINE ALPHA
    
    SUBROUTINE BETA(param, val)
        TYPE (btype), INTENT(INOUT):: param
        INTEGER, INTENT(IN):: val
    END SUBROUTINE BETA
END INTERFACE
CONTAINS

! Definition using atype
SUBROUTINE ALPHA(param, val)
    TYPE (atype), INTENT(INOUT):: param
    INTEGER, INTENT(IN):: val
    param%kode = val
    print *, 'alpha'
END SUBROUTINE ALPHA

! Definition using btype
SUBROUTINE BETA(param, val)
    TYPE (btype), INTENT(INOUT):: param
    INTEGER, INTENT(IN):: val
    param%kode = val
    print *, 'beta'
END SUBROUTINE BETA
END MODULE POLYMOD


PROGRAM main
    USE POLYMOD
    TYPE (atype):: adata
    TYPE (btype):: bdata
    
    ! See if it works
    call greek(adata, 65)
    call greek(bdata, 66)
    print *, 'adata ', adata%kode
    print *, 'bdata ', bdata%kode
end program 

RE: Polymorphism / Dynamic dispatch? Fortran 90.

(OP)
Hello xwb,

That's a valiant effort but it doesn't make it.

You can see from your main here:
call greek(adata, 65)
call greek(bdata, 66)

You are able to access the two different subroutines using the types 'adata' and 'bdata' to match the type of the called subroutine.

However that still means two different calls, the difference being the types adata and bdata.

As I said in the original post I need "I want a single (ONE) subroutine call" that can access both, CALL GREEK() end of. The reasoning for this is a select-case structure of if-else to select the 'right' routine would be horrendously wordy and slow, loads of code lines because a) the amount of subroutines that may be called is not just ALPHA through to BRAVO, but ALPHA through to ZEBRA and the argument list to the routines can be sizeable. I need one ring to rule them all. One call. I know it's a toughy it's been wrecking my brain.

Thank you for your effort though, it really is appreciated.

Regards,

Frank

RE: Polymorphism / Dynamic dispatch? Fortran 90.

Can you explain what you mean by "access both". Give a coding example, even if it is not syntactically correct for F90.

This doesn't sound like a polymorphic call. If there is no difference in the parameters, how does the code know which one to call.

RE: Polymorphism / Dynamic dispatch? Fortran 90.

(OP)
This in code/psuedo-code is what I want to do.

MODULE JIMMY
!
CONTAINS
SUBROUTINE ALPHA (identical_dummy_arg_list)
! Does stuff with args
END SUBROUTINE ALPHA
!
SUBROUTINE BRAVO (identical_dummy_arg_list)
! Does different stuff with args but updates the same args
END SUBROUTINE BRAVO
!
END MODULE JIMMY

MAIN
USE JIMMY, ONLY : ALPHA,BRAVO

INTERFACE GREEK
PROCEDURE ALPHA,BRAVO
END INTERFACE GREEK

IF (TEST.EQ.1) THEN
! I will want to call ALPHA with the argument list
! so I need to change something to make that happen.
ELSE (IF TEST.EQ.2) THEN
! I will want to call BRAVO with the argument list
! so I need to change something to make that happen.
END IF
!
!Some code in here to make the call to GREEK call to the right ALPHA or BRAVO depending on the above logic.
!
CALL GREEK(argument_list) ! and GREEK calls the right ALPHA or BRAVO, i.e. a single call
! If it works Happiness ensues
!
RETURN
END

What I DON'T WANT is:
IF (TEST.EQ.1) THEN
CALL ALPHA(huge arg list)
ELSE (IF TEST.EQ.2) THEN
CALL BRAVO(huge_arg_list)
...
ELSE IF (ITEST.EQ.n) THEN
CALL ZEBRA(huge_arg_list)
END IF
-------------------------------------------------------------------------

Thanks again.

Regards,


Frank

RE: Polymorphism / Dynamic dispatch? Fortran 90.

then make it simple and additionally to all the subroutines

CODE

SUBROUTINE ALPHA (identical_dummy_arg_list)
...
SUBROUTINE BRAVO (identical_dummy_arg_list)
...
SUBROUTINE ZEBRA (identical_dummy_arg_list)
... 
create a subroutine with the same dummy arg list plus a selector, which calls the right procedure, e.g.:

CODE

subroutine SELECTED_SUBROUTINE (selector, identical_dummy_arg_list)
...
select case (selector)
   case ('ALPHA')
      call ALPHA(identical_dummy_arg_list)
   ...
   case ('BRAVO')
      call BRAVO(identical_dummy_arg_list)
   ...
   case ('ZEBRA')
      call ZEBRA(identical_dummy_arg_list)
   ...
   case default
      call ERROR_BAD_SELECTOR_VALUE
end select
end subroutine 
and call it in your main program:

CODE

program main
   ...
   ! set the selector value depending on some logic
   ...
   call SELECTED_SUBROUTINE (selector, identical_arg_list) 
   ...
end program main 

RE: Polymorphism / Dynamic dispatch? Fortran 90.

mikrom beat me to the punch...I was about to say just about the same; basically, you cannot get away from the 'if-then' in some shape or form if you want to tell things apart. So, instead of putting the "if-then" in the main program, you place it inside the single function being call.

RE: Polymorphism / Dynamic dispatch? Fortran 90.

(OP)
Again, thanks to all. I do appreciate it.

Simple yes, but in mikroms solution that single call now becomes two subroutine calls with a full (and large in this application) argument list and a long-as-your-arm select case or if-else structure in the first subroutine called before you even get to call the subroutine that you want. It won't do.

Do that a couple of million times and there goes the speed of the application and the one I'm working on must have the rivets ground down to be as aerodynamic as possible. No fat allowed!

Surely there has to be a way to do this?

Regards,


Frank



RE: Polymorphism / Dynamic dispatch? Fortran 90.

Then the only thing that comes to my mind are procedure pointers. But unfortunately this feature is supported only in newer standard 2003, not in 90, so if you upgrade your compiler you can do it like this:

FrankMonkey.f95

CODE

module my_subroutines
  implicit none

  type subroutine_type
    procedure(subroutine_interface), nopass, pointer :: sub_ptr    
  end type subroutine_type

  abstract interface
    subroutine  subroutine_interface(foo, bar, baz)
      double precision, intent(in) :: foo, bar, baz
    end subroutine subroutine_interface
  end interface  

  contains

  ! all subroutines to call
  subroutine  alpha(foo, bar, baz)
     double precision, intent(in) :: foo, bar, baz
     write(*,*) "calling: ALPHA"    
  end subroutine alpha

  subroutine  bravo(foo, bar, baz)
     double precision, intent(in) :: foo, bar, baz
     write(*,*) "calling: BRAVO"    
  end subroutine bravo
 
  subroutine  zebra(foo, bar, baz)
     double precision, intent(in) :: foo, bar, baz
     write(*,*) "calling: ZEBRA"    
  end subroutine zebra
end module my_subroutines

program main
  use my_subroutines
  implicit none
  CHARACTER(len=5) :: arg
  double precision :: foo, bar, baz 
  type(subroutine_type) :: my_proc

  ! set the pointer value
  call get_command_argument(1, arg)
  select case (arg)
    case ('ALPHA')
      my_proc%sub_ptr => alpha
    case ('BRAVO')
      my_proc%sub_ptr => bravo
    case ('ZEBRA')
      my_proc%sub_ptr => zebra
    case default
      stop 'Error calling subroutine !'
   end select

   ! call the selected subroutine
   call  my_proc%sub_ptr(foo, bar, baz)

end program 

Results:

CODE

$ gfortran FrankMonkey.f95 -o FrankMonkey
$ ./FrankMonkey ALPHA
 calling: ALPHA
$ ./FrankMonkey BRAVO
 calling: BRAVO
$ ./FrankMonkey
STOP Error calling subroutine ! 

RE: Polymorphism / Dynamic dispatch? Fortran 90.

Does your implementation of F90 have Cray pointers? Does the following compile on your compiler. If it does, you can do something similar to mikrom's solution using function pointers.

CODE

program craytest
	POINTER (p, picreg)
	INTEGER picreg
	INTEGER J(1024)

! This has the same effect as j(1) = 0, j(2) = 44
      p = LOC(j)
      picreg = 0
      p = p + 4   ! for 4-byte integer
      picreg = 44
	print *, j(1), j(2)
	print '(Z)', p
end program craytest 

RE: Polymorphism / Dynamic dispatch? Fortran 90.

And, no, with modules you do not need to pass a long list of arguments, just encapsulate the data and the functions that manipulate it in the same module.

RE: Polymorphism / Dynamic dispatch? Fortran 90.

xwb you are awesome !
With the Cray pointers it seems to be very simple - i tried what you suggested:

FrankMonkey2.f95

CODE

! compilation:
!   gfortran FrankMonkey2.f95 -o FrankMonkey2 -fcray-pointer
module my_subroutines
  implicit none

  contains

  ! all subroutines to call
  subroutine  alpha(foo, bar, baz)
     double precision, intent(in) :: foo, bar, baz
     write(*,*) "calling: ALPHA"    
  end subroutine alpha

  subroutine  bravo(foo, bar, baz)
     double precision, intent(in) :: foo, bar, baz
     write(*,*) "calling: BRAVO"    
  end subroutine bravo
 
  subroutine  zebra(foo, bar, baz)
     double precision, intent(in) :: foo, bar, baz
     write(*,*) "calling: ZEBRA"    
  end subroutine zebra
end module my_subroutines

program main
  use my_subroutines
  implicit none
  CHARACTER(len=5) :: arg
  double precision :: foo, bar, baz 
  pointer (sub_ptr, selected_subroutine)
  external selected_subroutine

  ! set the pointer to a subroutine
  call get_command_argument(1, arg) 
  select case (arg)
    case ('ALPHA')
      sub_ptr = loc(alpha)
    case ('BRAVO')
      sub_ptr = loc(bravo)
    case ('ZEBRA')
      sub_ptr = loc(zebra)
    case default
      stop 'Error calling subroutine !'
   end select

   ! call the selected subroutine
   call  selected_subroutine(foo, bar, baz)
end program 


Output:

CODE

$ gfortran FrankMonkey2.f95 -o FrankMonkey2 -fcray-pointer
$ ./FrankMonkey2 ALPHA
 calling: ALPHA
$ ./FrankMonkey2 BRAVO
 calling: BRAVO
$ ./FrankMonkey2 ZEBRA
 calling: ZEBRA
$ ./FrankMonkey2 foo bar baz
STOP Error calling subroutine ! 

RE: Polymorphism / Dynamic dispatch? Fortran 90.

Quote (salgerman)


And, no, with modules you do not need to pass a long list of arguments, just encapsulate the data and the functions that manipulate it in the same module.
Hi salgerman
Could you show a short code example, what you mean, please ?

RE: Polymorphism / Dynamic dispatch? Fortran 90.

CODE --> Fortran90

module my_module
    implicit none
    integer :: a
contains
    subroutine alpha()
        a = 1
    end subroutine alpha

    subroutine beta()
        a = 2
    end subroutine beta

    subroutine gamma()
        a = 3
    end subroutine gamma
end module my_module

program main
    use my_module
    a = 0
    call alpha()
    write(*,*) 'a = ', a
    call beta()
    write(*,*) 'a = ', a
    call gamma()
    write(*,*) 'a = ', a
end program main 

RE: Polymorphism / Dynamic dispatch? Fortran 90.

And, as I mentioned before, for as long as you need to tell things apart you are going to need a "select" or an "if-then" somewhere, there is no way around it...even the example with pointers needs a "select" to assign the pointer, so, what's the point of complicating the matter with potential memory leaks and the like problems? ...just saying.

RE: Polymorphism / Dynamic dispatch? Fortran 90.

now I understand what you mean: instead of subroutine arguments to use module variables

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!

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