Passing a subroutine as an argument depending on a value

Lately I have been passing a subroutine as an argument,
call do_something(…,mysub,…)

Now I’m in a situation where I need to pass a subroutine, and the choice of subroutine depends on some value:

if (value.eq.1) call do_something(…,mysub1,…)
if (value.eq.2) call do_something(…,mysub2,…)

if(value.eq.50) call do_something(…mysub50,…)

Obviously the use of if statements isn’t desirable when there are more than a few subroutines to choose from.

So, what is a good way to accomplish the goal of passing a subroutine as an argument, where the choice of subroutine depends on some value?

2 Likes

You could store pointers to the subroutines in an array and pass the array element:

procedure, pointer, dimension(2000) :: proc
proc(1) => mysub1
proc(2) => mysub2
...
call do_something(..., proc(1), ...)
2 Likes

Thank you, that’s perfect. I’ve been programming in Fortran for decades but not needed to do this until now.

1 Like

If your conditions really are all equality with some integer, then select case will be a slightly better construct.

The reality is that this selection will have to occur somewhere, it’s a matter of in what form and where you want to put it. If you really will always call do_something, I’d lean towards having that call outside the conditional construct. So something like

procedure(sub_interface), pointer :: selected_sub

select case (option)
case (1)
  selected_sub => mysub1
case (2)
  selected_sub => mysub2
...
end select

call do_something(...,selected_sub,...)

In fact, I would probably put the select case block in its own procedure, so you can do selected_sub => select_sub(option)

1 Like

Note that I made a silly mistake here (pmk pointed that out): you need an array of a derived type that has a procedure pointer component:

type procp
     procedure, pointer :: proc
end type procp
type(procp), dimension(1000) :: procs
... call procs%proc(i)

This would be my preferred solution. To go even further, you could even make the values of option named constants:

integer, parameter :: option_1 = 1
integer, parameter :: option_2 = 2
...

select case (option)
case (option_1)
  selected_sub => mysub1
case (option_2)
  selected_sub => mysub2
...
end select

Lovely and explicit.

I think Fortran 202X is even proposed proper enumerators, which would make this even nicer, as you wouldn’t even need to number the options.

I pass a string and use select case to decide what function to call, for example

function stat_vec_str(str_stat,xx) result(xstat)
! compute a statistic for xx(:)
character (len=*), intent(in) :: str_stat
real(kind=dp)    , intent(in) :: xx(:)
real(kind=dp)                 :: xstat
...
select case (str_stat)
   case (stat_labels(iimedian))   ; xstat = median(xx)
   case (stat_labels(iimean))     ; xstat = mean(xx)
   case (stat_labels(iigeomean))  ; xstat = geo_mean(xx)
   case (stat_labels(iimean_nonzero)); xstat = mean(pack(xx,abs(xx) > tiny_real))
   case (stat_labels(iisum))      ; xstat = sum(xx)
   case (stat_labels(iigeo_ret))  ; xstat = product(1+xx) - 1.0_dp
   case (stat_labels(iimean_abs)) ; xstat = mean(abs(xx))
   ...
end select
end function stat_vec_str

Here stat_labels is a parameter array of character constants defined in the module.

Thanks for these solutions. To provide some context, this is related to a problem in simulating beam dynamics in particle accelerators. When I wrote “call do_something” I was referring to calling a subroutine that does numerical integration of particle trajectories. The details of the equations can vary significantly depending on a particle’s location in the accelerator. Basically, I want to pass as an argument the appropriate subroutine depending on a particle’s location. I could of course just make a huge subroutine, containing a select case, for evaluating the right hand side of the equations of motion. But that would be a huge mess. If I associate an integer with each type beamline element (i.e., each magnet), then the choice of what subroutine to pass can be made depending on that integer.

1 Like