Fortran/Fortran 示例
以下 Fortran 代码示例 或示例程序展示了根据编译器而不同的情况。第一组示例适用于 Fortran II、IV 和 77 编译器。其余示例可以使用任何较新的标准 Fortran 编译器进行编译和运行(有关编译器列表,请参阅 Fortran 主文章的末尾)。根据惯例,大多数当代 Fortran 编译器会根据源代码文件名后缀选择在编译期间使用的语言标准:对于 .f
(或不太常见的 .for
),使用 FORTRAN 77;对于 .f90
,使用 Fortran 90;对于 .f95
,使用 Fortran 95。如果支持其他标准,则可以使用命令行选项手动选择它们。
注意:在 FORTRAN 90 之前,大多数 FORTRAN 编译器强制执行 固定格式源代码,这是从 IBM 穿孔卡 中继承下来的。
- 注释必须以第 1 列的 * 或 C 或 ! 开头
- 语句标签必须出现在第 1-5 列
- 续行必须在第 6 列中包含非空格字符
- 语句必须从第 7 列开始
- 行长度可能限制为 72 个字符(源自穿孔卡的 80 字节宽度,最后 8 个字符保留用于(可选)序列号)
如果在编译 FORTRAN 代码时出现错误,请先检查列对齐。一些编译器还提供通过使用编译器标志实现自由格式源代码的功能
一张数据卡输入
如果输入值之一为零,则程序将以作业控制卡列表中的错误代码“1”结束,该代码在程序执行后出现。正常输出将是一行打印的 A、B、C 和 AREA。没有说明特定的单位。
C AREA OF A TRIANGLE - HERON'S FORMULA
C INPUT - CARD READER UNIT 5, INTEGER INPUT
C OUTPUT -
C INTEGER VARIABLES START WITH I,J,K,L,M OR N
READ(5,501) IA,IB,IC
501 FORMAT(3I5)
IF (IA) 701, 777, 701
701 IF (IB) 702, 777, 702
702 IF (IC) 703, 777, 703
777 STOP 1
703 S = (IA + IB + IC) / 2.0
AREA = SQRT( S * (S - IA) * (S - IB) * (S - IC) )
WRITE(6,801) IA,IB,IC,AREA
801 FORMAT(4H A= ,I5,5H B= ,I5,5H C= ,I5,8H AREA= ,F10.2,
$13H SQUARE UNITS)
STOP
END
多张数据卡输入
该程序具有两个输入检查:一个是检查空白卡以指示数据结束,另一个是检查输入数据中的零值。任一条件都会导致消息被 打印。
C AREA OF A TRIANGLE - HERON'S FORMULA
C INPUT - CARD READER UNIT 5, INTEGER INPUT, ONE BLANK CARD FOR END-OF-DATA
C OUTPUT - LINE PRINTER UNIT 6, REAL OUTPUT
C INPUT ERROR DISPAY ERROR MESSAGE ON OUTPUT
501 FORMAT(3I5)
601 FORMAT(4H A= ,I5,5H B= ,I5,5H C= ,I5,8H AREA= ,F10.2,
$13H SQUARE UNITS)
602 FORMAT(10HNORMAL END)
603 FORMAT(23HINPUT ERROR, ZERO VALUE)
INTEGER A,B,C
10 READ(5,501) A,B,C
IF(A.EQ.0 .AND. B.EQ.0 .AND. C.EQ.0) GO TO 50
IF(A.EQ.0 .OR. B.EQ.0 .OR. C.EQ.0) GO TO 90
S = (A + B + C) / 2.0
AREA = SQRT( S * (S - A) * (S - B) * (S - C) )
WRITE(6,601) A,B,C,AREA
GO TO 10
50 WRITE(6,602)
STOP
90 WRITE(6,603)
STOP
END
多张数据卡输入
该程序在 READ 语句中使用 END 和 ERR 参数进行两个输入检查,一个是检查空白卡以指示数据结束;另一个是检查零值和有效数据。任一条件都会导致消息被打印。
C AREA OF A TRIANGLE - HERON'S FORMULA
C INPUT - CARD READER UNIT 5, INTEGER INPUT, NO BLANK CARD FOR END OF DATA
C OUTPUT - LINE PRINTER UNIT 6, REAL OUTPUT
C INPUT ERROR DISPAYS ERROR MESSAGE ON OUTPUT
501 FORMAT(3I5)
601 FORMAT(" A= ",I5," B= ",I5," C= ",I5," AREA= ",F10.2,
$"SQUARE UNITS")
602 FORMAT("NORMAL END")
603 FORMAT("INPUT ERROR OR ZERO VALUE ERROR")
INTEGER A,B,C
10 READ(5,501,END=50,ERR=90) A,B,C
IF(A=0 .OR. B=0 .OR. C=0) GO TO 90
S = (A + B + C) / 2.0
AREA = SQRT( S * (S - A) * (S - B) * (S - C) )
WRITE(6,601) A,B,C,AREA
GO TO 10
50 WRITE(6,602)
STOP
90 WRITE(6,603)
STOP
END
可在 IBM 1130 页面上找到 FORTRAN IV(后来演变为 FORTRAN 66)程序卡组的怀旧示例,其中包括进行编译和执行所需的 IBM 1130 DM2 JCL。IBM 1130 模拟器可在 IBM 1130.org 上获得,它允许在 PC 上编译和运行 FORTRAN IV 程序。
为了符合计算传统,第一个示例演示了一个简单的程序,用于在屏幕(或打印机)上显示“Hello, world”。
C FORTRAN IV WAS ONE OF THE FIRST PROGRAMMING
C LANGUAGES TO SUPPORT SOURCE COMMENTS
WRITE (6,7)
7 FORMAT(13H HELLO, WORLD)
STOP
END
该程序将“HELLO, WORLD”打印到 Fortran 单位号 6,在大多数机器上,它指的是 行式打印机 或 终端。(穿孔卡阅读器 或 键盘 通常连接为单位 5)。WRITE
语句中的数字 7 指的是对应 FORMAT
语句的语句号。FORMAT
语句可以放置在与调用它们的 WRITE
语句相同的程序或函数/子例程块中的任何位置。通常,FORMAT
语句紧随调用它的 WRITE
语句放置;或者,FORMAT
语句被分组在一起,放置在程序或子程序块的末尾。如果执行流程进入 FORMAT
语句,则它是一个 空操作;因此,上面的示例只有两个可执行语句,WRITE
和 STOP
。
上述示例中 FORMAT
语句中的初始 13H
定义了一个 Hollerith 常量,这里表示紧随其后的 13 个字符将被视为字符常量(注意 Hollerith 常量没有用定界符包围)。(一些编译器还支持用 单引号 括起来的字符文字,这在 FORTRAN 77 中成为标准做法。)
紧随 13H 后的空格是一个回车控制字符,它告诉 I/O 系统在输出上换行。此位置的零表示换两行(双倍行距),1 表示换页,+ 字符表示不换行,允许覆盖打印。
从 FORTRAN 77 开始,使用单引号来分隔字符文字,并且可以使用内联字符字符串来代替对 FORMAT
语句的引用。注释行可以使用第 1 列中的 C
或星号 (*
) 来指示。
PROGRAM HELLO
* The PRINT statement is like WRITE,
* but prints to the standard output unit
PRINT '(A)', 'Hello, world'
STOP
END
从 Fortran 90 开始,除了单引号之外,还允许使用 双引号。Hello, world 例子的更新版本(这里使用的是从 FORTRAN 77 开始支持的列表定向 I/O)可以用 Fortran 90 编写如下
program HelloWorld
write (*,*) 'Hello, world!' ! This is an inline comment
end program HelloWorld
以下 FORTRAN 77 中的入门示例使用 欧几里得算法 的逐字实现,找到两个数字 和 的 最大公约数。
* euclid.f (FORTRAN 77)
* Find greatest common divisor using the Euclidean algorithm
PROGRAM EUCLID
PRINT *, 'A?'
READ *, NA
IF (NA.LE.0) THEN
PRINT *, 'A must be a positive integer.'
STOP
END IF
PRINT *, 'B?'
READ *, NB
IF (NB.LE.0) THEN
PRINT *, 'B must be a positive integer.'
STOP
END IF
PRINT *, 'The GCD of', NA, ' and', NB, ' is', NGCD(NA, NB), '.'
STOP
END
FUNCTION NGCD(NA, NB)
IA = NA
IB = NB
1 IF (IB.NE.0) THEN
ITEMP = IA
IA = IB
IB = MOD(ITEMP, IB)
GOTO 1
END IF
NGCD = IA
RETURN
END
以上示例旨在说明以下内容
- 以上示例中的
PRINT
和READ
语句使用 '*
' 作为格式,指定列表定向格式。列表定向格式指示编译器根据以下参数对所需的输入或输出格式进行有根据的猜测。 - 由于运行 Fortran 的最早机器具有有限的字符集,FORTRAN 77 使用诸如
.EQ.
、.NE.
、.LT.
、.GT.
、.LE.
和.GE.
之类的缩写来分别表示关系运算符 =、≠、<、>、≤ 和 ≥。 - 此示例依赖于 隐式类型机制 来指定
NA
、NB
、IA
、IB
和ITEMP
的 INTEGER 类型。 - 在函数
NGCD(NA, NB)
中,函数参数NA
和NB
的值分别复制到局部变量IA
和IB
中。这是必要的,因为IA
和IB
的值在函数内部被修改。因为 Fortran 函数和子例程中的参数传递默认情况下使用 按引用调用(而不是像 C 这样的语言中默认的 按值调用),从函数内部修改NA
和NB
实际上会修改调用函数的PROGRAM
主单元中对应的实际参数。
以下是编译和运行程序的结果。
$ g77 -o euclid euclid.f
$ euclid
A?
24
B?
36
The GCD of 24 and 36 is 12.
以下 FORTRAN 77 示例打印出 (其中 )的值,对于 的值。
* cmplxd.f (FORTRAN 77)
* Demonstration of COMPLEX numbers
*
* Prints the values of e ** (j * i * pi / 4) for i = 0, 1, 2, ..., 7
* where j is the imaginary number sqrt(-1)
PROGRAM CMPLXD
IMPLICIT COMPLEX(X)
PARAMETER (PI = 3.141592653589793, XJ = (0, 1))
DO 1, I = 0, 7
X = EXP(XJ * I * PI / 4)
IF (AIMAG(X).LT.0) THEN
PRINT 2, 'e**(j*', I, '*pi/4) = ', REAL(X), ' - j',-AIMAG(X)
ELSE
PRINT 2, 'e**(j*', I, '*pi/4) = ', REAL(X), ' + j', AIMAG(X)
END IF
2 FORMAT (A, I1, A, F10.7, A, F9.7)
1 CONTINUE
STOP
END
以上示例旨在说明以下内容
IMPLICIT
语句可用于根据变量的初始字母指定变量的隐式类型,如果与上面 描述的 默认隐式类型方案不同。在此示例中,此语句指定以字母X
开头的变量的隐式类型应为COMPLEX
。PARAMETER
语句可用于指定常量。此示例中的第二个常量 (XJ
) 被赋予复数值 ,其中 是 虚数单位 。DO
语句中的第一个数字指定循环体中考虑的最后一个语句的编号。在此示例中,由于END IF
和FORMAT
都不是单个可执行语句,因此使用CONTINUE
语句(什么也不做)仅仅是为了在循环中有一个语句来表示循环的最后一个语句。EXP()
对应于指数函数 。在 FORTRAN 77 中,这是一个通用函数,这意味着它接受多种类型(例如REAL
和在此示例中为COMPLEX
)的参数。在 FORTRAN 66 中,必须根据函数参数的类型按名称调用特定函数(对于此示例,COMPLEX
值参数为CEXP()
)。- 当应用于
COMPLEX
值参数时,REAL()
和AIMAG()
分别返回参数的实部和虚部的值。
顺便说一句,以上程序的输出如下(有关这些值作为 复平面 中的单位圆上均匀分布的八个点的几何解释,请参见有关 欧拉公式 的文章)。
$ cmplxd
e**(j*0*pi/4) = 1.0000000 + j0.0000000
e**(j*1*pi/4) = 0.7071068 + j0.7071068
e**(j*2*pi/4) = 0.0000000 + j1.0000000
e**(j*3*pi/4) = -0.7071068 + j0.7071068
e**(j*4*pi/4) = -1.0000000 - j0.0000001
e**(j*5*pi/4) = -0.7071066 - j0.7071069
e**(j*6*pi/4) = 0.0000000 - j1.0000000
e**(j*7*pi/4) = 0.7071070 - j0.7071065
在上面的一些数字中,最后一个十进制位出现了错误,这是由于COMPLEX
数据类型以单精度表示其实部和虚部造成的。顺便说一下,Fortran 90 还将双精度复数数据类型标准化了(尽管一些编译器在更早的时候就提供了这种类型)。
program area
implicit none
real :: A, B, C, S
! area of a triangle
read *, A, B, C
S = (A + B + C)/2
A = sqrt(S*(S-A)*(S-B)*(S-C))
print *,"area =",A
stop
end program area
在这个 Fortran 90 代码示例中,程序员在 DO 循环内编写了大部分代码。执行时,指令被打印到屏幕上,并且 SUM 变量在循环外部被初始化为零。一旦循环开始,它就会要求用户输入任何数字。每次循环重复时,这个数字都会加到 SUM 变量中。如果用户输入 0,EXIT 语句就会终止循环,并且 SUM 的值会显示在屏幕上。
在这个程序中,还有一个数据文件。在循环开始之前,程序会创建一个名为 "SumData.DAT" 的文本文件(如果该文件已经存在,则打开它)。在循环过程中,WRITE 语句会将用户输入的任何数字存储到这个文件中,并在循环终止时,也会将答案保存到文件中。
! sum.f90
! Performs summations using in a loop using EXIT statement
! Saves input information and the summation in a data file
program summation
implicit none
integer :: sum, a
print *, "This program performs summations. Enter 0 to stop."
open (unit=10, file="SumData.DAT")
sum = 0
do
print *, "Add:"
read *, a
if (a == 0) then
exit
else
sum = sum + a
end if
write (10,*) a
end do
print *, "Summation =", sum
write (10,*) "Summation =", sum
close(10)
end
执行时,控制台会显示以下内容
This program performs summations. Enter 0 to stop.
Add:
1
Add:
2
Add:
3
Add:
0
Summation = 6
而 SumData.DAT 文件将包含以下内容
1
2
3
Summation = 6
以下程序计算圆柱体的表面积,它演示了 Fortran 90 引入的自由格式源代码输入和其他特性。
program cylinder
! Calculate the surface area of a cylinder.
!
! Declare variables and constants.
! constants=pi
! variables=radius squared and height
implicit none ! Require all variables to be explicitly declared
integer :: ierr
character(1) :: yn
real :: radius, height, area
real, parameter :: pi = 3.141592653589793
interactive_loop: do
! Prompt the user for radius and height
! and read them.
write (*,*) 'Enter radius and height.'
read (*,*,iostat=ierr) radius,height
! If radius and height could not be read from input,
! then cycle through the loop.
if (ierr /= 0) then
write(*,*) 'Error, invalid input.'
cycle interactive_loop
end if
! Compute area. The ** means "raise to a power."
area = 2*pi * (radius**2 + radius*height)
! Write the input variables (radius, height)
! and output (area) to the screen.
write (*,'(1x,a7,f6.2,5x,a7,f6.2,5x,a5,f6.2)') &
'radius=',radius,'height=',height,'area=',area
yn = ' '
yn_loop: do
write(*,*) 'Perform another calculation? y[n]'
read(*,'(a1)') yn
if (yn=='y' .or. yn=='Y') exit yn_loop
if (yn=='n' .or. yn=='N' .or. yn==' ') exit interactive_loop
end do yn_loop
end do interactive_loop
end program cylinder
以下程序演示了动态内存分配和基于数组的操作,这是 Fortran 90 引入的两个特性。特别值得注意的是,在操作数组时没有使用DO
循环和IF
/THEN
语句;数学运算应用于整个数组。另一个明显的特点是使用描述性的变量名和符合现代编程风格的通用代码格式。这个例子计算了交互式输入数据的平均值。
program average
! Read in some numbers and take the average
! As written, if there are no data points, an average of zero is returned
! While this may not be desired behavior, it keeps this example simple
implicit none
integer :: number_of_points
real, dimension(:), allocatable :: points
real :: average_points=0., positive_average=0., negative_average=0.
write (*,*) "Input number of points to average:"
read (*,*) number_of_points
allocate (points(number_of_points))
write (*,*) "Enter the points to average:"
read (*,*) points
! Take the average by summing points and dividing by number_of_points
if (number_of_points > 0) average_points = sum(points)/number_of_points
! Now form average over positive and negative points only
if (count(points > 0.) > 0) positive_average = sum(points, points > 0.) &
/count(points > 0.)
if (count(points < 0.) > 0) negative_average = sum(points, points < 0.) &
/count(points < 0.)
deallocate (points)
! Print result to terminal
write (*,'(''Average = '', 1g12.4)') average_points
write (*,'(''Average of positive points = '', 1g12.4)') positive_average
write (*,'(''Average of negative points = '', 1g12.4)') negative_average
end program average
以下示例演示了可用于过程的现代 Fortran 特性,包括延迟形状、保护和可选参数,这是一个求解线性方程组的函数。
function gauss_sparse(num_iter, tol, b, A, x, actual_iter) result(tol_max)
! This function solves a system of equations (Ax = b) by using the Gauss-Seidel Method
implicit none
real :: tol_max
! Input: its value cannot be modified from within the function
integer, intent(in) :: num_iter
real, intent(in) :: tol
real, intent(in), dimension(:) :: b, A(:,:)
! Input/Output: its input value is used within the function, and can be modified
real, intent(inout) :: x(:)
! Output: its value is modified from within the function, only if the argument is required
integer, optional, intent(out) :: actual_iter
! Locals
integer :: i, n, iter
real :: xk
! Initialize values
n = size(b) ! Size of array, obtained using size intrinsic function
tol_max = 2. * tol
iter = 0
! Compute solution until convergence
convergence_loop: do while (tol_max >= tol .and. iter < num_iter); iter = iter + 1
tol_max = -1. ! Reset the tolerance value
! Compute solution for the k-th iteration
iteration_loop: do i = 1, n
! Compute the current x-value
xk = (b(i) - dot_product(A(i,:i-1),x(:i-1)) - dot_product(A(i,i+1:n),x(i+1:n))) / A(i, i)
! Compute the error of the solution
! dot_product(a,v)=a'b
tol_max = max((abs(x(i) - xk)/(1. + abs(xk))) ** 2, abs(A(i, i) * (x(i) - xk)), tol_max)
x(i) = xk
enddo iteration_loop
enddo convergence_loop
if (present(actual_iter)) actual_iter = iter
end function gauss_sparse
请注意,此例程的显式接口必须对调用者可用,以便知道类型签名。这最好通过将函数放在一个MODULE
中,然后在调用例程中USE
这个模块来实现。另一种方法是使用INTERFACE
块,如下例所示
program test_gauss_sparse
implicit none
! explicit interface to the gauss_sparse function
interface
function gauss_sparse(num_iter, tol, b, A, x, actual_iter) result(tol_max)
real :: tol_max
integer, intent(in) :: num_iter
real, intent(in) :: tol
real, intent(in), dimension(:) :: b, A(:,:)
real, intent(inout) :: x(:)
integer, optional, intent(out) :: actual_iter
end function
end interface
! declare variables
integer :: i, N = 3, actual_iter
real :: residue
real, allocatable :: A(:,:), x(:), b(:)
! allocate arrays
allocate (A(N, N), b(N), x(N))
! Initialize matrix
A = reshape([(real(i), i = 1, size(A))], shape(A))
! Make matrix diagonally dominant
do i = 1, size(A, 1)
A(i,i) = sum(A(i,:)) + 1
enddo
! Initialize b
b = [(i, i = 1, size(b))]
! Initial (guess) solution
x = b
! invoke the gauss_sparse function
residue = gauss_sparse(num_iter = 100, &
tol = 1E-5, &
b = b, &
A = a, &
x = x, &
actual_iter = actual_iter)
! Output
print '(/ "A = ")'
do i = 1, size(A, 1)
print '(100f6.1)', A(i,:)
enddo
print '(/ "b = " / (f6.1))', b
print '(/ "residue = ", g10.3 / "iterations = ", i0 / "solution = "/ (11x, g10.3))', &
residue, actual_iter, x
end program test_gauss_sparse
在需要通过过程的参数返回值的那些情况下,子程序比函数更可取;以下交换两个数组内容的子程序演示了这一点
subroutine swap_real(a1, a2)
implicit none
! Input/Output
real, intent(inout) :: a1(:), a2(:)
! Locals
integer :: i
real :: a
! Swap
do i = 1, min(size(a1), size(a2))
a = a1(i)
a1(i) = a2(i)
a2(i) = a
enddo
end subroutine swap_real
与前面的示例一样,此例程的显式接口必须对调用者可用,以便知道类型签名。与之前一样,这最好通过将函数放在一个MODULE
中,然后在调用例程中USE
这个模块来实现。另一种方法是使用INTERFACE
块。
编写前面示例中swap_real
子程序的另一种方法是
subroutine swap_real(a1, a2)
implicit none
! Input/Output
real, intent(inout) :: a1(:), a2(:)
! Locals
integer :: N
! Swap, using the internal subroutine
N = min(size(a1), size(a2))
call swap_e(a1(:N), a2(:N))
contains
elemental subroutine swap_e(a1, a2)
real, intent(inout) :: a1, a2
real :: a
a = a1
a1 = a2
a2 = a
end subroutine swap_e
end subroutine swap_real
在这个示例中,swap_e
子程序是元素过程,即它按元素的方式作用于其数组参数。元素过程必须是纯的(即,它们不能有副作用,只能调用纯过程),并且所有参数都必须是标量。由于swap_e
是swap_real
子程序的内部过程,因此其他程序单元无法调用它。
以下程序是对任何两个swap_real
子程序的测试
program test_swap_real
implicit none
! explicit interface to the swap_real subroutine
interface
subroutine swap_real(a1, a2)
real, intent(inout) :: a1(:), a2(:)
end subroutine swap_real
end interface
! Declare variables
integer :: i
real :: a(10), b(10)
! Initialize a, b
a = [(real(i), i = 1, 20, 2)]
b = a + 1
! Output before swap
print '(/"before swap:")'
print '("a = [", 10f6.1, "]")', a
print '("b = [", 10f6.1, "]")', b
! Call the swap_real subroutine
call swap_real(a, b)
! Output after swap
print '(// "after swap:")'
print '("a = [", 10f6.1, "]")', a
print '("b = [", 10f6.1, "]")', b
end program test_swap_real
在 Fortran 中,指针 的概念与类似 C 的语言中的概念不同。Fortran 90 指针不仅仅存储目标变量的内存地址;它还包含其他描述性信息,例如目标的秩、每个维度的上限和下限,甚至跨越内存的步长。这使得 Fortran 90 指针可以指向子矩阵。
Fortran 90 指针与定义明确的“目标”变量关联,方法是使用指针赋值运算符 (=>
) 或ALLOCATE
语句。当指针出现在表达式中时,它们总是被解引用;不允许进行“指针算术”。
以下示例演示了这个概念
module SomeModule
implicit none
contains
elemental function A(x) result(res)
integer :: res
integer, intent(IN) :: x
res = x + 1
end function
end module SomeModule
program Test
use SomeModule, DoSomething => A
implicit none
!Declare variables
integer, parameter :: m = 3, n = 3
integer, pointer :: p(:)=>null(), q(:,:)=>null()
integer, allocatable, target :: A(:,:)
integer :: istat = 0, i, j
character(80) :: fmt
! Write format string for matrices
! (/ A / A, " = [", 3( "[",3(i2, 1x), "]" / 5x), "]" )
write (fmt, '("(/ A / A, "" = ["", ", i0, "( ""["",", i0, "(i2, 1x), ""]"" / 5x), ""]"" )")') m, n
allocate(A(m, n), q(m, n), stat = istat)
if (istat /= 0) stop 'Error during allocation of A and q'
! Matrix A is:
! A = [[ 1 4 7 ]
! [ 2 5 8 ]
! [ 3 6 9 ]
! ]
A = reshape([(i, i = 1, size(A))], shape(A))
q = A
write(*, fmt) "Matrix A is:", "A", ((A(i, j), j = 1, size(A, 2)), i = 1, size(A, 1))
! p will be associated with the first column of A
p => A(:, 1)
! This operation on p has a direct effect on matrix A
p = p ** 2
! This will end the association between p and the first column of A
nullify(p)
! Matrix A becomes:
! A = [[ 1 4 7 ]
! [ 4 5 8 ]
! [ 9 6 9 ]
! ]
write(*, fmt) "Matrix A becomes:", "A", ((A(i, j), j = 1, size(A, 2)), i = 1, size(A, 1))
! Perform some array operation
q = q + A
! Matrix q becomes:
! q = [[ 2 8 14 ]
! [ 6 10 16 ]
! [12 12 18 ]
! ]
write(*, fmt) "Matrix q becomes:", "q", ((q(i, j), j = 1, size(A, 2)), i = 1, size(A, 1))
! Use p as an ordinary array
allocate (p(1:m*n), stat = istat)
if (istat /= 0) stop 'Error during allocation of p'
! Perform some array operation
p = reshape(DoSomething(A + A ** 2), shape(p))
! Array operation:
! p(1) = 3
! p(2) = 21
! p(3) = 91
! p(4) = 21
! p(5) = 31
! p(6) = 43
! p(7) = 57
! p(8) = 73
! p(9) = 91
write(*, '("Array operation:" / (4x,"p(",i0,") = ",i0))') (i, p(i), i = 1, size(p))
deallocate(A, p, q, stat = istat)
if (istat /= 0) stop 'Error during deallocation'
end program Test
一个模块 是一个程序单元,它包含数据定义、全局数据和CONTAIN
ed 过程。与简单的INCLUDE
文件 不同,模块是一个独立的程序单元,可以单独编译并以二进制形式链接。编译后,模块的公共内容可以通过USE
语句使其对调用例程可见。
模块机制使过程的显式接口很容易被调用例程访问。事实上,现代 Fortran 鼓励每个SUBROUTINE
和FUNCTION
都CONTAIN
在一个MODULE
中。这使得程序员可以使用较新的参数传递选项,并且允许编译器对接口进行完整的类型检查。
以下示例还演示了派生类型、运算符重载和泛型过程。
module GlobalModule
! Reference to a pair of procedures included in a previously compiled
! module named PortabilityLibrary
use PortabilityLibrary, only: GetLastError, & ! Generic procedure
Date ! Specific procedure
! Constants
integer, parameter :: dp_k = kind (1.0d0) ! Double precision kind
real, parameter :: zero = (0.)
real(dp_k), parameter :: pi = 3.141592653589793_dp_k
! Variables
integer :: n, m, retint
logical :: status, retlog
character(50) :: AppName
! Arrays
real, allocatable, dimension(:,:,:) :: a, b, c, d
complex(dp_k), allocatable, dimension(:) :: z
! Derived type definitions
type ijk
integer :: i
integer :: j
integer :: k
end type ijk
type matrix
integer m, n
real, allocatable :: a(:,:) ! Fortran 2003 feature. For Fortran 95, use the pointer attribute instead
end type matrix
! All the variables and procedures from this module can be accessed
! by other program units, except for AppName
public
private :: AppName
! Generic procedure swap
interface swap
module procedure swap_integer, swap_real
end interface swap
interface GetLastError ! This adds a new, additional procedure to the
! generic procedure GetLastError
module procedure GetLastError_GlobalModule
end interface GetLastError
! Operator overloading
interface operator(+)
module procedure add_ijk
end interface
! Prototype for external procedure
interface
function gauss_sparse(num_iter, tol, b, A, x, actual_iter) result(tol_max)
real :: tol_max
integer, intent(in) :: num_iter
real, intent(in) :: tol
real, intent(in), dimension(:) :: b, A(:,:)
real, intent(inout) :: x(:)
integer, optional, intent(out) :: actual_iter
end function gauss_sparse
end interface
! Procedures included in the module
contains
! Internal function
function add_ijk(ijk_1, ijk_2)
type(ijk) add_ijk, ijk_1, ijk_2
intent(in) :: ijk_1, ijk_2
add_ijk = ijk(ijk_1%i + ijk_2%i, ijk_1%j + ijk_2%j, ijk_1%k + ijk_2%k)
end function add_ijk
! Include external files
include 'swap_integer.f90' ! Comments SHOULDN'T be added on include lines
include 'swap_real.f90'
end module GlobalModule