美文网首页
Fortran实现多态

Fortran实现多态

作者: 忆霜晨 | 来源:发表于2018-06-07 23:15 被阅读0次

前言

Fortran是世界上最早出现的计算机高级程序设计语言，主要用于科学与工程计算领域。Fortran的几个重要的版本是：

  • FORTRAN 77，现在仍然可以看到很多使用该版本写的代码，比如Lapack里面的代码。
  • Fortran 90，最重要的改进是引入了自由格式代码。
  • Fortran 2003，该版本改进了衍生类型，支持面向对象编程。

Fortran语言的特点是比较严谨，语法和Matlab有相似之处。但是和Python、Java等高级语言相比，如果要使用其面向对象的特性，仍然有不少限制。

使用Fortran实现面向对象编程一个很重要的关键字就是 class，该关键字只能用于可分配数据项（allocatable）、指针（pointer）或者虚元。class 关键字和 type 关键字的不同之处在于，前者可以实现参数的动态绑定，即面向对象一个很重要的特性——多态。

以下代码实现了一个使用参数动态绑定的过程。抽象类 BaseSolver 包含了：抽象类 BaseTimeSolver、抽象类 BaseSpaceSolver，MySolver 是 BaseSolver 的子类，给 MySolver 传入的是 BaseTimeSolver 的子类 MyTimeSolver 和 BaseSpaceSolver 的子类 MySpaceSolver。

代码中涉及到了很多Fortran语言的关键字，一方面可以看出该语言确实十分严谨，另一方面也让人觉得较为繁琐。关于Fortran语言更多的知识可以参考后面列出的资料[1][2][3]，另外可以参考官方给出的语法规范。

（注：《Fortran95/2003程序设计(第3版)》这本书介绍了不少这部分的内容，书本上源码的个别地方有误需要注意。《Modern Fortran Explained》这部分内容讲解比较详细，推荐。《Modern Fortran: Style and Usage》这本书源码字体排版对阅读来说显得很不友好。）

一、主函数

输出结果 
PROGRAM MAIN
use mod_MySolver
use mod_MyTimeSolver
use mod_MySpaceSolver
implicit none

    type(MySolver), pointer :: me_solver
    
    type(MyTimeSolver), pointer :: me_time_solver
    type(MySpaceSolver), pointer :: me_space_solver
    
    type(MyTimeSolver) :: test_time_solver
    
    
    call test_time_solver % set_class_msg('Hello World!')
    write(*, *) TRIM(ADJUSTL(test_time_solver % get_class_msg()))
    write(*, *) 
    
    allocate( me_solver )
    allocate( me_time_solver )
    allocate( me_space_solver )

    call me_time_solver % set_class_msg('time solver A')
    call me_space_solver % set_class_msg('space solver B')
    
    call me_solver % time_solver_init( me_time_solver )
    call me_solver % space_solver_init( me_space_solver )
    
    call me_solver % print_class_msg()
    
    call me_solver % some_algorithm()

END PROGRAM

二、Time相关

2.1、Time抽象基类

module mod_BaseTimeSolver

!---------
! 抽象类 |
!---------
type, abstract, public :: BaseTimeSolver

contains

    procedure(abs_set_class_msg), deferred :: set_class_msg
    procedure(abs_get_class_msg), deferred :: get_class_msg
    procedure(abs_time_algorithm), deferred :: time_algorithm

end type BaseTimeSolver
!=========

!-----------------------
! 定义抽象类方法的接口 |
!-----------------------  
abstract interface

    subroutine abs_set_class_msg( this, msg )
    import BaseTimeSolver
    implicit none
        class(BaseTimeSolver), intent(inout) :: this
        character(len=*), intent(in) :: msg
            
    end subroutine abs_set_class_msg
    
    
    function abs_get_class_msg( this ) result( msg )
    import BaseTimeSolver
    implicit none
        class(BaseTimeSolver), intent(in) :: this
        
        character(len=180) :: msg
    
    end function abs_get_class_msg
    
    
    subroutine abs_time_algorithm( this )
    import BaseTimeSolver
    implicit none
        class(BaseTimeSolver), intent(inout) :: this
            
    end subroutine abs_time_algorithm

end interface
    

end module

2.2、Time基类的一个实现

module mod_MyTimeSolver
use mod_BaseTimeSolver
implicit none

!---------------
! 继承自抽象类 |
!---------------
type, extends(BaseTimeSolver), public :: MyTimeSolver

    character(len=180), private :: class_msg = ''

contains

    procedure :: set_class_msg   => m_set_class_msg
    procedure :: get_class_msg   => m_get_class_msg
    procedure :: time_algorithm  => m_time_algorithm

end type MyTimeSolver
!===============

    private :: m_set_class_msg
    private :: m_get_class_msg
    private :: m_time_algorithm

contains
!-----------------------
! 继承类方法的具体实现 |
!-----------------------

    subroutine m_set_class_msg( this, msg )
    implicit none
        class(MyTimeSolver), intent(inout) :: this
        character(len=*), intent(in) :: msg
    
        this % class_msg = msg
    
        return
    end subroutine m_set_class_msg
    
    
    function m_get_class_msg( this ) result( msg )
    implicit none
        class(MyTimeSolver), intent(in) :: this
        
        character(len=180) :: msg
        
        msg = TRIM(ADJUSTL(this % class_msg))
    
        return
    end function m_get_class_msg
    
    
    subroutine m_time_algorithm( this )
    implicit none
        class(MyTimeSolver), intent(inout) :: this
        
        write(*, *) "... time algorithm ..."
        
        return
    end subroutine m_time_algorithm

end module

三、Space相关

3.1、Space抽象基类

module mod_BaseSpaceSolver

!---------
! 抽象类 |
!---------
type, abstract, public :: BaseSpaceSolver

contains

    procedure(abs_set_class_msg), deferred :: set_class_msg
    procedure(abs_get_class_msg), deferred :: get_class_msg
    procedure(abs_space_algorithm), deferred :: space_algorithm

end type BaseSpaceSolver
!=========

!-----------------------
! 定义抽象类方法的接口 |
!-----------------------  
abstract interface

    subroutine abs_set_class_msg( this, msg )
    import BaseSpaceSolver
    implicit none
        class(BaseSpaceSolver), intent(inout) :: this
        character(len=*), intent(in) :: msg
            
    end subroutine abs_set_class_msg
    
    
    function abs_get_class_msg( this ) result( msg )
    import BaseSpaceSolver
    implicit none
        class(BaseSpaceSolver), intent(in) :: this
        
        character(len=180) :: msg
    
    end function abs_get_class_msg
    
    
    subroutine abs_space_algorithm( this )
    import BaseSpaceSolver
    implicit none
        class(BaseSpaceSolver), intent(inout) :: this
            
    end subroutine abs_space_algorithm

end interface
    

end module

3.2、Space基类的一个实现

module mod_MySpaceSolver
use mod_BaseSpaceSolver
implicit none
    
!---------------
! 继承自抽象类 |
!---------------
type, extends(BaseSpaceSolver), public :: MySpaceSolver

    character(len=180), private :: class_msg = ''

contains

    procedure :: set_class_msg   => m_set_class_msg
    procedure :: get_class_msg   => m_get_class_msg
    procedure :: space_algorithm => m_space_algorithm

end type MySpaceSolver
!===============

    private :: m_set_class_msg
    private :: m_get_class_msg
    private :: m_space_algorithm

contains
!-----------------------
! 继承类方法的具体实现 |
!-----------------------

    subroutine m_set_class_msg( this, msg )
    implicit none
        class(MySpaceSolver), intent(inout) :: this
        character(len=*), intent(in) :: msg
    
        this % class_msg = msg
    
        return
    end subroutine m_set_class_msg
    
    
    function m_get_class_msg( this ) result( msg )
    implicit none
        class(MySpaceSolver), intent(in) :: this
        
        character(len=180) :: msg
        
        msg = TRIM(ADJUSTL(this % class_msg))
    
        return
    end function m_get_class_msg
    
    
    subroutine m_space_algorithm( this )
    implicit none
        class(MySpaceSolver), intent(inout) :: this
        
        write(*, *) "... space algorithm ..."
        
        return
    end subroutine m_space_algorithm

end module

四、Solver相关

4.1、Solver基类

module mod_BaseSolver
use mod_BaseSpaceSolver
use mod_BaseTimeSolver
implicit none

!---------
! 抽象类 |
!---------
type, abstract, public :: BaseSolver

contains

    procedure(abs_time_solver_init),  deferred :: time_solver_init
    procedure(abs_space_solver_init), deferred :: space_solver_init
    procedure(abs_print_class_msg),   deferred :: print_class_msg
    procedure(abs_some_algorithm),    deferred :: some_algorithm

end type BaseSolver
!=========

!-----------------------
! 定义抽象类方法的接口 |
!-----------------------  
abstract interface

    subroutine abs_time_solver_init( this, time_solver )
    import :: BaseSolver, BaseTimeSolver
    implicit none
        class(BaseSolver), intent(inout) :: this
        class(BaseTimeSolver), target, intent(in) :: time_solver
            
    end subroutine abs_time_solver_init
    
    
    subroutine abs_space_solver_init( this, space_solver )
    import :: BaseSolver, BaseSpaceSolver
    implicit none
        class(BaseSolver), intent(inout) :: this
        class(BaseSpaceSolver), target, intent(in) :: space_solver
            
    end subroutine abs_space_solver_init
    
    
    subroutine abs_print_class_msg( this )
    import :: BaseSolver
    implicit none
        class(BaseSolver), intent(inout) :: this
            
    end subroutine abs_print_class_msg
    
    
    subroutine abs_some_algorithm( this )
    import :: BaseSolver
    implicit none
        class(BaseSolver), intent(inout) :: this
            
    end subroutine abs_some_algorithm

end interface    
    
    
end module

4.2、Solver类的一个实现

module mod_MySolver
use mod_BaseSolver
use mod_BaseSpaceSolver
use mod_BaseTimeSolver
implicit none

!---------------
! 继承自抽象类 |
!---------------
type, extends(BaseSolver), public :: MySolver

    character(len=180), private :: class_msg = ''
    class(BaseTimeSolver),  pointer, private :: me_time_solver
    class(BaseSpaceSolver), pointer, private :: me_space_solver

contains
 
    procedure :: time_solver_init  => m_time_solver_init
    procedure :: space_solver_init => m_space_solver_init
    procedure :: print_class_msg   => m_print_class_msg
    procedure :: some_algorithm    => m_some_algorithm 

end type MySolver
!===============

    private :: m_time_solver_init
    private :: m_space_solver_init
    private :: m_print_class_msg
    private :: m_some_algorithm

contains
!-----------------------
! 继承类方法的具体实现 |
!-----------------------

    subroutine m_time_solver_init( this, time_solver )
    implicit none
        class(MySolver), intent(inout) :: this
        class(BaseTimeSolver), target, intent(in) :: time_solver
            
        this % me_time_solver => time_solver
            
        return
    end subroutine m_time_solver_init
    
    
    subroutine m_space_solver_init( this, space_solver )
    implicit none
        class(MySolver), intent(inout) :: this
        class(BaseSpaceSolver), target, intent(in) :: space_solver
        
        this % me_space_solver => space_solver
        
        return
    end subroutine m_space_solver_init
    
    
    subroutine m_print_class_msg( this )
    implicit none
        class(MySolver), intent(inout) :: this
        
        this % class_msg =                                          &
            TRIM(ADJUSTL(this % me_time_solver % get_class_msg()))  &
            // ' + ' //                                             &
            TRIM(ADJUSTL(this % me_space_solver % get_class_msg()))
        
        write(*, *) "CLASS Msg:"
        write(*, *) TRIM(ADJUSTL(this % class_msg))
        write(*, *)
        
        return
    end subroutine m_print_class_msg
    
    
    subroutine m_some_algorithm( this )
    implicit none
        class(MySolver), intent(inout) :: this
        
        write(*, *) "Some algorithm:"
        call this % me_time_solver % time_algorithm()
        call this % me_space_solver % space_algorithm()
        write(*, *)     

        return
    end subroutine m_some_algorithm
    
end module

  1. Stephen J.Chapman. Fortran95/2003程序设计(第3版), 中国电力出版社, 2009. ↩

  2. Michael Metcalf, John Reid, Malcolm Cohen. Modern Fortran Explained. OUP Oxford, 2011. ↩

  3. Norman S. Clerman, Walter Spector. Modern Fortran: Style and Usage. Cambridge University Press, 2011. ↩

相关文章

  • Fortran实现多态

    前言 Fortran是世界上最早出现的计算机高级程序设计语言，主要用于科学与工程计算领域。Fortran的几个重要...

  • Fortran多态基础

    Fortran多态 左志华 zuo.zhihua@qq.com[mailto:zuo.zhihua@qq.com]...

  • Java基础之面向对象

    1.多态，继承，封装 Java实现多态有哪些必要条件？具体怎么实现？多态的实现原理？多态的作用？ 答：多态的优点 ...

  • 2018-01-25

    多态机制 java语言，实现多态...

  • 2.0 多态的实现

    本小节知识点: 【掌握】如何实现多态 【了解】多态的原理 【掌握】多态的注意点 1.如何实现多态 Animal是父...

  • jvm结构&运行机制&多态实现

    浅析Java虚拟机结构与机制 浅谈多态机制的意义及实现 多态：编译时多态（重载）、运行时多态（继承父类、实现接口）...

  • Java_basic_10: 多态polymorphism

    多态polymorphism 多态是指对象的多种形态 主要可以分为引用多态和方法多态 继承是多态的实现基础 引用多...

  • Golang learning 面向对象 多态

    通过interface 实现多态

  • 实现golang语言的多态

    如何实现golang语言的多态？ C++里面有多态是其三大特性之一，那么golang里面的多态我们该怎么实现？ g...

  • Swift 多态实现探究

    多态 父类指针指向子类对象 Swift 中多态的实现类似于 c++ 中的虚表 OC 多态实现利用的是 Runtim...

网友评论

      本文标题：Fortran实现多态

      本文链接：https://www.haomeiwen.com/subject/zdlfsftx.html

      延伸阅读

      深度阅读

      • 您也可以注册成为美文阅读网的作者，发表您的原创作品、分享您的心情！

      栏目导航

      热点阅读

      关于我们|服务条款|联系我们|Fortran实现多态|投稿指南|网站地图|RSS订阅|排版工具|手机版

      提供经典美文摘抄,优美散文欣赏,现代诗歌精选,短篇小说,心情随笔,表白情书范文,故事会在线阅读欣赏

      Copyright © 2014-2023 Haomeiwen.com All Rights Reserved. 好美文阅读网 版权所有

      备案信息：桂公网安备 45052102000051号 · 桂ICP备13007215号-3

      本站所收录作品、热点评论等信息部分来源互联网，目的只是为了系统归纳学习和传递资讯

      所有作品版权归原创作者所有，与本站立场无关，如不慎侵犯了你的权益，请联系我们告知，我们将做删除处理！