! ==============================================================================
! 通过 gfortran ./test.f90 -o ./run && ./run 运行
! 程序名：
!   第10章习题，及书上例题
! 目的:
! 
! 修订记录:
!         日期              编程者               改动描述
! ===================   =============   =====================================
! 2021-05-10 17:15:53       Sola            测验10-1 4 判断星期几
! 2021-05-10 17:22:01       Sola            测验10-1 5 字符串反序
! 2021-05-10 17:33:13       Sola            测验10-1 6-8 测试字符
! 2021-05-10 18:14:05       Sola            例题10-3 转换输出数值格式
! 2021-05-10 21:58:38       Sola            测验10-2 3
! 2021-05-11 14:30:07       Sola            习题10-4 字符串转大写
! 2021-05-11 15:00:14       Sola            习题10-5 字符串转小写
! 2021-05-11 16:03:39       Sola            习题10-8 首字母大写
! 2021-05-11 17:39:18       Sola            习题10-9 10-8可变函数版(话说直接写的就是可变函数版本的...)
! 2021-05-11 17:39:48       Sola            习题10-10 检测字符中实际字符数
! 2021-05-11 18:16:41       Sola            习题10-11 检测第一个和最后一个非空字符位置(话说上一题的函数改一改不就是了)
! 2021-05-11 19:10:54       Sola            习题10-12 输入参数文件
! 2021-05-11 21:51:02       Sola            习题10-13 直方图 ??? 这是什么鬼需求
! 2021-05-12 11:28:44       Sola            习题10-14 随机数直方图
! 2021-05-12 13:18:26       Sola            习题10-15 拷贝文件去除注释
! 程序结构:
! 
! ==============================================================================
! 模块：
module Chapter10
    implicit none
    ! 数据字典
    ! 声明常数
    REAL, PARAMETER :: PI=3.14159265            ! PI值
    REAL, PARAMETER :: e=2.718281828459         ! 自然对数
    INTEGER, PARAMETER :: arrayLength=20        ! 数组基准长度
    ! 声明变量
    ! 创建显式接口
    contains
end module Chapter10
! ==============================================================================
! 主程序：
program ProName
    ! use ModName
    implicit none
    ! 数据字典
    ! 声明常量
    ! 声明变量
    ! 变量初始化
    ! 数据输入
    ! 运算过程
    ! 结果输出
    ! call Exercises10_1_4
    ! call Exercises10_1_5
    ! call Exercises10_1_6_8
    ! call Example10_3
    ! call Exercises10_2_3
    ! call Exercises10_4
    ! call Exercises10_10
    ! call Exercises10_12
    ! call Exercises10_13
    ! call Exercises10_14
    call Exercises10_15
end program ProName
! ==============================================================================
! 子程序
! subroutine SubName(varName1,varName2)
!     use MouName
!     implicit none
!     Type, intent(inout) :: varName
! end subroutine SubName
! ==============================================================================
! 函数
! function FunName(varName1,varName2)
!     use MouName
!     implicit none
! end function FunName
! ==============================================================================
! 测试10-1 4 判断星期几
subroutine Exercises10_1_4
    implicit none
    integer :: i
    write(*,*) (day(i), i = 7, 1, -1)
contains
    function day(iday)
        integer, intent(in) :: iday
        character(len=3) :: day
        character(len=3), dimension(7) :: days=(/'SUN', 'MON', 'TUE', 'WED', 'THU', 'FRI', 'SAT'/)
        if ( (iday>=1) .and. (iday<=7) ) then
            day = days(iday)
        end if
    end function day
end subroutine Exercises10_1_4
! 测试10-1 5 字符串反序
subroutine Exercises10_1_5
    implicit none
    write(*,*) swap_string('Hello World!')
contains
    function swap_string(string)
        character(len=*), intent(in) :: string
        character(len=len(string)) :: swap_string
        integer :: length, i
        length = len(string)
        do i = 1, length
            swap_string(length-i+1: length-i+1) = string(i: i)
        end do
    end function swap_string
end subroutine Exercises10_1_5
! 测验10-1 6-8
subroutine Exercises10_1_6_8
    implicit none
    call sub1
    call sub2
    call sub3
contains
    subroutine sub1
        character(len=20) :: last='JOHNSON'
        character(len=20) :: first='JAMES'
        character :: middle_initial='R'
        character(len=42) :: name
        write(*,*) middle_initial
        name = last //', '//first//middle_initial
        write(*,*) name
    end subroutine sub1
    subroutine sub2
        character(len=4) :: a='123'
        character(len=12) :: b
        b = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
        write(*,*) a, ', ', b
        b(5: 8) = a(2: 3)
        write(*,*) a, ', ', b
    end subroutine sub2
    subroutine sub3
        character(len=80) :: line
        integer :: ipos1, ipos2, ipos3, ipos4
        line = 'This is a test line containing some input data!'
        ipos1 = index(line, 'in')
        ipos2 = index(line, 'Test')
        ipos3 = index(line, 't l')
        ipos4 = index(line, 'in', .TRUE.)
        write(*,*) ipos1, ipos2, ipos3, ipos4
    end subroutine sub3
end subroutine Exercises10_1_6_8
! 例题10-3 转换输出数值格式
subroutine Example10_3
    implicit none
    real :: input
    character(len=1) :: runLevel
    outer:do
        write(*, *) '请输入数值:'
        read(*, *) input
        write(*, *) '输出的结果为:', num2str(input)
        inner:do
            write(*, *) '是否接着输入下一个数值? 继续(Y)/结束(N)'
            read(*, *) runLevel
            if ( runLevel == 'Y' .or. runLevel == 'y' ) then
                exit inner
            else if ( runLevel == 'N' .or. runLevel == 'n' ) then
                exit outer
            else
                write(*,*) '非法输入! 请重新输入!'
            end if
        end do inner
    end do outer
contains
    function num2str(num)
        character(len=12) :: num2str        ! 函数输出类型
        real, intent(in) :: num             ! 输入实数
        if ( abs(num) <= 9999999. .and. abs(num) >= 0.01 .or. num == 0 ) then
            write(num2str, '(F12.4)') num
        else
            write(num2str, '(ES12.5)') num
        end if
    end function num2str
end subroutine Example10_3
! 测验10-2 3
subroutine Exercises10_2_3
    implicit none
    character(len=30) :: line = '123456789012345678901234567890'
    character(len=30) :: fmt = '(3X, I6, 12X, I3, F6.2)'
    integer :: ival1, ival2
    real :: rval3
    read (line, fmt) ival1, ival2, rval3
    write(*,*) ival1, ival2, rval3
end subroutine Exercises10_2_3
! 习题10-4 字符串转大写
subroutine Exercises10_4
    implicit none
    character(len=132) :: input
    character :: runLevel
    outer:do
        write(*, *) '请输入一段字符（小于132字，包含空格字符请用引号括起）'
        read(*, *) input
        write(*, *) '转换大写结果为：', Ucase(input)
        write(*, *) '转换小写结果为：', Lcase(input)
        write(*, *) '首字符大写结果为：', Caps(input)
        inner:do
            write(*, *) '是否接着转换下一个字符串? 继续(Y)/结束(N)'
            read(*, *) runLevel
            if ( runLevel == 'Y' .or. runLevel == 'y' ) then
                exit inner
            else if ( runLevel == 'N' .or. runLevel == 'n' ) then
                exit outer
            else
                write(*,*) '非法输入! 请重新输入!'
            end if
        end do inner
    end do outer
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
    ! 转换为小写
    function Lcase(str)                                                 
        character(len=*), intent(in) :: str                             ! 定义输入字符串
        character(len=len(str)) :: Lcase                                ! 定义函数类型
        integer :: i                                                    ! 循环参数
        do i = 1, len(str)                                              ! 对每个输入字符循环
            if ( lge(str(i: i), 'A') .and. lle(str(i: i), 'Z') ) then   ! 如果字符在A~Z中
                Lcase(i: i) = achar( iachar(str(i: i)) + 32 )           ! 输出小写
            else
                Lcase(i: i) = str(i: i)                                 ! 如果不再, 输出原字符
            end if
        end do
    end function Lcase
    ! 首字符大写
    ! 情况可能如下:
    ! 1. 小写字母, runLevel .eqv. .TRUE. 转换为大写, runLevel = .FALSE.
    ! 2. 小写字母, runLevel .eqv. .FALSE. 不变
    ! 3. 大写字母, runLevel .eqv. .TRUE. 不变, runLevel = .FALSE.
    ! 4. 大写字母, runLevel .eqv. .FALSE. 转换为小写
    ! 5. 非字符, runLevel = .TRUE. 
    function Caps(str)
        character(len=*), intent(in) :: str                                                                 ! 输入字符
        character(len=len(str)) :: Caps                                                                     ! 定义函数类型
        integer :: i                                                                                        ! 循环参数
        logical :: runLevel                                                                                 ! 运行级别(判断是否为首字母)
        runLevel = .TRUE.                                                                                   ! 初始化运行级别
        do i = 1, len(str)                                                                                  ! 遍历每个字符
            if ( lge(str(i: i), 'a') .and. lle(str(i: i), 'z') .and. ( runLevel .eqv. .TRUE. ) ) then       ! 小写字母为首字母
                Caps(i: i) = achar( iachar(str(i: i)) - 32 )                                                ! 转换为大写字母
                runLevel = .FALSE.                                                                          ! 下一个字符非首字母
            elseif ( lge(str(i: i), 'a') .and. lle(str(i: i), 'z') .and. ( runLevel .eqv. .FALSE. ) ) then  ! 小写字母非首字母
                Caps(i: i) = str(i: i)                                                                      ! 不改变字符
            elseif ( lge(str(i: i), 'A') .and. lle(str(i: i), 'Z') .and. ( runLevel .eqv. .TRUE. ) ) then   ! 大写字母为首字母
                Caps(i: i) = str(i: i)                                                                      ! 不改变字符
                runLevel = .FALSE.                                                                          ! 下一个字符非首字母
            elseif ( lge(str(i: i), 'A') .and. lle(str(i: i), 'Z') .and. ( runLevel .eqv. .FALSE. ) ) then  ! 大写字母非首字母
                Caps(i: i) = achar( iachar(str(i: i)) + 32 )                                                ! 转换为小写字母
            elseif ( lge(str(i: i), '0') .and. lle(str(i: i), '9') ) then                                   ! 如果是数字
                Caps(i: i) = str(i: i)                                                                      ! 不改变字符
                runLevel = .FALSE.                                                                          ! 下一个字符不是首字母
            else                                                                                            ! 非字母
                Caps(i: i) = str(i: i)                                                                      ! 不改变字符
                runLevel = .TRUE.                                                                           ! 下一个字符是首字母(如果是字母)
            end if
        end do
    end function Caps
end subroutine Exercises10_4
! 习题10-10 检测字符串中实际字符数量
subroutine Exercises10_10
    implicit none
    character(len=132) :: input
    character :: runLevel
    integer :: errorLevel
    integer :: firstNonBlank, lastNonBlank
    outer:do
        write(*, *) '请输入一段字符（小于132字，包含空格字符请用引号括起）'
        read(*, *) input
        write(*, *) '该字符的长度为：', LenUsed(input)
        write(*, *) '该字符的允许长度为：', len(input)
        write(*, *) '该字符除去尾部空格的长度为：', len_trim(input)
        call NonBlank(input, firstNonBlank, lastNonBlank, errorLevel)
        if ( errorLevel /= 0 ) then
            write(*, *) '错误! 没有输入字符或输入字符为空!'
        else
            write(*, *) '第一个非空字符在第', firstNonBlank, '位, 最后一个非空字符在第', lastNonBlank, '位。'
        end if
        inner:do
            write(*, *) '是否接着计算下一个字符串? 继续(Y)/结束(N)'
            read(*, *) runLevel
            if ( runLevel == 'Y' .or. runLevel == 'y' ) then
                exit inner
            else if ( runLevel == 'N' .or. runLevel == 'n' ) then
                exit outer
            else
                write(*,*) '非法输入! 请重新输入!'
            end if
        end do inner
    end do outer
contains
    ! 习题10-10 判断字符串中有多少字符
    function LenUsed(str)
        character(len=*), intent(in) :: str         ! 输入字符串
        integer :: LenUsed                          ! 定义函数返回类型
        integer :: i                                ! 循环参数
        integer :: firstSpace, lastSpace            ! 首位空白字符位置
        firstSpace = 0                              ! 初始化变量
        lastSpace = len(str)
        do i = 1, lastSpace                         ! 判断字符串首最后一个空白字符位置
            if ( str(i:i) == ' ' ) then
                firstSpace = i
            else
                exit
            end if
        end do
        if ( firstSpace /= lastSpace ) then         ! 如果不是全部都是空白字符
            do i = lastSpace, firstSpace+1, -1      ! 判断字符串尾第一个空白字符位置
                if ( str(i:i) == ' ' ) then
                    lastSpace = i
                else
                    exit
                end if
            end do
            LenUsed = lastSpace - firstSpace - 1    ! 判断字符串实际使用长度
        else
            LenUsed = 0                             ! 如果全部都是空白字符, 则长度为0
        end if
    end function LenUsed
    ! 习题10-11 判断字符串第一个和最后一个空白字符位置
    subroutine NonBlank(str, firstNonBlank, lastNonBlank, errorLevel)
        character(len=*), intent(in) :: str                 ! 输入字符串
        integer :: i                                        ! 循环参数
        integer, intent(out) :: firstNonBlank, lastNonBlank ! 首位空白字符位置
        integer, intent(out) :: errorLevel
        firstNonBlank = len(str)                            ! 初始化变量
        lastNonBlank = 0
        do i = firstNonBlank, 1, -1                         ! 判断字符串最后一个非空白位置
            if ( .not. str(i:i) == ' ' ) then
                lastNonBlank = i
                exit
            end if
        end do
        if ( lastNonBlank /= 0 ) then                       ! 如果不是全部都是空白字符
            do i = 1, lastNonBlank                          ! 判断字符串第一个空白字符位置
                if ( .not. str(i:i) == ' ' ) then
                    firstNonBlank = i
                    exit
                end if
            end do
            errorLevel = 0
        else
            firstNonBlank = 0                               ! 如果全部都是空白字符, 则位置为0
            errorLevel = 1
        end if
    end subroutine NonBlank
end subroutine Exercises10_10
! 习题10-12 输入参数文件
subroutine Exercises10_12
    implicit none
    character(len=132) :: str
    real :: start, stop, dt
    logical :: plot
    integer :: errorLevel
    open(unit=1, status='scratch', iostat=errorLevel)   ! 打开文件并输入数据
    if ( errorLevel /= 0 ) stop "打开临时文件失败"
    write(1, '(A)') &
    &"start=0.0",&
    &"stop=10.0",&
    &"dt=0.2",&
    &"plot on",&
    &"   ",&
    &"   "
    rewind(unit=1, iostat=errorLevel)                   ! 回到第一行
    if ( errorLevel /= 0 ) stop "操作临时文件失败"
    do                                                  ! 读取文件知道文件末尾
        read(1, '(A)', iostat=errorLevel) str           ! 将内容赋值给字符串
        if ( errorLevel /= 0 ) exit                     ! 判断是否到达文件末尾
        call InputData(str, start, stop, dt, plot)      ! 读取值
    end do
    write(*, *) start, stop, dt, plot                   ! 显示当前读取到的值
    close(unit=1, iostat=errorLevel)                    ! 关闭临时文件
    if ( errorLevel /= 0 ) stop "关闭临时文件失败"      ! 检测关闭状态
contains
    subroutine InputData(str, start, stop, dt, plot)                    ! 读取值子程序
        character(len=*), intent(inout) :: str                          ! 输入的字符串
        real, intent(out) :: start, stop, dt                            ! 输出数值
        integer :: tempLoc                                              ! 临时保存位置的变量
        integer :: equLoc, length                                       ! 等号位置及字符串长度
        logical :: plot                                                 ! 输出逻辑值
        equLoc = index(str, '=')                                        ! 得到等号位置
        length = len(str)                                               ! 得到字符串长度
        if ( equLoc == 0 ) then                                         ! 如果没有等号
            tempLoc = index( Ucase(str), 'PLOT')                        ! 检测全大写字符串中是否有PLOT字符
            if ( tempLoc /= 0 ) then                                    ! 如果有
                if ( index(Ucase(str(1: length)), 'ON') /= 0 ) then     ! 判断PLOT状态并赋值
                    plot = .TRUE.
                elseif ( index(Ucase(str(1: length)), 'OFF') /= 0) then
                    plot = .FALSE.
                end if
            end if
            return
        end if
        tempLoc = index( Ucase(str), 'START')                           ! 判断是否是START变量
        if ( tempLoc /= 0 .and. tempLoc < equLoc ) then                 ! 如果是
            write(str, '(A)') str(equLoc+1: length)                     ! 将值部分读入字符串
            read(str, *) start                                          ! 读取值, 接下来相同
            return
        end if
        tempLoc = index( Ucase(str), 'STOP')
        if ( tempLoc /= 0 .and. tempLoc < equLoc ) then
            write(str, '(A)') str(equLoc+1: length)
            read(str, *) stop
            return
        end if
        tempLoc = index( Ucase(str), 'DT')
        if ( tempLoc /= 0 .and. tempLoc < equLoc ) then
            write(str, '(A)') str(equLoc+1: length)
            read(str, *) dt
            return
        end if
    end subroutine InputData
    ! 转换为大写
    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 Exercises10_12
! 习题10-13 直方图 ??? 这是什么鬼需求
! 基本逻辑如下:
! 1. 首先打开一个临时文件, 并向其中输入数据
! 2. 读取数据, 并向数组中填入相关值
! 3. 依据数据, 构建一个二维数组, 并模拟图表构成
! 4. 打印这个数组, 模拟直方图的形式
subroutine Exercises10_13
    implicit none
    integer :: errorLevel
    character(len=6), dimension(7) :: arrayName                                             ! 类名
    integer, dimension(7) :: arrayValue                                                     ! 类值
    arrayName = (/'100~95', '94~90 ', '89~85 ', '84~80 ', '79~75 ', '74~70 ', '69~65 '/)    ! 定义类名
    arrayValue = (/3, 6, 9, 7, 4, 2, 1/)                                                    ! 定义类值
    write(*,*) '              Form 10.13 学生成绩分布直方图'                                ! 输出标题
    call DrawHistogram(arrayName, arrayValue, errorLevel)                                   ! 绘图
contains
    ! 直方图绘制
    subroutine DrawHistogram(arrayName, arrayValue, errorLevel)
        character(len=*), dimension(:), intent(in) :: arrayName                                         ! 输入类名
        integer, dimension(:), intent(in) :: arrayValue                                                 ! 输入类值
        integer, intent(out) :: errorLevel                                                              ! 错误码
        character(len=max(maxval(len_trim(arrayName))+1, 6)), allocatable, dimension(:, :) :: arrayDraw ! 绘图矩阵
        integer :: temp, length                                                                         ! 范围边界
        character(len=max(maxval(len_trim(arrayName))+1, 6)) :: bar, line                               ! 绘制形状
        integer :: i                                                                                    ! 循环参数
        if ( size(arrayName, 1) /= size(arrayValue, 1) ) then                                           ! 如果类名和值数量不匹配, 报错并返回
            errorLevel = 1
            return
        end if
        length = size(arrayValue, 1)                                                                    ! 获取图表类数目
        ! temp = 1                                                                                        ! 初始化类值最大值位置
        ! do i = 2, length                                                                                ! 获取类值最大值位置
        !     if ( arrayValue(i) > arrayValue(temp) ) then
        !         temp = i
        !     end if
        ! end do
        ! temp = arrayValue(temp)                                                                         ! 获取最大类值(话说为啥不直接用maxval函数)
        temp = maxval(arrayValue)                               ! 获取最大类值
        bar = ''                                                ! 初始化形状
        do i = 1, len(bar)-2
            bar(i: i) = '%'                                     ! 形成形状(用于表示直方图)
        end do
        do i = 1, len(line)
            line(i: i) = '_'                                    ! 用于显示图表下边界
        end do
        allocate(arrayDraw(temp+4, length+1), stat=errorLevel)  ! 定义数组
        if (errorLevel /= 0) print *, "arrayDraw: Allocation request denied"
        arrayDraw = ''                                          ! 初始化绘制数组
        do i = 1, temp + 3
            write(arrayDraw(i, 1)(1: 3), '(I3)') temp + 3 - i   ! 绘制数组坐标轴纵轴值
        end do
        do i = 1, temp + 3
            arrayDraw(i, 1)(len(bar)-1:len(bar)) = '| '         ! 绘制数组坐标轴纵轴边界
        end do
        arrayDraw(temp+3, 1)(len(bar)-1:len(bar)) = '|_'        ! 绘制数组坐标轴零点边界
        do i = temp-2, 1, -5
            arrayDraw(i, 1)(len(bar)-1:len(bar)) = '|-'         ! 绘制数组坐标轴纵轴刻度
        end do
        arrayDraw(temp+3, 2: length+1) = line                   ! 绘制数组坐标轴横轴
        write(arrayDraw(temp+4, 2:size(arrayName, 1)+1), '(A)') (trim(arrayName(i)), i = 1, size(arrayName, 1)) ! 绘制数组坐标轴横轴类名
        do i = 1, size(arrayName, 1)
            arrayDraw(temp+3-arrayValue(i):temp+2, i+1) = bar   ! 绘制数组直方图
        end do
        do i = 1, temp + 4
            write(*, '(100A)') arrayDraw(i, :)                  ! 打印绘制数组
        end do
        if (allocated(arrayDraw)) deallocate(arrayDraw, stat=errorLevel)    ! 释放数组
        if (errorLevel /= 0) print *, "arrayDraw: Deallocation request denied"
        errorLevel = 0                                          ! 设定错误等级为0
    end subroutine DrawHistogram
end subroutine Exercises10_13
! 习题10-14 随机数直方图
module ran001
	implicit none
	integer :: n = 12345
end module ran001
subroutine Exercises10_14
    implicit none
    integer :: i
    integer :: errorLevel
    real :: randomValue
    character(len=9), dimension(20) :: arrayName                                    ! 类名
    integer, dimension(20) :: arrayValue                                            ! 类值
    write(*,*) '              Form 10.14 随机数分布直方图'                          ! 输出标题
    arrayName = (/&
    &'0.00~0.05', '0.05~0.10', '0.10~0.15', '0.15~0.20', &
    &'0.20~0.25', '0.25~0.30', '0.30~0.35', '0.35~0.40', &
    &'0.40~0.45', '0.45~0.50', '0.50~0.55', '0.55~0.60', &
    &'0.60~0.65', '0.65~0.70', '0.70~0.75', '0.75~0.80', &
    &'0.80~0.85', '0.85~0.90', '0.90~0.95', '0.95~1.00'/)                           ! 定义类名
    call seed0(12346.)
    arrayValue = 0
    do i = 1, 20000
        call random(randomValue)
        arrayValue(int(randomValue*20+1)) = arrayValue(int(randomValue*20+1)) + 1
    end do
    call DrawHistogram(arrayName, arrayValue, errorLevel)                           ! 绘图
contains
    ! 直方图绘制
    subroutine DrawHistogram(arrayName, arrayValue, errorLevel)
        character(len=*), dimension(:), intent(in) :: arrayName                                         ! 输入类名
        integer, dimension(:), intent(in) :: arrayValue                                                 ! 输入类值
        integer, intent(out) :: errorLevel                                                              ! 错误码
        character(len=max(maxval(len_trim(arrayName))+1, 7)), allocatable, dimension(:, :) :: arrayDraw ! 绘图矩阵
        integer :: temp, length                                                                         ! 范围边界
        character(len=max(maxval(len_trim(arrayName))+1, 7)) :: bar, line                               ! 绘制形状
        integer :: i                                                                                    ! 循环参数
        integer :: maxValue                                                                             ! 最大值
        if ( size(arrayName, 1) /= size(arrayValue, 1) ) then   ! 如果类名和值数量不匹配, 报错并返回
            errorLevel = 1
            return
        end if
        length = size(arrayValue, 1)                            ! 获取图表类数目
        temp = maxval(arrayValue)                               ! 获取最大类值
        bar = ''                                                ! 初始化形状
        do i = 1, len(bar)-2
            bar(i: i) = '%'                                     ! 形成形状(用于表示直方图)
        end do
        do i = 1, len(line)
            line(i: i) = '_'                                    ! 用于显示图表下边界
        end do
        allocate(arrayDraw(14, length+1), stat=errorLevel)      ! 定义数组
        if (errorLevel /= 0) print *, "arrayDraw: Allocation request denied"
        arrayDraw = ''                                          ! 初始化绘制数组
        maxValue = maxval(arrayValue)
        do i = 1, 13
            write(arrayDraw(i, 1)(1: 4), '(I4)') nint(real(maxValue)*(13. - real(i))/10.)   ! 绘制数组坐标轴纵轴值
        end do
        do i = 1, 12
            arrayDraw(i, 1)(len(bar)-2:len(bar)) = '|  '        ! 绘制数组坐标轴纵轴边界
        end do
        arrayDraw(13, 1)(len(bar)-2:len(bar)) = '|__'           ! 绘制数组坐标轴零点边界
        do i = 8, 1, -5
            arrayDraw(i, 1)(len(bar)-2:len(bar)) = '|- '        ! 绘制数组坐标轴纵轴刻度
        end do
        arrayDraw(13, 2: length+1) = line                       ! 绘制数组坐标轴横轴
        write(arrayDraw(14, 2:size(arrayName, 1)+1), '(A)') (trim(arrayName(i)), i = 1, size(arrayName, 1)) ! 绘制数组坐标轴横轴类名
        do i = 1, size(arrayName, 1)
            arrayDraw(13-nint(real(arrayValue(i))*10./real(maxValue)):12, i+1) = bar                        ! 绘制数组直方图
        end do
        do i = 1, 14
            write(*, '(100A)') arrayDraw(i, :)                  ! 打印绘制数组
        end do
        if (allocated(arrayDraw)) deallocate(arrayDraw, stat=errorLevel)                                    ! 释放数组
        if (errorLevel /= 0) print *, "arrayDraw: Deallocation request denied"
        errorLevel = 0                                          ! 设定错误等级为0
    end subroutine DrawHistogram
    subroutine seed0(iseed)
        use ran001
        real, intent(in) :: iseed
        n = abs(iseed)
    end subroutine seed0
    subroutine random(ran)
        use ran001
        real, intent(inout) :: ran
        n = mod(8121*n+28411,134456)
        ran = real(n)/134456
    end subroutine random
end subroutine Exercises10_14
! 习题10-15 拷贝文件去除注释
subroutine Exercises10_15
    implicit none
    character(len=132) :: str
    integer :: errorLevel
    open(unit=1, status='scratch', iostat=errorLevel)
    if ( errorLevel /= 0 ) stop ""
    write(1, '(A)') &
    &"subroutine DrawHistogram(arrayName, arrayValue, errorLevel)'!'", &
    &"character(len=*), dimension(:), intent(in) :: arrayName                                         ! 输入类名", &
    &"integer, dimension(:), intent(in) :: arrayValue                                                 ! 输入类值", &
    &"integer, intent(out) :: errorLevel                                                              ! 错误码", &
    &"character(len=max(maxval(len_trim(arrayName))+1, 7)), allocatable, dimension(:, :) :: arrayDraw ! 绘图矩阵", &
    &"integer :: temp, length                                                                         ! 范围边界", &
    &"character(len=max(maxval(len_trim(arrayName))+1, 7)) :: bar, line                               ! 绘制形状"
    rewind(unit=1, iostat=errorLevel)
    if ( errorLevel /= 0 ) stop ""
    do
        read(1, '(A)', iostat=errorLevel) str
        if ( errorLevel /= 0 ) exit
        write(*, *) Uncomment(str)
    end do
contains
    function Uncomment(str)
        character(len=*), intent(in) :: str
        character(len=len(str)) :: Uncomment
        integer :: i
        integer :: runLevel
        runLevel = 0
        do i = 1, len(str)
            if ( str(i: i) == '!' .and. (runLevel == 0) ) then      ! 将感叹号转换为空格
                Uncomment(i: i) = ' '
            else
                Uncomment(i: i) = str(i: i)
            end if
            if ( str(i: i) == '"' .and. runLevel == 0 ) then        ! 判断不转换感叹号的场景
                runLevel = 1
            elseif ( str(i: i) == '"' .and. runLevel == 1 ) then
                runLevel = 0
            elseif ( str(i: i) == "'" .and. runLevel == 0 ) then
                runLevel = 2
            elseif ( str(i: i) == "'" .and. runLevel == 2 ) then
                runLevel = 0
            end if
        end do
    end function Uncomment
end subroutine Exercises10_15