call different subroutines with pointer

[zwh]

The following code to call different subroutine with pointer
(without using if statement) work for most Fortran compiler
I have used so far, (it use some extention feature of fortran 90),
but I can not get it work with Lahey Fortran Lahey/Fujitsu Optimizing Fortran 95 Compiler on linux, can anyone help me to get it working with Lahey Fortran 95 compiler for linux,
thank you very much for your help

program main

imodel=1
call mat_ele1(imodel)
call CallMySub

imodel=2
call mat_ele2(imodel)
call CallMySub
end

SUBROUTINE mat_ele1(imodel)
external mysub1
call InstallSubs (mysub1)
return
end

SUBROUTINE mat_ele2(imodel)
external mysub2
call InstallSubs (mysub2)
return
end

SUBROUTINE InstallSubs(TestSub)
EXTERNAL TestSub
POINTER (P_WhichSub, WhichSub)
COMMON /SUBS/ P_WhichSub
P_WhichSub = LOC(TestSub)
END SUBROUTINE

SUBROUTINE CallMySub
POINTER (P_WhichSub, WhichSub)
COMMON /SUBS/ P_WhichSub
EXTERNAL WhichSub
CALL WhichSub
END SUBROUTINE


subroutine mysub1
write (*,*) "Hi 1!"
return
END

subroutine mysub2
write (*,*) "Hi 2!"
return
end


I known there is alternative way to do it with lahey fortram, (an
example is given below), but with this one, one can not pass
argument, that is why I prefer to use the one above.


program ptrt
implicit none
integer ptr ! holds address of routine
integer doit
external doit
ptr = loc( doit )
print *,'calling callarg with ptr ',ptr
! call callarg( ptr )
call callarg( %VAL( ptr ) )
end

integer function doit()
implicit none
print *,'doit'
end

subroutine callarg( routine )
implicit none
integer routine ! routine to be called
external routine
integer i
i = routine()
end

[tzeis]

I don't know how to make method 1 work. The big difficulty is tricking Fortran into "calling" what it thinks is a variable.
Method 2 seems like a much more fruitful path, because you can successfully trick Fortran. It seems to me that there is no problem calling function doit with arguments, you just have to make sure that all the "doits" you send to subroutine callarg have the same number of arguments. Try this:


program ptrt
implicit none
integer ptr ! holds address of routine
integer doit
external doit
ptr = loc( doit )
print *,'calling callarg with ptr ',ptr
call callarg( %VAL( ptr ) )
end

integer function doit(i,j,k)
implicit none
integer :: i,j,k
print *,'doit', i,j,k
end

subroutine callarg( routine )
implicit none
integer routine ! routine to be called
external routine
integer i
i = routine(1,2,3)
end