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