! ============================================================================== ! 通过 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