! ============================================================================== ! 通过 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 堆排序 ! 了解有这么个玩意就成