Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.
28760 Discussions

EXTERNAL subprogram as an argument to a subroutine in the CONTAINS section of a module

avinashs
New Contributor I
1,483 Views

I have a module that contains an internal subroutine (say S) which has an external function (say F) as a dummy argument. The internal subroutine S is then called by other internal subroutines (S1, S2 etc.) in the module with functions having the same interface as the external argument (F1, F2 etc.). However, this generates an error since the calls to the S cannot "find" F1, F2. Of course, this is a standard practice if the subprograms were not in a module and defined as standalone subprograms in one or more files.

My questions are:
1. Is this an error because it does not conform to the Fortran standard?
2. Is there a way around this?

I am attaching a sample program that explains the situation and generates the error.

As further background ... The reason for using the internal subprogram S in this way is that it was previously a standalone subprogram that I want to simply insert into the module without having to make any modifications.

module test_internal_subroutine_with_external_function

  implicit none

contains

  subroutine stats(n, x, a, s, func)
    external :: func ! OK: no compilation error
    integer :: n
    real :: a, s, x(n)
    ! calculates average and standard deviation of
    ! function values defined by EXTERNAL routine func
    ! evaluated at the n components of vector x
    integer :: i
    real :: f(n)
    do i = 1,n
       f(i) = func(x(i)) ! error #6404: This name does not have a type, and must have an explicit type. [FUNC]
    end do
    a = sum(f)/n
    s = sqrt(sum((f - a)**2)/(n - 1))
  end subroutine stats

  function func1(x) result(r)
    real :: x, r
    r = sin(x)
  end function func1

  function func2(x) result(r)
    real :: x, r
    r = cos(x)
  end function func2

  subroutine evaluate()
    external :: func1, func2 ! OK: no compilation error
    integer :: n
    real :: a1, s1, a2, s2
    real, allocatable :: x(:)
    ! evaluate statistics for two functions
    n = 100
    allocate(x(n))
    call random_number(x)
    call stats(n, x, a1, s1, func1) ! OK: no compilation error
    call stats(n, x, a2, s2, func2) ! OK: no compilation error
    print *, 'sin(x)', a1, s1
    print *, 'cos(x)', a2, s2
    read *
    deallocate(x)
  end subroutine evaluate
  
end module test_internal_subroutine_with_external_function

 

0 Kudos
5 Replies
Andreas_Z_
New Contributor I
1,483 Views

The error message you show on code line 17 does not say that the subroutine cannot find the external function. It indicates that func (and thereby its returned value) has not been assigned a type (i.e. real in this case).
On line 8, try:   real, external :: func.

0 Kudos
andrew_4619
Honored Contributor III
1,483 Views

if "evaluate"  has been told to use  func1 and func2  that are external. That is fine but they must exist in some other source that is not in a module or you will get a link error for not found.

If you want to use the func1 and func2 that are in the module than these have already been defined fully and are fully visible to evaluate by default. You should not declare them again as the compiler will then ignore the existing local  definitions. 

0 Kudos
FortranFan
Honored Contributor III
1,483 Views

With your current approach with classic but limited FORTRAN approach with EXTERNAL, you would need to declare the type of the function result e.g., REAL FUNC in your STATS subprogram.

But now that you're using MODULEs and moving away from standalone subprograms, you may want to consider using more modern facilities with explicit interfaces including ABSTRACT ones like so for your code which will give you considerable safety with procedure arguments and type,kind,rank checking, etc.:

module test_internal_subroutine_with_external_function

   implicit none

   abstract interface
      function Ifunc(x) result(r)
         real :: x, r
      end function Ifunc
   end interface

contains

   subroutine stats(n, x, a, s, func)
      integer :: n
      real :: a, s, x(n)
      procedure(Ifunc) :: func

      ! calculates average and standard deviation of
      ! function values defined by EXTERNAL routine func
      ! evaluated at the n components of vector x
      integer :: i
      real :: f(n)
      do i = 1,n
         f(i) = func(x(i)) ! error #6404: This name does not have a type, and must have an explicit type. [FUNC]
      end do
      a = sum(f)/n
      s = sqrt(sum((f - a)**2)/(n - 1))
   end subroutine stats

   function func1(x) result(r)
      real :: x, r
      r = sin(x)
   end function func1

   function func2(x) result(r)
      real :: x, r
      r = cos(x)
   end function func2

   subroutine evaluate()
      procedure(Ifunc) :: func1, func2
      integer :: n
      real :: a1, s1, a2, s2
      real, allocatable :: x(:)
      ! evaluate statistics for two functions
      n = 100
      allocate(x(n))
      call random_number(x)
      call stats(n, x, a1, s1, func1) ! OK: no compilation error
      call stats(n, x, a2, s2, func2) ! OK: no compilation error
      print *, 'sin(x)', a1, s1
      print *, 'cos(x)', a2, s2
      read *
      deallocate(x)
   end subroutine evaluate

end module test_internal_subroutine_with_external_function

 

0 Kudos
avinashs
New Contributor I
1,483 Views

Thanks for all the helpful responses. The use of interfaces instead of EXTERNAL statements is the only solution which means that I can reuse the standalone subroutines in the modules only after replacing the EXTERNAL statements with PROCEDURE statements referencing the correct interface blocks. I implemented this approach and it works correctly without any errors.

0 Kudos
Paul_Dent
New Contributor I
1,352 Views
I think I see an error. Your function Stats has an argument X declared to an array X(N) therein. But the other functions func1, func2 do not have an array argument in that position. The arguments must match in all respects.
0 Kudos
Reply