500 lines
32 KiB
Fortran
500 lines
32 KiB
Fortran
! ==============================================================================
|
|
! 通过 gfortran ./test.f90 -o ./run && ./run 运行
|
|
! 程序名：
|
|
! 第14章习题
|
|
! 目的:
|
|
!
|
|
! 修订记录:
|
|
! 日期 编程者 改动描述
|
|
! =================== ============= =====================================
|
|
! 2021-05-20 22:06:14 Sola 测验14-1 格式描述符的使用
|
|
! 2021-05-22 00:53:01 Sola 测验14-2 跳过，顺便判断正误全错
|
|
! 2021-05-22 16:36:07 Sola 习题14-1 ~ 习题14-3 跳过
|
|
! 2021-05-22 16:36:28 Sola 习题14-4 整数描述符
|
|
! 2021-05-22 16:39:34 Sola 习题14-5 使用其他进制描述符
|
|
! 2021-05-22 16:52:07 Sola 习题14-6 使用通用类型显示随机数
|
|
! 2021-05-22 16:58:00 Sola 习题14-7 使用:描述符
|
|
! 2021-05-22 17:36:35 Sola 习题14-8 使用通用类型描述符
|
|
! 2021-05-22 17:41:53 Sola 习题14-9 工程表示法
|
|
! 2021-05-22 17:45:23 Sola 习题14-10 跳过
|
|
! 2021-05-22 17:45:32 Sola 习题14-11 验证列表输出
|
|
! 2021-05-22 19:05:42 Sola 习题14-12 验证列表读取
|
|
! 2021-05-22 19:36:08 Sola 习题14-13 跳过
|
|
! 2021-05-22 19:36:17 Sola 习题14-14 验证不同类型输出
|
|
! 2021-05-22 19:55:46 Sola 习题14-15 ~ 习题14-17 跳过
|
|
! 2021-05-22 19:56:16 Sola 习题14-18 截尾拷贝文件
|
|
! 2021-05-23 13:14:29 Sola 习题14-19 INQUIRE语句测试等
|
|
! 2021-05-23 14:00:38 Sola 习题14-20 逆置方式复制文件
|
|
! 2021-05-23 14:40:18 Sola 习题14-21 比较格式化和未格式化文件
|
|
! 2021-05-23 15:47:44 Sola 习题14-22 比较顺序和直接访问文件
|
|
! 程序结构:
|
|
!
|
|
! ==============================================================================
|
|
! 主程序：
|
|
program Chapter14
|
|
implicit none
|
|
! 数据字典
|
|
! 声明常量
|
|
! 声明变量
|
|
! 变量初始化
|
|
! 数据输入
|
|
! 运算过程
|
|
! 结果输出
|
|
! call Test14_1
|
|
call Exercises14_4
|
|
! call Exercises14_6
|
|
! call Exercises14_7
|
|
! call Exercises14_8
|
|
! call Exercises14_11
|
|
! call Exercises14_14
|
|
! call Exercises14_18
|
|
! call Exercises14_19
|
|
! call Exercises14_20
|
|
! call Exercises14_21
|
|
call Exercises14_22
|
|
end program Chapter14
|
|
! ==============================================================================
|
|
subroutine Test14_1
|
|
implicit none
|
|
real :: a=4096.07
|
|
integer :: i=-2002, j=1776, k=-3
|
|
write(*, 1) a, a, a, a, a
|
|
1 format(1X, F10.1, F9.2, E12.5, G12.5, G11.4)
|
|
read(*, *) i, j, k
|
|
write(*, 2) i, j, k
|
|
2 format(' i = ', I10, ' j = ', I10, ' k = ', I10)
|
|
! write(*, '(I8, I8.8)') 1024, 1024
|
|
end subroutine Test14_1
|
|
! 习题14-4 整数描述符 习题14-5 使用其他进制描述符
|
|
subroutine Exercises14_4
|
|
implicit none
|
|
integer :: i
|
|
write(*, *) 'print I8 & I8.8'
|
|
write(*, 1) 1024, 1024, -128, -128, 30000, 30000
|
|
1 format(I8, 2X, I8.8)
|
|
write(*, *) 'print B16, O11 & Z8'
|
|
write(*, 2) (1024, i = 1, 3), (-128, i = 1, 3), (30000, i = 1, 3)
|
|
2 format(B16, T20, O11, T40, Z8)
|
|
end subroutine Exercises14_4
|
|
! 习题14-6 使用万能类型显示随机数
|
|
subroutine Exercises14_6
|
|
implicit none
|
|
real :: temp
|
|
integer :: i
|
|
do i = 1, 9
|
|
call random_seed()
|
|
call random_number(temp)
|
|
temp = temp*110000 - 10000
|
|
write(*, '(I1, 2X, G11.5)') i, temp
|
|
end do
|
|
end subroutine Exercises14_6
|
|
! 习题14-7 使用:描述符
|
|
subroutine Exercises14_7
|
|
implicit none
|
|
real, dimension(9) :: temp
|
|
integer :: i
|
|
do i = 1, 9
|
|
! call random_seed()
|
|
call random_number(temp(i))
|
|
temp(i) = temp(i)*110000 - 10000
|
|
end do
|
|
! write(*, '(2("VALUE(", SSI1, ") = ", SPF10.2:, 2X))') (i, temp(i), i = 1, 9)
|
|
write(*, '(2("VALUE(", SSI1, ") = ", SPI7.6, SSF0.2:, 2X))') (i, int(temp(i)), abs(temp(i)-int(temp(i))), i = 1, 9)
|
|
end subroutine Exercises14_7
|
|
! 习题14-8 使用通用类型描述符 习题14-9 工程表示法
|
|
subroutine Exercises14_8
|
|
implicit none
|
|
! 习题14-8 使用通用类型描述符
|
|
write(*, '(G10.4)') -6.38765E10
|
|
write(*, '(G10.4)') -6.38765E2
|
|
write(*, '(G10.4)') -6.38765E-1
|
|
write(*, '(G10.4)') 2345.6
|
|
write(*, '(G10.4)') .TRUE.
|
|
write(*, '(G10.4)') 'String!'
|
|
! 习题14-9 工程表示法
|
|
write(*, '(EN15.6)') -6.38765E10
|
|
write(*, '(EN15.6)') -6.38765E2
|
|
write(*, '(EN15.6)') -6.38765E-1
|
|
write(*, '(EN15.6)') 2345.6
|
|
end subroutine Exercises14_8
|
|
! 习题14-11 验证列表输出
|
|
! 习题14-12 验证列表读取
|
|
subroutine Exercises14_11
|
|
implicit none
|
|
integer :: i, j
|
|
real, dimension(3, 3) ::array
|
|
integer :: errorLevel
|
|
namelist /io/ array
|
|
array = reshape((/((10.*i*j, j = 1, 3), i = 0, 2)/), (/3, 3/))
|
|
write(*, *) "习题14-11 验证列表输出"
|
|
write(*, nml=io)
|
|
open(unit=1, status='scratch', iostat=errorLevel)
|
|
if ( errorLevel /= 0 ) stop ""
|
|
write(1, '(A)') &
|
|
&"&io array(1, 1) = -100.", &
|
|
&"array(3, 1) = 6., array(1, 3) = -6./", &
|
|
&"array(2, 2) = 1000. /"
|
|
rewind(unit=1, iostat=errorLevel)
|
|
if ( errorLevel /= 0 ) stop ""
|
|
read(1, nml=io)
|
|
write(*, *) "习题14-12 验证列表读取"
|
|
write(*, nml=io)
|
|
end subroutine Exercises14_11
|
|
! 习题14-14 验证不同类型输出
|
|
subroutine Exercises14_14
|
|
implicit none
|
|
call SubA
|
|
call SubB
|
|
contains
|
|
subroutine SubA
|
|
implicit none
|
|
real :: value=356.248
|
|
integer :: i
|
|
write(*, 200) 'Value = ', (value, i = 1, 5)
|
|
200 format('0', A, F10.4, G10.2, G11.5, G11.6, ES10.3)
|
|
end subroutine SubA
|
|
subroutine SubB
|
|
implicit none
|
|
integer, dimension(5) :: i
|
|
integer :: j
|
|
do j = 1, 5
|
|
i(j) = j**2
|
|
end do
|
|
read(*, *) i
|
|
write(*, 500) i
|
|
500 format(3(10X, I5))
|
|
end subroutine SubB
|
|
end subroutine Exercises14_14
|
|
! 习题14-18 截尾拷贝文件
|
|
! 1. 在OPEN语句中使用STATUS=和IOSTAT=子句确认输入文件已经存在
|
|
! 2. 在OPEN语句中使用STATUS=和IOSTAT=子句确认输出文件不存在
|
|
! 3. 如果输出文件存在，提示用户是否覆盖，否则终止程序
|
|
! 4. 拷贝完成后，询问用户是否删除原文件
|
|
! 变量：输入文件名、输出文件名、拷贝临时变量、错误状态值
|
|
subroutine Exercises14_18
|
|
implicit none
|
|
character(len=128) :: inputFile, outputFile ! 输入输出文件名
|
|
integer :: errorLevel ! 错误状态码
|
|
character(len=200) :: temp ! 保存输入的临时变量
|
|
character :: overwriteSwitch ! 判断是否覆盖已存在的输出文件的变量
|
|
logical :: outputFileOpen ! 判断输出文件是否打开的变量
|
|
do ! 获取输入文件名
|
|
write(*, fmt='(A)', advance='no') 'Please enter the name of the input file : ' ! 提示输入输入文件名
|
|
read(*, *) inputFile ! 读取输入文件名
|
|
open(unit=1, status='old', iostat=errorLevel, file=inputFile) ! 打开输入文件
|
|
if ( errorLevel /= 0 ) then
|
|
write(*, *) 'Warning: The input file dont exist!' ! 如果输入文件不存在, 提示错误并重新输入
|
|
else
|
|
exit ! 如果输入文件存在, 进行下一环节
|
|
end if
|
|
end do
|
|
write(*, fmt='(A)', advance='no') 'Please enter the name of the output file : ' ! 提示输入输出文件名
|
|
read(*, *) outputFile ! 读取输出文件名
|
|
open(unit=2, status='new', iostat=errorLevel, file=outputFile) ! 以新文件形式打开输出文件
|
|
if ( errorLevel /= 0 ) then
|
|
write(*, fmt='(A)', advance='no') 'Warning: The output file has existed, overwrite it? (Y/N): ' ! 如果输出文件存在, 提示是否覆盖
|
|
do
|
|
read(*, *, iostat=errorLevel) overwriteSwitch ! 读取用户选项
|
|
if ( errorLevel /= 0 .or. ( Ucase(overwriteSwitch) /= 'Y' .and. Ucase(overwriteSwitch) /= 'N' ) ) then ! 如果输入非法
|
|
write(*, fmt='(A)', advance='no') 'Illgle input, please enter again (Y/N): ' ! 提示错误, 并再次读取用户输入
|
|
elseif ( Ucase(overwriteSwitch) == 'Y' ) then
|
|
open(unit=2, status='replace', iostat=errorLevel, file=outputFile) ! 如果选择覆盖
|
|
if ( errorLevel /= 0 ) stop "Warning: Replace the output file fatal!" ! 如果打开输出文件失败, 退出程序
|
|
exit ! 如果打开输出文件成功, 进行下一环节
|
|
else
|
|
exit ! 如果选择不覆盖, 进入下一环节
|
|
end if
|
|
end do
|
|
end if
|
|
if ( Ucase(overwriteSwitch) /= 'N' ) then ! 如果输出文件不存在或用户选择覆盖
|
|
inquire(unit=2, opened=outputFileOpen, iostat=errorLevel) ! 确认输出文件已打开
|
|
if ( errorLevel /= 0 ) stop "Query output file status error " ! 如果查询输出文件状态出错, 提示错误信息并终止程序
|
|
if ( outputFileOpen .eqv. .FALSE. ) stop "The output file is not open!" ! 如果输出文件未打开, 提示错误信息并终止程序
|
|
do ! 逐行复制文件内容
|
|
read(1, '(A)', iostat=errorLevel) temp ! 读取每行给临时变量
|
|
if ( errorLevel < 0 ) then
|
|
exit ! 如果到达文件末尾, 结束读取, 进入下一环节
|
|
elseif ( errorLevel > 0 ) then
|
|
stop "Error reading file record!" ! 如果读取文件记录出错, 提示错误信息并终止程序
|
|
else
|
|
write(2, '(A)', iostat=errorLevel) trim(temp) ! 将读取到的内容去除尾部空格后, 输出到输出文件
|
|
! write(*, '(A)', iostat=errorLevel) trim(temp)
|
|
if ( errorLevel /= 0 ) stop "Error copying records!" ! 拷贝记录出错, 提示错误信息并终止程序
|
|
end if
|
|
end do
|
|
write(*, fmt='(A)', advance='no') 'The copy is complete, whether to delete the input file? (Y/N): ' ! 复制文件完成, 提示用户是否删除输入文件
|
|
do ! 检测用户输出
|
|
read(*, *, iostat=errorLevel) overwriteSwitch ! 读取用户输出(这里重复使用变量了,,,)
|
|
if ( errorLevel /= 0 .or. ( Ucase(overwriteSwitch) /= 'Y' .and. Ucase(overwriteSwitch) /= 'N' ) ) then
|
|
write(*, fmt='(A)', advance='no') 'Illgle input, please enter again (Y/N): ' ! 如果输入非法, 提示错误信息并重新读取用户输入
|
|
elseif ( Ucase(overwriteSwitch) == 'Y' ) then
|
|
close(unit=1, status='delete', iostat=errorLevel) ! 如果用户选择删除输入文件, 关闭并删除输入文件
|
|
if ( errorLevel /= 0 ) stop "Error closing input file!" ! 如果关闭输入文件出错, 提示错误信息并终止程序
|
|
write(*, '(A)') 'Delete input file successed!' ! 顺利关闭并删除输入文件, 提示成功信息
|
|
exit ! 结束检测用户输入, 进入下一环节
|
|
else
|
|
close(unit=1, status='keep', iostat=errorLevel) ! 如果用户选择不删除, 则关闭输入文件
|
|
if ( errorLevel /= 0 ) stop "Error closing input file!" ! 如果关闭输入文件出错, 提示错误信息并终止程序
|
|
exit ! 顺利关闭输入文件, 结束检测用户输入, 进入下一环节
|
|
end if
|
|
end do
|
|
close(unit=2, iostat=errorLevel) ! 关闭输出文件
|
|
if ( errorLevel /= 0 ) stop "Error closing output file!" ! 如果关闭输出文件出错, 提示错误信息并终止程序
|
|
end if
|
|
write(*, '(A)') 'Program end! If the text appears garbled, please try to open the file in UTF-8 format!' ! 提示程序运行完成
|
|
contains
|
|
function Ucase(str)
|
|
character(len=*), intent(in) :: str ! 定义输入字符串
|
|
character(len=len(str)) :: ucase ! 定义函数类型
|
|
integer :: i ! 循环参数
|
|
do i = 1, len(str) ! 对输入每个字符循环
|
|
if ( lge(str(i: i), 'a') .and. lle(str(i: i), 'z') ) then ! 如果字符在a~z中
|
|
Ucase(i: i) = achar( iachar(str(i: i)) - 32 ) ! 输出大写
|
|
else
|
|
Ucase(i: i) = str(i: i) ! 如果不在, 输出原字符
|
|
end if
|
|
end do
|
|
end function Ucase
|
|
end subroutine Exercises14_18
|
|
! 习题14-19 INQUIRE语句测试等
|
|
subroutine Exercises14_19
|
|
implicit none
|
|
call SubA
|
|
call SubB
|
|
contains
|
|
subroutine SubA
|
|
implicit none
|
|
character(len=10) :: acc, fmt, act, delim
|
|
integer :: unit=35
|
|
logical :: lexist, lnamed, lopen
|
|
inquire(file='run', exist=lexist)
|
|
if ( lexist ) then
|
|
open(unit, file='run', status='old')
|
|
inquire(unit=unit, opened=lopen, exist=lexist, named=lnamed, access=acc, form=fmt, action=act, delim=delim)
|
|
write(*, 100) lexist, lopen, lnamed, acc, fmt, act, delim
|
|
100 format(1X, "File status: Exist = ", L1, ' Opened = ', L1, ' Named = ', L1, ' Access = ', A,/&
|
|
&' Format = ', A, ' Action = ', A,/&
|
|
&' Delims = ', A)
|
|
end if
|
|
end subroutine SubA
|
|
subroutine SubB
|
|
implicit none
|
|
integer :: i1=10
|
|
open (9, file='file1', access='direct', form='formatted', status='new', recl=6)
|
|
write(9, '(I6)', rec=1) i1
|
|
end subroutine SubB
|
|
end subroutine Exercises14_19
|
|
! 习题14-20 逆置方式复制文件
|
|
subroutine Exercises14_20
|
|
implicit none
|
|
character(len=128) :: inputFile, outputFile ! 输入输出文件名
|
|
integer :: errorLevel ! 错误状态码
|
|
character(len=200) :: temp ! 保存输入的临时变量
|
|
character :: overwriteSwitch ! 判断是否覆盖已存在的输出文件的变量
|
|
logical :: outputFileOpen ! 判断输出文件是否打开的变量
|
|
integer :: fileLength = 0 ! 文件长度计数
|
|
integer :: i ! 循环参数
|
|
do ! 获取输入文件名
|
|
write(*, fmt='(A)', advance='no') 'Please enter the name of the input file : ' ! 提示输入输入文件名
|
|
read(*, *) inputFile ! 读取输入文件名
|
|
open(unit=1, status='old', iostat=errorLevel, file=inputFile) ! 打开输入文件
|
|
if ( errorLevel /= 0 ) then
|
|
write(*, *) 'Warning: The input file dont exist!' ! 如果输入文件不存在, 提示错误并重新输入
|
|
else
|
|
exit ! 如果输入文件存在, 进行下一环节
|
|
end if
|
|
end do
|
|
write(*, fmt='(A)', advance='no') 'Please enter the name of the output file : ' ! 提示输入输出文件名
|
|
read(*, *) outputFile ! 读取输出文件名
|
|
open(unit=2, status='new', iostat=errorLevel, file=outputFile) ! 以新文件形式打开输出文件
|
|
if ( errorLevel /= 0 ) then
|
|
write(*, fmt='(A)', advance='no') 'Warning: The output file has existed, overwrite it? (Y/N): ' ! 如果输出文件存在, 提示是否覆盖
|
|
do
|
|
read(*, *, iostat=errorLevel) overwriteSwitch ! 读取用户选项
|
|
if ( errorLevel /= 0 .or. ( Ucase(overwriteSwitch) /= 'Y' .and. Ucase(overwriteSwitch) /= 'N' ) ) then ! 如果输入非法
|
|
write(*, fmt='(A)', advance='no') 'Illgle input, please enter again (Y/N): ' ! 提示错误, 并再次读取用户输入
|
|
elseif ( Ucase(overwriteSwitch) == 'Y' ) then
|
|
open(unit=2, status='replace', iostat=errorLevel, file=outputFile) ! 如果选择覆盖
|
|
if ( errorLevel /= 0 ) stop "Warning: Replace the output file fatal!" ! 如果打开输出文件失败, 退出程序
|
|
exit ! 如果打开输出文件成功, 进行下一环节
|
|
else
|
|
exit ! 如果选择不覆盖, 进入下一环节
|
|
end if
|
|
end do
|
|
end if
|
|
if ( Ucase(overwriteSwitch) /= 'N' ) then ! 如果输出文件不存在或用户选择覆盖
|
|
inquire(unit=2, opened=outputFileOpen, iostat=errorLevel) ! 确认输出文件已打开
|
|
if ( errorLevel /= 0 ) stop "Query output file status error " ! 如果查询输出文件状态出错, 提示错误信息并终止程序
|
|
if ( outputFileOpen .eqv. .FALSE. ) stop "The output file is not open!" ! 如果输出文件未打开, 提示错误信息并终止程序
|
|
do ! 逐行复制文件内容
|
|
read(1, '(A)', iostat=errorLevel) temp ! 读取每行给临时变量
|
|
if ( errorLevel < 0 ) then
|
|
exit ! 如果到达文件末尾, 结束读取, 进入下一环节
|
|
elseif ( errorLevel > 0 ) then
|
|
stop "01: Error reading file record!" ! 如果读取文件记录出错, 提示错误信息并终止程序
|
|
end if
|
|
fileLength = fileLength + 1 ! 记录文件行数
|
|
end do
|
|
backspace(unit=1, iostat=errorLevel) ! 回退到上一行(文件结束位置)
|
|
if ( errorLevel /= 0 ) stop "02: Error reading file record!"
|
|
backspace(unit=1, iostat=errorLevel) ! 回退到上一行(文件末端记录开始)
|
|
if ( errorLevel /= 0 ) stop "02: Error reading file record!"
|
|
do i = 1, fileLength ! 逐行复制文件内容
|
|
read(1, '(A)', iostat=errorLevel) temp ! 读取每行给临时变量
|
|
if ( errorLevel /= 0 ) then
|
|
stop "03: Error reading file record!" ! 如果读取文件记录出错, 提示错误信息并终止程序
|
|
else
|
|
write(2, '(A)', iostat=errorLevel) trim(temp) ! 将读取到的内容去除尾部空格后, 输出到输出文件
|
|
! write(*, '(A)', iostat=errorLevel) trim(temp)
|
|
if ( errorLevel /= 0 ) stop "04: Error copying records!" ! 拷贝记录出错, 提示错误信息并终止程序
|
|
end if
|
|
backspace(unit=1, iostat=errorLevel) ! 回退到本次读取记录开始
|
|
if ( errorLevel /= 0 ) stop "05: Error reading file record!"
|
|
backspace(unit=1, iostat=errorLevel) ! 回退到下次读取记录开始
|
|
if ( errorLevel /= 0 ) stop "06: Error reading file record!"
|
|
end do
|
|
write(*, fmt='(A)', advance='no') 'The copy is complete, whether to delete the input file? (Y/N): ' ! 复制文件完成, 提示用户是否删除输入文件
|
|
do ! 检测用户输出
|
|
read(*, *, iostat=errorLevel) overwriteSwitch ! 读取用户输出(这里重复使用变量了,,,)
|
|
if ( errorLevel /= 0 .or. ( Ucase(overwriteSwitch) /= 'Y' .and. Ucase(overwriteSwitch) /= 'N' ) ) then
|
|
write(*, fmt='(A)', advance='no') 'Illgle input, please enter again (Y/N): ' ! 如果输入非法, 提示错误信息并重新读取用户输入
|
|
elseif ( Ucase(overwriteSwitch) == 'Y' ) then
|
|
close(unit=1, status='delete', iostat=errorLevel) ! 如果用户选择删除输入文件, 关闭并删除输入文件
|
|
if ( errorLevel /= 0 ) stop "Error closing input file!" ! 如果关闭输入文件出错, 提示错误信息并终止程序
|
|
write(*, '(A)') 'Delete input file successed!' ! 顺利关闭并删除输入文件, 提示成功信息
|
|
exit ! 结束检测用户输入, 进入下一环节
|
|
else
|
|
close(unit=1, status='keep', iostat=errorLevel) ! 如果用户选择不删除, 则关闭输入文件
|
|
if ( errorLevel /= 0 ) stop "Error closing input file!" ! 如果关闭输入文件出错, 提示错误信息并终止程序
|
|
exit ! 顺利关闭输入文件, 结束检测用户输入, 进入下一环节
|
|
end if
|
|
end do
|
|
close(unit=2, iostat=errorLevel) ! 关闭输出文件
|
|
if ( errorLevel /= 0 ) stop "Error closing output file!" ! 如果关闭输出文件出错, 提示错误信息并终止程序
|
|
end if
|
|
write(*, '(A)') 'Program end! If the text appears garbled, please try to open the file in UTF-8 format!' ! 提示程序运行完成
|
|
contains
|
|
function Ucase(str)
|
|
character(len=*), intent(in) :: str ! 定义输入字符串
|
|
character(len=len(str)) :: ucase ! 定义函数类型
|
|
integer :: i ! 循环参数
|
|
do i = 1, len(str) ! 对输入每个字符循环
|
|
if ( lge(str(i: i), 'a') .and. lle(str(i: i), 'z') ) then ! 如果字符在a~z中
|
|
Ucase(i: i) = achar( iachar(str(i: i)) - 32 ) ! 输出大写
|
|
else
|
|
Ucase(i: i) = str(i: i) ! 如果不在, 输出原字符
|
|
end if
|
|
end do
|
|
end function Ucase
|
|
end subroutine Exercises14_20
|
|
! 习题14-21 比较格式化和未格式化文件
|
|
subroutine Exercises14_21
|
|
implicit none
|
|
integer, parameter :: sgl=selected_real_kind(p=1) ! 单精度类型数
|
|
real(sgl), dimension(10000) :: array ! 输入数组
|
|
real(sgl) :: timeFor, timeUnfor ! 输出格式化文件和非格式化文件所需时间
|
|
integer :: i ! 循环参数
|
|
integer :: errorLevel ! 错误状态码
|
|
integer, dimension(8) :: timeNow ! 计算时间用
|
|
integer, dimension(8) :: timeOld ! 计算时间用
|
|
do i = 1, 10000
|
|
call random_number(array(i)) ! 获取一个长度10000的随机数组
|
|
end do
|
|
array = array*2E6 - 1E6 ! 重设数组值的大小范围
|
|
open(unit=1, file='TempFormatted', status='replace', form='formatted', iostat=errorLevel) ! 打开格式化文件
|
|
if ( errorLevel /= 0 ) stop ""
|
|
open(unit=2, file='TempUnformatted', status='replace', form='unformatted', iostat=errorLevel) ! 打开非格式化文件
|
|
if ( errorLevel /= 0 ) stop ""
|
|
call set_timer ! 开始计算时间
|
|
write(1, '(100ES13.6)') array ! 将数组内容输出到格式化文件
|
|
call elapsed_time(timeFor) ! 计算经过时间
|
|
call set_timer ! 开始计算时间
|
|
do i = 1, 100
|
|
write(2) array(100*(i-1)+1: 100*i) ! 将数组输出到非格式化文件中
|
|
end do
|
|
call elapsed_time(timeUnfor) ! 计算经过时间
|
|
write(*, *) '写入格式化文件花费时间 ', timeFor, ' s, 写入非格式化文件花费时间 ', timeUnfor, ' s'! 输出结果
|
|
contains
|
|
subroutine set_timer ! 创建子程序1
|
|
call DATE_AND_TIME(values=timeNow) ! 调用当前时间子程序
|
|
end subroutine set_timer ! 结束子程序1
|
|
subroutine elapsed_time(timePast) ! 创建子程序2
|
|
real, intent(out) :: timePast ! 定义输出变量
|
|
timeOld = timeNow ! 传递值
|
|
call set_timer ! 调用子程序1
|
|
timePast = ((real(timeNow(3)-timeOld(3))*24 + real(timeNow(5)-timeOld(5)))&
|
|
&*60 + real(timeNow(6)-timeOld(6)))*60 + real(timeNow(7)-timeOld(7)) + &
|
|
&real(timeNow(8)-timeOld(8))/1000 ! 计算经历时间(秒)
|
|
end subroutine elapsed_time ! 结束子程序2
|
|
end subroutine Exercises14_21
|
|
! 习题14-22 比较顺序和直接访问文件
|
|
subroutine Exercises14_22
|
|
implicit none
|
|
integer, parameter :: sgl=selected_real_kind(p=1) ! 单精度类型数
|
|
real(sgl), dimension(10000) :: array ! 输入数组
|
|
real(sgl) :: timeSeqFor, timeDirFor, timeDirUnf ! 输出格式化文件和非格式化文件所需时间
|
|
real(sgl) :: temp ! 临时变量
|
|
integer :: i, j ! 循环参数
|
|
integer :: errorLevel ! 错误状态码
|
|
integer, dimension(8) :: timeNow ! 计算时间用
|
|
integer, dimension(8) :: timeOld ! 计算时间用
|
|
do i = 1, 10000
|
|
call random_number(array(i)) ! 获取一个长度10000的随机数组
|
|
end do
|
|
array = array*2E6 - 1E6 ! 重设数组值的大小范围
|
|
open(unit=1, file='TempSeqFor', status='replace', form='formatted', access='sequential', iostat=errorLevel) ! 打开格式化顺序访问文件
|
|
if ( errorLevel /= 0 ) stop ""
|
|
write(1, '(ES14.7)') array ! 将数组内容输出到格式化顺序访问文件
|
|
open(unit=2, file='TempDirFor', status='replace', form='formatted', access='direct', recl=14, iostat=errorLevel) ! 打开格式化随机访问文件
|
|
if ( errorLevel /= 0 ) stop ""
|
|
do i = 1, 10000
|
|
write(2, rec=i, fmt='(ES14.7)') array(i) ! 将数组内容输出到格式化随机访问文件
|
|
end do
|
|
inquire(iolength=i) array(1)
|
|
open(unit=3, file='TempDirUnf', status='replace', form='unformatted', access='direct', recl=i, iostat=errorLevel) ! 打开非格式化随机访问文件
|
|
if ( errorLevel /= 0 ) stop ""
|
|
do i = 1, 10000
|
|
write(3, rec=i) array(i) ! 将数组输出到非格式化随机访问文件中
|
|
end do
|
|
call set_timer ! 开始计算时间
|
|
do i = 1, 1000
|
|
rewind(unit=1, iostat=errorLevel)
|
|
if (errorLevel /= 0 ) stop ""
|
|
do j = 1, i
|
|
read(1, *) temp
|
|
end do
|
|
rewind(unit=1, iostat=errorLevel)
|
|
if (errorLevel /= 0 ) stop ""
|
|
do j = 1, 10000-i+1
|
|
read(1, *) temp
|
|
end do
|
|
end do
|
|
call elapsed_time(timeSeqFor) ! 计算经过时间
|
|
call set_timer ! 开始计算时间
|
|
do i = 1, 1000
|
|
read(2, '(ES14.7)', rec=i) temp
|
|
read(2, '(ES14.7)', rec=10000-i+1) temp
|
|
end do
|
|
call elapsed_time(timeDirFor) ! 计算经过时间
|
|
call set_timer ! 开始计算时间
|
|
do i = 1, 1000
|
|
read(3, rec=i) temp
|
|
read(3, rec=10000-i+1) temp
|
|
end do
|
|
call elapsed_time(timeDirUnf) ! 计算经过时间
|
|
write(*, *) '格式化顺序访问文件读取耗时 : ', timeSeqFor, ' s'
|
|
write(*, *) '格式化随机访问文件读取耗时 : ', timeDirFor, ' s'
|
|
write(*, *) '非格式化随机访问文件读取耗时 : ', timeDirUnf, ' s'
|
|
contains
|
|
subroutine set_timer ! 创建子程序1
|
|
call DATE_AND_TIME(values=timeNow) ! 调用当前时间子程序
|
|
end subroutine set_timer ! 结束子程序1
|
|
subroutine elapsed_time(timePast) ! 创建子程序2
|
|
real, intent(out) :: timePast ! 定义输出变量
|
|
timeOld = timeNow ! 传递值
|
|
call set_timer ! 调用子程序1
|
|
timePast = ((real(timeNow(3)-timeOld(3))*24 + real(timeNow(5)-timeOld(5)))&
|
|
&*60 + real(timeNow(6)-timeOld(6)))*60 + real(timeNow(7)-timeOld(7)) + &
|
|
&real(timeNow(8)-timeOld(8))/1000 ! 计算经历时间(秒)
|
|
end subroutine elapsed_time ! 结束子程序2
|
|
end subroutine Exercises14_22 |