298 lines
12 KiB
Fortran
298 lines
12 KiB
Fortran
! ==============================================================================
|
||
! 通过 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 |