Fortran语法汇总（上）

前言

本人介绍：
  wibibaboo（CSDN博客名，非实名），本科毕业于西安交通大学，现在是西安交通大学在读硕士研究生。本科学的专业是能源与动力工程，本科毕业后选择了继续在能源行业深造。
  我第一次接触Fortran是在大二的时候上了一门叫“工程程序分析与设计”的课，虽然大一的时候学过C语言，但是C语言那头疼的指针、栈、堆等数据结构让我对计算机编程产生了一定的抵触心理。在我接触Fortran后，Fortran优雅的语法让我对这门语言产生了浓厚的兴趣（并且我的专业更倾向于选择Fortran这个高效的数值计算语言来编程处理问题），于是兴趣（可能还有专业背景）便驱使我不断学习这门语言的新特性。本科的所有实验的数据处理，我都是用的Fortran+Matlab，毕业设计我也选择了用Fortran来作为我强大的数值计算编程工具。事实证明，这门“上古”编程语言在数值计算领域依然焕发着生机。
参考资料来源：
  这个博客是我拜读了由彭国伦编著的《Fortran95程序设计》、陈斌等编著的《工程分析程序设计》以及Stephen J.Chapman编著的《Fortran程序设计（第四版）》后以及查阅了网上各种各样的资料，用自己的语言、排版方式、编码习惯整理出来的学习资料，供我自己在今后的科研道路中查阅。读者如果有疑问或者不懂的地方，欢迎在CSDN平台上私信我讨论并解决问题，也欢迎其他像我一样热爱Fortran、热爱编程的小伙伴们指教。
特别声明：
  本人对此博客的创作无任何商业目的，文章仅供学习参考，转载请注明出处，严禁盗用！

$$命名规范$$

（1）类名首字母大写。
（2）变量名、过程名、模块名小写。
（3）保留字名、库过程名、常量名大写。
（4）多个单词之间用下划线分隔。

$$基础知识$$

（1）!表示注释符。
（2）&表示续行符。
（3）**表示指数符。
（4）Fortran是不区分大小写的语言。
（5）;可以用来分隔一行代码中的不同语句。
（6）为了表示方便，今后[]中的内容表示可选内容。
（7）Fortran的声明语句必须要放在执行语句之前，这是不同于C语言的地方。

$$两种格式$$

（1）自由格式（Free Format）：以.F90为程序文件扩展名。
（2）固定格式（Fixed Format）：以.F或.FOR为程序文件扩展名。

第1章 数据类型

Fortran默认将以字母i、j、k、l、m、n开头的变量认为是INTEGER类型，其他字母开头的变量认为是REAL型。

IMPLICIT INTEGER(A,B,C) !以A、B、C开头的变量都视为整型
IMPLICIT INTEGER(A-F,I,K) !以A到F、I、K开头的变量都视为整型
IMPLICIT NONE !关闭默认类型功能，所有变量都要事先声明

（1）如果两个整数的除法不是整数，计算机会自动截去答案的小数部分。
（2）在判断两个实型数据是否相等时，由于实数不能被精确表示，因此要特别小心。

1.1 实型

REAL(KIND = kind_number) :: real_var

计算机/编译器	32字节实数对应的kind_number	64字节实数对应的kind_number	128字节实数对应的kind_number
PC/GNU Fortran	4（默认）	8	16
PC/Intel Visual Fortran	4（默认）	8	16
PC/NAGWare Fortran	1（默认）	2	不支持

根据传统惯例，在任意指定计算机上的较短版本的REAL数据类型被看作是单精度的，较长版本的REAL数据类型被看作是双精度的。在大部分计算机上，单精度实数用4字节（32位）来存储，双精度实数用8字节（64位）来存储。而在一些64位处理器上，用8字节（64位）来存储单精度数，用16字节（128位）来存储双精度数。因此不能保证在不同处理器中单/双精度数具有同样的长度，这种可变性使得术语“单精度”和“双精度”很难用于描述一个实数的真正精度（大多数Fortran编译器也支持16字节（128位）实数类型，称为四倍精度）。

为了使程序在不同处理器的计算机之间可移植，应该始终为类别号（即kind_number）指定一个有名常量，并在所有的类型定义语句中使用这个有名常量，在不同的处理器中运行该程序的时候只需要修改有名常量对应的值即可：

INTEGER,PARAMETER :: SGL = 4 !对应单精度kind_number的取值
INTEGER,PARAMETER :: DBL = 8 !对应双精度kind_number的取值
REAL(KIND = SGL) :: single_real_var
REAL(KIND = DBL) :: double_real_var

!实型常量
3.14159 !默认实数类别
3.14159_4 !当4为合法的实数类别时才有效
3.14159_DBL !当DBL是一个整型常量时有效
3.14159E0 !单精度指数
3.14159D0 !双精度指数

此外，Fortran提供了内置函数SELECTED_REAL_KIND来自动选择合适的实型数据的类别号，这个函数返回适合或者超过指定取值范围和精度的实型数据的最小类别的类别号：

kind_number = SELECTED_REAL_KIND(P = precision,R = range)
!precision：所需精度（即有效数字位数）
!range：所需的指数范围（即10^range）

下面这个程序示例了如何使用这个函数来选择基于某个处理器的实型变量的类别，并用KIND函数查询了类别号，用PRECISION函数查询了可以表示的有效数字位数，用RANGE函数查询了可以表示的指数范围：

PROGRAM main
    IMPLICIT NONE
    INTEGER,PARAMETER :: SGL = SELECTED_REAL_KIND(P = 6,R = 37)
    INTEGER,PARAMETER :: DBL = SELECTED_REAL_KIND(P = 13,R = 200)
    REAL(KIND = SGL) :: single_real_var = 0.0
    REAL(KIND = DBL) :: double_real_var = 0.0_DBL
    WRITE(*,*) KIND(single_real_var),PRECISION(single_real_var),RANGE(single_real_var) !4 6 37
    WRITE(*,*) KIND(double_real_var),PRECISION(double_real_var),RANGE(double_real_var) !8 15 307
END PROGRAM main

Fortran还提供了一个称为iso_Fortran_env的内置模块，它包含相关给定处理器上可用数据类型的类别的信息，以及描述不同类型数据的常量的标准名称：

PROGRAM main
    USE iso_Fortran_env
    IMPLICIT NONE
    INTEGER(KIND = INT8) :: int8_var !请求当前处理器上的8位整型变量
    INTEGER(KIND = INT16) :: int16_var !请求当前处理器上的16位整型变量
    INTEGER(KIND = INT32) :: int32_var !请求当前处理器上的32位整型变量
    INTEGER(KIND = INT64) :: int64_var !请求当前处理器上的64位整型变量
    REAL(KIND = REAL32) :: real32_var !请求当前处理器上的32位实型变量
    REAL(KIND = REAL64) :: real64_var !请求当前处理器上的64位实型变量
    REAL(KIND = REAL128) :: real128_var !请求当前处理器上的128位实型变量
    WRITE(*,"('All category values supported by INTEGER:',*(I3))") INTEGER_KINDS !1 2 4 8
    WRITE(*,"('All category values supported by REAL:',*(I3))") REAL_KINDS !4 8 16
    WRITE(*,"('All category values supported by CHARACTER:',*(I3))") CHARACTER_KINDS !1
    WRITE(*,"('All category values supported by LOGICAL:',*(I3))") LOGICAL_KINDS !1 2 4 8
END PROGRAM

如果需要一个双精度的运算，那么应该很小心地确保参与运算的每个中间值都是双精度的，所有中间结果都应该存在双精度变量中。如果用于初始化变量的常量是以单精度格式写的，那么变量将会被初始化成单精度的，而不管常量中所写的有效数字的个数：

PROGRAM main
    IMPLICIT NONE
    INTEGER,PARAMETER :: DBL = SELECTED_REAL_KIND(P = 13)
    REAL(KIND = DBL) :: a1 = 6.666000666000666
    REAL(KIND = DBL) :: a2 = 6.666000666000666_DBL
    WRITE(*,*) a1 !6.66600084304810
    WRITE(*,*) a2 !6.66600066600067
END PROGRAM

所有支持单精度实数的通用函数也支持双精度实数，如果输入值是单精度的，那么函数将会计算出单精度结果，如果输入值是双精度的，那么函数将会计算出双精度结果。DBLE函数可以将任意数值转化为双精度数。通常以下三种情况需要使用双精度数：
（1）当计算所需数据的绝对值的动态范围小于$10^{-39}$或者大于$10^{39}$的时候。
（2）当需要对大小非常不同的数据进行相加或者相减的时候。
（3）当需要对两个大小非常接近的数进行相减的时候。

1.2 整型

INTEGER(KIND = kind_number) :: int_var

计算机/编译器	8字节整数对应的kind_number	16字节整数对应的kind_number	32字节整数对应的kind_number	64字节整数对应的kind_number
PC/GNU Fortran	1	2	4（默认）	8
PC/Intel Visual Fortran	1	2	4（默认）	8
PC/NAGWare Fortran	1	2	3（默认）	4

Fortran提供了内置函数SELECTED_INT_KIND来自动选择合适的整型数据的类别号，这个函数返回适合于当前计算机中所指定范围的整型数值的最小类别的类别号：

kind_number = SELECTED_INT_KIND(R = range)
!range：所需的指数范围（即10^range）

INTEGER,PARAMETER :: SHORT = SELECTED_INT_KIND(3)
INTEGER,PARAMETER :: LONG = SELECTED_INT_KIND(9)
INTEGER(KIND = SHORT) :: short_int_var
INTEGER(KIND = LONG) :: long_int_var

!整型常量
10 !默认的整型类别
10_4 !当4为合法的整型类别时有效
10_LONG !当LONG是一个整型常量时有效

此外，也可以用内置模块iso_Fortran_env，直接指定整型变量的字节数，前已述及，这里不再赘述。

取整函数	含义
int_var = INT(real_var)	截尾取整
int_var = NINT(real_var)	四舍五入取整
int_var = CEILING(real_var)	向上取整
int_var = FLOOR(real_var)	向下取整

1.3 字符型

ASCII（America Standard Code for Information Interchange）和Unicode（ISO 10646）是两种基本的字符集。ASCII字符集是一个系统，该系统中的每个字符按1个字节来存储，这种字符集可以容纳256个字符，标准ASCII定义了其中的前128个可取值，剩余的128个字符在不同的国家有不同的定义，这些定义取决于特定国家使用的编码页。Unicode字符集用2个字节来表示每个字符，最多允许1112064个可能的字符，它几乎涵盖了地球上所有语言用到的字符。在没有特别说明的情况下，今后默认用ASCII字符集。

CHARACTER(KIND = kind_number,LEN = len_number) :: char_var
!kind_number：所需的字符集的类别号

Fortran2003提供了一个叫做SELECTED_CHAR_KIND的新函数用于返回指定字符集的类别号：

kind_number = SELECTED_CHAR_KIND(name)
!name：取值为"DEFAULT"、"ASCII"、"ISO_10646"（Unicode）

Fortran标准不需要编译器能够支持Unicode字符集，但是它为使用Unicode字符集的需提供了支持函数。GNU Fortran支持ASCII和Unicode两个字符集，Intel Fortran仅支持ASCII字符集。

（1）str_var(2:2)表示str的第二个字符，不能写成str_var(2)。
（2）一个英文字母占一个字符长度，一个汉字占两个字符长度。
（3）Fortran中“字符型”和“字符串型”是一个意思，它们都由单/双引号括起来，今后在没有特别声明的情况下统称为“字符型”。
（4）如果字符串中包含单/双引号，那么必须用双/单引号来括住它，否则必须用两个连续的单/双引号来表示字符串中的单/双引号。

PROGRAM main
    IMPLICIT NONE
    CHARACTER(LEN = 5) :: str1,str2,str3
    str1 = "abc" !str1 = "abc□□"
    str2 = "ABCDEFG" !str2 = "ABCDE"
    str1(4:5) = "de" !str1 = "abcde"
    str3 = str1(1:2) // str2(3:5) !str3 = "abCDE"
END PROGRAM main

内置字符函数	含义
char_var = CHAR(int_var)	返回处理器所用的排序序列中对应于int_var的字符
char_var = ACHAR(int_var)	返回ASCII排序序列中对应于值int_var的字符
int_var = ICHAR(char_var)	返回处理器所用排序序列中对应于char_var的整数值
int_var = IACHAR(char_var)	返回ASCII排序序列中对应于char_var的整数值
int_var = LEN(str_var)	求str_var的声明长度
int_var = LEN_TRIM(str_var)	求str_var去掉尾部空格的长度
str_var2 = TRIM(str_var1)	将str_var1去掉尾部空格后赋值给str_var2
int_var = INDEX(str_var1,str_var2[,log_var])	求str_var2在str_var1中第一次出现的位置，log_var可以改变查找方式，如果取值为.TRUE.表示从后往前查找，反之从前往后查找
log_var = LLT(str_var1,str_var2)	根据ASCII排序序列，如果str_var1<str_var2，则返回.TRUE.
log_var = LLE(str_var1,str_var2)	根据ASCII排序序列，如果str_var1<=str_var2，则返回.TRUE.
log_var = LGT(str_var1,str_var2)	根据ASCII排序序列，如果str_var1>str_var2，则返回.TRUE.
log_var = LGE(str_var1,str_var2)	根据ASCII排序序列，如果str_var1>=str_var2，则返回.TRUE.

ACHAR函数和IACHAR函数（以及CHAR函数和ICHAR函数）的功能相同，只是前者不考虑特定处理器采用的字符集，而是基于ASCII排序序列进行，其运行结果不论在什么计算机上都是相同的，因此应该用它们来替代后者，以提高程序的可移植性。

字符型数据可以和字符型数据进行比较运算，但是字符型数据不能和数值型数据进行比较运算。字符型数据在比较时，从每个字符串的第一个字符开始，如果它们是相同的，那么再比较第二个字符，直到发现两个字符串之间存在的第一个差别为止；如果两个字符串在比较到其中一个结束时始终没有差别，那么就认为另一个字符串为大。如果程序有可能在具有不同字符集的计算机上运行，在比较两个字符串的时候，应当用逻辑函数LLT（字符串小于）、LLE（字符串小于等于）、LGT（字符串大于）、LGE（字符串大于等于）代替普通的逻辑运算符。

1.4 复数型

COMPLEX(KIND = kind_number) :: complx_var

复数型常量的表示格式是：(r,i)，r表示实部，i表示虚部。因此每个复数需要两个实数空间。在任意给定的处理器中，默认复数类别总是和默认实数类别相同，因此内置函数SELECTED_REAL_KIND也可以用于指定处理器无关情况下复数的大小。

在格式化输入、输出复数的时候，第一个格式描述符用于描述复数的实部，第二个格式描述符用于描述复数的虚部。从键盘格式化读取复数的时候输入行不包含括号，从键盘表控读取复数的时候，输入行复数必须包含括号和逗号。格式化输出复试的时候只有实部和虚部的数值被输出，表控输出复数的时候复数的括号和逗号也一并被输出：

PROGRAM main
    IMPLICIT NONE
    COMPLEX(KIND = 4)  :: c
    READ(*,*) c !表控输入：(1.0,2.0)
    WRITE(*,*) c !表控输出：□(1.000000,2.000000)
    READ(*,"(2F5.2)") !格式化输入：1.0□2.0
    WRITE(*,"(2F5.2)") c !格式化输出：□1.00□2.00
END PROGRAM

如果一个实数表达式被赋给一个复数变量，那么表达式的值将被放在复数变量的实部，复数变量的虚部被设定为0；当一个复数值要赋给一个实型或整型变量时，复数的实部赋给变量，虚部被丢弃。复数之间只能比较是否相等，不能比较大小。

复数内置函数	含义
complx_var = CMPLX(r,i,KIND = kind_number)	把实数或整数r、i转换为实部为r虚部为i的复数，kind_number用于指定复数类别号
int_var = INT(complx_var,KIND = kind_number)	将复数的实部转化为整数，kind_number用于指定整数类别号
real_var = REAL(complx_var,KIND = kind_number)	将复数的实部转化为实数，kind_number用于指定实数类别号
real_var = DBLE(complx_var)	将复数的实部转化为双精度实数
real_var = AIMAG(complx_var)	将复数的虚部转化为实数
real_var = CABS(complx_var)	计算复数的模
complx_var2 = CONJG(complx_var1)	计算复数的共轭复数

Fortran标准规定如果没有在输入参数中显式的指明类别号，那么函数CMPLX返回默认的复数类别，这样就可能会在不知情的情况下意外地损失精度：

PROGRAM main
    IMPLICIT NONE
    INTEGER,PARAMETER :: DBL = SELECTED_REAL_KIND(P = 13)
    COMPLEX(KIND = DBL) :: c1,c2
    REAL(KIND = DBL) :: r = 3.333333333333333_DBL
    REAL(KIND = DBL) :: i = 6.666666666666666_DBL
    c1 = CMPLX(r,i)
    c2 = CMPLX(r,i,KIND = DBL)
    WRITE(*,*) c1 !□(3.33333325386047,6.66666650772095)
    WRITE(*,*) c2 !□(3.33333333333333,6.66666666666667)
END PROGRAM

1.5 逻辑型

LOGICAL(KIND = kind_number) :: log_var

（1）kind_number可以取1、2、4、8，缺省值为4。
（2）逻辑常量只能是.TRUE.或.FALSE.。
（3）在输出逻辑变量时，输出值只能是T和F，分别代表逻辑真和逻辑假。
（4）在输入逻辑变量时必须是.TRUE./.FALSE.或以T/F开头的字符或字符串。

第2章 流程控制

2.1 逻辑运算

关系逻辑运算符	含义	关系逻辑运算符	含义
==或.EQ.	相等	/=或.NE.	不相等
>或.GT.	大于	<或.LT.	小于
>=或.GE.	大于等于	<=或.LE.	小于等于

组合逻辑运算符	含义	组合逻辑运算符	含义
.AND.	且	.OR.	或
.EQV.	同或	.NEQV.	异或
.NOT.	非

2.2 分支结构

IF(log_expr) execution_session

IF(int_var) 100,200,300 !int_var<0,GOTO 100;int_var=0,GOTO 200;int_var>0,GOTO 300

[name:] IF(log_expr_1) THEN
    execution_session_1
ELSE IF(log_expr_2) THEN [name] !命名的IF语句在THEN后的名称可省
    execution_session_2
...
ELSE IF(log_expr_n-1) THEN [name]
    execution_session_n-1
[ELSE [name]]
    [execution_session_n]
END IF [name] !命名的IF语句在END IF后的名称不可省

[name:] SELECT CASE(var) !只能是整型、字符型、逻辑型
    CASE(val_1) [name] !命名的SELECT语句在CASE后的名称可省
        execution_session_1
    ...
    CASE(val_n-1) [name]
        execution_session_n-1
    [CASE DEFAULT [name]]
        [execution_session_n]
END SELECT [name] !命名的SELECT语句在END SELECT后的名称不可省

2.3 循环结构

[name:] DO index = istart,iend,incr
    execution_session
END DO [name] !命名的计数循环在END DO后的名称不可省

[name:] DO WHILE(log_expr)
    execution_session
END DO [name] !命名的DO WHILE循环在END DO后的名称不可省

[name:] DO
    execution_session_1
    IF(log_expr) EXIT [name] !命名的当循环在EXIT等与循环相关的语句后的名称可省
    execution_session_2
END DO [name] !命名的当循环在END DO后的名称不可省

2.4 其他控制语句

PAUSE !暂停程序运行
GOTO ??? !跳转到行代码???处
CONTINUE !程序从该处继续执行
EXIT [name] !跳出该层[name]循环
CYCLE [name] !跳过该次[name]循环
RETURN !例程从该位置返回到调用它的位置

[ERROR] STOP !程序停止运行
[ERROR] STOP n !程序停止运行，并且打印数字n
[ERROR] STOP "Error" !程序停止运行，并且打印字符串“Error”

2.5 流程控制的简单应用

!小型交互式计算器
PROGRAM main
    IMPLICIT NONE
    REAL(KIND = 4) :: a,b,ans
    CHARACTER(LEN = 1) oper
    WRITE(*,"('Please enter the first number:')")
    READ(*,*) a
    WRITE(*,"('Please enter the operator(+、-、*、/):')")
    READ(*,"(A1)") oper
    WRITE(*,"('Please enter the second number:')")
    READ(*,*) b
    SELECT CASE(oper)
        CASE('+')
            ans = a + b
        CASE('-')
            ans = a - b
        CASE('*')
            ans = a * b
        CASE('/')
            ans = a / b
        CASE DEFAULT
            STOP "Error input!"
    END SELECT
    WRITE(*,"(F5.2,A1,F5.2,'=',F5.2)") a,oper,b,ans
END PROGRAM main

!猜数字游戏
PROGRAM main
    IMPLICIT NONE
    INTEGER(KIND = 4) :: guess_time = 0 !猜测次数
    REAL(KIND = 4),PARAMETER :: err = 0.1 !猜测偏差
    REAL(KIND = 4) :: temp_num
    REAL(KIND = 4) :: random_num !0.0~10.0之间的随机数
    REAL(KIND = 4) :: guess_num !猜测的数
    CALL random_seed() !随机数种子
    CALL random_number(temp_num) !生成0.0~1.0之间的随机数保存在temp_num中
    random_num = 0 + (10 - 0) * temp_num !这才是0.0~10.0之间的随机数
    DO WHILE(guess_time < 11) !只有10次机会
        guess_time = guess_time + 1
        WRITE(*,"('Please enter the number you guessed(0~10):')")
        READ(*,*) guess_num
        IF(ABS(guess_num - random_num) < err) EXIT
        WRITE(*,"('Wrong guess, you have ',I2,' times left.')") 10 - guess_time
        IF(random_num >= 0.0 .AND. random_num <= guess_num) THEN
            WRITE(*,"('The right number is between 0.0 and ',F4.1)") guess_num
        ELSE
            WRITE(*,"('The right number is between ',F4.1,'and 10.0')") guess_num
        END IF
    END DO
    IF(guess_time == 10) THEN
        STOP "Unfortunately, the opportunity has been used up!"
    END IF
    WRITE(*,"('Congratulations, you''ve got it!')")
END PROGRAM main

!字符串加密
PROGRAM main
    IMPLICIT NONE
    INTEGER(KIND = 4) :: i,str_len,key
    CHARACTER(LEN = 20) :: str
    WRITE(*,*) 'Please enter the string you want to encrypt:'
    READ(*,"(A20)") str
    WRITE(*,"('Please enter the encryption key:')")
    READ(*,*) key
    str_len = LEN_TRIM(str) !获取字符串长度
    DO i = 1,str_len
        str(i:i) = ACHAR(IACHAR(str(i:i)) + key)
    END DO
    WRITE(*,"('The encrypted string is ',A20)") str
END PROGRAM main

第3章 数组

3.1 一维数组

DATA_TYPE :: vec_name(vec_size) !vec_size只能是常数或常量，不能是变量
DATA_TYPE,DIMENSION(vec_size) :: vec_name

出于本人习惯，今后对数组的声明统一用第二种方式。Fortran的数组索引值默认从1开始，但是可以通过特别声明来改变这个默认规则：

DATA_TYPE,DIMENSION(istart:iend) :: vec_name !索引从istart~iend

一维数组初的始化需要用到数组构造器，数组构造器的起始分隔符是(/或[，结束分隔符是/)或]，两种数组构造器的作用一致，前者属于老版本形式，后者属于新版本形式，本文之后的内容统一用后者：

INTEGER(KIND = 4),DIMENSION(5) :: vec = (/ 1,2,3,4,5 /)
INTEGER(KIND = 4),DIMENSION(5) :: vec = [1,2,3,4,5]

用下标三元组可以对一维数组的部分元素操作，下标三元组指定了所有数组下标的有序子集，这个子集的起点是istart，结束点是iend，按incr增量前进。如果下标三元组中缺省istart，它默认取值为数组中第一个元素的下标；如果三元组中缺省iend，它默认取值为数组中最后一个元素的下标；如果三元组中缺省incr，它默认取值为1：

vec(istart:iend:incr)

Fortran也支持对整个一维数组元素的操作：

vec = 5 !vec(i) = 5
vec = vec * 10 !vec(i) = vec(i)*10
vec2 = vec1 !vec2(i) = vec1(i)
vec3 = vec1 + vec2 !vec3(i) = vec1(i) + vec2(i)
vec3 = vec1 * vec2 !vec3(i) = vec1(i) * vec2(i)
vec3 = vec1 / vec2 !vec3(i) = vec1(i) / vec2(i)
vec2 = SIN(vec1) !vec2(i) = SIN(vec1(i))
vec3 = vec1 > vec2 !vec3是一个逻辑数组
vec(:) = matrx(:,2) !把二维数组matrx的第二列的内容赋值给一维数组vec

3.2 二维数组

Fortran最高可以支持十五维数组，这里仅介绍到二维数组（也叫矩阵），高维数组可以类推。

DATA_TYPE :: matrx_name(matrx_size1,matrx_size2)
DATA_TYPE,DIMENSION(matrx_size1,matrx_size2) :: matrx_name

同样地，可以通过特别声明来改变二维数组的索引范围：

DATA_TYPE,DIMENSION(istart1:iend1,istart2:iend2) :: matrx_name !第一维索引从istart1~iend1，第二维索引从istart2~iend2

Fortran中二维数组以列为主顺序为数组元素分配空间，也就是说，Fortran在内存中首先为第一列分配空间，接着是第二列，直到所有列被分配完，这种分配二维数组内存空间的方式被称为列主（Column Major）原则。对于C等编程语言来说，它们分配二维数组内存空间的方式刚好与Fortran相反，被称为是行主（Row Major）原则。

为了提高程序运行效率，在遍历数组的时候就很有必要根据数组的保存规则进行高效访问。下面是遍历一个三维数组的高效方式：

DO i = 1,5
    DO j = 1,5
        DO k = 1,5
            WRITE(*,*) cubic(k,j,i)
        END DO
    END DO
END DO

二维数组的初始化不能用数组构造器，因为数组构造器总是产生一个一维数组，为了克服数组构造器的这种限制，Fortran提供了RESHAPE函数，它可以在不改变数组中元素个数的情况下，改变一个数组的结构：

PROGRAM main
    IMPLICIT NONE
    INTEGER(KIND = 4) :: i,j
    INTEGER(KIND = 4),DIMENSION(4,3) :: matrx
    matrx = RESHAPE([1,1,1,1,2,2,2,2,3,3,3,3],[4,3])
    WRITE(*,"(4(I2.2,2X,I2.2,2X,I2.2,/))") ((matrx(i,j),j = 1,3),i = 1,4) !隐式DO循环
    !01□□02□□03
    !01□□02□□03
    !01□□02□□03
    !01□□02□□03
END PROGRAM main

与一维数组类似，用下标三元组也可以对二维数组的部分元素操作：

matrx(istart1:iend1:incr1,istart2:iend2:incr2)

Fortran也支持对整个二维数组元素的操作：

matrx = 5 !matrx(i,j) = 5
matrx = matrx * 10 !matrx(i,j) = matrx(i,j)*10
matrx2 = matrx1 !matrx2(i,j) = matrx1(i,j)
matrx3 = matrx1 + matrx2 !matrx3(i,j) = matrx1(i,j) + matrx2(i,j)
matrx3 = matrx1 * matrx2 !matrx3(i,j) = matrx1(i,j) * matrx2(i,j)
matrx3 = matrx1 / matrx2 !matrx3(i,j) = matrx1(i,j) / matrx2(i,j)
matrx2 = SIN(matrx1) !matrx2(i,j) = SIN(matrx1(i,j))
matrx3 = matrx1 > matrx2 !matrx3是一个逻辑数组
matrx(:,:) = cubic(:,:,1) !把三维数组cubic的第一页赋值给二维数组matrx

3.3 WHERE结构

WHERE(mask_expr) array_assignment_statements !mask_expr是一个逻辑数组

[name:] WHERE(mask_expr_1)
    array_assignment_statements_1
ELSE WHERE(mask_expr_2) [name] !命名的WHERE结构在ELSE WHERE后的名称可省
    array_assignment_statements_2
    ...
ELSE WHERE(mask_expr_n-1) [name]
    array_assignment_statements_n-1
ELSE WHERE [name]
    array_assignment_statements_n
END WHERE [name] !命名的WHERE结构在END WHERE后的名称不可省

例：假设年所得30000以下税率为10%，30000~50000之间为12%，50000以上为15%。记录5个人的所得税金额。

PROGRAM main
    IMPLICIT NONE
    REAL(KIND = 4),DIMENSION(5) :: income = [25000,30000,50000,40000,35000]
    REAL(KIND = 4),DIMENSION(5) :: tax
    WHERE(income < 30000.0)
        tax = income * 0.10
    ELSE WHERE(income < 50000.0)
        tax = income * 0.12
    ELSE WHERE
        tax = income * 0.15
    END WHERE
    WRITE(*,'(5(F8.1))') tax
END PROGRAM main

3.4 FORALL结构

该结构的本质作用是通过循环对数组中的元素进行修改或者调用。可以在FORALL中使用WHERE，但不可以在WHERE中使用FORALL，写几段程序感受一下：

FORALL(i = 1:5) vec(i) = 10 !vec(i) = 10

[name:] FORALL(i = 1:5,j = 1:5,matrx(i,j) < 10)
    matrx(i,j) = 0 !将matrx中小于10的元素置0
END FORALL [name]

例：把矩阵的上半部分设置为1，对角线设置为0，下半部分设置为-1。

PROGRAM main
    IMPLICIT NONE
    INTEGER(KIND = 4) :: i,j
    INTEGER(KIND = 4) :: matrx(4,4)
    FORALL(i = 1:4,j = 1:4,i > j) matrx(i,j) = -1
    FORALL(i = 1:4,j = 1:4,i == j) matrx(i,j) = 0
    FORALL(i =1:4,j = 1:4,i < j) matrx(i,j) = 1
    WRITE(*,"(4(4(I2,2X),/))") ((matrx(i,j),j = 1,4),i = 1,4)
END PROGRAM main
!□0□□□1□□□1□□□1
!-1□□□0□□□1□□□1
!-1□□-1□□□0□□□1
!-1□□-1□□-1□□□0

3.5 可分配数组

到现在为止，所看到的所有数组的大小都是在程序执行语句之前的类型声明语句中声明好的，这种数组声明的类型称为静态内存分配（Static Memory Allocation）。在更多的情况下，需要等到程序运行之后才会知道所需要使用的数组的大小。这时候就要用到动态内存分配（Dynamic Memory Allocation）。

Fortran在类型声明语句中使用ALLOCATABLE属性来声明动态分配内存的数据，使用ALLOCATE语句分配实际内存，用ALLOCATED查询分配状态，最后用DEALLOCATE语句释放内存。以二维数组为例：

!（1）声明矩阵的可分配属性
DATA_TYPE,ALLOCATABLE,DIMENSION(:,:) :: matrx

!（2）给矩阵分配实际内存
!（2.1）第一种方式
ALLOCATE(matrx(matrx_dim1,matrx_dim2)[,STAT = allocate_stat][,ERRMSG = allocate_err_str])
!分配成功allocate_stat取值为0，反之取值为非0
!allocate_err_str包含描述信息，用来告诉用户问题所在
!（2.2）第二种方式
ALLOCATE(matrx,SOURCE = source_matrx[,STAT = allocate_stat][,ERRMSG = allocate_err_str])
!将源矩阵source_matrx复制给matrx

!（3）查询分配的状态
log_var = ALLOCATED(matrx)

!（4）释放分配的内存
DEALLOCATE(matrx[,STAT = deallocate_stat])
!释放成功deallocate_status取值为0，反之取值为非0

在配置空间时也可以设定数组索引的初始值：

DATA_TYPE,ALLOCATABLE,DIMENSION(:,:) :: matrx
ALLOCATE(matrx(istart1:iend1,istart2:iend2))

Fortran2003和更高版本允许通过简单地赋值来自动分配和释放可分配数组：

PROGRAM main
    IMPLICIT NONE
    INTEGER(KIND = 4) :: i
    INTEGER(KIND = 4),ALLOCATABLE,DIMENSION(:) :: vec1
    INTEGER(KIND = 4),DIMENSION(3) :: vec2 = [1,2,3]
    INTEGER(KIND = 4),DIMENSION(5) :: vec3 = [1,2,3,4,5]
    vec1 = vec2 !把数组vec1按3个元素值的规模来分配
    WRITE(*,"(L2)") ALLOCATED(vec1) !□T
    WRITE(*,"(3(I3))") (vec1(i),i = 1,SIZE(vec1)) !□□1□□2□□3
    vec1 = vec3 !把数组vec1按5个元素值的规模来分配
    WRITE(*,"(L2)") ALLOCATED(vec1) !□T
    WRITE(*,"(5(I3))") (vec1(i),i = 1,SIZE(vec1)) !□□1□□2□□3□□4□□5
    DEALLOCATE(vec1)
END PROGRAM main

在子例程或者函数中没有声明SAVE属性的可分配数组，当子例程或函数退出时会被自动释放，不需要DEALLOCATE语句。

第4章 过程

过程（Procedure）分为子例程（Subroutine）和函数（Function）两种。前者可以通过参数来返回多个结果，后者只能通过参数来返回单个结果。

Fortran可以把每个子任务作为独立的程序单元来编码，这个独立的程序单元被称为外部过程（External Procedure）。分为外部子例程（External Subroutine）和外部函数（External Function）。

包含在另一个被称为宿主程序单元（可以是主程序也可以是过程）中的过程被称为内部过程（Internal Procedure）。分为内部子例程（Internal Subroutine）和内部函数（Internal Function）。内部过程和宿主程序一起编译，只能由宿主程序单元调用，内部过程必须跟在宿主过程的所有执行语句之后，并且必须用CONTAINS语句引入。

4.1 子例程

SUBROUTINE subroutine_name(argument_list)
    ...
    declaration_session
    ...
    execution_session
    ...
    [RETURN]
END [SUBROUTINE [subroutine_name]]

argument_list中的参数被称为形参（Dummy Argument），子例程实际上没有为它们真正分配内存空间，它们仅仅是从调用程序单元传递来的实参（Actual Argument）的占位符。子例程的编译独立于主程序和其他的过程，因为程序中的每个程序单元都是独立进行编译的。局部变量名和语句标号可以在不同的子例程中被复用。子例程的调用格式如下：

CALL subroutine_name(argument_list)

例：编写一个根据直角三角形的两条直角边计算斜边的程序。

PROGRAM main
    IMPLICIT NONE
    REAL(KIND = 4) :: side1,side2
    REAL(KIND = 4) :: hypotenuse
    side1 = 3.0
    side2 = 4.0
    CALL calculate_hypotenuse(side1,side2,hypotenuse)
    WRITE(*,"(F4.1)") hypotenuse
END PROGRAM main

SUBROUTINE calculate_hypotenuse(side1,side2,hypotenuse)
    IMPLICIT NONE
    REAL(KIND = 4),INTENT(IN) :: side1,side2
    REAL(KIND = 4),INTENT(OUT) :: hypotenuse
    hypotenuse = SQRT(side1**2 + side2**2)
END SUBROUTINE calculate_hypotenuse

INTENT属性	含义
INTENT(IN)	形参仅用于向过程传入数据
INTENT(OUT)	形参仅用于将结果返回给调用程序
INTENT(INOUT)	形参既可用于向过程传入数据，也可用于将结果返回给调用程序

值得指出的是，对于形参列表中的每一个参数来说，都应该声明一个合适的INTENT属性，这样编译器就可以在编译的时候使用这些信息来捕捉编程中出现的错误。

4.2 函数

函数分为固有函数（Intrinsic Function）和函数子程序（Function Subprogram）。前者指的是Fortran自带的函数，后者指的是用户自己定义的函数，其构造格式如下：

!第一种方法
FUNCTION function_name(argument_list)
    ...
    declaration_session(Including function_name without "INTENT attribute")
    ...
    execution_session
    ...
    function_name = expr
    [RETURN]
END [FUNCTION [function_name]]

!第二种方法
DATA_TYPE FUNCTION function_name(argument_list)
    ...
    declaration_session(Excluding function_name)
    ...
    execution_session
    ...
    function_name = expr
    [RETURN]
END [FUNCTION [function_name]]

!第三种写法
DATA_TYPE FUNCTION function_name(argument_list) RESULT(ret)
    ...
    declaration_session(Excluding ret & function_name)
    ...
    execution_session
    ...
    ret = expr
    [RETURN]
END [FUNCTION [function_name]]

4.3 模块过程

模块过程（Module Procedure）：包含在模块中的子例程和函数。分为模块子例程（Module Subroutine）和模块函数（Module Function）。

MODULE module_name
    ...
    CONTAINS
    ...
    SUBROUTINE subroutine_name(argument_list)
        ...
    END [SUBROUTINE [subroutine_name]]
    ...
    FUNCTION function_name(argument_list)
        ...
    END [FUNCTION [function_name]]
	...
END [MODULE [moudle_name]]

为什么非要在模块中包含过程呢？这是因为当在模块中编译一个过程并且在调用程序中使用模块时，该过程接口的所有细节对编译器都是可用的，当编译器调用程序时，编译器可以自动检测过程调用中的参数个数、类型、是否是数组以及每个参数的INTENT属性。一个在模块内编译和使用USE（必须在IMPLICIT NONE之前）访问的过程称为带有显式接口（Explicit Interface），无论何时使用该过程，Fortran编译器都清楚地知道过程的每个参数的所有细节，并可以通过检查接口来确保正确使用过程。与之相反，不在模块内定义的过程称为带有隐式接口（Implicit Interface），Fortran编译器在编译和调用过程的程序单元时，不知道这些过程的任何信息，所以只能假设用户正确地使用了参数的个数、类型等信息。提供显式接口的方法还有两种，第一种方法是将过程放在主函数中作为内部过程；第二种方法是使用INTERFACE块，这将在后面的内容介绍。

模块有个不好的地方就是如果模块发生任何改变，编译器将重新编译整个模块，程序中任何依赖于模块的部分发生改变也要重新编译该模块，这就导致了如果涉及某个关键模块的线路被更改，就会引起大规模的重新编译，占用很长的时间，Fortran提供了一个叫做子模块（Submodule）的技术来解决这个问题：

!模块本身，包含模块过程的接口（即调用参数）
MODULE my_module
    IMPLICIT NONE
    INTERFACE !用接口块生成显式接口
        MODULE SUBROUTINE sub(x,y,sum)
            IMPLICIT NONE
            INTEGER(KIND = 4),INTENT(IN) :: x,y
            INTEGER(KIND = 4),INTENT(OUT) :: sum
        END SUBROUTINE sub
        MODULE FUNCTION func(x,y)
            IMPLICIT NONE
            INTEGER(KIND = 4),INTENT(IN) :: x,y
            INTEGER(KIND = 4) :: func
        END FUNCTION func
    END INTERFACE
END MODULE my_module
    
!子模块，包含过程的实际可执行代码
SUBMODULE(my_module) my_submodule
    IMPLICIT NONE
    CONTAINS
    MODULE PROCEDURE sub
        sum = x + y
    END PROCEDURE sub
    MODULE PROCEDURE func
        func = x + y
    END PROCEDURE func
END SUBMODULE my_submodule

PROGRAM main
    USE my_module
    IMPLICIT NONE
    INTEGER(KIND = 4) :: x = 10,y = 20,sum
    CALL sub(x,y,sum)
    WRITE(*,*) sum !30
    WRITE(*,*) func(x,y) !30
END PROGRAM main

当使用USE关联访问模块时，默认情况下，模块中定义的所有实体对于含有USE语句的程序单元都可使用。但是当许多项数据同时定义在一个模块中而特定的程序单元仅需要少数几个数据项时，这些非必要的数据项在程序单元中均可访问，这样会导致程序员有可能错误地修改它们。比较好的做法是限制对任意过程或数据实体的访问，只有那些“了解”它们的程序才可以访问，这一过程就是众所周知的数据隐藏（Data Hiding）。如果对模块中的某个项指定了PUBLIC（默认）属性，那么模块外的程序单元就可以访问该项；如果对模块中的某个项指定了PRIVATE属性，那么模块外的程序单元就不能访问该项，但是模块中的过程仍可以访问该项；如果对模块中的某个项指定了PROTECTED属性，那么该项对于模块外程序单元只可读，任何其他模块试图修改它的值都会引起编译错误。访问权限的声明方法如下：

PUBLIC :: list_of_public_items
PRIVATE :: list_of_private_items
PROTECTED :: list_of_protected_items

如果一个模块包括PRIVATE语句而没有具体的内容列表，那么在默认状态下，模块中每个数据项和过程都是私有的，任何公用项都必须使用单独的PUBLIC语句显式声明。在设计模块时，推荐使用这种方法，因为这样仅暴露给程序实际需要的信息。下面这个程序可以根据用户的存/取钱情况记录存/取操作的时间节点以及金库剩余总金额，并将数据与文件进行了交互：

MODULE bank
    IMPLICIT NONE
    PRIVATE
    PUBLIC :: money_out,money_in
    INTEGER(KIND = 4) :: total_money = 1000000 !银行金库总金额（私有）
    CONTAINS
    SUBROUTINE money_out(name,money) !取钱
        CHARACTER(LEN = *),INTENT(IN) :: name
        INTEGER(KIND = 4),INTENT(IN) :: money
        CHARACTER(LEN = 20) :: date,time
        CALL date_and_time(date,time)
        OPEN(UNIT = 10,FILE = "e:\bank.txt",POSITION = "APPEND")
        WRITE(UNIT = 10,FMT = "('Date: ',A10,'Time: ',A2,':',A2,':',A2)") date,time(1:2),time(3:4),time(5:6)
        total_money = total_money - money
        WRITE(UNIT = 10,FMT = "(A10,' load',I6,'RMB.')") name,money
        WRITE(UNIT = 10,FMT = "('Bank inventory amount: ',I8,'RMB.')") total_money
        CLOSE(UNIT = 10)
    END SUBROUTINE money_out
    SUBROUTINE money_in(name,money) !存钱
        CHARACTER(LEN = *),INTENT(IN) :: name
        INTEGER(KIND = 4),INTENT(IN) :: money
        CHARACTER(LEN = 20) :: date,time
        CALL date_and_time(date,time)
        OPEN(UNIT = 10,FILE = "e:\bank.txt",POSITION = "APPEND")
        WRITE(UNIT = 10,FMT = "('Date: ',A10,'Time: ',A2,':',A2,':',A2)") date,time(1:2),time(3:4),time(5:6)
        total_money = total_money + money
        WRITE(UNIT = 10,FMT = "(A10,' save',I6,'RMB.')") name,money
        WRITE(UNIT = 10,FMT = "('Bank inventory amount: ',I8,'RMB.')") total_money
        CLOSE(UNIT = 10)
    END SUBROUTINE money_in
END MODULE bank

PROGRAM main
    USE bank
    IMPLICIT NONE
    CALL money_out("Tom",1000)
    CALL money_in("Jerry",2000)
    !WRITE(*,"('Bank inventory amount: ',I8,'RMB.')") total_money !私有变量无法访问
END PROGRAM main

（1）在模块中，派生数据类型的元素对于模块外的程序可以设置为不可访问，但是派生数据类型作为整体仍然可以被外部程序访问，例如：

TYPE :: vector
    PRIVATE
    REAL(KIND = 4) :: x
    REAL(KIND = 4) :: y
END TYPE vector

（2）在模块中，可以将派生数据类型整体声明为私有的，在这种情况下，派生数据类型不能被使用该模块的任何程序访问，这种派生数据类型仅适用于模块内部运算，例如：

TYPE,PRIVATE :: vector
    REAL(KIND = 4) :: x
    REAL(KIND = 4) :: y
END TYPE vector

（3）在模块中，可以将派生数据类型的单个元素声明为私有或公有，这个时候外部程序可以使用派生数据类型整体，也可以访问部分元素，例如：

TYPE :: vector
    REAL(KIND = 4),PUBLIC :: x
    REAL(KIND = 4),PRIVATE :: y
END TYPE vector

（4）在模块中，即使派生数据类型本身是公有的，仍然可以将该类型的某个变量声明为私有，例如：

TYPE :: vector
    REAL(KIND = 4) :: x
    REAL(KIND = 4) :: y
END TYPE vector
TYPE(vector),PRIVATE :: vec

除了通过把模块中某些数据项声明为PRIVATE来限制其他程序的访问外，还可以对使用模块的程序进一步限定所使用的数据项表，并且修改这些数据项的名字。为了限制对模块中特定数据项的访问，可以将ONLY子句添加到USE语句中：

USE module_name,ONLY : only_list

有时候模块中的某个数据项名可能和本地某个局部数据项名或者和同样由该程序单元使用的其他模块中的数据项名相同，这种情况下，重命名该数据项，可以避免一个名字两个定义这样的冲突。亦或是有时候模块中的某个数据项的名称太长，而程序单元又要频繁使用该数据项的时候，重命名不失为一种好方法：

USE module_name,local_name => module_name
USE module_name,ONLY : local_name => module_name

4.4 作用域

一个对象（变量、有名常量、过程名以及语句标号等）的作用范围是程序中定义该对象的那一部分，分为全局范围、局部范围、块范围、语句范围。

块（Block）是Fortran2008新引入的一种结构体类型，它是宿主程序或过程内的任意一段代码块，可以包含任何所需的代码，也可以定义专属局部变量：

PROGRAM main
    IMPLICIT NONE
    INTEGER(KIND = 4) :: a = 1
    WRITE(*,"(I2)") a !1
    BLOCK
        INTEGER(KIND = 4) :: a
        WRITE(*,"(I2)") a !**
        a = 2
        WRITE(*,"(I2)") a !2
    END BLOCK
    WRITE(*,"(I2)") a !1
END PROGRAM main

Fortran程序的不同作用域有：主程序、内部过程、外部过程、模块、派生数据类型的定义、块、接口。这些作用域内的每个局部对象都必须唯一，但是作用域之间的对象可以重用。

如果一个作用域完全包含另外一个作用域，那么前者被称为宿主作用域，后者被称为内层作用域。内层作用域自动继承宿主作用域中声明的对象定义，而在内层作用域中重新定义的同名对象除外，这种继承又被称为宿主关联。如果内部过程使用一个宿主域定义的变量名，且不重新定义它，那么在内部过程中对这个变量的修改也将导致宿主域的该变量被修改。

在模块中定义的对象的作用范围通常就是该模块，但是可以使用USE关联扩大它们的作用范围。如果模块名出现在程序中的USE语句中，那么所有在该模块中定义的对象都会自动变成使用该模块的程序的对象，所以这些对象的名字都必须唯一。

当使用嵌套作用域时，应当避免在内层作用域和外层作用域中对同名对象定义不同的内涵。对于内部过程更是如此，可以通过简单地给它们不同于宿主过程中变量名的名字，而避免在内部过程中发生混淆变量名的现象。

4.5 过程的参数

Fortran程序和它的子例程/函数之间参数的传递方式为地址传递，这个意思是说调用子例程/函数时所传递出去的参数和子例程/函数中接收的参数将会使用相同的内存地址来记录数据，改变形参的值会影响到实参的值：

PROGRAM main
    IMPLICIT NONE
    INTEGER(KIND = 4) :: a = 1,b = 2
    CALL swap(a,b)
    WRITE(*,"('a = ',I2,2X,'b = ',I2)") a,b !a□=□□2,b□=□□1
END PROGRAM main

SUBROUTINE swap(a,b)
    INTEGER(KIND = 4),INTENT(INOUT) :: a,b
    INTEGER(KIND = 4) :: temp
    temp = a
    a = b
    b = temp
END SUBROUTINE swap

如果传递给子例程的参数是一个数组，此时指针指向的是数组中第一个元素的位置，子例程需要同时知道数组的地址和大小，保证不会发生越界才能进行数组操作，当数组作为参数传递时有两种写法：

!（1）显式结构的形参数组
!一维数组作为参数传递
SUBROUTINE sub_for_vector(vec,n)
    IMPLICIT NONE
    INTEGER(KIND = 4),INTENT(IN) :: n !一维数组的大小声明必须放前面
    REAL(KIND = 4),DIMENSION(n),INTENT(IN) :: vec
    ...
END SUBROUTINE sub_for_vector
!二维数组作为参数传递
SUBROUTINE sub_for_matrx(matrx,m,n)
    IMPLICIT NONE
    INTEGER(KIND = 4),INTENT(IN) :: m,n !二维数组的大小声明必须放前面
    REAL(KIND = 4),DIMENSION(m,n),INTENT(IN) :: matrx
    ...
END SUBROUTINE sub_for_matrx

!（2）不定结构的形参数组
MODULE module_for_interface !把子例程放在模块里提供显式接口
    CONTAINS
    !一维数组作为参数传递
    SUBROUTINE sub_for_vector(vec)
        IMPLICIT NONE
        REAL(KIND = 4),DIMENSION(:),INTENT(IN) :: vec
        ...
    END SUBROUTINE sub_for_vector
    !二维数组作为参数传递
    SUBROUTINE sub_for_matrx(matrx)
        IMPLICIT NONE
        REAL(KIND = 4),DIMENSION(:,:),INTENT(IN) :: matrx
        ...
    END SUBROUTINE sub_for_matrx
END MODULE module_for_interface

函数和子例程也可以被当作调用参数来进行传递，这个时候传递的地址是一个指向过程的指针：

!（1）函数作为参数传递
PROGRAM main
    IMPLICIT NONE
    REAL(KIND = 4),EXTERNAL :: func !声明func是函数子程序
    REAL(KIND = 4),INTRINSIC :: SIN !声明SIN是固有函数
    CALL sub_for_func(func) !函数子程序作为参数传递
    CALL sub_for_func(SIN) !固有函数作为参数传递
END PROGRAM main

SUBROUTINE sub_for_func(f)
    IMPLICIT NONE
    !REAL(KIND = 4),EXTERNAL,INTENT(IN) :: f !EXTERNAL和INTENT不能同时出现
    REAL(KIND = 4),EXTERNAL :: f
    WRITE(*,*) f(1.0)
END SUBROUTINE sub_for_func

REAL(KIND = 4) FUNCTION func(num)
    IMPLICIT NONE
    REAL(KIND = 4),INTENT(IN) :: num
    func = num
END FUNCTION func

!（2）子例程作为参数传递
PROGRAM main
    IMPLICIT NONE
    EXTERNAL :: sub !声明sub是子例程
    CALL sub_for_sub(sub) !子例程作为参数传递
END PROGRAM main

SUBROUTINE sub_for_sub(s)
    IMPLICIT NONE
    EXTERNAL :: s
    CALL s()
END SUBROUTINE sub_for_sub
    
SUBROUTINE sub()
    IMPLICIT NONE
    WRITE(*,*) "Hello!"
END SUBROUTINE sub

如果子例程有显式接口，那么它的形参可以是带有ALLOCATABLE属性的可分配数组。此时的可分配数组也可以有INTENT属性。如果有INTENT(IN)属性，那么不允许在子例程中对这个数组分配空间或者释放空间，数组中的值也不能修改；如果有INTENT(INOUT)属性，那么可分配数组可以在子例程的任何位置被释放、重分配或者修改；如果有INTENT(OUT)属性，那么可分配数组在传入子例程的时候就会被自动释放掉，实际数组中的数据全部丢失：

MODULE module_for_interface
    CONTAINS
    SUBROUTINE sub_for_vector(vec) !可分配数组作为参数传递
        IMPLICIT NONE
        INTEGER(KIND = 4) :: i
        INTEGER(KIND = 4),ALLOCATABLE,DIMENSION(:),INTENT(INOUT) :: vec
        IF(ALLOCATED(vec)) THEN
            WRITE(*,*) "The vector has been allocated."
            DEALLOCATE(vec) !回收数组
            ALLOCATE(vec(5)) !按5个元素的大小重新分配空间
            vec = [1,2,3,4,5] !重新赋值
        ELSE
            WRITE(*,*) "The vector has not been allocated yet."
        END IF
        WRITE(*,"(5(I2.2,2X))") (vec(i),i = 1,5)
    END SUBROUTINE sub_for_vector
END MODULE module_for_interface

PROGRAM main
    USE module_for_interface
    IMPLICIT NONE
    INTEGER(KIND = 4) :: i
    INTEGER(KIND = 4),ALLOCATABLE,DIMENSION(:) :: vec
    ALLOCATE(vec(3))
    vec = [(i,i = 1,3)]
    WRITE(*,"(3(I2.2,2X))") (vec(i),i = 1,3)
    CALL sub_for_vector(vec)
END PROGRAM main

同样的，如果函数有显式接口，那么函数的返回值也可以是带有ALLOCATABLE属性的可分配数组，此时形参中的可分配数组不能有INTENT属性：

MODULE module_for_interface
    CONTAINS
    FUNCTION func_for_vector(n) !可分配数组作为返回值
        IMPLICIT NONE
        INTEGER(KIND = 4),INTENT(IN) :: n
        INTEGER(KIND = 4) :: i
        INTEGER(KIND = 4),ALLOCATABLE,DIMENSION(:) :: func_for_vector
        ALLOCATE(func_for_vector(n)) !按n个元素的大小分配空间
        DO i = 1,n
            func_for_vector(i) = i
        END DO
        WRITE(*,"(<n>(I2.2,2X))") (func_for_vector(i),i = 1,n)
        !WRITE(*,"(I2.2,2X,$)") (func_for_vector(i),i = 1,n)
    END FUNCTION func_for_vector
END MODULE module_for_interface

PROGRAM main
    USE module_for_interface
    IMPLICIT NONE
    INTEGER(KIND = 4) :: n = 5
    INTEGER(KIND = 4),ALLOCATABLE,DIMENSION(:) :: vec
    vec = func_for_vector(n)
    DEALLOCATE(vec)
END PROGRAM main

如果传递给子例程的参数是一个不定长度的字符串变量，这时需要用*来声明其长度。下面这个子例程将字符串中的所有小写字母转换成大写字母：

SUBROUTINE lowercase_to_capital(str)
    IMPLICIT NONE
    INTEGER(KIND = 4) :: i
    CHARACTER(LEN = *),INTENT(INOUT) :: str
    DO i = 1,LEN_TRIM(str)
        IF(LGT(str(i:i),"a") .AND. LLE(str(i:i),"z")) THEN
            str(i:i) = ACHAR(IACHAR(str(i:i)) - 32)
        END IF
    END DO
END SUBROUTINE lowercase_to_capital

同样，不定长度的字符串变量数组也可以作为参数传递给子例程。下面这个程序将字符串变量数组中的元素进行排序：

PROGRAM main
    IMPLICIT NONE
    INTEGER(KIND = 4) :: i
    CHARACTER(LEN = 10),DIMENSION(4) :: str_vec = ["Fortran","fortran","Matlab","matlab"]
    DO i = 1,4
        str_vec(i) = TRIM(str_vec(i)) !去除尾部空格
    END DO
    CALL sort_str_vec(str_vec,4)
    WRITE(*,"(4(A7,2X))") (str_vec(i),i = 1,4) !Fortran□□Matlab□□□fortran□□matlab
END PROGRAM main

SUBROUTINE sort_str_vec(str_vec,n)
    IMPLICIT NONE
    INTEGER(KIND = 4) :: i,j,min_index
    INTEGER(KIND = 4),INTENT(IN) :: n
    CHARACTER(LEN = *),DIMENSION(n),INTENT(INOUT) :: str_vec
    CHARACTER(LEN = LEN(str_vec)) :: temp_str !LEN(str_vec)求的是str_vec中字符串的定义长度
    DO i = 1,n-1
        min_index = i
        DO j = i + 1,n
            IF(LLT(str_vec(j),str_vec(min_index))) min_index = j
        END DO
        IF(i /= min_index) THEN
            temp_str = str_vec(i)
            str_vec(i) = str_vec(min_index)
            str_vec(min_index) = temp_str
        END IF
    END DO
END SUBROUTINE sort_str_vec

不定长度的字符串变量也可以作为函数的返回值，这个时候需要提供显示接口。接下来顺带复习一下三种提供显示接口的方法：

!（1）用模块提供函数的显式接口
MODULE module_for_str_func
    CONTAINS
    FUNCTION str_func(n)
        IMPLICIT NONE
        INTEGER(KIND = 4),INTENT(IN) :: n
        CHARACTER(LEN = n) :: str_func
        CHARACTER(LEN = 26) :: alphabet = "abcdefghijklmnopqrstuvwxyz"
        str_func = alphabet(1:n)
    END FUNCTION str_func
END MODULE module_for_str_func
    
PROGRAM main
    USE module_for_str_func
    IMPLICIT NONE
    INTEGER(KIND = 4) :: n = 3
    WRITE(*,"(A<n>)") str_func(n) !abc
    !WRITE(*,"(A)") str_func(n) !abc
END PROGRAM main

!（2）用接口块提供函数的显式接口
PROGRAM main
    IMPLICIT NONE
    INTERFACE
        FUNCTION str_func(n)
            IMPLICIT NONE
            INTEGER(KIND = 4),INTENT(IN) :: n
            CHARACTER(LEN = n) :: str_func
        END FUNCTION str_func
    END INTERFACE
    INTEGER(KIND = 4) :: n = 3
    WRITE(*,"(A<n>)") str_func(n)
END PROGRAM main

FUNCTION str_func(n)
    IMPLICIT NONE
    INTEGER(KIND = 4),INTENT(IN) :: n
    CHARACTER(LEN = n) :: str_func
    CHARACTER(LEN = 26) :: alphabet = "abcdefghijklmnopqrstuvwxyz"
    str_func = alphabet(1:n)
END FUNCTION str_func

!（3）直接将函数放在主函数中作为内部函数也相当于提供了显示接口
PROGRAM main
    IMPLICIT NONE
    INTEGER(KIND = 4) :: n = 3
    WRITE(*,"(A<n>)") str_func(n)
    CONTAINS
    FUNCTION str_func(n)
        IMPLICIT NONE
        INTEGER(KIND = 4),INTENT(IN) :: n
        CHARACTER(LEN = n) :: str_func
        CHARACTER(LEN = 26) :: alphabet = "abcdefghijklmnopqrstuvwxyz"
        str_func = alphabet(1:n)
    END FUNCTION str_func
END PROGRAM main

如果过程接口是显式的，那么就可以通过使用关键字参数改变传递给过程的实参顺序：

MODULE module_test
    IMPLICIT NONE
    CONTAINS
    REAL(KIND = 4) FUNCTION func(first,second,third)
        IMPLICIT NONE
        REAL(KIND = 4),INTENT(IN) :: first,second,third
        func = (first - second) / third
    END FUNCTION func
END MODULE module_test
    
PROGRAM main
    USE module_test
    IMPLICIT NONE
    WRITE(*,*) func(1.0,2.0,3.0) !-0.3333333
    WRITE(*,*) func(first=1.0,second=2.0,third=3.0) !-0.3333333
    WRITE(*,*) func(second=2.0,first=1.0,third=3.0) !-0.3333333
    WRITE(*,*) func(1.0,third=3.0,second=2.0) !-0.3333333
    !一旦一个关键字参数出现在参数列表中，那么该位置往后的其他参数都必须是关键字参数
END PROGRAM main

关键字参数这项技术本身没有什么实际用处，看上去只是为了多敲一些字符，结果却是一样的，但是当使用带有OPTIONAL属性的可选参数时，关键字参数就非常有用了。可选参数是指在调用过程中不一定会出现的过程形参，它仅可用于有显式接口的过程中。包含可选参数的过程必须要有办法确定该过程执行时可选参数是否出现，这个办法就是用Fortran自带的逻辑函数PRESENT来判断。下面这个程序可以根据用户的偏好搜索数组中最大或最小值，并且可以定位其在数组中的位置的程序：

MODULE module_for_extremes
    IMPLICIT NONE
    CONTAINS
    SUBROUTINE extremes(vec,n,maxval,maxindx,minval,minindx)
        IMPLICIT NONE
        INTEGER(KIND = 4),INTENT(IN) :: n
        REAL(KIND = 4),INTENT(IN),DIMENSION(n) :: vec
        !可选参数
        REAL(KIND = 4),INTENT(OUT),OPTIONAL :: maxval
        INTEGER(KIND = 4),INTENT(OUT),OPTIONAL :: maxindx
        REAL(KIND = 4),INTENT(OUT),OPTIONAL :: minval
        INTEGER(KIND = 4),INTENT(OUT),OPTIONAL :: minindx
        !临时变量
        REAL(KIND = 4) :: max_val,min_val
        INTEGER(KIND = 4) :: i,max_indx,min_indx
        max_val = vec(1)
        min_val = vec(1)
        max_indx = 1
        min_indx = 1
        DO i = 2,n
            !寻找最大值
            IF(vec(i) > max_val) THEN
                max_val = vec(i)
                max_indx = i
            END IF
            !寻找最小值
            IF(vec(i) < min_val) THEN
                min_val = vec(i)
                min_indx = i
            END IF
        END DO
        !报告结果
        IF(PRESENT(maxval)) THEN
            maxval = max_val
        END IF
        IF(PRESENT(maxindx)) THEN
            maxindx = max_indx
        END IF
        IF(PRESENT(minval)) THEN
            minval = min_val
        END IF
        IF(PRESENT(minindx)) THEN
            minindx = min_indx
        END IF
    END SUBROUTINE extremes
END MODULE module_for_extremes
    
PROGRAM main
    USE module_for_extremes
    IMPLICIT NONE
    INTEGER(KIND = 4) :: n = 5
    REAL(KIND = 4),DIMENSION(5) :: vec = [3,1,2,5,4]
    REAL(KIND = 4) :: min_val
    INTEGER(KIND = 4) :: min_indx
    CALL extremes(vec,n,minval=min_val,minindx=min_indx)
    WRITE(*,*) min_val,min_indx
END PROGRAM main

4.6 特殊过程

纯过程（Pure Procedure）是没有任何负面影响的过程，也就是说它不会修改输入参数的值，也不会修改任何在函数外部可见的其他数据（比如模块中的数据）。分为纯函数（Pure Function）和纯子例程（Pure Subroutine）。

PURE FUNCTION pure_func(x,y) !纯函数
    IMPLICIT NONE
    INTEGER(KIND = 4),INTENT(IN) :: x,y
    INTEGER(KIND = 4) :: pure_func
    pure_func = x + y
END FUNCTION pure_func

PURE SUBROUTINE pure_sub(x,y,sum) !纯子例程
    IMPLICIT NONE
    INTEGER(KIND = 4),INTENT(IN) :: x,y
    INTEGER(KIND = 4),INTENT(OUT) :: sum
    sum = x + y
END SUBROUTINE pure_sub

（1）纯过程中的局部变量不可以有SAVE属性。
（2）在纯过程中也不可以在类型声明的同时初始化局部变量，因为这一初始化含有SAVE属性。
（3）任何被纯过程调用的过程也必须是纯过程。
（4）在纯函数中每个参数都必须定义为INTENT(IN)属性。
（5）纯过程不能有任何外部文件I/O操作。
（6）纯过程不能包含STOP语句。

在普通过程前面加上ELEMENTAL关键字的过程被称为逐元过程（Elemental Procedure）。分为逐元函数（Elemental Function）和逐元子例程（Elemental Subroutine）。逐元过程的形参必须是标量，但是它的输入参数可以是标量也可以是数组。如果一个逐元函数的参数是标量，那么它的返回值也是标量；如果一个逐元函数的参数是数组，那么它的返回值也是和输入参数相同结构的数组。用户自定义的逐元函数一定是纯函数，所有的形参以及函数返回值都必须是标量并且不能带有POINTER属性。

如果逐元过程被设计成可以修改其输入参数，这样它就成了不纯逐元过程（Impure Elemental Procedure），被修改的参数必须用INTENT(INOUT)属性。

PROGRAM main
    IMPLICIT NONE
    REAL(KIND = 4) :: x = 3.0,y = 4.0
    REAL(KIND = 4),EXTERNAL :: impure_elemental_func !声明是外部函数
    WRITE(*,"(F3.1)") impure_elemental_func(x,y) !5.0
END PROGRAM main
    
IMPURE ELEMENTAL REAL(KIND = 4) FUNCTION impure_elemental_func(x,y)
    IMPLICIT NONE
    REAL(KIND = 4),INTENT(INOUT) :: x,y
    x = x**2
    y = y**2
    impure_elemental_func = SQRT(x + y)
END FUNCTION impure_elemental_func

过程除了可以让别人调用，还可以自己调用自己，这叫做递归（recursion）。比较经典的案例是用递归计算阶乘：
$$n!=\{\begin{array}{l}n(n-1)!,n\ge 1\\ 1,n=0\end{array}$$

PROGRAM main
    IMPLICIT NONE
    INTEGER :: n = 5,ans
    INTEGER,EXTERNAL :: func_for_fact
    CALL sub_for_fact(n,ans)
    WRITE(*,*) ans
    WRITE(*,*) func_for_fact(n)
END PROGRAM main

!递归子例程
RECURSIVE SUBROUTINE sub_for_fact(n,ans)
    IMPLICIT NONE
    INTEGER(KIND = 4),INTENT(IN) :: n
    INTEGER(KIND = 4),INTENT(OUT) :: ans
    INTEGER(KIND = 4) :: temp
    IF(n >= 1) THEN
        CALL sub_for_fact(n-1,temp)
        ans = n * temp
    ELSE IF(n == 0) THEN
        ans = 1
    ELSE
        ans = -1 !计算结果无意义
    END IF
END SUBROUTINE sub_for_fact

!递归函数
RECURSIVE INTEGER(KIND = 4) FUNCTION func_for_fact(n) RESULT(ans) !递归函数必须使用RESULT来改名
    IMPLICIT NONE
    INTEGER(KIND = 4),INTENT(IN) :: n
    IF(n >= 1) THEN
        ans = n * func_for_fact(n-1)
    ELSE IF(n == 0) THEN
        ans = 1
    ELSE
        ans = -1 !计算结果无意义
    END IF
END FUNCTION func_for_fact

4.7 接口块

虽说将过程放在模块中也可以创建显式接口，但不幸的是，有时将过程放在模块中并不是很方便甚至不太可能。例如，假设一个技术组织有一个由成百上千个子例程和函数构成的函数库，这些子例程或函数都是用Fortran的早期版本所写，这个库函数却想用在新版本的程序中。重写所有的过程和函数，将它们放在模块中，并且添加诸如INTENT属性的显式接口会带来很大的问题，因为如果按照这种方式修改过程，老版本的程序可能就不能使用这些函数了，这并不是大多数组织想要的结果。因此接口块才是最优选择：

INTERFACE
    interface_body
END INTERFACE

interface_body由相应外部过程的初始SUBROUTINE语句、FUNCTION语句、与过程参数相关的类型声明语句、END SUBROUTINE语句、END FUNCTION语句组成，这些语句为编译器给出了调用程序和外部过程之间接口一致性检查的足够信息。下面这个程序示例了用接口块提供显式接口让函数可以返回数组的方法：

PROGRAM main
    IMPLICIT NONE
    INTERFACE
        FUNCTION random_vector(a,b,n) RESULT(vec)
            IMPLICIT NONE
            REAL(KIND = 4),INTENT(IN) :: a,b
            INTEGER(KIND = 4),INTENT(IN) :: n
            REAL(KIND = 4),ALLOCATABLE,DIMENSION(:) :: vec
            INTEGER(KIND = 4) :: i
            REAL(KIND = 4) :: temp
        END FUNCTION random_vector
    END INTERFACE
    INTEGER(KIND = 4) :: n = 10
    REAL(KIND = 4),ALLOCATABLE,DIMENSION(:) :: vec
    vec = random_vector(1.0,10.0,n)
    WRITE(*,"(<n>F6.2)") vec
    DEALLOCATE(vec)
END PROGRAM main

FUNCTION random_vector(a,b,n) RESULT(vec)
    IMPLICIT NONE
    REAL(KIND = 4),INTENT(IN) :: a,b
    INTEGER(KIND = 4),INTENT(IN) :: n
    REAL(KIND = 4),ALLOCATABLE,DIMENSION(:) :: vec
    INTEGER(KIND = 4) :: i
    REAL(KIND = 4) :: temp
    ALLOCATE(vec(n))
    CALL random_seed() !调用随机数函数之前必须调用随机数种子
    DO i = 1,n
        CALL random_number(temp) !产生0~1之间的随机数，用temp接收
        vec(i) = a + (b - a) * temp !产生a~b之间的随机数
    END DO
END FUNCTION random_vector

（1）如果一个过程在模块中已经被定义，此时如果再给过程提供接口块，会造成显式接口二次定义，是非法的。
（2）接口块常用于为用早期版本的Fortran、其他语言所写、独立编译的过程提供显式接口，在这种情况下，写一个接口块就能让现代Fortran程序有一个对所有参数进行检测的显式接口，同时也让旧版的Fortran或非Fortran程序可以不需做任何改变而被现代Fortran所使用。
（3）每个接口都是一个独立的作用域，同样的变量名可以出现在接口和包含该接口的同一程序中而不引起混乱。
（4）接口块中的形参必须与相应过程的形参在类型、方向及数组大小等方面相同，但是它们的名字可以不相同。然而，没必要在接口中更换这些参数的名字。

4.8 通用过程

通用过程是指能够操作多种不同数据类型的过程。比如ABS函数，不管输入数据是整型数还是实型数甚至是复数，它都可以得到正确的结果。除了嵌入在编译器中的标准过程外，Fortran还允许用户定义自己的通用过程。如果给INTERFACE语句加上一个通用名，那么在接口块中定义的每个过程接口都可以看作一个特定版本的通用过程，这种接口块被称为通用接口块，当编译器在程序中遇到这个含有通用接口块的通用过程名时，它会检查调用这个通用过程的参数，以便确定应该使用哪个特定的过程：

INTERFACE generic_name
    specific_interface_body_1
    specific_interface_body_2
    ...
END INTERFACE [generic_name]

例如，可能想要定义一个通用子例程sort，能够对整型数、单精度实型数、双精度实型数或者字符数据进行排序，具体对哪种数据排序依赖于输入的参数：

PROGRAM main
    IMPLICIT NONE
    INTERFACE sort
        SUBROUTINE sort_int(vec,n)
            IMPLICIT NONE
            INTEGER(KIND = 4),INTENT(IN) :: n
            INTEGER(KIND = 4),INTENT(INOUT),DIMENSION(n) :: vec
            INTEGER(KIND = 4) :: i,j
            INTEGER(KIND = 4) :: temp
        END SUBROUTINE sort_int
        SUBROUTINE sort_single_real(vec,n)
            IMPLICIT NONE
            INTEGER(KIND = 4),INTENT(IN) :: n
            REAL(KIND = 4),INTENT(INOUT),DIMENSION(n) :: vec
            INTEGER(KIND = 4) :: i,j
            REAL(KIND = 4) :: temp
        END SUBROUTINE sort_single_real
        SUBROUTINE sort_double_real(vec,n)
            IMPLICIT NONE
            INTEGER(KIND = 4),INTENT(IN) :: n
            REAL(KIND = 8),INTENT(INOUT),DIMENSION(n) :: vec
            INTEGER(KIND = 4) :: i,j
            REAL(KIND = 8) :: temp
        END SUBROUTINE sort_double_real
        SUBROUTINE sort_char(vec,n)
            IMPLICIT NONE
            INTEGER(KIND = 4),INTENT(IN) :: n
            CHARACTER(LEN = *),INTENT(INOUT),DIMENSION(n) :: vec
            INTEGER(KIND = 4) :: i,j
            CHARACTER(LEN = LEN(vec)) :: temp
        END SUBROUTINE sort_char
    END INTERFACE sort
    INTEGER(KIND = 4) :: n = 5
    INTEGER(KIND = 4),DIMENSION(5) :: int_vec = [2,1,5,4,3]
    REAL(KIND = 4),DIMENSION(5) :: single_real_vec = [2.0,1.0,5.0,4.0,3.0]
    REAL(KIND = 8),DIMENSION(5) :: double_real_vec = [2.0_8,1.0_8,5.0_8,4.0_8,3.0_8]
    CHARACTER(LEN = 10),DIMENSION(5) :: char_vec = ["12","21","11","22","23"]
    CALL sort(int_vec,n)
    CALL sort(single_real_vec,n)
    CALL sort(double_real_vec,n)
    CALL sort(char_vec,n)
    WRITE(*,*) int_vec
    WRITE(*,*) single_real_vec
    WRITE(*,*) double_real_vec
    WRITE(*,*) char_vec
END PROGRAM main
    
SUBROUTINE sort_int(vec,n)
    IMPLICIT NONE
    INTEGER(KIND = 4),INTENT(IN) :: n
    INTEGER(KIND = 4),INTENT(INOUT),DIMENSION(n) :: vec
    INTEGER(KIND = 4) :: i,j
    INTEGER(KIND = 4) :: temp
    !冒泡排序算法
    DO i = 1,n - 1
        DO j = i + 1,n
            IF(vec(i) > vec(j)) THEN
                temp = vec(i)
                vec(i) = vec(j)
                vec(j) = temp
            END IF
        END DO
    END DO
END SUBROUTINE sort_int
SUBROUTINE sort_single_real(vec,n)
    IMPLICIT NONE
    INTEGER(KIND = 4),INTENT(IN) :: n
    REAL(KIND = 4),INTENT(INOUT),DIMENSION(n) :: vec
    INTEGER(KIND = 4) :: i,j
    REAL(KIND = 4) :: temp
    DO i = 1,n - 1
        DO j = i + 1,n
            IF(vec(i) > vec(j)) THEN
                temp = vec(i)
                vec(i) = vec(j)
                vec(j) = temp
            END IF
        END DO
    END DO
END SUBROUTINE sort_single_real
SUBROUTINE sort_double_real(vec,n)
    IMPLICIT NONE
    INTEGER(KIND = 4),INTENT(IN) :: n
    REAL(KIND = 8),INTENT(INOUT),DIMENSION(n) :: vec
    INTEGER(KIND = 4) :: i,j
    REAL(KIND = 8) :: temp
    DO i = 1,n - 1
        DO j = i + 1,n
            IF(vec(i) > vec(j)) THEN
                temp = vec(i)
                vec(i) = vec(j)
                vec(j) = temp
            END IF
        END DO
    END DO
END SUBROUTINE sort_double_real
SUBROUTINE sort_char(vec,n)
    IMPLICIT NONE
    INTEGER(KIND = 4),INTENT(IN) :: n
    CHARACTER(LEN = *),INTENT(INOUT),DIMENSION(n) :: vec
    INTEGER(KIND = 4) :: i,j
    CHARACTER(LEN = LEN(vec)) :: temp !LEN(vec)表示vec数组中的字符串的定义长度
    DO i = 1,n - 1
        DO j = i + 1,n
            IF(vec(i) > vec(j)) THEN
                temp = vec(i)
                vec(i) = vec(j)
                vec(j) = temp
            END IF
        END DO
    END DO
END SUBROUTINE sort_char

前面提到，“如果一个过程在模块中已经被定义，此时如果再给过程提供接口块，会造成显式接口二次定义，是非法的”。但是如果想要将通用过程的每个特定过程都写入模块当中该怎么办呢？Fortran提供了一个专门用在通用接口块中的MODULE PROCEDURE语句：

INTERFACE generic_name
    MODULE PROCEDURE specific_procedure_name_1
    MODULE PROCEDURE specific_procedure_name_2
    ...
END INTERFACE [generic_name]

下面的程序用这一技术改写了上一个例子：

MODULE generic_sort
    IMPLICIT NONE
    INTEGER,PARAMETER :: SGL = SELECTED_REAL_KIND(P=6)
    INTEGER,PARAMETER :: DBL = SELECTED_REAL_KIND(P=13)
    INTERFACE sort
        MODULE PROCEDURE sort_int
        MODULE PROCEDURE sort_single_real
        MODULE PROCEDURE sort_double_real
        MODULE PROCEDURE sort_char
    END INTERFACE sort
    CONTAINS
    SUBROUTINE sort_int(vec,n)
        IMPLICIT NONE
        INTEGER(KIND = 4),INTENT(IN) :: n
        INTEGER(KIND = 4),INTENT(INOUT),DIMENSION(n) :: vec
        INTEGER(KIND = 4) :: i,j
        INTEGER(KIND = 4) :: temp
        DO i = 1,n - 1
            DO j = i + 1,n
                IF(vec(i) > vec(j)) THEN
                    temp = vec(i)
                    vec(i) = vec(j)
                    vec(j) = temp
                END IF
            END DO
        END DO
    END SUBROUTINE sort_int
    SUBROUTINE sort_single_real(vec,n)
        IMPLICIT NONE
        INTEGER(KIND = 4),INTENT(IN) :: n
        REAL(KIND = 4),INTENT(INOUT),DIMENSION(n) :: vec
        INTEGER(KIND = 4) :: i,j
        REAL(KIND = 4) :: temp
        DO i = 1,n - 1
            DO j = i + 1,n
                IF(vec(i) > vec(j)) THEN
                    temp = vec(i)
                    vec(i) = vec(j)
                    vec(j) = temp
                END IF
            END DO
        END DO
    END SUBROUTINE sort_single_real
    SUBROUTINE sort_double_real(vec,n)
        IMPLICIT NONE
        INTEGER(KIND = 4),INTENT(IN) :: n
        REAL(KIND = 8),INTENT(INOUT),DIMENSION(n) :: vec
        INTEGER(KIND = 4) :: i,j
        REAL(KIND = 8) :: temp
        DO i = 1,n - 1
            DO j = i + 1,n
                IF(vec(i) > vec(j)) THEN
                    temp = vec(i)
                    vec(i) = vec(j)
                    vec(j) = temp
                END IF
            END DO
        END DO
    END SUBROUTINE sort_double_real
    SUBROUTINE sort_char(vec,n)
        IMPLICIT NONE
        INTEGER(KIND = 4),INTENT(IN) :: n
        CHARACTER(LEN = *),INTENT(INOUT),DIMENSION(n) :: vec
        INTEGER(KIND = 4) :: i,j
        CHARACTER(LEN = LEN(vec)) :: temp
        DO i = 1,n - 1
            DO j = i + 1,n
                IF(vec(i) > vec(j)) THEN
                    temp = vec(i)
                    vec(i) = vec(j)
                    vec(j) = temp
                END IF
            END DO
        END DO
    END SUBROUTINE sort_char
END MODULE generic_sort
    
PROGRAM main
    USE generic_sort
    IMPLICIT NONE
    INTEGER(KIND = 4) :: n = 5
    INTEGER(KIND = 4),DIMENSION(5) :: int_vec = [2,1,5,4,3]
    REAL(KIND = 4),DIMENSION(5) :: single_real_vec = [2.0,1.0,5.0,4.0,3.0]
    REAL(KIND = 8),DIMENSION(5) :: double_real_vec = [2.0_8,1.0_8,5.0_8,4.0_8,3.0_8]
    CHARACTER(LEN = 10),DIMENSION(5) :: char_vec = ["12","21","11","22","23"]
    CALL sort(int_vec,n)
    CALL sort(single_real_vec,n)
    CALL sort(double_real_vec,n)
    CALL sort(char_vec,n)
    WRITE(*,*) int_vec
    WRITE(*,*) single_real_vec
    WRITE(*,*) double_real_vec
    WRITE(*,*) char_vec
END PROGRAM main

下面再来看一个简单的根据用户输入的参数的个数来求方程的根的例子：

MODULE generic_solve
    IMPLICIT NONE
    INTERFACE solve
        MODULE PROCEDURE solve1
        MODULE PROCEDURE solve2
    END INTERFACE solve
    CONTAINS
    REAL(KIND = 4) FUNCTION solve1(a,b) !解一元一次方程ax+b=0
        REAL(KIND = 4),INTENT(IN) :: a,b
        solve1 = - b / a
    END FUNCTION solve1
    FUNCTION solve2(a,b,c) !解一元二次方程ax^2+bx+c=0
        REAL(KIND = 4),INTENT(IN) :: a,b,c
        REAL(KIND = 4),DIMENSION(2) :: solve2
        REAL(KIND = 4) :: delta
        delta = b * b - 4 * a * c
        IF(delta < 0) THEN
            WRITE(*,*) "The equation has no solution!"
            STOP
        ELSE IF(delta == 0) THEN
            solve2(1) = - b / (2 * a)
            solve2(2) = solve2(1)
        ELSE
            solve2(1) = (-b + SQRT(delta)) / (2 * a)
            solve2(2) = (-b - SQRT(delta)) / (2 * a)
        END IF
    END FUNCTION solve2
END MODULE generic_solve

PROGRAM main
    USE generic_solve
    IMPLICIT NONE
    WRITE(*,*) solve(1.0,2.0) !-2
    WRITE(*,*) solve(1.0,3.0,2.0) !-1 -2
END PROGRAM main

派生数据类型所绑定的过程也可以是通用的，这些过程需要使用GENERIC语句声明。下面这个程序示例了用通用类型绑定过程实现矢量加矢量或矢量加标量的功能：

MODULE generic_bind_procedure
    IMPLICIT NONE
    TYPE :: vector
        REAL(KIND = 4) :: x
        REAL(KIND = 4) :: y
        CONTAINS
        GENERIC :: add => vector_add_vector,vector_add_scalar
        PROCEDURE,PASS :: vector_add_vector
        PROCEDURE,PASS :: vector_add_scalar
    END TYPE vector
    CONTAINS
    TYPE(vector) FUNCTION vector_add_vector(this_vec,that_vec)
        IMPLICIT NONE
        CLASS(vector),INTENT(IN) :: this_vec,that_vec
        vector_add_vector%x = this_vec%x + that_vec%x
        vector_add_vector%y = this_vec%y + that_vec%y
    END FUNCTION vector_add_vector
    TYPE(vector) FUNCTION vector_add_scalar(this_vec,that_scalar)
        IMPLICIT NONE
        CLASS(vector),INTENT(IN) :: this_vec
        REAL(KIND = 4),INTENT(IN) :: that_scalar
        vector_add_scalar%x = this_vec%x + that_scalar
        vector_add_scalar%y = this_vec%y + that_scalar
    END FUNCTION vector_add_scalar
END MODULE generic_bind_procedure

PROGRAM main
    USE generic_bind_procedure
    IMPLICIT NONE
    TYPE(vector) :: vec1 = vector(1.0,2.0)
    TYPE(vector) :: vec2 = vector(3.0,4.0)
    REAL(KIND = 4) :: scalar = 5.0
    WRITE(*,*) vec1%add(vec2) !4 6
    WRITE(*,*) vec1%add(scalar) !6 7
END PROGRAM main

4.9 运算符重载

一般的运算符重载接口块写法如下：

!当函数不在模块中时
INTERFACE OPERATOR(operator_symbol)
    specific_interface_body_1
    specific_interface_body_2
    ...
END INTERFACE [OPERATOR(operator_symbol)]

!当函数在模块中时
INTERFACE OPERATOR(operator_symbol)
    MODULE PROCEDURE function_name_1
    MODULE PROCEDURE function_name_2
    ...
END INTERFACE [OPERATOR(operator_symbol)]

其中operator_symbol是任何标准的内置运算符（+、-、×、÷、＞、＜等）或用户自定义的操作符。用户自定义的操作符是以点号开头和结束的最长包含63个字符的序列（数字和下划线不允许出现在操作符名中），例如.INVERSE.就是一个用户自定义的操作符。一旦定义了操作符，它作为对函数的引用来处理。

（1）同一个操作符可以关联多个函数，这些函数通过形参的类型的不同而区分开。
（2）如果与同一个操作符关联的函数只有一个形参，那么该操作符就是一元操作符；如果有两个形参，那么就是二元操作符。
（3）对于二元操作符而言，操作符左边的操作数是该函数的第一个参数，右边的是第二个。

赋值运算符（=）重载接口块写法如下：

!当子例程不在模块中时
INTERFACE ASSIGNMENT(=)
    specific_interface_body_1
    specific_interface_body_2
    ...
END INTERFACE [ASSIGNMENT(=)]

!当子例程在模块中时
INTERFACE ASSIGNMENT(=)
    MODULE PROCEDURE subroutine_name_1
    MODULE PROCEDURE subroutine_name_2
    ...
END INTERFACE [ASSIGNMENT(=)]

（1）对于赋值运算符来说，接口体必须指向子例程而不是函数。
（2）同一个赋值运算符可以关联多个子例程，这些子例程通过形参的类型的不同而区分开。
（3）子例程必须有两个参数。第一个参数是赋值语句的输出，相当于赋值语句左边的数据，必须以INTENT(OUT)说明；第二个参数是赋值语句的输入，相当于赋值语句右边的数据，必须以INTENT(IN)说明。

例：创建一个名为vector的派生数据类型矢量，该类型拥有3个元素x、y、z。定义9个函数分别完成：将数组转化为矢量、将矢量转化为数组、矢量加矢量、矢量减矢量、矢量乘标量、标量乘矢量、矢量除标量、矢量点乘、矢量叉乘。

MODULE vectors_operation
    IMPLICIT NONE
    PRIVATE !程序不需要访问模块中的子例程或函数
    PUBLIC :: vector,ASSIGNMENT(=),OPERATOR(+),OPERATOR(-),&
              &OPERATOR(*),OPERATOR(/),OPERATOR(.DOT.),OPERATOR(.CROSS.)
    !定义矢量数据类型
    TYPE :: vector
        REAL(KIND = 4) :: x
        REAL(KIND = 4) :: y
        REAL(KIND = 4) :: z
    END TYPE vector
    !操作符重载接口
    INTERFACE ASSIGNMENT(=)
        MODULE PROCEDURE array_to_vector !将数组转化为矢量
        MODULE PROCEDURE vector_to_array !将矢量转化为数组
    END INTERFACE ASSIGNMENT(=)
    INTERFACE OPERATOR(+)
        MODULE PROCEDURE vector_add_vector !矢量加矢量
    END INTERFACE OPERATOR(+)
    INTERFACE OPERATOR(-)
        MODULE PROCEDURE vector_subtract_vector !矢量减矢量
    END INTERFACE OPERATOR(-)
    INTERFACE OPERATOR(*)
        MODULE PROCEDURE vector_times_scalar !矢量乘标量
        MODULE PROCEDURE scalar_times_vector !标量乘矢量
    END INTERFACE OPERATOR(*)
    INTERFACE OPERATOR(/)
        MODULE PROCEDURE vector_div_scalar !矢量除标量
    END INTERFACE OPERATOR(/)
    INTERFACE OPERATOR(.DOT.)
        MODULE PROCEDURE vector_dot_vector !矢量点乘
    END INTERFACE OPERATOR(.DOT.)
    INTERFACE OPERATOR(.CROSS.)
        MODULE PROCEDURE vector_cross_vector !矢量叉乘
    END INTERFACE OPERATOR(.CROSS.)
    CONTAINS
    !过程的实现
    SUBROUTINE array_to_vector(vec,arr) !将数组转化为矢量
        IMPLICIT NONE
        REAL(KIND = 4),INTENT(IN),DIMENSION(3) :: arr
        TYPE(vector),INTENT(OUT) :: vec
        vec%x = arr(1)
        vec%y = arr(2)
        vec%z = arr(3)
    END SUBROUTINE array_to_vector
    SUBROUTINE vector_to_array(arr,vec) !将矢量转化为数组
        IMPLICIT NONE
        TYPE(vector),INTENT(IN) :: vec
        REAL(KIND = 4),INTENT(OUT),DIMENSION(3) :: arr
        arr(1) = vec%x
        arr(2) = vec%y
        arr(3) = vec%z
    END SUBROUTINE vector_to_array
    TYPE(vector) FUNCTION vector_add_vector(vec1,vec2) !矢量加矢量
        IMPLICIT NONE
        TYPE(vector),INTENT(IN) :: vec1,vec2
        vector_add_vector%x = vec1%x + vec2%x
        vector_add_vector%y = vec1%y + vec2%y
        vector_add_vector%z = vec1%z + vec2%z
    END FUNCTION vector_add_vector
    TYPE(vector) FUNCTION vector_subtract_vector(vec1,vec2) !矢量减矢量
        IMPLICIT NONE
        TYPE(vector),INTENT(IN) :: vec1,vec2
        vector_subtract_vector%x = vec1%x - vec2%x
        vector_subtract_vector%y = vec1%y - vec2%y
        vector_subtract_vector%z = vec1%z - vec2%z
    END FUNCTION vector_subtract_vector
    TYPE(vector) FUNCTION vector_times_scalar(vec,s) !矢量乘标量
        IMPLICIT NONE
        TYPE(vector),INTENT(IN) :: vec
        REAL(KIND = 4),INTENT(IN) :: s
        vector_times_scalar%x = vec%x * s
        vector_times_scalar%y = vec%y * s
        vector_times_scalar%z = vec%z * s
    END FUNCTION vector_times_scalar
    TYPE(vector) FUNCTION scalar_times_vector(s,vec) !标量乘矢量
        IMPLICIT NONE
        REAL(KIND = 4),INTENT(IN) :: s
        TYPE(vector),INTENT(IN) :: vec
        scalar_times_vector%x = s * vec%x
        scalar_times_vector%y = s * vec%y
        scalar_times_vector%z = s * vec%z
    END FUNCTION scalar_times_vector
    TYPE(vector) FUNCTION vector_div_scalar(vec,s) !矢量除标量
        IMPLICIT NONE
        TYPE(vector),INTENT(IN) :: vec
        REAL(KIND = 4),INTENT(IN) :: s
        vector_div_scalar%x = vec%x / s
        vector_div_scalar%y = vec%y / s
        vector_div_scalar%z = vec%z / s
    END FUNCTION vector_div_scalar
    REAL(KIND = 4) FUNCTION vector_dot_vector(vec1,vec2) !矢量点乘
        IMPLICIT NONE
        TYPE(vector),INTENT(IN) :: vec1,vec2
        vector_dot_vector = vec1%x * vec2%x + vec1%y * vec2%y + vec1%z * vec2%z
    END FUNCTION vector_dot_vector
    TYPE(vector) FUNCTION vector_cross_vector(vec1,vec2) !矢量叉乘
        IMPLICIT NONE
        TYPE(vector),INTENT(IN) :: vec1,vec2
        vector_cross_vector%x = vec1%y * vec2%z - vec1%z * vec2%y
        vector_cross_vector%y = vec1%z * vec2%x - vec1%x * vec2%z
        vector_cross_vector%z = vec1%x * vec2%y - vec1%y * vec2%x
    END FUNCTION vector_cross_vector
END MODULE vectors_operation
    
PROGRAM main
    USE vectors_operation
    IMPLICIT NONE
    REAL(KIND = 4),DIMENSION(3) :: arr1,arr2
    TYPE(vector) :: vec1,vec2
    REAL(KIND = 4) :: s = 10.0
    arr1 = [1.0,2.0,3.0]
    arr2 = [4.0,5.0,6.0]
    vec1 = arr1
    vec2 = arr2
    WRITE(*,*) vec1 + vec2
    WRITE(*,*) vec1 - vec2
    WRITE(*,*) vec1 * s
    WRITE(*,*) s * vec1
    WRITE(*,*) vec1 / s
    WRITE(*,*) vec1 .DOT. vec2
    WRITE(*,*) vec1 .CROSS. vec2
END PROGRAM main

一般的运算符和赋值运算符也可以通过使用GNERIC语句和派生数据类型绑定（下面这个程序如果加上注释部分会报错，报错信息见程序的最后，我至今没有找出报错的根本原因到底是什么。但是我发现vector_to_array和scalar_times_vector的参数列表当中的第一个参数都不是Vector类型，于是我尝试着给这两个过程加上NOPASS属性，但是还是没能让程序跑起来）：

MODULE module_for_vector
    IMPLICIT NONE
    TYPE :: vector
        REAL(KIND = 4) :: x
        REAL(KIND = 4) :: y
        REAL(KIND = 4) :: z
        CONTAINS
        GENERIC :: ASSIGNMENT(=) => array_to_vector!,vector_to_array
        GENERIC :: OPERATOR(+) => vector_add_vector
        GENERIC :: OPERATOR(-) => vector_subtract_vector
        GENERIC :: OPERATOR(*) => vector_times_scalar!,scalar_times_vector
        GENERIC :: OPERATOR(/) => vector_div_scalar
        GENERIC :: OPERATOR(.DOT.) => vector_dot_vector
        GENERIC :: OPERATOR(.CROSS.) => vector_cross_vector
        PROCEDURE,PASS :: array_to_vector
        !PROCEDURE,NOPASS :: vector_to_array
        PROCEDURE,PASS :: vector_add_vector
        PROCEDURE,PASS :: vector_subtract_vector
        PROCEDURE,PASS :: vector_times_scalar
        !PROCEDURE,NOPASS :: scalar_times_vector
        PROCEDURE,PASS :: vector_div_scalar
        PROCEDURE,PASS :: vector_dot_vector
        PROCEDURE,PASS :: vector_cross_vector
    END TYPE vector
    CONTAINS
    SUBROUTINE array_to_vector(vec,arr)
        IMPLICIT NONE
        REAL(KIND = 4),INTENT(IN),DIMENSION(3) :: arr
        CLASS(vector),INTENT(OUT) :: vec
        vec%x = arr(1)
        vec%y = arr(2)
        vec%z = arr(3)
    END SUBROUTINE array_to_vector
    !SUBROUTINE vector_to_array(arr,vec)
    !    IMPLICIT NONE
    !    CLASS(vector),INTENT(IN) :: vec
    !    REAL(KIND = 4),INTENT(OUT),DIMENSION(3) :: arr
    !    arr(1) = vec%x
    !    arr(2) = vec%y
    !    arr(3) = vec%z
    !END SUBROUTINE vector_to_array
    TYPE(vector) FUNCTION vector_add_vector(vec1,vec2)
        IMPLICIT NONE
        CLASS(vector),INTENT(IN) :: vec1,vec2
        vector_add_vector%x = vec1%x + vec2%x
        vector_add_vector%y = vec1%y + vec2%y
        vector_add_vector%z = vec1%z + vec2%z
    END FUNCTION vector_add_vector
    TYPE(vector) FUNCTION vector_subtract_vector(vec1,vec2)
        IMPLICIT NONE
        CLASS(vector),INTENT(IN) :: vec1,vec2
        vector_subtract_vector%x = vec1%x - vec2%x
        vector_subtract_vector%y = vec1%y - vec2%y
        vector_subtract_vector%z = vec1%z - vec2%z
    END FUNCTION vector_subtract_vector
    TYPE(vector) FUNCTION vector_times_scalar(vec,s)
        IMPLICIT NONE
        CLASS(vector),INTENT(IN) :: vec
        REAL(KIND = 4),INTENT(IN) :: s
        vector_times_scalar%x = vec%x * s
        vector_times_scalar%y = vec%y * s
        vector_times_scalar%z = vec%z * s
    END FUNCTION vector_times_scalar
    !TYPE(vector) FUNCTION scalar_times_vector(s,vec)
    !    IMPLICIT NONE
    !    REAL(KIND = 4),INTENT(IN) :: s
    !    CLASS(vector),INTENT(IN) :: vec
    !    scalar_times_vector%x = s * vec%x
    !    scalar_times_vector%y = s * vec%y
    !    scalar_times_vector%z = s * vec%z
    !END FUNCTION scalar_times_vector
    TYPE(vector) FUNCTION vector_div_scalar(vec,s)
        IMPLICIT NONE
        CLASS(vector),INTENT(IN) :: vec
        REAL(KIND = 4),INTENT(IN) :: s
        vector_div_scalar%x = vec%x / s
        vector_div_scalar%y = vec%y / s
        vector_div_scalar%z = vec%z / s
    END FUNCTION vector_div_scalar
    REAL(KIND = 4) FUNCTION vector_dot_vector(vec1,vec2)
        IMPLICIT NONE
        CLASS(vector),INTENT(IN) :: vec1,vec2
        vector_dot_vector = vec1%x * vec2%x + vec1%y * vec2%y + vec1%z * vec2%z
    END FUNCTION vector_dot_vector
    TYPE(vector) FUNCTION vector_cross_vector(vec1,vec2)
        IMPLICIT NONE
        CLASS(vector),INTENT(IN) :: vec1,vec2
        vector_cross_vector%x = vec1%y * vec2%z - vec1%z * vec2%y
        vector_cross_vector%y = vec1%z * vec2%x - vec1%x * vec2%z
        vector_cross_vector%z = vec1%x * vec2%y - vec1%y * vec2%x
    END FUNCTION vector_cross_vector
END MODULE module_for_vector
    
PROGRAM main
    USE module_for_vector
    IMPLICIT NONE
    REAL(KIND = 4),DIMENSION(3) :: arr1,arr2
    TYPE(vector) :: vec1,vec2
    REAL(KIND = 4) :: s = 10.0
    arr1 = [1.0,2.0,3.0]
    arr2 = [4.0,5.0,6.0]
    vec1 = arr1
    vec2 = arr2
    WRITE(*,*) vec1 + vec2
    WRITE(*,*) vec1 - vec2
    WRITE(*,*) vec1 * s
    !WRITE(*,*) s * vec1
    WRITE(*,*) vec1 / s
    WRITE(*,*) vec1 .DOT. vec2
    WRITE(*,*) vec1 .CROSS. vec2
END PROGRAM main
!error #8420: If generic-spec is OPERATOR, ASSIGNMENT or defined IO, each of its specific bindings must have a passed object dummy argument.   [VECTOR_TO_ARRAY]
!error #8420: If generic-spec is OPERATOR, ASSIGNMENT or defined IO, each of its specific bindings must have a passed object dummy argument.   [SCALAR_TIMES_VECTOR]