Internal Procedures as actual arguements

[adrianholt]

The FORTRAN standard will not allow internal procedures to be actual arguements to another procedure. COMPAQ FORTRAN seems to allow this, which is a very nice feature. However the contained internal procedure I am using is an ARRAY FUNCTION which causes a compile error in COMPAQ. Is there any way around this so I can still use a CONTAINED ARRAY FUNCTION?

Example Below::

module obsvTest3

implicit none
private

integer, parameter :: iDim = 2
contains
!------------------------------------
subroutine test1 ()

! double precision, external :: testfun
! double precision, dimension(iDim), external :: testfun
! external :: testfun

call testmethod (testfun)

contains
!------------------------------------
function testfun ()

! double precision :: testfun
double precision, dimension(iDim) :: testfun

testfun = 1d0

end function testfun


end subroutine test1
!------------------------------------
subroutine testmethod (dFun)

double precision, dimension(iDim), external :: dFun
! double precision, external :: dFun
! external :: dFun

double precision, dimension (iDim) :: dLocal
! double precision :: dLocal

dLocal = dFun()

end subroutine testmethod

!-------------------------------------
end module obsvTest3

[james1]

First, you want to pass a pointer to the routine as in CALL TESTMETHOD(LOC(TESTFUN)). Then in TESTFUN define an interface for the function it is to call, and assign the function pointer as in:

subroutine testmethod (lpFun)

interface
function testfun ()
  integer, parameter :: iDim = 2
  double precision, dimension(iDim) :: testfun
  end function
end interface
double precision, dimension (iDim) :: dLocal

integer (int_ptr_kind()) lpFun
pointer (dFunPtr, testfun)

dFunPtr = lpFun
dLocal = testfun()

James

[Steven_L_Intel1]

Your main problem is that you cannot declare an array-returning function using EXTERNAL. You must use an INTERFACE for this. If you do that, you run into an annoying aspect of the language which makes host-associated definitions invisible inside INTERFACE blocks. So you have to do it this way instead:

module mydefs
integer, parameter :: iDim = 2
end module mydefs

module obsvTest3
use mydefs
implicit none
private

contains
!------------------------------------
subroutine test1 ()

! double precision, external :: testfun
! double precision, dimension(iDim), external :: testfun
! external :: testfun 

call testmethod (testfun)

contains
!------------------------------------
function testfun ()

! double precision :: testfun
double precision, dimension(iDim) :: testfun

testfun = 1d0

end function testfun


end subroutine test1
!------------------------------------
subroutine testmethod (dFun)

interface
  function dFun
  use mydefs
  double precision, dimension(iDim) :: dFun
  end function dFun
  end interface

double precision, dimension (iDim) :: dLocal
! double precision :: dLocal

dLocal = dFun()

end subroutine testmethod

!-------------------------------------
end module obsvTest3

Steve