Sola/Fortran-95-2003-Program-3rd-Edition-Exercise
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

update file date

Browse Source
This commit is contained in:
SolaSUSTech
2025-09-25 16:46:47 +08:00
parent 88fdb762e0
commit 1d9f18d8f3
15 changed files with 0 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

398
20210513-第11章习题.f90 Normal file
View File

@ -0,0 +1,398 @@
! ==============================================================================
! 通过 gfortran ./test.f90 -o ./run && ./run 运行
! 程序名：
! 第11章习题
! 目的:
!
! 修订记录:
! 日期 编程者 改动描述
! =================== ============= =====================================
! 2021-05-13 14:32:35 Sola 习题11-5 判断格式是否正确
! 2021-05-13 15:42:31 Sola 习题11-6 函数的导数
! 2021-05-13 17:17:22 Sola 习题11-7 经时计算，判断单精度和双精度时间
! 2021-05-14 19:19:29 Sola 习题11-8 跳过，习题11-9 复数计算
! 2021-05-14 19:56:11 Sola 习题11-10 复数的振幅和相位
! 2021-05-14 20:09:50 Sola 习题11-11 欧拉公式
! 程序结构:
!
! ==============================================================================
! 模块：
module Chapter11
implicit none
! 数据字典
! 声明常数
REAL, PARAMETER :: PI=3.14159265 ! PI值
REAL, PARAMETER :: e=2.718281828459 ! 自然对数
INTEGER, PARAMETER :: arrayLength=20 ! 数组基准长度
! 声明变量
! 创建显式接口
contains
! subroutine SubName(varName1,varName2)
! implicit none
! ! 数据字典
! end subroutine SubName
end module Chapter11
! ==============================================================================
! 主程序：
program ProName
implicit none
! 数据字典
! 声明常量
! 声明变量
! 变量初始化
! 数据输入
! 运算过程
! 结果输出
! call Exercises11_5
! call Exercises11_6
! call Exercises11_7
! call Exercises11_9
! call Exercises11_10
call Exercises11_11
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
! ==============================================================================
! 习题11-5
subroutine Exercises11_5
implicit none
call Suba
! call Subb
contains
subroutine Suba
integer, parameter :: sgl = kind(0.0)
integer, parameter :: dbl = kind(0.0D0)
real(kind=sgl) :: a
real(kind=dbl) :: b
integer :: i
integer :: errorLevel
open(unit=1, status='scratch', iostat=errorLevel)
if ( errorLevel /= 0 ) stop ""
write(*, *) sgl, dbl
do i = 1, 45
write(*, *) i, selected_real_kind(r=i)
end do
write(1, '(A)') &
&"111111111111111111111111111111111111111111111", &
&"222222222222222222222222222222222222222222222"
rewind(unit=1, iostat=errorLevel)
if ( errorLevel /= 0 ) stop ""
read(1, '(F16.2)') a, b
write(*, *) a, b
end subroutine Suba
! subroutine Subb
! end subroutine Subb
end subroutine Exercises11_5
! 习题11-6 函数的导数
subroutine Exercises11_6
implicit none
integer, parameter :: realType = selected_real_kind(p=13) ! 确认实数类型
real(realType) :: x0, dx ! 待测点, 步长
real(realType) :: derivationX0 ! 导数值
real(realType), external :: Fx ! 外部函数
x0 = 0._realType ! 变量初始化
dx = 0.01_realType
call Derivation(Fx, x0, dx, derivationX0) ! 计算导数
write(*, *) '函数在0处的值为', Fx(0._realType), '在0处的导数值为', derivationX0 ! 输出结果
contains
subroutine Derivation(inputFunction, x0, dx, derivationX0)
integer, parameter :: realType = selected_real_kind(p=13) ! 确认实数类型
real(realType), intent(in) :: x0, dx ! 输入点位及步长
real(realType), intent(out) :: derivationX0 ! 输出的导数值
real(realType), external :: inputFunction ! 外部函数
derivationX0 = (inputFunction(x0 + dx) - inputFunction(x0))/dx ! 计算导数值
end subroutine Derivation
end subroutine Exercises11_6
function Fx(x)
implicit none
integer, parameter :: realType = selected_real_kind(p=13) ! 确认实数类型
real(realType), intent(in) :: x ! 输入点位
real(realType) :: Fx ! 定义函数输出类型
Fx = 10._realType*sin(20._realType*x) ! 计算函数值
end function Fx
! 习题11-7 经时计算 不过话说回来，现在的编译器在这边好像还是有优化的，，，结果可能不太准
subroutine Exercises11_7
implicit none
integer, parameter :: dbl = selected_real_kind(p=13)
integer, parameter :: sgl = selected_real_kind(p=1)
real(dbl), dimension(10, 10) :: matrix
real(dbl), dimension(10) :: arrayX
real(sgl), dimension(10, 10) :: matrix1
real(sgl), dimension(10) :: arrayX1
integer, dimension(8) :: timeNow
real :: timePast
integer, dimension(8) :: timeOld
integer :: errorLevel
integer :: i
open(unit=1, status='scratch', iostat=errorLevel)
if ( errorLevel /= 0 ) stop ""
write(1, '(A)') &
&" -2., 5., 1., 3., 4. -1., -2., -1., -5., -2.", &
&" 6., 4., -1., 6., -4., -5., 3., -1., 4., 3.", &
&" -6., -5., -2., -2., -3., 6., 4., 2., -6., 4.", &
&" 2., 4., 4., 4., 5., -4., 0., 0., -4., 6.", &
&" -4., -1., 3., -3., -4., -4., -4., 4., 3., -3.", &
&" 4., 3., 5., 1., 1., 1., 0., 3., 3., 6.", &
&" 1., 2., -2., 0., 3., -5., 5., 0., 1., -4.", &
&" -3., -4., 2., -1., -2., 5., -1., -1., -4., 1.", &
&" 5., 5., -2., -5., 1., -4., -1., 0., -2., -3.", &
&" -5., -2., -5., 2., -1., 3., -1., 1., -4., 4."
rewind(unit=1, iostat=errorLevel)
if ( errorLevel /= 0 ) stop ""
arrayX = (/ -5., -6., -7., 0., 5., -8., 1., -4., -7., 6./)
read(1, *) (matrix(i, :), i = 1, 10)
rewind(unit=1, iostat=errorLevel)
if ( errorLevel /= 0 ) stop ""
arrayX1 = (/ -5., -6., -7., 0., 5., -8., 1., -4., -7., 6./)
read(1, *) (matrix1(i, :), i = 1, 10)
call set_timer
do i = 1, 1000000
call GAEli1(matrix1, arrayX1, errorLevel)
! arrayX1 = (/ -5., -6., -7., 0., 5., -8., 1., -4., -7., 6./)
end do
call elapsed_time(timePast)
write(*, *) '使用单精度计算消耗时间', timePast, 's'
call set_timer
do i = 1, 1000000
call GAEli2(matrix, arrayX, errorLevel)
! arrayX = (/ -5., -6., -7., 0., 5., -8., 1., -4., -7., 6./)
end do
call elapsed_time(timePast)
write(*, *) '使用双精度计算消耗时间', timePast, '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
! 高斯-亚当消元法，不破坏输入矩阵
subroutine GAEli1(matrixInput1, arrayX, errorLevel)
integer, parameter :: varKind = selected_real_kind(p=2)
real(varKind), dimension(:, :), intent(inout) :: matrixInput1 ! 输入矩阵(输入)
real(varKind), dimension(size(matrixInput1, 1), size(matrixInput1, 2)) :: matrixInput
! 运算矩阵
real(varKind), dimension(:), intent(inout) :: arrayX ! 输入常数向量, 输出X解向量
integer, intent(out) :: errorLevel ! 错误值
real(varKind) :: temp ! 临时值, 用于数值交换
integer :: maxLocate ! 最大值所在行
integer :: i, n, m ! 局部变量: 循环参数
matrixInput = matrixInput1
m = size(matrixInput, 1)
do n = 1, m
maxLocate = n ! 初始化绝对值最大的位置
do i = n+1, m ! 执行最大支点技术，减少舍入误差
if ( abs(matrixInput(i, n)) > abs(matrixInput(maxLocate, n)) ) then
maxLocate = i
end if
end do
if ( abs(matrixInput(maxLocate, n)) < 1.0E-30 ) then
errorLevel = 1 ! 如果绝对值最大为0, 则矩阵不满秩, 无解
return ! 退出运算
end if
if ( maxLocate /= n ) then ! 如果绝对值最大值位置发生了变化, 则交换
do i = 1, m
temp = matrixInput(maxLocate, i)
matrixInput(maxLocate, i) = matrixInput(n, i)
matrixInput(n, i) = temp
end do
temp = arrayX(maxLocate)
arrayX(maxLocate) = arrayX(n)
arrayX(n) = temp
end if
do i = 1, m ! 消去其他行所有第n列的系数
if ( i /= n ) then
temp = -matrixInput(i, n)/matrixInput(n, n) ! 这里务必要设置一个临时值保存数值, 不然会被修改
matrixInput(i, :) = matrixInput(i, :) + matrixInput(n, :)*temp
arrayX(i) = arrayX(i) + arrayX(n)*temp
end if
end do
end do
do i = 1, m ! 产生X的解向量
arrayX(i) = arrayX(i)/matrixInput(i, i)
matrixInput(i, i) = 1.
end do
errorLevel = 0
end subroutine GAEli1
subroutine GAEli2(matrixInput1, arrayX, errorLevel)
integer, parameter :: varKind = selected_real_kind(p=13)
real(varKind), dimension(:, :), intent(inout) :: matrixInput1 ! 输入矩阵(输入)
real(varKind), dimension(size(matrixInput1, 1), size(matrixInput1, 2)) :: matrixInput
! 运算矩阵
real(varKind), dimension(:), intent(inout) :: arrayX ! 输入常数向量, 输出X解向量
integer, intent(out) :: errorLevel ! 错误值
real(varKind) :: temp ! 临时值, 用于数值交换
integer :: maxLocate ! 最大值所在行
integer :: i, n, m ! 局部变量: 循环参数
matrixInput = matrixInput1
m = size(matrixInput, 1)
do n = 1, m
maxLocate = n ! 初始化绝对值最大的位置
do i = n+1, m ! 执行最大支点技术，减少舍入误差
if ( abs(matrixInput(i, n)) > abs(matrixInput(maxLocate, n)) ) then
maxLocate = i
end if
end do
if ( abs(matrixInput(maxLocate, n)) < 1.0E-30 ) then
errorLevel = 1 ! 如果绝对值最大为0, 则矩阵不满秩, 无解
return ! 退出运算
end if
if ( maxLocate /= n ) then ! 如果绝对值最大值位置发生了变化, 则交换
do i = 1, m
temp = matrixInput(maxLocate, i)
matrixInput(maxLocate, i) = matrixInput(n, i)
matrixInput(n, i) = temp
end do
temp = arrayX(maxLocate)
arrayX(maxLocate) = arrayX(n)
arrayX(n) = temp
end if
do i = 1, m ! 消去其他行所有第n列的系数
if ( i /= n ) then
temp = -matrixInput(i, n)/matrixInput(n, n) ! 这里务必要设置一个临时值保存数值, 不然会被修改
matrixInput(i, :) = matrixInput(i, :) + matrixInput(n, :)*temp
arrayX(i) = arrayX(i) + arrayX(n)*temp
end if
end do
end do
do i = 1, m ! 产生X的解向量
arrayX(i) = arrayX(i)/matrixInput(i, i)
matrixInput(i, i) = 1.
end do
errorLevel = 0
end subroutine GAEli2
end subroutine Exercises11_7
! 习题11-9 复数计算
subroutine Exercises11_9
implicit none
integer, parameter :: dbl = selected_real_kind(p=3)
complex(dbl), dimension(3, 3) :: matrix
complex(dbl), dimension(3) :: arrayX
integer :: errorLevel
integer :: i
open(unit=1, status='scratch', iostat=errorLevel)
if ( errorLevel /= 0 ) stop ""
write(1, '(A)') &
&"( -2., 5.), ( 1., 3.), ( 4., -1.)", &
&"( 2., -1.), ( -5., -2.), ( -1., 6.)", &
&"( -1., 6.), ( -4., -5.), ( 3., -1.)", &
&"( 7., 5.), (-10., -8.), ( -3., -3.)"
rewind(unit=1, iostat=errorLevel)
if ( errorLevel /= 0 ) stop ""
read(1, *) (matrix(i, :), i = 1, 3)
read(1, *) arrayX
call GAEli(matrix, arrayX, errorLevel)
write(*, *) '计算结果为：'
write(*, *) 'x1 = ', arrayX(1)
write(*, *) 'x2 = ', arrayX(2)
write(*, *) 'x3 = ', arrayX(3)
contains
! 复数求解
subroutine GAEli(matrixInput1, arrayX, errorLevel)
integer, parameter :: varKind = selected_real_kind(p=3)
complex(varKind), dimension(:, :), intent(inout) :: matrixInput1 ! 输入矩阵(输入)
complex(varKind), dimension(size(matrixInput1, 1), size(matrixInput1, 2)) :: matrixInput
! 运算矩阵
complex(varKind), dimension(:), intent(inout) :: arrayX ! 输入常数向量, 输出X解向量
integer, intent(out) :: errorLevel ! 错误值
complex(varKind) :: temp ! 临时值, 用于数值交换
integer :: maxLocate ! 最大值所在行
integer :: i, n, m ! 局部变量: 循环参数
matrixInput = matrixInput1
m = size(matrixInput, 1)
do n = 1, m
maxLocate = n ! 初始化绝对值最大的位置
do i = n+1, m ! 执行最大支点技术，减少舍入误差
if ( cabs(matrixInput(i, n)) > cabs(matrixInput(maxLocate, n)) ) then
maxLocate = i
end if
end do
if ( cabs(matrixInput(maxLocate, n)) < 1.0E-30 ) then
errorLevel = 1 ! 如果绝对值最大为0, 则矩阵不满秩, 无解
return ! 退出运算
end if
if ( maxLocate /= n ) then ! 如果绝对值最大值位置发生了变化, 则交换
do i = 1, m
temp = matrixInput(maxLocate, i)
matrixInput(maxLocate, i) = matrixInput(n, i)
matrixInput(n, i) = temp
end do
temp = arrayX(maxLocate)
arrayX(maxLocate) = arrayX(n)
arrayX(n) = temp
end if
do i = 1, m ! 消去其他行所有第n列的系数
if ( i /= n ) then
temp = -matrixInput(i, n)/matrixInput(n, n) ! 这里务必要设置一个临时值保存数值, 不然会被修改
matrixInput(i, :) = matrixInput(i, :) + matrixInput(n, :)*temp
arrayX(i) = arrayX(i) + arrayX(n)*temp
end if
end do
end do
do i = 1, m ! 产生X的解向量
arrayX(i) = arrayX(i)/matrixInput(i, i)
matrixInput(i, i) = 1.
end do
errorLevel = 0
end subroutine GAEli
end subroutine Exercises11_9
! 习题11-10 复数的振幅和相位
subroutine Exercises11_10
implicit none
integer, parameter :: sgl=selected_real_kind(p=2) ! 定义单精度
complex(sgl) :: var1 ! 定义复数
real(sgl) :: amp, theta ! 定义振幅和相位
real(sgl), parameter :: PI=3.14159265 ! 圆周率
call InputComplex(amp, theta) ! 调用子程序, 获取输入复数的振幅和相位
write(*, *) '振幅为：', amp, '， 相位为：', theta, '°' ! 输出结果
contains
subroutine InputComplex(amp, theta)
integer, parameter :: sgl=selected_real_kind(p=2) ! 定义单精度
real(sgl), intent(out) :: amp, theta ! 定义输出结果
complex(sgl) :: var1 ! 定义输入复数
write(*, *) '请输入一个复数：' ! 提示信息
read(*, *) var1 ! 读取输入复数
amp = cabs(var1) ! 获取振幅
theta = atan(aimag(var1)/real(var1))*360./(2.*PI) ! 获取相位(角度)
end subroutine InputComplex
end subroutine Exercises11_10
! 习题11-11 欧拉公式
subroutine Exercises11_11
implicit none
integer, parameter :: sgl=selected_real_kind(p=2) ! 定义单精度
real(sgl) :: theta ! 定义角度(弧度)
complex(sgl) :: var1 ! 定义复数
real(sgl) :: PI=3.14159265 ! 圆周率
integer :: i ! 循环参数
do i = 0, 2 ! 循环theta = 0, pi/2, pi
theta = i*PI/2. ! 计算theta
write(*, '("theta = ", F6.2,", e^theta_i = " 2("(", ES9.2, ",", ES9.2, ") "))') &
&theta, cexp(cmplx(0., theta, sgl)), EulerFormula(theta)! 输出结果
end do
contains
! 欧拉公式
function EulerFormula(theta)
integer, parameter :: sgl=selected_real_kind(p=2) ! 定义单精度
real(sgl), intent(in) :: theta ! 定义输入角度(弧度)
complex(sgl) :: EulerFormula ! 定义函数返回类型
EulerFormula = cmplx(cos(theta), sin(theta), sgl) ! 计算返回值
end function EulerFormula
end subroutine Exercises11_11