美文网首页
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实现多态

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

          延伸阅读

          深度阅读

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

          栏目导航

          热点阅读

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

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

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

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

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

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