Search code examples
genericsmodulefortranassignment-operatorfortran2008

Using SubModules for Generic Assignments in Fortran


If we have three different Files with different Derived types,

MyTypeMod.f90:

MODULE MyTypeMod

TYPE, ABSTRACT :: MyType
INTEGER :: Num
END TYPE MyType

CONTAINS

END MODULE MyTypeMod

MyType1Mod.f90

MODULE MyType1Mod
USE MyTypeMod,  ONLY : MyType
USE MyType2Mod, ONLY : MyType2
IMPLICIT NONE

TYPE, EXTENDS(MyType) :: MyType1
CONTAINS
PROCEDURE :: Type1EqualsType2
GENERIC :: ASSIGNMENT(=) => Type1EqualsType2
END TYPE MyType1

CONTAINS

SUBROUTINE Type1EqualsType2(Type1, Type2)
TYPE(MyType1), INTENT(OUT) :: Type1
TYPE(MyType2), INTENT(IN) :: Type2
Type1%Num = Type2%Num
END SUBROUTINE Type1EqualsType2

END MODULE MyType1Mod

MyType2Mod.f90

MODULE MyType1Mod
USE MyTypeMod,  ONLY : MyType
USE MyType1Mod, ONLY : MyType1
IMPLICIT NONE

TYPE, EXTENDS(MyType) :: MyType2
CONTAINS
PROCEDURE :: Type2EqualsType1
GENERIC :: ASSIGNMENT(=) => Type2EqualsType1
END TYPE MyType2

CONTAINS

SUBROUTINE Type2EqualsType1(Type2, Type1)
TYPE(MyType2), INTENT(OUT) :: Type2
TYPE(MyType1), INTENT(IN) :: Type1
Type2%Num = Type1%Num
END SUBROUTINE Type2EqualsType1

END MODULE MyType2Mod

Here, In this case I couldn't able to compile the Program due to Module files Interdependent on each other. Can I use SubModules to solve the problem?


Solution

  • Unfortunately no, you can't do quite what you want using submodules. This is because both functions Type1EqualsType2 and Type2EqualsType1 require both MyType1 and MyType2 in their function interfaces. Even if you use submodules, both functions will have to have interfaces in their respective modules, and so the circular dependency will remain.

    However, there are a couple of possible workarounds:

    Select type

    You can have the intent(in) arguments of both functions be class(MyType), and only do type resolution using a select type statement. This will allow you to move the function definitions to submodules and resolve the circular dependency, but will also mean that you have to handle cases where a different type which extends MyType is passed to the function. Also, select type can be a little slow, depending on your use case.

    Code for this would look something like:

    MODULE MyTypeMod
      IMPLICIT NONE
      TYPE, ABSTRACT :: MyType
        INTEGER :: Num
      END TYPE MyType
    END MODULE MyTypeMod
    
    MODULE MyType1Mod
      USE MyTypeMod, ONLY : MyType
      IMPLICIT NONE
      
      TYPE, EXTENDS(MyType) :: MyType1
      CONTAINS
        PROCEDURE :: Type1EqualsType2
        GENERIC :: ASSIGNMENT(=) => Type1EqualsType2
      END TYPE
      
      interface
        module SUBROUTINE Type1EqualsType2(this, input)
          TYPE(MyType1), INTENT(OUT) :: this
          class(MyType), INTENT(IN) :: input
        END SUBROUTINE
      end interface
    END MODULE
    
    MODULE MyType2Mod
      USE MyTypeMod, ONLY : MyType
      IMPLICIT NONE
      
      TYPE, EXTENDS(MyType) :: MyType2
      CONTAINS
        PROCEDURE :: Type2EqualsType1
        GENERIC :: ASSIGNMENT(=) => Type2EqualsType1
      END TYPE
      
      interface
        module SUBROUTINE Type2EqualsType1(this, input)
          TYPE(MyType2), INTENT(OUT) :: this
          class(MyType), INTENT(IN) :: input
        END SUBROUTINE
      end interface
    END MODULE
    
    submodule (MyType1Mod) MyType1Submod
      use MyType2Mod, only : MyType2
      implicit none
    contains
      module procedure MyType1EqualsMyType2
        select type(input); type is(MyType1)
          this%Num = input%Num
        type is(MyType2)
          this%Num = input%Num
        class default
          ! Some kind of error handling goes here.
        end select
      end procedure
    end submodule
    
    submodule (MyType2Mod) MyType2Submod
      use MyType1Mod, only : MyType1
      implicit none
    contains
      module procedure MyType2EqualsMyType1
        select type(input); type is(MyType1)
          this%Num = input%Num
        type is(MyType2)
          this%Num = input%Num
        class default
          ! Some kind of error handling goes here.
        end select
      end procedure
    end submodule
    

    Generic procedure

    You can instead replace the type-bound assignment(=) definitions with generic assignment(=) definitions. This avoids the runtime polymorphism, but means you have to define the assignments in a new module.

    This would look something like:

    MODULE MyTypeMod
      IMPLICIT NONE
      TYPE, ABSTRACT :: MyType
        INTEGER :: Num
      END TYPE MyType
    END MODULE MyTypeMod
    
    MODULE MyType1Mod
      USE MyTypeMod, ONLY : MyType
      IMPLICIT NONE
      
      TYPE, EXTENDS(MyType) :: MyType1
      END TYPE
    END MODULE
    
    MODULE MyType2Mod
      USE MyTypeMod, ONLY : MyType
      IMPLICIT NONE
      
      TYPE, EXTENDS(MyType) :: MyType2
      END TYPE
    END MODULE
    
    module MyEqualsMod
      use MyType1Mod : only MyType1
      use MyType2Mod : only MyType2
      implicit none
      
      interface assignment(=)
        module procedure MyType1EqualsMyType2
        module procedure MyType2EqualsMyType1
      end interface
    contains
      subroutine MyType1EqualsMyType2(this,input)
        type(MyType1), intent(out) :: this
        type(MyType2), intent(in) :: input
        this%Num = input%Num
      end subroutine
    
      subroutine MyType2EqualsMyType1(this,input)
        type(MyType2), intent(out) :: this
        type(MyType1), intent(in) :: input
        this%Num = input%Num
      end subroutine
    end module