Question about interfaces and submodules

Hi everyone,

I know that I can use an interface to provide implementations for multiple types, like this:

module iface_help_1
    implicit none

    interface somesub
        module procedure :: somesub_int
        module procedure :: somesub_real
    end interface

contains

    subroutine somesub_int(x)
        integer, intent(inout) :: x
        x = x + 1
    end subroutine

    subroutine somesub_real(x)
        real, intent(inout) :: x
        x = x + 1.0
    end subroutine
end module

And I also know that I can use an interface to move the implementation of a procedure into a submodule, thereby dissociating the procedure declaration and signature from it’s implementation:

module iface_help_2
    implicit none

    interface
        module subroutine sub1(x)
            integer, intent(inout) :: x
        end subroutine
    end interface
end module


submodule (iface_help_2) iface_help_2_impl
    implicit none
contains

    module procedure sub1
        x = x+1
    end procedure

end submodule 

But how can I do both? Suppose in the second example, I wanted to provide integer and real implementations of sub1 - how would I do that?

Thanks,
Harris

1 Like

Just reuse the syntax from the generic interface:

module iface_help_2
    implicit none

    interface sub
        module subroutine sub1(x)
            integer, intent(inout) :: x
        end subroutine
        module subroutine sub2(x)
            real, intent(inout) :: x
        end subroutine
    end interface
end module

submodule (iface_help_2) iface_help_2_impl
    implicit none
contains
    module procedure sub1
        x = x+1
    end procedure
    module procedure sub2
        x = x+1
    end procedure
end submodule 

program main
    use iface_help_2
    real :: rx
    integer :: ix
    ix = 1
    rx = 1
    call sub(ix)
    call sub(rx)
    print *, ix, rx
end program

Example output:

$ ifort iface.f90
$ ./a.out
           2   2.000000    
1 Like

@ivanpribec ,

An alternative you may want to keep in mind for certain situations (e.g., PRIVATE/PUBLIC considerations, readability, style aspects - not wanting to split / create multiple INTERFACE blocks with module subprograms, etc.) is the Fortran 2018 facility with GENERIC statement to declare generic interfaces:

   ..
   interface
      module subroutine sub1(x)
         integer, intent(inout) :: x
      end subroutine
      module subroutine sub2(x)
         real, intent(inout) :: x
      end subroutine
   end interface
   ..
   generic :: sub => sub1, sub2 !<-- Note generic interface 'sub' can have PUBLIC/PRIVATE attribute
   ..
5 Likes

That is great!

I didn’t know this form of generic before. Looks like I have to study MFE more.

What’s the advantage of using submodules? Is it just a “device” to help with code organization?
Is the combination of modules & submodules a similar concept as the header (.h) and source (.c) files in typical C language projects?

This is also my first message on this forum, so greetings to all. Looking forward to learn more from the discussions here.

3 Likes

Hello @art-rasa! Nice to have you here.

I cannot comment fully on the similarity with C, but in a way yes. The way I understand is if you have a module which only defines the interfaces, and place the actual implementations in a submodule, then a change in the implementation (the submodule) does not require recompilation of any client code consuming routines from the module. If you imagine having a large hierarchy of modules, then you can also decrease build times by avoiding recompilation cascades.

Splitting your modules into smaller submodules can also significantly decrease memory usage during compilation as was demonstrated recently in an issue with stdlib (https://github.com/fortran-lang/stdlib/pull/283). The peak memory load was reduced from 25 GB to 3.5 GB.

Another reason might be to hide the implementation of a library (e.g. a vendor might provide you the interface module, and a shared library object).

I believe in C/C++, in the first step of compilation, the compiler will actually substitute the include statements with the actual content of the header files, which dramatically increases build times. The situation got so bad, that C++20 introduced modules. (I visited a lecture from Google, where they said compiling the Chromium browser from source takes around 45 min on a very powerful workstation.)

Steve Lionel wrote a nice blog post introducing submodules:

3 Likes

@art-rasa,

Welcome to this Discourse.

TL;DR version:
Submodules allow a means to

  1. Avoid compilation cascade
  2. Separate interfaces of subprograms (functions per C terminology) from implementation.
3 Likes