跳转到内容

Fortran/Fortran 示例

来自维基教科书,开放世界中的开放书籍

以下 Fortran 代码示例 或示例程序展示了根据编译器而不同的情况。第一组示例适用于 Fortran II、IV 和 77 编译器。其余示例可以使用任何较新的标准 Fortran 编译器进行编译和运行(有关编译器列表,请参阅 Fortran 主文章的末尾)。根据惯例,大多数当代 Fortran 编译器会根据源代码文件名后缀选择在编译期间使用的语言标准:对于 .f(或不太常见的 .for),使用 FORTRAN 77;对于 .f90,使用 Fortran 90;对于 .f95,使用 Fortran 95。如果支持其他标准,则可以使用命令行选项手动选择它们。

FORTRAN II、IV 和 77 编译器

[编辑 | 编辑源代码]

注意:在 FORTRAN 90 之前,大多数 FORTRAN 编译器强制执行 固定格式源代码,这是从 IBM 穿孔卡 中继承下来的。

  • 注释必须以第 1 列的 *C! 开头
  • 语句标签必须出现在第 1-5 列
  • 续行必须在第 6 列中包含非空格字符
  • 语句必须从第 7 列开始
  • 行长度可能限制为 72 个字符(源自穿孔卡的 80 字节宽度,最后 8 个字符保留用于(可选)序列号)

如果在编译 FORTRAN 代码时出现错误,请先检查列对齐。一些编译器还提供通过使用编译器标志实现自由格式源代码的功能

三角形面积程序

[编辑 | 编辑源代码]

简单的 Fortran II 程序

[编辑 | 编辑源代码]

一张数据卡输入

如果输入值之一为零,则程序将以作业控制卡列表中的错误代码“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

简单的 Fortran IV 程序

[编辑 | 编辑源代码]

多张数据卡输入

该程序具有两个输入检查:一个是检查空白卡以指示数据结束,另一个是检查输入数据中的零值。任一条件都会导致消息被 打印

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

简单的 Fortran 77 程序

[编辑 | 编辑源代码]

多张数据卡输入

该程序在 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

"Retro" FORTRAN IV

[编辑 | 编辑源代码]

可在 IBM 1130 页面上找到 FORTRAN IV(后来演变为 FORTRAN 66)程序卡组的怀旧示例,其中包括进行编译和执行所需的 IBM 1130 DM2 JCL。IBM 1130 模拟器可在 IBM 1130.org 上获得,它允许在 PC 上编译和运行 FORTRAN IV 程序。

Hello, World 程序

[编辑 | 编辑源代码]

为了符合计算传统,第一个示例演示了一个简单的程序,用于在屏幕(或打印机)上显示“Hello, world”。

FORTRAN 66(也称 FORTRAN IV)

[编辑 | 编辑源代码]
 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 语句,则它是一个 空操作;因此,上面的示例只有两个可执行语句,WRITESTOP

上述示例中 FORMAT 语句中的初始 13H 定义了一个 Hollerith 常量,这里表示紧随其后的 13 个字符将被视为字符常量(注意 Hollerith 常量没有用定界符包围)。(一些编译器还支持用 单引号 括起来的字符文字,这在 FORTRAN 77 中成为标准做法。)

紧随 13H 后的空格是一个回车控制字符,它告诉 I/O 系统在输出上换行。此位置的零表示换两行(双倍行距),1 表示换页,+ 字符表示不换行,允许覆盖打印。

FORTRAN 77

[编辑 | 编辑源代码]

从 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

[编辑 | 编辑源代码]

从 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 例子

[编辑 | 编辑源代码]

最大公约数

[编辑 | 编辑源代码]

以下 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

以上示例旨在说明以下内容

  • 以上示例中的 PRINTREAD 语句使用 '*' 作为格式,指定列表定向格式。列表定向格式指示编译器根据以下参数对所需的输入或输出格式进行有根据的猜测。
  • 由于运行 Fortran 的最早机器具有有限的字符集,FORTRAN 77 使用诸如 .EQ..NE..LT..GT..LE..GE. 之类的缩写来分别表示关系运算符 =、≠、<、>、≤ 和 ≥。
  • 此示例依赖于 隐式类型机制 来指定 NANBIAIBITEMP 的 INTEGER 类型。
  • 在函数 NGCD(NA, NB) 中,函数参数 NANB 的值分别复制到局部变量 IAIB 中。这是必要的,因为 IAIB 的值在函数内部被修改。因为 Fortran 函数和子例程中的参数传递默认情况下使用 按引用调用(而不是像 C 这样的语言中默认的 按值调用),从函数内部修改 NANB 实际上会修改调用函数的 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 IFFORMAT 都不是单个可执行语句,因此使用 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 还将双精度复数数据类型标准化了(尽管一些编译器在更早的时候就提供了这种类型)。

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/95 例子

[编辑 | 编辑源代码]

使用 DO 循环进行求和

[编辑 | 编辑源代码]

在这个 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_eswap_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

模块编程

[编辑 | 编辑源代码]

一个模块 是一个程序单元,它包含数据定义、全局数据和CONTAINed 过程。与简单的INCLUDE 文件 不同,模块是一个独立的程序单元,可以单独编译并以二进制形式链接。编译后,模块的公共内容可以通过USE 语句使其对调用例程可见。

模块机制使过程的显式接口很容易被调用例程访问。事实上,现代 Fortran 鼓励每个SUBROUTINEFUNCTIONCONTAIN 在一个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
华夏公益教科书