! ==============================================================================
! 通过 gfortran ./test.f90 -o ./run && ./run 运行
! 程序名：
!   第13章习题
! 目的:
! 
! 修订记录:
!         日期              编程者               改动描述
! ===================   =============   =====================================
! 2021-05-19 21:36:27       Sola            习题13-1 上一章写过了
! 2021-05-19 21:36:44       Sola            习题13-2 递归函数和子程序计算阶乘
! 2021-05-19 22:06:42       Sola            习题13-3 验证例题13-2的子程序
! 2021-05-19 22:30:37       Sola            习题13-4 ~ 习题13-18 跳过
! 2021-05-19 22:56:02       Sola            习题13-19 极坐标复数
! 2021-05-19 23:21:36       Sola            习题13-20 复数的极坐标乘除
! 2021-05-19 23:40:41       Sola            习题13-21 ~ 习题13-22 跳过
! 2021-05-19 23:42:15       Sola            习题13-23 ...之前就是这么写的
! 2021-05-19 23:44:46       Sola            习题13-24 跳过
! 程序结构:
! 
! ==============================================================================
! 主程序：
program Chapter13
    implicit none
    ! 数据字典
    ! 声明常量
    ! 声明变量
    ! 变量初始化
    ! 数据输入
    ! 运算过程
    ! 结果输出
    ! call Exercises13_2
    ! call Exercises13_3
    ! call Exercises13_19
    ! call Exercises13_20
end program Chapter13
! ==============================================================================
! 习题13-2 递归函数和子程序计算阶乘
subroutine Exercises13_2
    implicit none
    interface
        subroutine SubFactorial(n, result)
            implicit none
            integer, intent(in) :: n
            integer, intent(out) :: result
            integer :: temp
        end subroutine SubFactorial
        recursive function FunFactorial(n) result(result)
            implicit none
            integer, intent(in) :: n
            integer :: result
        end function FunFactorial
    end interface
    integer :: result
    call SubFactorial(5, result)
    write(*, *) "通过子程序计算5的阶乘为：  ", result
    write(*, *) "通过函数计算10的阶乘为：   ", FunFactorial(10)
end subroutine Exercises13_2
! 阶乘运算子程序
recursive subroutine SubFactorial(n, result)
    implicit none
    integer, intent(in) :: n
    integer, intent(out) :: result
    integer :: temp
    if ( n >= 1 ) then
        call SubFactorial(n-1, temp)
        result = n*temp
    else
        result = 1
    end if
end subroutine SubFactorial
! 阶乘运算函数
recursive function FunFactorial(n) result(result)
    implicit none
    integer, intent(in) :: n
    integer :: result
    if ( n >= 1 ) then
        result = n*FunFactorial(n-1)
    else
        result = 1
    end if
end function FunFactorial
! 习题13-3 验证例题13-2子程序, 求极值
subroutine Exercises13_3
    implicit none
    interface
        subroutine Extremes(a, n, maxVal, posMaxVal, minVal, posMinVal)
            implicit none
            integer, intent(in) :: n
            real, intent(in), dimension(n) :: a
            real, intent(out), optional :: maxVal
            integer, intent(out), optional :: posMaxVal
            real, intent(out), optional :: minVal
            integer, intent(out), optional :: posMinVal
        end subroutine Extremes
    end interface
    real, dimension(18) :: input
    integer :: maxLoc, minLoc
    real :: maxValue, minValue
    input = (/ 3., 4., 0., 1., 2., 1., 1., 9., 9., 8., 0., 7., 2., 0., 7., 3., 3., 3./)
    call Extremes(input, 18, minVal=minValue, maxVal=maxValue, posMinVal=minLoc, posMaxVal=maxLoc)
    write(*, *) "数组在第", maxLoc, "位取到最大值", maxValue
    write(*, *) "数组在第", minLoc, "位取到最小值", minValue
end subroutine Exercises13_3
subroutine Extremes(a, n, maxVal, posMaxVal, minVal, posMinVal)
    implicit none
    integer, intent(in) :: n
    real, intent(in), dimension(n) :: a
    real, intent(out), optional :: maxVal
    integer, intent(out), optional :: posMaxVal
    real, intent(out), optional :: minVal
    integer, intent(out), optional :: posMinVal
    integer :: i
    real :: realMax
    integer :: posMax
    real :: realMin
    integer :: posMin
    realMax = a(1)
    posMax = 1
    realMin = a(1)
    posMin = 1
    do i = 2, n
        if ( a(i) > realMax ) then
            realMax = a(i)
            posMax = i
        end if
        if ( a(i) < realMin ) then
            realMin = a(i)
            posMin = i
        end if
    end do
    if ( present(maxVal) ) maxVal = realMax
    if ( present(posMaxVal) ) posMaxVal = posMax
    if ( present(minVal) ) minVal = realMin
    if ( present(posMinVal) ) posMinVal = posMin
end subroutine Extremes
! 习题13-19 极坐标复数
module Exercises13_19_Mod
    implicit none
    interface assignment(=)
        module procedure Complex2Polar
        module procedure Polar2Complex
    end interface
    interface operator(*)
        module procedure PolarMul
    end interface
    interface operator(/)
        module procedure PolarDiv
    end interface
    type :: polar
        real :: z
        real :: theta
    end type
    private
    ! private :: Complex2Polar, Polar2Complex
    public :: assignment(=), polar, operator(*), operator(/)
contains
    subroutine Complex2Polar(result, input)
        implicit none
        type(polar), intent(out) :: result
        complex, intent(in) :: input
        result%z = cabs(input)
        result%theta = atan(aimag(input)/real(input))
    end subroutine
    subroutine Polar2Complex(result, input)
        implicit none
        complex, intent(out) :: result
        type(polar), intent(in) :: input
        result = cmplx(input%z*cos(input%theta), input%z*sin(input%theta))
    end subroutine
    function PolarMul(var1, var2) result(result)
        implicit none
        type(polar), intent(in) :: var1, var2
        type(polar) :: result
        result%z = var1%z*var2%z
        result%theta = mod(var1%theta + var2%theta + 3.141593, 3.141593*2) - 3.141593
    end function PolarMul
    function PolarDiv(var1, var2) result(result)
        implicit none
        type(polar), intent(in) :: var1, var2
        type(polar) :: result
        result%z = var1%z/var2%z
        result%theta = mod(var1%theta - var2%theta + 3.141593, 3.141593*2) - 3.141593
    end function PolarDiv
end module Exercises13_19_Mod
subroutine Exercises13_19
    use Exercises13_19_Mod, only: assignment(=), polar
    implicit none
    type(polar) :: a
    complex :: b
    b = (1.0, 2.0)
    a = b
    b = a
    write(*, *) "计算得到的极坐标形式为", a, "; 计算得到的直角坐标形式为", b
end subroutine Exercises13_19
! 习题13-20 复数的极坐标乘除
subroutine Exercises13_20
    use Exercises13_19_Mod, only: polar, operator(*), operator(/), assignment(=)
    implicit none
    complex :: a, b
    type(polar) :: c, d
    a = (1.0, 1.0)
    b = (1.0,-1.0)
    c = a
    d = b
    write(*, *) "c的初始值为:   ", c, "; d的初始值为:   ", d
    write(*, *) "c*d的结果为:   ", c*d, "; c/d的结果为:   ", c/d
end subroutine Exercises13_20