init
This commit is contained in:
298
第12章习题.f90
Normal file
298
第12章习题.f90
Normal file
@ -0,0 +1,298 @@
|
||||
! ==============================================================================
|
||||
! 通过 gfortran ./test.f90 -o ./run && ./run 运行
|
||||
! 程序名：
|
||||
! 第12章习题
|
||||
! 目的:
|
||||
!
|
||||
! 修订记录:
|
||||
! 日期 编程者 改动描述
|
||||
! =================== ============= =====================================
|
||||
! 2021-05-16 16:04:01 Sola 习题12-1 改进例题程序
|
||||
! 2021-05-16 20:45:49 Sola 习题12-2 复数坐标系转换
|
||||
! 2021-05-16 20:46:28 Sola 习题12-3 复数极坐标乘法
|
||||
! 2021-05-16 20:46:40 Sola 习题12-4 复数极坐标除法
|
||||
! 2021-05-16 20:56:15 Sola 习题12-5 建立过了，跳过
|
||||
! 2021-05-16 20:59:10 Sola 习题12-6 卡笛尔坐标系下点位和直线
|
||||
! 2021-05-16 21:04:08 Sola 习题12-7 两点间距离
|
||||
! 2021-05-16 21:14:41 Sola 习题12-8 通过两点计算直线参数
|
||||
! 2021-05-16 21:36:52 Sola 习题12-9 追踪雷达目标，莫得数据，跳过
|
||||
! 程序结构:
|
||||
!
|
||||
! ==============================================================================
|
||||
! 模块：
|
||||
module Chapter12
|
||||
implicit none
|
||||
! 数据字典
|
||||
! 声明常数
|
||||
REAL, PARAMETER :: PI=3.14159265 ! PI值
|
||||
REAL, PARAMETER :: e=2.718281828459 ! 自然对数
|
||||
INTEGER, PARAMETER :: arrayLength=20 ! 数组基准长度
|
||||
integer, parameter :: sgl = selected_real_kind(p=1) ! 单精度类型
|
||||
type :: complexChange
|
||||
real(sgl) :: var1 ! 参数1
|
||||
real(sgl) :: var2 ! 参数2
|
||||
contains
|
||||
procedure, pass :: Car2Pol ! 直角坐标系转化为极坐标系
|
||||
procedure, pass :: Pol2Car ! 极坐标系转化为直角坐标系
|
||||
procedure, pass :: PolProduct ! 极坐标系乘法
|
||||
procedure, pass :: PolDivision ! 极坐标系乘法
|
||||
end type complexChange
|
||||
type :: point ! 点位的派生数据
|
||||
real(sgl) :: x ! X坐标
|
||||
real(sgl) :: y ! Y坐标
|
||||
contains
|
||||
procedure, pass :: Distance ! 两点间距离
|
||||
procedure, pass :: Point2line ! 计算两点间直线方程
|
||||
end type point
|
||||
type :: line ! 直线的派生数据
|
||||
real(sgl) :: m ! 斜率
|
||||
real(sgl) :: b ! 截距
|
||||
end type line
|
||||
type :: radarInfo
|
||||
real(sgl) :: length ! 距离
|
||||
real(sgl) :: theta ! 角度
|
||||
real(sgl) :: time ! 扫描时间
|
||||
end type radarInfo
|
||||
! 声明变量
|
||||
! 创建显式接口
|
||||
contains
|
||||
! subroutine SubName(varName1,varName2)
|
||||
! implicit none
|
||||
! ! 数据字典
|
||||
! end subroutine SubName
|
||||
! 直角坐标系转化为极坐标系
|
||||
type(complexChange) function Car2Pol(this)
|
||||
class(complexChange) :: this
|
||||
Car2Pol%var1 = sqrt(this%var1**2 + this%var2**2)
|
||||
Car2Pol%var2 = atan(this%var2, this%var1)
|
||||
end function Car2Pol
|
||||
! 极坐标系转化为直角坐标系
|
||||
type(complexChange) function Pol2Car(this)
|
||||
class(complexChange) :: this
|
||||
Pol2Car%var1 = this%var1*cos(this%var2)
|
||||
Pol2Car%var2 = this%var1*sin(this%var2)
|
||||
end function Pol2Car
|
||||
! 复数的极坐标系乘法
|
||||
type(complexChange) function PolProduct(this, input)
|
||||
class(complexChange) :: this, input
|
||||
PolProduct%var1 = this%var1*input%var1
|
||||
PolProduct%var2 = mod(this%var2 + input%var2 + PI, 2*PI) - PI
|
||||
end function PolProduct
|
||||
! 复数的极坐标除法
|
||||
type(complexChange) function PolDivision(this, input)
|
||||
class(complexChange) :: this, input
|
||||
PolDivision%var1 = this%var1/input%var1
|
||||
PolDivision%var2 = mod(this%var2 - input%var2 + PI, 2*PI) - PI
|
||||
end function PolDivision
|
||||
! 计算两点间距离
|
||||
real function Distance(pointA, pointB)
|
||||
class(point) :: pointA, pointB
|
||||
Distance = sqrt((pointB%x - pointA%x)**2 + (pointB%y - pointA%y)**2)
|
||||
end function Distance
|
||||
type(line) function Point2line(pointA, pointB)
|
||||
class(point) :: pointA, pointB
|
||||
if ( abs(pointA%x - pointB%x) < 1E-30 ) then
|
||||
stop "所求直线无斜率（与Y轴平行）"
|
||||
end if
|
||||
Point2line%m = (pointA%y - pointB%y)/(pointA%x - pointB%x)
|
||||
Point2line%b = pointA%y - Point2line%m*pointA%x
|
||||
end function Point2line
|
||||
end module Chapter12
|
||||
! ==============================================================================
|
||||
! 主程序：
|
||||
program ProName
|
||||
implicit none
|
||||
! 数据字典
|
||||
! 声明常量
|
||||
! 声明变量
|
||||
! 变量初始化
|
||||
! 数据输入
|
||||
! 运算过程
|
||||
! 结果输出
|
||||
! call customer_database
|
||||
! call Exercises12_2
|
||||
! call Exercises12_7
|
||||
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
|
||||
! ==============================================================================
|
||||
! 习题12-1 修改例题
|
||||
! 定义了公共模块用来读取数据
|
||||
module types
|
||||
implicit none
|
||||
type :: presonal_info
|
||||
character(len=12) :: first
|
||||
character :: mi
|
||||
character(len=12) :: last
|
||||
character(len=26) :: street
|
||||
character(len=12) :: city
|
||||
character(len=2) :: state
|
||||
integer :: zip
|
||||
end type presonal_info
|
||||
end module types
|
||||
! 输入数据以及排序的主函数
|
||||
subroutine customer_database
|
||||
use types
|
||||
implicit none
|
||||
integer, parameter :: MAX_SIZE = 100
|
||||
logical, external :: lt_last
|
||||
logical, external :: lt_city
|
||||
logical, external :: lt_zip
|
||||
type(presonal_info), dimension(MAX_SIZE) :: customers
|
||||
integer :: choice
|
||||
logical :: exceed = .FALSE.
|
||||
character(len=20) :: filename
|
||||
integer :: i
|
||||
integer :: nvals = 0
|
||||
integer :: status
|
||||
type(presonal_info) :: temp
|
||||
open(unit=1, status='scratch', iostat=status)
|
||||
if ( status /= 0 ) stop ""
|
||||
write(1, '(A)') &
|
||||
&"John Q Public 123 Sesame Street Anywhere NY 10035", &
|
||||
&"James R Johnson Rt. 5 Box 207C West Monroe LA 71291", &
|
||||
&"Joseph P Ziskend P. O. Box 433 APO AP 96555", &
|
||||
&"Andrew D Jackson Jackson Square New Orleans LA 70003", &
|
||||
&"Jane X Doe 12 Lakeside Drive Glenview IL 60025", &
|
||||
&"Colin A Jeffries 11 Main Street Chicago IL 60003"
|
||||
rewind(unit=1, iostat=status)
|
||||
if ( status /= 0 ) stop ""
|
||||
do
|
||||
read(1, 1010, iostat=status) temp
|
||||
1010 format(A12, 1X, A1, 1X, A12, 1X, A26, 1X, A12, 1X, A2, 1X, I5)
|
||||
if ( status /= 0 ) exit
|
||||
nvals = nvals + 1
|
||||
if ( nvals <= MAX_SIZE ) then
|
||||
customers(nvals) = temp
|
||||
else
|
||||
exceed = .TRUE.
|
||||
end if
|
||||
end do
|
||||
if ( exceed ) then
|
||||
write(*, 1020) nvals, MAX_SIZE
|
||||
1020 format(' Maximum array size exceeded: ', I6, ' > ', I6)
|
||||
else
|
||||
write(*, 1030)
|
||||
1030 format(&
|
||||
1X, 'Enter way to sort database:', /&
|
||||
1X, ' 1 -- By last name ', /&
|
||||
1X, ' 2 -- By city ', /&
|
||||
1X, ' 3 -- By zip code ')
|
||||
read(*, *) choice
|
||||
select case (choice)
|
||||
case(1)
|
||||
call sort_database(customers, nvals, lt_last)
|
||||
case(2)
|
||||
call sort_database(customers, nvals, lt_city)
|
||||
case(3)
|
||||
call sort_database(customers, nvals, lt_zip)
|
||||
case default
|
||||
write(*, *) 'Invalid choice entered!'
|
||||
end select
|
||||
write(*, '(A)') 'The sorted database values are: '
|
||||
write(*, 1040) (customers(i), i = 1, nvals)
|
||||
1040 format(A12, 1X, A1, 1X, A12, 1X, A26, 1X, A12, 1X, A2, 1X, I5)
|
||||
end if
|
||||
end subroutine customer_database
|
||||
! 排序对应数据子程序
|
||||
subroutine sort_database(array, n, lt_fun)
|
||||
use types
|
||||
implicit none
|
||||
integer, intent(in) :: n
|
||||
type(presonal_info), dimension(n), intent(inout) :: array
|
||||
logical, external :: lt_fun
|
||||
integer :: i
|
||||
integer :: iptr
|
||||
integer :: j
|
||||
type(presonal_info) :: temp
|
||||
do i = 1, n-1
|
||||
iptr = i
|
||||
do j = i+1, n
|
||||
if ( lt_fun(array(j),array(iptr)) ) then
|
||||
iptr = j
|
||||
end if
|
||||
end do
|
||||
if ( i /= iptr ) then
|
||||
temp = array(i)
|
||||
array(i) = array(iptr)
|
||||
array(iptr) = temp
|
||||
end if
|
||||
end do
|
||||
end subroutine sort_database
|
||||
! 排序函数
|
||||
logical function lt_last(a, b)
|
||||
use types
|
||||
implicit none
|
||||
type(presonal_info), intent(in) :: a, b
|
||||
lt_last = LLT(a%last, b%last)
|
||||
end function lt_last
|
||||
! 主要在这里修改，全部检测大写即可，如果需要继续改进的话，名称可能也要改？倒是也没必要，名字只有首字母大写
|
||||
logical function lt_city(a, b)
|
||||
use types
|
||||
implicit none
|
||||
type(presonal_info), intent(in) :: a, b
|
||||
lt_city = LLT(Ucase(a%city), Ucase(b%city))
|
||||
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
|
||||
end function lt_city
|
||||
logical function lt_zip(a, b)
|
||||
use types
|
||||
implicit none
|
||||
type(presonal_info), intent(in) :: a, b
|
||||
lt_zip = a%zip < b%zip
|
||||
end function lt_zip
|
||||
! 习题12-2 具体函数参考派生数据在模块中的定义
|
||||
! 习题12-3 极坐标表示复数乘法
|
||||
! 习题12-4 极坐标表示复数出发
|
||||
subroutine Exercises12_2
|
||||
use Chapter12
|
||||
implicit none
|
||||
type(complexChange) :: POLAR, a, b
|
||||
! 习题12-2
|
||||
POLAR = complexChange(123., 456.)
|
||||
write(*, *) 'POLAR为： ', POLAR
|
||||
write(*, *) 'POLAR转化为极坐标系为： ', POLAR%Car2Pol()
|
||||
write(*, *) 'POLAR转化为直角坐标系为： ', POLAR%Pol2Car()
|
||||
! 习题12-3
|
||||
POLAR = POLAR%Car2Pol()
|
||||
a = POLAR
|
||||
b = POLAR%PolProduct(a)
|
||||
write(*, *) 'POLAR之间的乘积为： ', b
|
||||
! 习题12-4
|
||||
b = b%PolDivision(a)
|
||||
write(*, *) '其乘积除以POLAR为： ', b
|
||||
contains
|
||||
end subroutine Exercises12_2
|
||||
! 习题12-7 两点间距离，两点间建立直线
|
||||
subroutine Exercises12_7
|
||||
use Chapter12
|
||||
implicit none
|
||||
type(point) :: pointA, pointB
|
||||
pointA = point(1., 3.)
|
||||
pointB = point(3., 1.)
|
||||
write(*, *) '点A与点B之间的距离为： ', pointA%Distance(pointB)
|
||||
write(*, *) '点A与点B之间的直线的斜率和截距为： ', pointA%Point2line(pointB)
|
||||
contains
|
||||
end subroutine Exercises12_7
|
||||
Reference in New Issue
Block a user