! ============================================================================== ! 通过 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