932 lines
44 KiB
Fortran
932 lines
44 KiB
Fortran
! ==============================================================================
|
||
! 通过 gfortran ./test.f90 -o ./run && ./run 运行
|
||
! 程序名：
|
||
! 习题
|
||
! 目的:
|
||
!
|
||
! 修订记录:
|
||
! 日期 编程者 改动描述
|
||
! =================== ============= =====================================
|
||
! 2021-04-16 19:59:35 Sola 7.3 1~4 编写源代码
|
||
! 2021-04-16 20:30:45 Sola 修改7.3 4的代码（直接比较赋值不就好了）
|
||
! 2021-04-16 21:28:46 Sola 测试下external语句的使用
|
||
! 2021-04-17 16:10:12 Sola 习题7-9b
|
||
! 2021-04-17 16:22:35 Sola 习题7-10
|
||
! 2021-04-17 16:51:53 Sola 习题7-14 随机数程序
|
||
! 2021-04-17 16:57:46 Sola 习题7-15 掷色子程序
|
||
! 2021-04-17 17:39:09 Sola 习题7-16 泊松分布
|
||
! 2021-04-17 18:01:03 Sola 习题7-18 计算双曲正弦值、余弦值、正切值
|
||
! 2021-04-17 18:49:40 Sola 习题7-19 向量叉积（3维向量）
|
||
! 2021-04-17 20:16:43 Sola 习题7-20 数组排序
|
||
! 2021-04-17 21:11:06 Sola 习题7-21 函数的最大值和最小值
|
||
! 2021-04-17 21:45:25 Sola 习题7-22 代入函数计算
|
||
! 2021-04-17 21:54:08 Sola 习题7-23 微分函数
|
||
! 2021-04-18 00:54:09 Sola 习题7-24 噪声值微分
|
||
! 2021-04-18 11:50:23 Sola 习题7-25 二进制运算(加减及进制转换)
|
||
! 2021-04-25 15:23:51 Sola 习题7-26 线性最小二乘拟合
|
||
! 2021-04-25 16:00:28 Sola 习题7-27 最小二乘拟合的相关系数
|
||
! 2021-04-25 16:07:05 Sola 习题7-28 生日问题
|
||
! 2021-04-25 17:42:55 Sola 习题7-29 经时计算
|
||
! 2021-04-25 21:04:53 Sola 习题7-30 使用计时器子程序
|
||
! 2021-04-25 21:49:32 Sola 习题7-31 估算无限序列
|
||
! 2021-04-25 22:45:24 Sola 习题7-32 使用子程序计算随机分布
|
||
! 2021-04-26 00:20:22 Sola 习题7-33 高斯(正态)分布
|
||
! 2021-04-26 01:43:23 Sola 习题7-34 引力
|
||
! 2021-04-26 01:54:59 Sola 习题7-35 堆排序, 了解有这么个玩意就成
|
||
! 程序结构:
|
||
!
|
||
! ==============================================================================
|
||
! 模块：
|
||
module MouName
|
||
implicit none
|
||
! 数据字典
|
||
! 声明常数
|
||
REAL, PARAMETER :: PI=3.14159265 ! PI值
|
||
REAL, PARAMETER :: e=2.718281828459 ! 自然对数
|
||
INTEGER, PARAMETER :: arrayLength=20 ! 数组基准长度
|
||
REAL, PARAMETER :: criticalZero=1.0E-30 ! 0的临界值
|
||
! 声明变量
|
||
! real function Function1(x)
|
||
! real function Function2(x)
|
||
! integer function Function3(n)
|
||
! logical function Function4(x,y)
|
||
real :: x, y
|
||
integer :: n
|
||
! 创建显式接口
|
||
contains
|
||
! 习题7.3 2
|
||
real function Function2(x)
|
||
implicit none
|
||
real, intent(in) :: x
|
||
Function2=(exp(x)-exp(-x))/(exp(x)+exp(-x))
|
||
end function Function2
|
||
! 习题7.3 3 计算阶乘
|
||
integer function Function3(n)
|
||
implicit none
|
||
! external :: Function3
|
||
integer, intent(in) :: n
|
||
integer :: i
|
||
Function3 = 1
|
||
do i=2,n
|
||
Function3 = Function3 * i
|
||
end do
|
||
end function Function3
|
||
! 习题7.3 4
|
||
logical function Function4(x, y)
|
||
implicit none
|
||
real, intent(in) :: x, y
|
||
! if ( x**2+y**2 > 1.0 ) then
|
||
! Function4 = .TRUE.
|
||
! else
|
||
! Function4 = .FALSE.
|
||
! end if
|
||
Function4 = x**2+y**2 > 1.0
|
||
end function Function4
|
||
! 测试用
|
||
subroutine Subroutine1(fun, x, result, errorLevel)
|
||
implicit none
|
||
real :: fun
|
||
! external :: fun
|
||
real, intent(in) :: x
|
||
real, intent(out) :: result
|
||
integer, intent(out) :: errorLevel
|
||
result = fun(x)
|
||
end subroutine Subroutine1
|
||
! 习题7-9 b
|
||
subroutine max_char(string, big)
|
||
implicit none
|
||
character(len=10), intent(in) :: string
|
||
character, intent(out) :: big
|
||
integer :: i
|
||
big = string(1:1)
|
||
do i = 2,10
|
||
if ( string(i:i) > big ) then
|
||
big = string(i:i)
|
||
end if
|
||
end do
|
||
end subroutine max_char
|
||
! 叉积运算函数
|
||
function VectorProduct_3(vectorX, vectorY)
|
||
implicit none
|
||
real, dimension(3) :: VectorProduct_3
|
||
real, dimension(3), intent(in) :: vectorX, vectorY
|
||
VectorProduct_3 = vectorX((/2,3,1/))*vectorY((/3,1,2/))-vectorY((/2,3,1/))*vectorX((/3,1,2/))
|
||
end function VectorProduct_3
|
||
! function VectorProduct_3(vectorX, vectorY)
|
||
! implicit none
|
||
! real, dimension(3) :: VectorProduct_3
|
||
! real, dimension(3), intent(in) :: vectorX, vectorY
|
||
! ! write(*,*) vectorX, vectorY
|
||
! ! VectorProduct_3=[1,1,1]
|
||
! VectorProduct_3 = vectorX((/2,3,1/))*vectorY((/3,1,2/))-vectorY((/2,3,1/))*vectorX((/3,1,2/))
|
||
! end function VectorProduct_3
|
||
! 随机数子程序
|
||
! subroutine random(ran, iseed)
|
||
! implicit none
|
||
! real, intent(in) :: iseed
|
||
! real, intent(out) :: ran
|
||
! real :: n
|
||
! if ( iseed = '' ) then
|
||
! iseed = 12345
|
||
! end if
|
||
! n = abs(iseed)
|
||
! n = mod(8121*n+28411,134456)
|
||
! ran = real(n)/134456
|
||
! end subroutine random
|
||
! 字符串二进制加法运算
|
||
function BinaryAddition(strInput1, strInput2, strLength)
|
||
implicit none
|
||
integer, intent(in) :: strLength
|
||
character(len=strLength), intent(in) :: strInput1, strInput2
|
||
character(len=strLength) :: BinaryAddition
|
||
integer :: i, j
|
||
j = 0
|
||
do i = 1, strLength
|
||
if ( (strInput1(i:i) /= '0' .and. strInput1(i:i) /= '1') &
|
||
&.or. (strInput2(i:i) /= '0' .and. strInput2(i:i) /= '1') ) stop "输入数据包含非法字符"
|
||
end do
|
||
do i = strLength, 1, -1
|
||
select case ( iachar(strInput1(i:i)) + iachar(strInput2(i:i)) + j )
|
||
case ( 96:96 )
|
||
BinaryAddition(i:i) = '0' ! 0+0
|
||
j = 0
|
||
case ( 97:97 )
|
||
BinaryAddition(i:i) = '1' ! 0+1, 1+0, 0+0+1
|
||
j = 0
|
||
case ( 98:98 )
|
||
BinaryAddition(i:i) = '0' ! 1+1, 1+0+1, 0+1+1
|
||
j = 1
|
||
case ( 99:99 )
|
||
BinaryAddition(i:i) = '1' ! 1+1+1
|
||
j = 1
|
||
end select
|
||
end do
|
||
end function BinaryAddition
|
||
! 字符串二进制减法运算
|
||
function BinarySubtraction(strInput1, strInput2, strLength)
|
||
implicit none
|
||
integer, intent(in) :: strLength
|
||
character(len=strLength), intent(in) :: strInput1, strInput2
|
||
character(len=strLength) :: BinarySubtraction
|
||
integer :: i, j
|
||
j = 0
|
||
do i = 1, strLength
|
||
if ( (strInput1(i:i) /= '0' .and. strInput1(i:i) /= '1') &
|
||
&.or. (strInput2(i:i) /= '0' .and. strInput2(i:i) /= '1') ) stop "输入数据包含非法字符"
|
||
end do
|
||
do i = strLength, 1, -1
|
||
select case ( iachar(strInput1(i:i)) - iachar(strInput2(i:i)) + j )
|
||
case ( 0:0 )
|
||
BinarySubtraction(i:i) = '0' ! 0-0, 1-1, 1-0-1
|
||
j = 0
|
||
case ( 1:1 )
|
||
BinarySubtraction(i:i) = '1' ! 1-0
|
||
j = 0
|
||
case ( -1:-1 )
|
||
BinarySubtraction(i:i) = '1' ! 0-1, 0-0-1, 1-1-1
|
||
j = -1
|
||
case ( -2:-2 )
|
||
BinarySubtraction(i:i) = '0' ! 0-1-1
|
||
j = -1
|
||
end select
|
||
end do
|
||
end function BinarySubtraction
|
||
! 字符串二进制转整型十进制
|
||
integer function BaseConversion_2To10(Base2Str, strLength)
|
||
implicit none
|
||
integer, intent(in) :: strLength
|
||
character(len=strLength), intent(in) :: Base2Str
|
||
integer :: i, value
|
||
BaseConversion_2To10 = 0
|
||
do i = 2, strLength
|
||
read(Base2Str(i:i),*) value
|
||
BaseConversion_2To10 = BaseConversion_2To10 + value*2**(strLength-i)
|
||
end do
|
||
if ( Base2Str(1:1) == '1' ) BaseConversion_2To10 = BaseConversion_2To10 - 2**(strLength-1)
|
||
end function BaseConversion_2To10
|
||
! 整数型十进制转字符串二进制
|
||
function BaseConversion_10To2(Base10Int, strLength)
|
||
implicit none
|
||
integer, intent(in) :: Base10Int, strLength
|
||
character(len=strLength) :: BaseConversion_10To2, oneBase2
|
||
integer :: i, value
|
||
value = abs(Base10Int)
|
||
if ( value > 2**(strLength-1) ) stop "数值越界"
|
||
do i = strLength, 1, -1
|
||
if ( mod(value, 2) == 1 ) then
|
||
BaseConversion_10To2(i:i) = '1'
|
||
else
|
||
BaseConversion_10To2(i:i) = '0'
|
||
end if
|
||
value = value / 2
|
||
end do
|
||
if ( Base10Int < 0 ) then
|
||
do i = 1, strLength
|
||
if ( BaseConversion_10To2(i:i) == '1' ) then
|
||
BaseConversion_10To2(i:i) = '0'
|
||
else
|
||
BaseConversion_10To2(i:i) = '1'
|
||
end if
|
||
end do
|
||
do i = 1, strLength-1
|
||
oneBase2(i:i) = '0'
|
||
end do
|
||
oneBase2(strLength:strLength) = '1'
|
||
BaseConversion_10To2 = BinaryAddition(BaseConversion_10To2, oneBase2, strLength)
|
||
end if
|
||
end function BaseConversion_10To2
|
||
end module MouName
|
||
! ==============================================================================
|
||
! 主程序：
|
||
program ProName
|
||
use MouName
|
||
implicit none
|
||
! 数据字典
|
||
! 声明常量
|
||
! 声明变量
|
||
! real, external :: Function1
|
||
real :: Function1
|
||
real :: result
|
||
integer :: errorLevel
|
||
! 变量初始化
|
||
! write(*,*) '1. 输入x=2，则f(x)= ', Function1(2.)
|
||
! write(*,*) '2. 输入x=3，则tanh(x)= ', Function2(3.)
|
||
! write(*,*) '3. 11的阶乘为 ', Function3(11)
|
||
! write(*,*) '4. 输入x=3，y=4，则其平方和是否大于1.0？结果为：', Function4(3., 4.)
|
||
! call Subroutine1(Function1, 3., result, errorLevel)
|
||
! write(*,*) result
|
||
! call Exercises7_9
|
||
! call Exercises7_10
|
||
! call Exercises7_15
|
||
! call Exercises7_16
|
||
! call Exercises7_18
|
||
! call Exercises7_19
|
||
! call Exercises7_20
|
||
! call Exercises7_21
|
||
! call Exercises7_23
|
||
! call Exercises7_25
|
||
! call Exercises7_26
|
||
! call Exercises7_28
|
||
! call Exercises7_29
|
||
! call Exercises7_31
|
||
! call Exercises7_32
|
||
! call Exercises7_33
|
||
! call Exercises7_34
|
||
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
|
||
! ==============================================================================
|
||
real function Function1(x)
|
||
implicit none
|
||
! 数据字典
|
||
real, intent(in) :: x
|
||
Function1 = (x-1)/(x+1)
|
||
end function Function1
|
||
! 习题7-9 b 最终结果会出现警告，但可以运行，结果也是正确的，不知道是不是巧合
|
||
subroutine Exercises7_9
|
||
use MouName
|
||
implicit none
|
||
character(len=10) :: str = '1AbHz05Z'
|
||
character :: largest
|
||
call max_char (str, largest)
|
||
write(*,100) str, largest
|
||
100 format(' The largest character in ', A, ' is ', A)
|
||
end subroutine Exercises7_9
|
||
! 习题7-10
|
||
module my_constants
|
||
implicit none
|
||
real, parameter :: PI_1 = 3.141593
|
||
real, parameter :: G_1 = 9.81
|
||
end module my_constants
|
||
subroutine Exercises7_10
|
||
! implicit none
|
||
use my_constants
|
||
write(*,*) 'SIN(2*PI) = ', sin(2.*PI_1)
|
||
! G_1 = 17.
|
||
end subroutine Exercises7_10
|
||
! 习题7-14
|
||
module ran001
|
||
implicit none
|
||
integer :: n = 12345
|
||
end module ran001
|
||
|
||
subroutine seed0(iseed)
|
||
use ran001
|
||
implicit none
|
||
real, intent(in) :: iseed
|
||
n = abs(iseed)
|
||
end subroutine seed0
|
||
|
||
subroutine random(ran)
|
||
use ran001
|
||
implicit none
|
||
real, intent(inout) :: ran
|
||
n = mod(8121*n+28411,134456)
|
||
ran = real(n)/134456
|
||
end subroutine random
|
||
|
||
subroutine Exercises7_14
|
||
implicit none
|
||
real :: randomSeed = 123456
|
||
real :: randomValue
|
||
integer :: i
|
||
call seed0(randomSeed)
|
||
do i = 1,10
|
||
call random(randomValue)
|
||
randomValue = randomValue*2.-1
|
||
write(*,*) randomValue
|
||
end do
|
||
end subroutine Exercises7_14
|
||
! 习题7-15
|
||
subroutine Exercises7_15
|
||
implicit none
|
||
real :: randomSeed = 123456
|
||
real :: randomValue, sum = 0
|
||
integer :: i, point
|
||
integer, dimension(6) :: pointSum
|
||
call seed0(randomSeed)
|
||
pointSum = 0
|
||
do i = 1,1000000
|
||
call random(randomValue)
|
||
point = int(randomValue*6+1)
|
||
! write(*,*) '你掷到了数字', point
|
||
pointSum(point) = pointSum(point) + 1
|
||
end do
|
||
write(*,*) '各点数计数分别为：', (pointSum(i), ',', i = 1, 6)
|
||
end subroutine
|
||
! 习题7-16
|
||
subroutine Exercises7_16
|
||
implicit none
|
||
real :: countPerMinute, time, probability, PoissonDistribution
|
||
integer :: k
|
||
countPerMinute=1.6
|
||
time=1.
|
||
do k = 0, 5
|
||
probability = PoissonDistribution(k, time, countPerMinute)
|
||
write(*,*) '一分钟内有', k, '辆车经过的可能性为', probability
|
||
end do
|
||
end subroutine Exercises7_16
|
||
! 泊松分布函数
|
||
real function PoissonDistribution(k, t, countBar)
|
||
implicit none
|
||
integer, intent(in) :: k
|
||
real, intent(in) :: t, countBar
|
||
integer :: i, kFactorial
|
||
kFactorial = 1
|
||
do i = 2, k
|
||
kFactorial = kFactorial*i
|
||
end do
|
||
PoissonDistribution = exp(-countBar*t)*(countBar*t)**k/real(kFactorial)
|
||
end function PoissonDistribution
|
||
! 习题7-18
|
||
subroutine Exercises7_18
|
||
implicit none
|
||
real :: x, FunSinh, FunCosh, FunTanh
|
||
integer :: i
|
||
real, dimension(11) :: numList=[-2.0,-1.5,-1.0,-0.5,-0.25,0.0,0.25,0.5,1.0,1.5,2.0]
|
||
x = 1.2
|
||
write(*,*) '双曲正弦值：计算结果为：', FunSinh(x), '验证值为：', sinh(x)
|
||
write(*,*) '双曲余弦值：计算结果为：', FunCosh(x), '验证值为：', cosh(x)
|
||
write(*,*) '双曲正切值：计算结果为：', FunTanh(x), '验证值为：', tanh(x)
|
||
write(*,*)
|
||
write(*,1) 'Num ', numList
|
||
write(*,*) '==== ======== ======== ======== ======== ======== &
|
||
&======== ======== ======== ======== ======== ========'
|
||
write(*,1) 'Sinh', (FunSinh(numList(i)), i = 1, 11)
|
||
write(*,1) 'CosH', (FunCosh(numList(i)), i = 1, 11)
|
||
write(*,1) 'Tanh', (FunTanh(numList(i)), i = 1, 11)
|
||
1 format(1X, A4, 11(1X, F8.5))
|
||
end subroutine Exercises7_18
|
||
! 双曲正弦
|
||
real function FunSinh(x)
|
||
implicit none
|
||
real, intent(in) :: x
|
||
FunSinh = (exp(x)-exp(-x))/2
|
||
end function FunSinh
|
||
! 双曲余弦
|
||
real function FunCosh(x)
|
||
implicit none
|
||
real, intent(in) :: x
|
||
FunCosh = (exp(x)+exp(-x))/2
|
||
end function FunCosh
|
||
! 双曲正切
|
||
real function FunTanh(x)
|
||
implicit none
|
||
real, intent(in) :: x
|
||
FunTanh = (exp(x)-exp(-x))/(exp(x)+exp(-x))
|
||
end function FunTanh
|
||
! 习题7-19 向量叉积（三维向量）
|
||
subroutine Exercises7_19
|
||
use MouName
|
||
implicit none
|
||
real, dimension(3) :: array1 ! 矢量1
|
||
real, dimension(3) :: array2 ! 矢量2
|
||
real, dimension(3) :: arrayResult ! 结果矢量
|
||
array1 = [-2.,4.,0.5]
|
||
array2 = [0.5,3.,2.]
|
||
write(*,1) VectorProduct_3(array1, array2)
|
||
1 format(1X, "矢量V1与矢量V2的差积为：", 3(1X, F6.2))
|
||
end subroutine Exercises7_19
|
||
! 叉积运算子程序，为啥子程序能运行，函数不可以，一定要放到模组里，，，是真的恶心，不然就会被当作调用数组而不是调用函数
|
||
! subroutine VectorProduct_3(vectorX, vectorY, arrayResult, n)
|
||
! implicit none
|
||
! integer :: n
|
||
! real, intent(in), dimension(n) :: vectorX, vectorY
|
||
! real, intent(out), dimension(n) :: arrayResult
|
||
! arrayResult = vectorX((/2,3,1/))*vectorY((/3,1,2/))-vectorY((/2,3,1/))*vectorX((/3,1,2/))
|
||
! end subroutine VectorProduct_3
|
||
! 习题7-20 数组排序
|
||
subroutine Exercises7_20
|
||
implicit none
|
||
integer, parameter :: arrayLength = 9
|
||
real, dimension(arrayLength) :: arr1, arr2
|
||
arr1 = (/1.,11.,-6.,17.,-23.,0.,5.,1.,-1./)
|
||
arr2 = (/31.,101.,36.,-17.,0.,10.,-8.,-1.,-1./)
|
||
call ArraySort(arr1, arr2, arrayLength)
|
||
write(*,1) 'arr1：', arr1
|
||
write(*,1) 'arr2：', arr2
|
||
1 format(1X, A, 9(F7.2, 1X))
|
||
end subroutine Exercises7_20
|
||
! 习题7-20 数组排序
|
||
subroutine ArraySort(arrayBase, arrayEntourage, n)
|
||
implicit none
|
||
integer :: n
|
||
real, intent(inout), dimension(n) :: arrayBase, arrayEntourage
|
||
integer :: i, j, maxPosition
|
||
real :: maxValue
|
||
do i = 1, n - 1
|
||
maxPosition = i
|
||
do j = i + 1, n
|
||
if ( arrayBase(maxPosition) < arrayBase(j) ) then
|
||
maxPosition = j
|
||
end if
|
||
end do
|
||
if ( i /= maxPosition ) then
|
||
maxValue = arrayBase(maxPosition)
|
||
arrayBase(maxPosition) = arrayBase(i)
|
||
arrayBase(i) = maxValue
|
||
maxValue = arrayEntourage(maxPosition)
|
||
arrayEntourage(maxPosition) = arrayEntourage(i)
|
||
arrayEntourage(i) = maxValue
|
||
end if
|
||
end do
|
||
end subroutine ArraySort
|
||
! 习题7-21 函数的最大值和最小值测试驱动程序
|
||
subroutine Exercises7_21
|
||
implicit none
|
||
real :: xStart, xEnd, xInc, minPosition, maxPosition, minValue, maxValue
|
||
real, external :: Exercises7_21_fun
|
||
call SearchFunctionExtermeValue(-1., 3., 200, Exercises7_21_fun, minPosition, minValue, maxPosition, maxValue)
|
||
write(*,1) 'Exercises7_21_fun 在 x = ', maxPosition, ' 处取到最大值 ',&
|
||
& maxValue, '，在 x = ', minPosition, ' 处取到最小值 ', minValue
|
||
1 format(1X, A, F5.2, A, F5.2, A, F5.2, A, F5.2)
|
||
end subroutine Exercises7_21
|
||
! 习题7-21 求取函数的最大值和最小值
|
||
subroutine SearchFunctionExtermeValue(firstValue, lastValue, numSteps, func, xmin, minValue, xmax, maxValue)
|
||
implicit none
|
||
real, intent(in) :: firstValue, lastValue
|
||
real, intent(out) :: xmin, xmax, minValue, maxValue
|
||
integer, intent(in) :: numSteps
|
||
real :: xInc
|
||
real, external :: func
|
||
real :: value, temp
|
||
value = firstValue
|
||
xmin = value
|
||
xmax = value
|
||
temp = func(value)
|
||
minValue = temp
|
||
maxValue = temp
|
||
do
|
||
value = value + (lastValue-firstValue)/numSteps
|
||
if ( value > lastValue ) exit
|
||
temp = func(value)
|
||
if ( temp > maxValue ) then
|
||
xmax = value
|
||
else if ( temp < minValue ) then
|
||
xmin = value
|
||
end if
|
||
end do
|
||
maxValue = func(xmax)
|
||
minValue = func(xmin)
|
||
end subroutine SearchFunctionExtermeValue
|
||
! 习题7-22 自定义函数给7-21
|
||
real function Exercises7_21_fun(x)
|
||
implicit none
|
||
real :: x
|
||
Exercises7_21_fun = x**3-5*x**2+5*x+2
|
||
end function Exercises7_21_fun
|
||
! 习题7-23 微分函数测试驱动程序 + 习题7-24 噪声值微分
|
||
! 程序结构：
|
||
! x = 0
|
||
! dx = 0.05
|
||
! 输入向量 = (sin(0+i*dx), i = 0,99)
|
||
! 调用子程序, 输入: 输入向量(100) 个数 dx 输出向量(99)
|
||
! 验证向量 = (cos(0+i*dx), i = 0,98)
|
||
! write 计算结果于实际值的接近程度判断结果为: abs(输出向量-验证向量) <= 临界值
|
||
! 子程序(输入向量(向量长度), 向量长度, 步长, 输出向量(向量长度-1))
|
||
! if abs(步长) <= 临界值 then
|
||
! write error!
|
||
! exit
|
||
! else
|
||
! 输出向量(i) = ((输入向量(i+1)-输入向量(i))/步长, i = 1, 99)
|
||
! end if
|
||
subroutine Exercises7_23
|
||
use MouName
|
||
implicit none
|
||
integer, parameter :: numSteps = 100
|
||
real, dimension(numSteps) :: arrayInput
|
||
real, dimension(numSteps-1) :: arrayResult, arrayCheck
|
||
real, dimension(numSteps-1) :: arrayNoise
|
||
integer :: i
|
||
real :: stepsLength
|
||
stepsLength = 0.05
|
||
arrayInput = [(sin(0+i*stepsLength), i = 0, numSteps-1)]
|
||
call Differential(arrayInput, numSteps, stepsLength, arrayResult)
|
||
arrayCheck = [(cos(0+i*stepsLength), i = 0, numSteps-2)]
|
||
write(*,*) '计算结果符合程度判断:', all((abs(arrayCheck-arrayResult) <= 0.05) .eqv. .TRUE.)
|
||
call RandomArrayCreator(numSteps-1, arrayNoise)
|
||
! arrayResult = arrayResult + arrayNoise * 0.04 - 0.02
|
||
write(*,'(10F6.2)') arrayResult - arrayCheck
|
||
end subroutine Exercises7_23
|
||
! 习题7-23 微分计算子程序
|
||
subroutine Differential(arrayInput, numSteps, stepsLength, arrayOutput)
|
||
use MouName
|
||
integer, intent(in) :: numSteps
|
||
real, dimension(numSteps), intent(in) :: arrayInput
|
||
real, dimension(numSteps-1), intent(out) :: arrayOutput
|
||
real, intent(in) :: stepsLength
|
||
if ( abs(stepsLength) <= criticalZero ) then
|
||
stop '步长过小, 请检查后再编译执行'
|
||
else
|
||
arrayOutput = [((arrayInput(i+1)-arrayInput(i))/stepsLength, i = 1, numSteps-1)]
|
||
end if
|
||
end subroutine Differential
|
||
! 噪声值产生(产生指定数目0~1的随机数)
|
||
subroutine RandomArrayCreator(randomNum, arrayOutput)
|
||
implicit none
|
||
real :: randomSeed = 207333
|
||
integer, intent(in) :: randomNum
|
||
real, dimension(randomNum), intent(out) :: arrayOutput
|
||
integer :: i
|
||
call seed0(randomSeed)
|
||
! arrayOutput = (/(call random(randomValue), i = 1, randomNum)/) ! call不返回值!
|
||
do i = 1, randomNum
|
||
call random(arrayOutput(i))
|
||
end do
|
||
end subroutine RandomArrayCreator
|
||
! 习题7-25 二进制补运算测试驱动程序
|
||
subroutine Exercises7_25
|
||
use MouName
|
||
implicit none
|
||
integer, parameter :: strLength = 8
|
||
character(len=strLength) :: str1, str2, strResult
|
||
integer :: intAdd, intSub
|
||
str1 = '11111111'
|
||
str2 = '00000001'
|
||
! strResult = BinaryAddition(str1, str2, strLength)
|
||
intAdd = BaseConversion_2To10(BinaryAddition(str1, str2, strLength), strLength)
|
||
intSub = BaseConversion_2To10(BinarySubtraction(str1, str2, strLength), strLength)
|
||
write(*,*) str1, ' + ', str2, ' 的结果为 ', BaseConversion_10To2(intAdd, strLength)
|
||
write(*,*) str1, ' - ', str2, ' 的结果为 ', BaseConversion_10To2(intSub, strLength)
|
||
write(*,*) BaseConversion_2To10(str1, strLength), ' + ', BaseConversion_2To10(str2, strLength), ' 的结果为 ', intAdd
|
||
write(*,*) BaseConversion_2To10(str1, strLength), ' - ', BaseConversion_2To10(str2, strLength), ' 的结果为 ', intSub
|
||
end subroutine Exercises7_25
|
||
! 习题7-26 线性最小二乘拟合 习题7-27 最小二乘拟合的相关系数 测试驱动程序
|
||
subroutine Exercises7_26
|
||
implicit none
|
||
integer, parameter :: arrayLength=20
|
||
real, dimension(arrayLength) :: arrayX, arrayY
|
||
real :: m, b, r
|
||
arrayX = (/-4.91, -3.84, -2.41, -2.62, -3.78, -0.52, -1.83, -2.01, +0.28, +1.08&
|
||
&, -0.94, +0.59, +0.69, +3.04, +1.01, +3.60, +4.53, +5.12, +4.43, +4.12/)
|
||
arrayY = (/-8.18, -7.49, -7.11, -6.15, -5.62, -3.30, -2.05, -2.83, -1.16, +0.52&
|
||
&, +0.21, +1.73, +3.96, +4.26, +5.75, +6.67, +7.70, +7.31, +9.05, 10.95/)
|
||
call LeastSquaresMethod(arrayX, arrayY, arrayLength, m, b, r)
|
||
write(*,1) m, b, r
|
||
1 format(1X, '计算得到的拟合方程为: y = ', F5.2, ' * x + ', F5.2, ' , 相关系数r为: ', F5.3)
|
||
end subroutine Exercises7_26
|
||
! 习题7-26 最小二乘法计算各参数（斜率、截距、相关系数）
|
||
subroutine LeastSquaresMethod(arrayX, arrayY, arrayLength, slope, intercept, correlationCoefficient)
|
||
implicit none
|
||
integer, intent(in) :: arrayLength ! 设定数组长度
|
||
real, dimension(arrayLength),intent(in) :: arrayX, arrayY ! 设定输入X、Y坐标数组
|
||
real, intent(out) :: slope, intercept, correlationCoefficient ! 设定输出斜率、截距和相关系数
|
||
integer :: i ! 循环变量
|
||
real :: x_bar, y_bar ! xy均值
|
||
real :: r ! 相关系数
|
||
real :: x_sum, y_sum ! xy总和
|
||
real :: x2_sum, xy_sum, y2_sum ! 各种参数
|
||
! 变量初始化
|
||
x_sum = 0
|
||
y_sum = 0
|
||
x2_sum = 0
|
||
y2_sum = 0
|
||
xy_sum = 0
|
||
i = 0
|
||
do i = 1, arrayLength ! 循环计算各参数
|
||
x_sum = x_sum + arrayX(i) ! x总和
|
||
y_sum = y_sum + arrayY(i) ! y总和
|
||
x2_sum = x2_sum + arrayX(i)**2 ! x方总和
|
||
y2_sum = y2_sum + arrayY(i)**2 ! y方总和
|
||
xy_sum = xy_sum + arrayX(i)*arrayY(i) ! xy总和
|
||
end do
|
||
x_bar = x_sum/real(i) ! x均值
|
||
y_bar = y_sum/real(i) ! y均值
|
||
slope = ( xy_sum - x_sum*y_bar )/( x2_sum - x_sum*x_bar ) ! 斜率
|
||
intercept = y_bar - slope*x_bar ! 截距
|
||
correlationCoefficient = ( real(i)*xy_sum - x_sum*y_sum )/& ! 相关系数
|
||
&sqrt( (real(i)*x2_sum - x_sum**2 )*( real(i)*y2_sum - y_sum**2 ) )
|
||
end subroutine LeastSquaresMethod
|
||
! 习题7-28 生日问题
|
||
subroutine Exercises7_28
|
||
implicit none
|
||
integer :: numPerson ! 房间内人数
|
||
real :: CompletelyDifferentProbability ! 调用理论值计算函数
|
||
real :: DifferentProbabilityTest ! 测试概率值计算
|
||
do numPerson = 2, 40
|
||
write(*,*) numPerson, '个人生日不同的理论概率为', CompletelyDifferentProbability(numPerson, 365)
|
||
write(*,*) numPerson, '个人生日不同的测试概率为', DifferentProbabilityTest(numPerson, 365)
|
||
end do
|
||
end subroutine Exercises7_28
|
||
! n个特定范围内的整数, 彼此之间完全不同的概率
|
||
real function CompletelyDifferentProbability(num, total)
|
||
implicit none
|
||
integer, intent(in) :: num ! 样本个数
|
||
integer, intent(in) :: total ! 可能的样本值总数
|
||
integer :: i ! 循环参数
|
||
CompletelyDifferentProbability = 1. ! 初始化输出
|
||
do i = 1, num - 1
|
||
CompletelyDifferentProbability = CompletelyDifferentProbability * real(total - i) / real(total)
|
||
end do
|
||
end function CompletelyDifferentProbability
|
||
! 从随机数中求n个特定范围内的整数, 彼此之间完全不同的概率
|
||
real function DifferentProbabilityTest(num, total)
|
||
implicit none
|
||
integer, intent(in) :: num ! 样本个数
|
||
integer, intent(in) :: total ! 样本值可能情况总数
|
||
integer, dimension(num) :: arrayTemp ! 样本值临时数组
|
||
integer, parameter :: numTest=90000 ! 测试次数
|
||
real :: randomValue
|
||
integer :: i, j ! 循环参数
|
||
integer :: temp ! 用于保存生成的随机数的临时值
|
||
call seed0(111111.) ! 获取初始随机参数
|
||
DifferentProbabilityTest = real(numTest) ! 初始化输出为测试次数
|
||
do i = 1, numTest ! 测试循环开始
|
||
arrayTemp = -1 ! 初始化随机数组
|
||
check: do j = 1, num ! 检查是否存在相同值循环
|
||
call random(randomValue) ! 获取一个1~0随机数
|
||
temp = floor(randomValue*total) ! 将随机数转化为1~总数之间的整数值
|
||
if ( any(arrayTemp==temp) ) then ! 如果存在相同数字
|
||
DifferentProbabilityTest = DifferentProbabilityTest - 1.! 中间值--
|
||
exit check ! 退出给随机数组赋值
|
||
end if ! 如果结束
|
||
arrayTemp(j) = temp ! 给随机数组当前位赋值
|
||
end do check ! 该次测试结束
|
||
end do ! 所有测试结束
|
||
DifferentProbabilityTest = DifferentProbabilityTest/real(numTest) ! 生成输出值(概率)
|
||
end function DifferentProbabilityTest
|
||
! 习题7-29 经时计算 习题公共模块
|
||
module ModuleExercises7_29 ! 定义模块
|
||
implicit none ! 声明显示表达
|
||
! 数据字典
|
||
integer, dimension(8) :: timeNow ! 当前时间数组
|
||
integer, dimension(8) :: timeOld ! 上一个时间数组
|
||
contains ! 所包含函数和子程序
|
||
! 习题7-29 经时计算 子程序1
|
||
subroutine set_timer ! 创建子程序1
|
||
implicit none ! 声明显示表达
|
||
call DATE_AND_TIME(values=timeNow) ! 调用当前时间子程序
|
||
end subroutine set_timer ! 结束子程序1
|
||
! 习题7-29 经时计算 子程序2
|
||
subroutine elapsed_time(timePast) ! 创建子程序2
|
||
implicit none ! 声明显示表达
|
||
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 module ModuleExercises7_29 ! 结束模块
|
||
! 习题7-29 经时计算 测试驱动程序 习题7-30 子程序计算
|
||
subroutine Exercises7_29 ! 定义测试驱动程序
|
||
use ModuleExercises7_29 ! 读取模块
|
||
implicit none ! 显式声明
|
||
integer, parameter :: arrayLength=100 ! 定义数组基础长度
|
||
real :: array1(arrayLength), array2(arrayLength*10), array3(arrayLength*100) ! 定义使用的随机数数组
|
||
real :: timePast ! 定义经历时间长度变量
|
||
real :: time1, time2, time3 ! 每次排序所消耗的时间
|
||
integer :: i, j ! 循环参数
|
||
! 变量初始化
|
||
time1 = 0
|
||
time2 = 0
|
||
time3 = 0
|
||
! 多次循环计算时间, 统计循环次数与用时总和
|
||
do j = 1, 10
|
||
call seed0(111111.) ! 随机数种子
|
||
do i = 1, 100 ! 给array1赋值
|
||
call random(array1(i))
|
||
end do
|
||
do i = 1, 1000 ! 给array2赋值
|
||
call random(array2(i))
|
||
end do
|
||
do i = 1, 10000 ! 给array3赋值
|
||
call random(array3(i))
|
||
end do
|
||
call set_timer ! 计算array1排序所需时间
|
||
call Sort(array1, arrayLength)
|
||
call elapsed_time(timePast)
|
||
time1 = time1 + timePast ! array1排序时间总计
|
||
call set_timer ! 计算array2排序所需时间
|
||
call Sort(array2, arrayLength*10)
|
||
call elapsed_time(timePast)
|
||
time2 = time2 + timePast ! array2排序时间总计
|
||
call set_timer ! 计算array3排序所需时间
|
||
call Sort(array3, arrayLength*100)
|
||
call elapsed_time(timePast)
|
||
time3 = time3 + timePast ! array3排序时间总计
|
||
end do
|
||
! 计算排序所需时间均值
|
||
time1 = time1/real(i)
|
||
time2 = time2/real(i)
|
||
time3 = time3/real(i)
|
||
write(*,1) time1, time2, time3 ! 打印排序时间信息
|
||
1 format(1X, '排序三个数组分别经历了', /&
|
||
&1X, '1. ', F10.8, ' s', /&
|
||
&1X, '2. ', F10.8, ' s', /&
|
||
&1X, '3. ', F10.8, ' s')
|
||
end subroutine Exercises7_29
|
||
! 习题7-30 排序子程序
|
||
subroutine Sort(array, n)
|
||
implicit none
|
||
integer :: n ! 数组长度
|
||
real, intent(inout), dimension(n) :: array ! 定义输入输出数组
|
||
integer :: i, j, maxPosition ! 循环参数和最大值位置
|
||
real :: maxValue ! 最大值的值
|
||
! 对数组进行排序
|
||
do i = 1, n - 1
|
||
maxPosition = i
|
||
do j = i + 1, n
|
||
if ( array(maxPosition) < array(j) ) then
|
||
maxPosition = j
|
||
end if
|
||
end do
|
||
if ( i /= maxPosition ) then
|
||
maxValue = array(maxPosition)
|
||
array(maxPosition) = array(i)
|
||
array(i) = maxValue
|
||
end if
|
||
end do
|
||
end subroutine Sort
|
||
! 习题7-31 估算无限序列 测试驱动程序
|
||
subroutine Exercises7_31
|
||
implicit none
|
||
integer, parameter :: arrayLength=8 ! 数组长度
|
||
real, dimension(arrayLength) :: arrayX, arrayY ! 输入数组X与输出数组Y
|
||
real :: ExEstimation ! 定义函数返回值类型
|
||
integer :: i ! 循环参数
|
||
arrayX = (/-10., -5., -1., 0., 1., 5., 10., 15./) ! 赋值输入数组X
|
||
! arrayY = (/((ExEstimation(arrayX(i)), i = 1, arrayLength))/) ! 好像不能这样用隐式循环
|
||
do i = 1, arrayLength ! 循环求输出数组Y的值
|
||
arrayY(i) = ExEstimation(arrayX(i)) ! 调用函数赋值
|
||
end do
|
||
write(*,1) arrayX, arrayY, exp(arrayX) ! 输出结果表格
|
||
1 format(1X, 'Form. e^x value estimation'/&
|
||
&1X, 'Input ', 8(1X, F9.2)/&
|
||
&1X, 'Output ', 8(1X, ES9.2)/&
|
||
&1X, 'Real ', 8(1X, ES9.2))
|
||
end subroutine Exercises7_31
|
||
! 习题7-31 EXP(X)
|
||
real function ExEstimation(x)
|
||
implicit none
|
||
real, intent(in) :: x ! 定义输入变量指数值
|
||
integer :: n ! 循环参数n
|
||
integer :: nFactorial ! n的阶乘
|
||
! 初始化变量
|
||
ExEstimation = 0
|
||
nFactorial = 1
|
||
do n = 0, 11 ! 取无限序列前12项
|
||
ExEstimation = ExEstimation + x**n/nFactorial ! 加和趋近结果值
|
||
nFactorial = nFactorial*(n+1) ! 计算下一次循环需要的阶乘值
|
||
end do
|
||
end function ExEstimation
|
||
! 习题7-32 使用子程序计算随机分布情况
|
||
subroutine Exercises7_32
|
||
implicit none
|
||
integer, parameter :: arrayLength=10000 ! 定义数组长为10000
|
||
real, dimension(arrayLength) :: array ! 定义随机数组
|
||
real :: Average, StandardDeviation ! 定义平均值和标准差为实型
|
||
integer :: i ! 循环参数
|
||
call seed0(111111.) ! 初始化随机数
|
||
do i = 1, arrayLength ! 循环给随机数组赋值
|
||
call random(array(i))
|
||
end do
|
||
! 输出结果
|
||
write(*,*) '随机数组平均值为: ', Average(array, arrayLength)
|
||
write(*,*) '随机数组标准差为: ', StandardDeviation(array, arrayLength)
|
||
write(*,*) '理论的平均值是0.5, 理论的标准偏差是', 1/sqrt(12.)
|
||
end subroutine Exercises7_32
|
||
! 习题7-33 计算数列平均值与标准偏差
|
||
real function Average(arrayInput, arrayLength)
|
||
implicit none
|
||
integer, intent(in) :: arrayLength ! 定义数组长度
|
||
real, dimension(arrayLength), intent(in) :: arrayInput ! 定义输入数组
|
||
integer :: i ! 循环参数
|
||
Average = 0 ! 初始化输出
|
||
do i = 1, arrayLength ! 循环加和数组值
|
||
Average = Average + arrayInput(i)
|
||
end do
|
||
Average = Average/real(i) ! 计算平均值
|
||
end function Average
|
||
real function StandardDeviation(arrayInput, arrayLength)
|
||
implicit none
|
||
integer, intent(in) :: arrayLength ! 定义数组长度
|
||
real, dimension(arrayLength), intent(in) :: arrayInput ! 定义输入数组
|
||
integer :: i ! 循环参数
|
||
real :: average ! 定义平均值
|
||
average = 0 ! 初始化平均值
|
||
StandardDeviation = 0 ! 初始化标准差
|
||
do i = 1, arrayLength ! 循环加和数组值
|
||
average = average + arrayInput(i)
|
||
end do
|
||
average = average/i ! 计算平均值
|
||
do i = 1, arrayLength ! 循环加和平均值与数组值的平方差
|
||
StandardDeviation = StandardDeviation + (average - arrayInput(i))**2
|
||
end do
|
||
StandardDeviation = sqrt(StandardDeviation/(i - 1)) ! 计算标准偏差
|
||
end function StandardDeviation
|
||
! 习题7-33 高斯(正态)分布
|
||
subroutine Exercises7_33
|
||
implicit none
|
||
integer, parameter :: arrayLength=1000 ! 定义数组长度
|
||
real, dimension(arrayLength) :: arrayNormal ! 定义随机正态分布数组
|
||
integer :: i ! 循环参数
|
||
real :: StandardDeviation, Average ! 定义函数返回值类型
|
||
call seed0(111111.) ! 初始化随机数
|
||
! do i = 1, int(arrayLength/2) ! 按照书上方法生成正态分布随机值
|
||
! call NormallyDistributedRandomValue(arrayNormal(2*i-1), arrayNormal(2*i))
|
||
! end do
|
||
do i = 1, arrayLength ! 使用Box–Muller变换得到正态分布随机值
|
||
call NormallyDistributedRandomValue1(arrayNormal(i))
|
||
end do
|
||
! write(*,'(25(F5.2, 1X))') arrayNormal ! 显示计算得到的正态分布数据
|
||
write(*,*) '标准的正态分布标准偏差为1.0, 而计算得到的随机数列标准偏差为',&
|
||
& StandardDeviation(arrayNormal, arrayLength), '平均值为',&
|
||
& Average(arrayNormal, arrayLength) ! 显示数据集的标准偏差与平均值
|
||
end subroutine
|
||
! 习题7-33 高斯分布(书上方法)
|
||
subroutine NormallyDistributedRandomValue(outputValue1, outputValue2)
|
||
implicit none
|
||
real, intent(out) :: outputValue1, outputValue2 ! 定义输出数据
|
||
real :: r ! 定义r值
|
||
do ! 循环获取x1,x2并判断
|
||
call random(outputValue1)
|
||
call random(outputValue2)
|
||
if ( outputValue1**2 + outputValue2**2 - 1. <= 0 ) exit ! 如果平方和小于1, 那么结束循环
|
||
end do
|
||
r = outputValue1**2 + outputValue2**2 ! 计算平方和
|
||
! write(*,*) r
|
||
outputValue1 = sqrt(-2.*log(r)/r)*outputValue1 ! 计算y1(输出值1)
|
||
outputValue2 = sqrt(-2.*log(r)/r)*outputValue2 ! 计算y2(输出值2)
|
||
end subroutine NormallyDistributedRandomValue
|
||
! 习题7-33 高斯分布(Box–Muller变换)
|
||
subroutine NormallyDistributedRandomValue1(outputValue)
|
||
implicit none
|
||
real, parameter :: PI = 3.14159265 ! 定义常数PI
|
||
real, intent(out) :: outputValue ! 定义输出值(符合正态分布的)
|
||
real :: outputValue1 ! 另一个需要的变量,但是不输出
|
||
call random(outputValue1) ! 获取均匀分布的随机数第一个数值
|
||
call random(outputValue) ! 获取均匀分布的随机数第二个数值
|
||
outputValue = sqrt(-2.*log(outputValue1))*cos(2*PI*outputValue) ! Box–Muller变换, 并输出结果
|
||
end subroutine NormallyDistributedRandomValue1
|
||
! 习题7-34 引力
|
||
subroutine Exercises7_34
|
||
implicit none
|
||
real, parameter :: mEarth=5.98E24 ! 地球质量(kg)
|
||
real :: m ! 卫星质量(kg)
|
||
real :: r ! 地心与卫星距离(m)
|
||
real :: Gravity ! 定义函数返回类型为实型
|
||
m = 1000. ! 设定卫星质量(kg)
|
||
r = 38000.*1000. ! 设定地卫距离(m)
|
||
write(*,*) '地球与卫星之间的引力大小为', Gravity(m, mEarth, r), ' N'
|
||
end subroutine Exercises7_34
|
||
! 引力计算
|
||
real function Gravity(m1, m2, r)
|
||
implicit none
|
||
real, parameter :: G=6.672E-11 ! 万有引力常数
|
||
real, intent(in) :: m1, m2, r ! 输入实型质量1,质量2,间距
|
||
Gravity = G*m1*m2/r**2 ! 输出两物体间引力值
|
||
end function Gravity
|
||
! 习题7-35 堆排序
|
||
! 了解有这么个玩意就成 |