Using SubModules for Generic Assignments in Fortran-CodePudding

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?

CodePudding user response：

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