默认分类 Fortran

Fortran面向对象二

MetMan博主神仙

2024-07-31

0 评论

103 阅读

510 个字

百度已收录

07/31

本文最后更新于 2024年08月03日，已超过 210天没有更新。如果文章内容或图片资源失效，请留言反馈，我会及时处理，谢谢！

面向对象编程核心概念包括封装、继承及多态。下面介绍Fortran的类继承及多态语法。

Fortran类继承

Fortran中类继承使用扩展（extends）关键字定义继承哪个父类。

type mytype
  integer :: value
end type mytype 
! extend from mytype
type, extends(mytype) :: mynewtype
  real :: extra 
end type mynewtype

新的类mynewtype除了继承mytype中成员value，还定义了新成员extra。

module mytypes
  implicit none
  type mytype
    integer :: value
  contains
    ! => 过程别名
    procedure,public :: write => write_mytype 
  end type mytype

  type, extends(mytype) :: mynewtype
    real :: extra
  end type mynewtype
contains
  subroutine write_mytype(v, lun)
    class(mytype) :: v  !Note: "class" not "type"
                      !this allow extension
    integer,intent(in) :: lun

    v%value = lun
  end subroutine write_mytype
end module

program test
  use mytypes
  implicit none
  type(mytype) :: v
  type(mynewtype) :: v_new

  v = mytype(2)
  print*,'Init value of mytype is ',v%value
  call v%write(10)
  print*,'Write value of mytype is ',v%value

  v_new = mynewtype(3, 2.0)
  print*,'Init value of mynewtype is ',v_new%value,v_new%extra

  print*,'Parent value is ',v_new%mytype%value
end

v_new%value(继承的体现)等价于v_new%mytype%value。

如果父类和继承类中包含private属性的成员，不能使用结构构造器（structure constructor）初始化类成员（比如v_new = mynewtype(3, 2.0)）。

继承类方法重载

扩展类型（子类）使用相同过程名称可以重载继承自父类的方法。

module mytypes
  implicit none
  type mytype
    integer :: value
  contains
    procedure,public :: write => write_mytype
  end type mytype

  type, extends(mytype) :: mynewtype
    real :: extra
  contains
    ! overriding method in extending type
    procedure,public :: write => write_mynewtype
  end type mynewtype
contains
  subroutine write_mytype(v, lun)
    class(mytype) :: v  !Note: "class" not "type"
                        !this allow extension
    integer,intent(in) :: lun

    print*, "use mytype method"
    v%value = lun
  end subroutine write_mytype
  subroutine write_mynewtype(v, lun)
    class(mynewtype) :: v  !Note: "class" not "type"
                      !this allow extension
    integer,intent(in) :: lun
    print*, "use mynewtype method"
    call v%mytype%write(lun) !Invoke the parent's routine
  end subroutine write_mynewtype
end module mytypes

program main
  use mytypes
  implicit none
  type(mynewtype) :: v_new

  v_new = mynewtype(2,3.0)
  call v_new%write(7)
end

mynewtype类重载了write方法的实现。

编译运行：

$ gfortran -o test test.f90
$ ./test 
program main
  use mytypes
  implicit none
  type(mynewtype) :: v_new

  v_new = mynewtype(2,3.0)
  call v_new%write(7)
end

多态参数（polymorphic argument）

多态（polymorphism）指变量可以改变其类型type。Fortran是一种强类型语言，即变量类型在编译时已确定，编译器可以检查类型是否正确。但Fortran 2003增加多态功能，随即增加了两个概念：declared type和dynamic type。前者指变量声明时的类型，编译时已知；而后者指运行时对象类型可变。为了支持多态，类型必须使用class声明，而不能用type。

如果将上面代码中write_mytype方法中对象哑元声明使用'type'代替'class'，编译报错。

  subroutine write_mytype(v, lun)
    type(mytype) :: v     !use 'type' instead of 'class'
    integer,intent(in) :: lun

    v%value = lun
  end subroutine write_mytype

报错信息如下

type_extend.f90:6:13:

    6 |     procedure,public :: write => write_mytype
      |             1
Error: Non-polymorphic passed-object dummy argument of ‘write_mytype’ at (1)

但这一限制只针对类方法（type-bound procedure），普通的模块过程可以使用type声明，比如

  subroutine write_mytype_new(v, lun)
    type(mytype) :: v    
    integer,intent(in) :: lun

    v%value = lun
  end subroutine write_mytype_new

但此时需要注意两个方面：

调用过程传入的第一个参数类型必须是mytype，不能是子类类型；
调用方法变成call write_mytype_new(v, 7)普通过程调用方法，参数必须全部传入并且一一对应，而不能是类方法调用过程v%write_mytype_new(7)。

class声明的变量必须是过程哑元（dummy）、指针（pointer）或可分配（alloctable）属性变量（因为是动态类型，无法在编译时确定需要的内存空间）。

由于class类型是动态类型，在具体使用时我们需要知道其代表哪个类（父类还是子类），Fortran标准为此设计了select type结构判断属于哪个类型。

PROGRAM p
  TYPE base
    INTEGER::i
  END TYPE
  ! child extend from base
  TYPE,EXTENDS(base)::child
    INTEGER::j
  END TYPE
  ! class defined with pointer attribute
  CLASS(base), POINTER :: bptr
  TYPE(base), TARGET :: base_target = base(10)
  TYPE(child), TARGET :: child_target = child(20, 30)

  bptr => base_target
  ! 动态判断bptr类型
  SELECT type(bptr)
    TYPE IS (base)
    PRINT *, "base type: component value: ", bptr%i
    TYPE IS (child)
    PRINT *, "child type: component values: ", bptr%i, bptr%j
    CLASS default 
    PRINT *, "type is not known"
  END SELECT

  bptr => child_target

  SELECT type(bptr)
    TYPE IS (base)
    PRINT *, "base type: component value: ", bptr%i
    TYPE IS (child)
    PRINT *, "child type: component values: ", bptr%i, bptr%j
  END SELECT

END PROGRAM p