Fortran/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
一個模組 是一個程式單元，它包含資料定義、全域性資料和CONTAINed 過程。與簡單的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