Fortran/OOP 在 Fortran 中
< Fortran
数据可以收集在 module 中。一般形式如下所示
module <name>
[use <module_names>]
[<declarations>]
contains
[<subroutines and functions>]
end module [<name>]
有三种可能的访问属性：public, private, protected。
public：外部代码具有读写访问权限。private：外部代码无访问权限。public, protected：外部代码具有读访问权限。
可以在外部代码中包含模块的公共数据。有三种方法。
use <moduleName>：包含所有公共数据和方法use <moduleName>, <renames>：包含所有公共数据和方法，但会重命名一些公共数据或方法use <moduleName>, only: <subset>：仅包含一些公共数据和方法
module test_m
implicit none
private ! All data is by default private.
! These procedures are set public -> accessible outside
public print_coords, set_coords
real :: x, y ! Not accessible outside module.
contains
subroutine print_coords
print *, "x, y", x, y
end subroutine
subroutine set_coords(new_x, new_y)
real, intent(in) :: new_x, new_y
x = new_x
y = new_y
end subroutine
end module
program main
use test_m ! Import the "test_m" module
implicit none
call set_coords(1.0, 1.0) ! Call the public procedure from test_mod
call print_coords
end program
module data_access_m
implicit none
private
public a, b
protected b
private c
integer :: a = 1
integer :: b = 1
integer :: c = 1
end module
program main
use data_access_m
! Accessing public object works.
print *, a
! Editing public object works.
a = 2
! Accessing protected object works.
print *, b
! Editing protected object does not work.
!b = 2 <- ERROR
! Accessing private object does not work
!print *, c <- ERROR
! Editing private object does not work
!c = 2 <- ERROR
end program
module test_module
implicit none
private
integer, public :: a = 1
integer, public, protected :: b = 1
integer, private :: c = 1
end module test_module
!> Import all public data of test_module.
program main
use test_module
print *, a, b
end program main
!> Import all data, and rename.
program main
use test_module, better_name => a
! New name use available.
print *, better_name
! Old name is not available anymore.
!print *, a <- ERROR
end program main
!> Import only a subset of the public data.
program main
use test_module, only : a
! Only a is loaded
print *, a
! b is not loaded
!print *, b <- ERROR
end program main
可以使用子模块扩展模块。出现了多种优势
- 拆分大型模块
- 拆分接口定义和实现，以便如果实现发生更改，则不需要重新编译依赖模块
- 两个模块需要彼此的数据。
!> simple module about circles
module circle_mod
implicit none
private
public :: area, radius
real :: radius
real, parameter :: PI = 3.1415
interface ! Interface block needed. Each function implemented via submodule needs an entry here.
module function area() ! Important. Note the "module" keyword.
real :: area
end function
end interface
end module
submodule (circle_mod) circle_subm ! Submodule (parent_mod) child_mod.
contains
module function area() ! Again "module" keyword.
area = PI*radius**2
end function
end submodule
program main
use circle_mod
implicit none
radius = 1.0
print *, "area:", area()
end program
在 Fortran 中，可以从其他结构中派生结构，称为派生数据类型。派生类型将具有父类型的功能以及新添加的功能，并且通用语法如下所示
type, extends(<parentTypeName>) :: <newTypeName>
<definitions>
end type
以下示例显示了公司中不同类型的人员。
module company_data_mod
implicit none
private
public phone_type, address_type, person_type, employee_type, salaried_worker_type, hourly_worker_type
type phone_type
integer :: area_code, number
end type
type address_type
integer :: number
character (len=:), allocatable :: street, city
character (len=2) :: state
integer :: zip_code
end type
type person_type
character (len=:), allocatable :: name
type (address_type) :: address
type (phone_type) :: phone
character (len=:), allocatable :: remarks
end type
type, extends (person_type) :: employee_type
integer :: phone_extension, mail_stop, id_number
end type
type, extends (employee_type) :: salaried_worker_type
real :: weekly_salary
end type
type, extends (employee_type) :: hourly_worker_type
real :: hourly_wage, overtime_factor, hours_worked
end type
end module
program main
use company_data_mod
implicit none
type (hourly_worker_type) :: obj
end program
可以定义在对象自动删除（超出范围）之前调用的过程。这是使用语句 final 完成的。以下示例说明了这一点
module person_m
implicit none
type person
integer, allocatable :: numbers(:)
contains
final :: del
end type
contains
subroutine del(this)
!! example for a derived type's destructor. allocatables are
!! deallocated automatically anyways. this is just to show the usage of
!! "final".
type (person), intent (inout) :: this
if (allocated(this%numbers)) deallocate (this%numbers)
end subroutine
end module
可以将基类型设置为 abstract，以便无法初始化该类型的对象，但可以从该类型派生子类型（通过 extends）。应该在子类型中定义的特定过程需要属性 deferred 以及显式接口。
以下示例说明了它们的使用。
module shape_m
implicit none
type, abstract :: shape
real :: a, b
contains
procedure :: print => shape_print
procedure (area_shape), deferred :: area
end type
interface
real function area_shape(this)
import :: shape
class (shape), intent (in) :: this
end function
end interface
contains
subroutine shape_print(this)
class (shape), intent (in) :: this
print *, 'a,b', this%a, this%b
end subroutine
end module
module line_m
use shape_m
implicit none
private
public line
type, extends (shape) :: line
contains
procedure :: area
end type
contains
real function area(this)
class (line), intent (in) :: this
area = abs(this%a - this%b)
end function
end module
module rectangle_m
use shape_m
implicit none
private
public rectangle
type, extends(shape) :: rectangle
contains
procedure :: area
end type
contains
real function area(this)
class (rectangle), intent (in) :: this
area = this%a * this%b
end function
end module
program main
use line_m
use rectangle_m
implicit none
type (line) :: l
type (rectangle) :: r
! line
l%a = 2.0
l%b = 4.0
print *, "line ... "
call l%print
print *, "-> from: ", l%a
print *, "-> to: ", l%b
print *, "-> length:", l%area()
! rectangle
r%a = 3.0
r%b = 5.0
print *
print *, "rectangle ..."
call r%print
print *, "-> side a:", r%a
print *, "-> side b:", r%b
print *, "-> area: ", r%area()
end program
可以使用 allocate 语句和 select type 环境中的类型定义来创建指向子类的指针。以下示例突出显示了它的使用。
module shape_m
implicit none
type, abstract :: shape
! Just an empty class used to implement a parent class.
! reason for abstract: there shouldnt be objects of TYPE(!) shape, just
! polymorphic CLASS instances.
end type
end module
module line_m
use shape_m
implicit none
type, extends (shape) :: line
! A child class w/ one attribute.
! Reason for extends(shape): polymorphic shape pointer can point to
! objects of this type.
real :: length
end type
end module
module rectangle_m
use shape_m
implicit none
type, extends (shape) :: rectangle
! A child class w/ another attribute
! Reason for extends(shape): (see explanation in line type)
real :: area
end type
end module
program main
use rectangle_m
use line_m
implicit none
class (shape), allocatable :: sh ! Pointer to parent class.
! allocate (line :: sh)
allocate (rectangle :: sh) ! Allocate using child types
select type (x => sh) ! Associate block. "x" will be a pointer to the child object and of its type(!!)
type is (line) ! Select the right child type (the one we used in the allocate statement)
x%length = 1.0
print *, 'line length', x%length
type is (rectangle)
x%area = 2.0
print *, 'rectangle area', x%area
! class is () ! Select by using classes.
class default ! If nothing of the above applied.
error stop 'class/type not specified!'
end select
end program