1016 lines
50 KiB
Fortran
1016 lines
50 KiB
Fortran
! ==============================================================================
|
||
! 通过 gfortran ./test.f90 -o ./run && ./run 运行
|
||
! 程序名：
|
||
! 第15章习题
|
||
! 目的:
|
||
!
|
||
! 修订记录:
|
||
! 日期 编程者 改动描述
|
||
! =================== ============= =====================================
|
||
! 2021-05-25 15:25:35 Sola 习题15-1 ~ 习题15-2 跳过
|
||
! 2021-05-25 15:28:00 Sola 习题15-3 指向非同类型地址以及赋值操作空格测试
|
||
! 2021-05-25 15:35:37 Sola 习题15-4 跳过
|
||
! 2021-05-25 15:35:50 Sola 习题15-5 测试未定义的ASSOCIATED值
|
||
! 2021-05-25 15:42:41 Sola 习题15-6 跳过
|
||
! 2021-05-25 15:42:53 Sola 习题15-7 指向数组及数组元素的指针
|
||
! 2021-05-25 15:53:19 Sola 习题15-8 指向数组的指针的上下界
|
||
! 2021-05-25 16:24:28 Sola 习题15-7 ~ 习题15-10 跳过
|
||
! 2021-05-25 16:24:56 Sola 习题15-11 测试子程序中指针的分配
|
||
! 2021-05-25 16:41:56 Sola 习题15-12 跳过
|
||
! 2021-05-25 16:42:06 Sola 习题15-13 插入排序程序（链表）
|
||
! 2021-05-25 19:19:01 Sola 习题15-14 插入排序程序（二叉树）
|
||
! 2021-05-26 04:39:20 Sola 习题15-15 ~ 习题15-16 跳过
|
||
! 2021-05-26 04:41:43 Sola 习题15-17 返回数组最大值指针
|
||
! 2021-05-26 11:45:56 Sola 习题15-18 返回数组类型指针最大值指针
|
||
! 2021-05-26 11:52:23 Sola 习题15-19 线性最小二乘拟合
|
||
! 2021-05-26 17:44:42 Sola 习题15-20 双向链表
|
||
! 程序结构:
|
||
!
|
||
! ==============================================================================
|
||
! 主程序：
|
||
program Chapter15
|
||
implicit none
|
||
! 数据字典
|
||
! 声明常量
|
||
! 声明变量
|
||
! 变量初始化
|
||
! 数据输入
|
||
! 运算过程
|
||
! 结果输出
|
||
! call Test15_1
|
||
! call Exercises15_3
|
||
! call Exercises15_5
|
||
! call Exercises15_7
|
||
! call Exercises15_8
|
||
! call Exercises15_11
|
||
! call Exercises15_13
|
||
! call Exercises15_14
|
||
! call Exercises15_17
|
||
! call Exercises15_18
|
||
! call Exercises15_19
|
||
! call Exercises15_20
|
||
! call Exercises15_21
|
||
! call Test
|
||
! call Exercises15_22
|
||
call Exercises15_21new
|
||
end program Chapter15
|
||
! ==============================================================================
|
||
! 习题15-3 指向非同类型地址以及赋值操作空格测试
|
||
subroutine Exercises15_3
|
||
implicit none
|
||
real, pointer :: p1
|
||
real, target :: x1=11.
|
||
integer, pointer :: p2
|
||
integer, target :: x2=12
|
||
p1=>x1
|
||
p2 => x2
|
||
write(*, '(A, 4G8.2)') ' p1, p2, x1, x2 = ', p1, p2, x1, x2
|
||
! p1=>p2
|
||
! p2=>x1
|
||
! write(*, '(A, 4G8.2)') ' p1, p2, x1, x2 = ', p1, p2, x1, x2
|
||
end subroutine Exercises15_3
|
||
! 习题15-5 测试未定义的ASSOCIATED值，未定义的值还真是随机的。。。
|
||
subroutine Exercises15_5
|
||
implicit none
|
||
real, pointer :: p1, p2
|
||
real, target :: x1=11.1, x2=-3.2
|
||
p1 => x1
|
||
write(*, *) associated(p1), associated(p2), associated(p1, x2)
|
||
end subroutine Exercises15_5
|
||
! 习题15-7 指向数组及数组元素的指针
|
||
subroutine Exercises15_7
|
||
implicit none
|
||
integer, dimension(:), pointer :: p1 => null()
|
||
integer, pointer :: p2 => null()
|
||
integer, dimension(1000), target :: array=1
|
||
p1 => array
|
||
p2 => array(10)
|
||
write(*, '(100I1)') p1
|
||
write(*, *) p2
|
||
end subroutine Exercises15_7
|
||
! 习题15-8 指向数组的指针的上下界
|
||
subroutine Exercises15_8
|
||
implicit none
|
||
integer :: i
|
||
real, dimension(-25: 25), target :: info=(/ (2.1*i, i = -25, 25) /)
|
||
real, dimension(:), pointer :: ptr1, ptr2, ptr3, ptr4
|
||
ptr4 => info
|
||
ptr1 => info(-25: 25: 5)
|
||
ptr2 => ptr1(1:: 2)
|
||
ptr3 => ptr2(3: 5)
|
||
write(*, '(A, 11F6.1)') ' ptr1 = ', ptr1
|
||
! write(*, *) lbound(ptr4), ubound(ptr4)
|
||
write(*, '(A, 11F6.1)') ' ptr2 = ', ptr2
|
||
write(*, '(A, 11F6.1)') ' ptr3 = ', ptr3
|
||
write(*, '(A, 11F6.1)') ' ave of ptr3 = ', sum(ptr3)/size(ptr3)
|
||
end subroutine Exercises15_8
|
||
! 习题15-11 测试子程序中指针的分配
|
||
module my_sub
|
||
implicit none
|
||
contains
|
||
subroutine running_sum(sum, value)
|
||
implicit none
|
||
real, pointer :: sum, value
|
||
! allocate(sum)
|
||
sum = sum + value
|
||
end subroutine running_sum
|
||
end module my_sub
|
||
subroutine Exercises15_11
|
||
use my_sub
|
||
implicit none
|
||
integer :: istat
|
||
real, pointer :: sum, value
|
||
allocate(sum, value, stat=istat)
|
||
write(*, *) 'Enter values to add: '
|
||
do
|
||
read (*, *, iostat=istat) value
|
||
if ( istat /= 0 ) exit
|
||
call running_sum(sum, value)
|
||
write(*, *) ' The sum is ', sum
|
||
end do
|
||
! contains
|
||
! subroutine running_sum(sum, value)
|
||
! implicit none
|
||
! real, pointer :: sum, value
|
||
! ! allocate(sum, value)
|
||
! sum = sum + value
|
||
! end subroutine running_sum
|
||
end subroutine Exercises15_11
|
||
! 习题15-13 插入排序程序（链表）
|
||
module Linked_List
|
||
implicit none
|
||
private ! 数据隐藏
|
||
public :: linkedList, LinkedListAdd, ShowLinkedList, strLength ! 显示指定数据
|
||
integer, parameter :: strLength=12 ! 声明字符串基本长度
|
||
type :: linkedList ! 链表结点数据类型
|
||
character(len=strLength) :: value ! 结点值
|
||
type(linkedList), pointer :: next ! 下一个结点地址
|
||
end type linkedList
|
||
contains
|
||
! recursive subroutine LinkedListAdd(value, ptr) ! 向链表中添加结点
|
||
! implicit none
|
||
! character(len=strLength), intent(in) :: value ! 声明输入数据
|
||
! type(linkedList), pointer, intent(inout) :: ptr ! 声明当前检测的结点
|
||
! type(linkedList), pointer :: temp => null() ! 声明临时结点
|
||
! if ( .not. associated(ptr) ) then ! 如果检测结点不存在
|
||
! allocate(ptr) ! 创建一个新结点
|
||
! ptr%value = value ! 该结点的值为输入数据
|
||
! ptr%next => null() ! 该节点的下一个结点为空
|
||
! else ! 如果检测结点存在
|
||
! if ( LGT(Ucase(value), Ucase(ptr%value)) ) then ! 如果输入数据大于结点值
|
||
! call LinkedListAdd(value, ptr%next) ! 递归调用
|
||
! else ! 如果输入数据小于结点值
|
||
! allocate(temp) ! 给temp分配内存
|
||
! temp%value = value ! 定义temp值
|
||
! temp%next => ptr ! 定义temp下一个结点为当前结点
|
||
! ptr => temp ! 将当前结点指针指向temp, 完成结点插入
|
||
! end if
|
||
! end if
|
||
! end subroutine LinkedListAdd
|
||
recursive subroutine LinkedListAdd(newNode, ptr) ! 向链表中添加结点
|
||
implicit none
|
||
type(linkedList), pointer, intent(inout) :: newNode ! 声明插入结点
|
||
type(linkedList), pointer, intent(inout) :: ptr ! 声明当前检测的结点
|
||
if ( .not. associated(ptr) ) then ! 如果检测结点不存在
|
||
ptr => newNode
|
||
else ! 如果检测结点存在
|
||
if ( LGT(Ucase(newNode%value), Ucase(ptr%value)) ) then ! 如果输入数据大于结点值
|
||
call LinkedListAdd(newNode, ptr%next) ! 递归调用
|
||
else ! 如果输入数据小于结点值
|
||
newNode%next => ptr ! 定义插入结点下一个结点为当前结点
|
||
ptr => newNode ! 将当前结点指针指向插入结点
|
||
end if
|
||
end if
|
||
end subroutine LinkedListAdd
|
||
recursive subroutine ShowLinkedList(head)
|
||
implicit none
|
||
type(linkedList), pointer, intent(in) :: head ! 声明输入结点
|
||
if ( associated(head%next) ) then ! 如果下一个结点存在
|
||
write(*, '(1X, 2A)', advance='no') trim(head%value), ',' ! 输出结果
|
||
call ShowLinkedList(head%next) ! 递归调用
|
||
else ! 如果下一个结点不存在
|
||
write(*, '(1X, A)', advance='yes') trim(head%value) ! 输出结果
|
||
end if
|
||
end subroutine ShowLinkedList
|
||
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 module Linked_List
|
||
subroutine Exercises15_13
|
||
use Linked_List, only: linkedList, LinkedListAdd, ShowLinkedList, strLength
|
||
implicit none
|
||
character(len=strLength) :: inputValue ! 声明输入
|
||
integer :: errorLevel ! 声明错误状态值
|
||
integer :: i=0 ! 循环参数
|
||
type(linkedList), pointer :: head => null() ! 声明链表头
|
||
type(linkedList), pointer :: newNode => null() ! 声明插入结点
|
||
write(*, *) 'Please enter 5 string, the max length is', strLength ! 提示信息
|
||
do i = 1, 5 ! 输入五个数据
|
||
write(*, '(1X, A)', advance='no') 'Please enter the value: ' ! 提示信息
|
||
read(*, *, iostat=errorLevel) inputValue ! 读取输入信息
|
||
if ( errorLevel /= 0 ) stop "" ! 检测读取状态
|
||
allocate(newNode, stat=errorLevel) ! 分配插入结点内存
|
||
if ( errorLevel /= 0 ) stop "" ! 检测分配状态
|
||
newNode%value = inputValue ! 给结点赋值
|
||
newNode%next => null() ! 定义结点指向地址为空
|
||
call LinkedListAdd(newNode, head) ! 插入结点
|
||
end do
|
||
write(*, '(1X, A)') 'Input ending, show the result:' ! 提示信息
|
||
call ShowLinkedList(head) ! 打印链表(截尾)
|
||
end subroutine Exercises15_13
|
||
! 习题15-14 插入排序程序（二叉树）
|
||
! 模块-二叉树
|
||
module Binary_Tree
|
||
implicit none
|
||
private
|
||
public :: binaryTreeName, BinaryTreeNameAdd, BinaryTreeNamePrint
|
||
type :: binaryTreeName ! 二叉树结点类型数据
|
||
real :: var1 ! 二叉树结点值
|
||
type(binaryTreeName), pointer :: before ! 该节点前一个结点
|
||
type(binaryTreeName), pointer :: next ! 该结点后一个结点
|
||
end type binaryTreeName
|
||
interface operator(>)
|
||
module procedure BinaryTreeNameGreater ! 结点大于比较
|
||
end interface
|
||
interface operator(<)
|
||
module procedure BinaryTreeNameLess ! 结点小于比较
|
||
end interface
|
||
contains
|
||
function BinaryTreeNameGreater(input1, input2) result(result) ! 结点大于比较函数
|
||
implicit none
|
||
logical :: result ! 输出结果类为布尔
|
||
type(binaryTreeName), intent(in) :: input1, input2 ! 输入两个二叉树结点
|
||
if ( input1%var1 > input2%var1 ) then
|
||
result = .TRUE. ! 如果结点1大于结点2, 则返回TURE
|
||
else
|
||
result = .FALSE. ! 如果结点1不大于结点2, 返回FALSE
|
||
end if
|
||
end function BinaryTreeNameGreater
|
||
function BinaryTreeNameLess(input1, input2) result(result) ! 结点小于比较函数
|
||
implicit none
|
||
logical :: result ! 输出结果类为布尔
|
||
type(binaryTreeName), intent(in) :: input1, input2 ! 输入两个二叉树结点
|
||
if ( input1%var1 < input2%var1 ) then
|
||
result = .TRUE. ! 如果结点1小于结点2, 则返回TURE
|
||
else
|
||
result = .FALSE. ! 如果结点1不小于结点2, 则返回FALSE
|
||
end if
|
||
end function BinaryTreeNameLess
|
||
recursive subroutine BinaryTreeNameAdd(newNode, ptr) ! 向二叉树中添加结点
|
||
implicit none
|
||
type(binaryTreeName), pointer, intent(inout) :: ptr ! 声明当前检测的结点
|
||
type(binaryTreeName), pointer, intent(inout) :: newNode ! 声明临时结点
|
||
if ( .not. associated(ptr) ) then ! 如果检测结点不存在
|
||
ptr => newNode ! 则将检测结点指向新节点
|
||
else ! 如果检测结点存在
|
||
if ( newNode > ptr ) then ! 如果输入数据大于结点值
|
||
call BinaryTreeNameAdd(newNode, ptr%next) ! 对检测结点后一个递归调用
|
||
else ! 如果输入数据小于结点值
|
||
call BinaryTreeNameAdd(newNode, ptr%before) ! 对检测结点前一个递归调用
|
||
end if
|
||
end if
|
||
end subroutine BinaryTreeNameAdd
|
||
recursive subroutine BinaryTreeNamePrint(root) ! 由小到大打印当前根结点下的所有值
|
||
implicit none
|
||
type(binaryTreeName), pointer, intent(in) :: root ! 输入指针root
|
||
if ( .not. associated(root) ) then
|
||
stop "" ! 如果该指针未关联, 停止并报错
|
||
else ! 如果该指针已关联
|
||
if ( associated(root%before) ) then
|
||
call BinaryTreeNamePrint(root%before) ! 如果该指针前一结点存在, 对前一结点递归调用
|
||
end if
|
||
write(*, '(1X, F10.8)') root%var1 ! 输出当前结点的值
|
||
if ( associated(root%next) ) then
|
||
call BinaryTreeNamePrint(root%next) ! 如果该指针后一结点存在, 对后一结点递归调用
|
||
end if
|
||
end if
|
||
end subroutine BinaryTreeNamePrint
|
||
end module Binary_Tree
|
||
! 模块-链表
|
||
module Linked_List_real
|
||
implicit none
|
||
private ! 数据隐藏
|
||
public :: linkedList, LinkedListAdd ! 显示指定数据
|
||
type :: linkedList ! 链表结点数据类型
|
||
real :: value ! 结点值
|
||
type(linkedList), pointer :: next ! 下一个结点地址
|
||
end type linkedList
|
||
contains
|
||
recursive subroutine LinkedListAdd(newNode, ptr) ! 向链表中添加结点
|
||
implicit none
|
||
type(linkedList), pointer, intent(inout) :: newNode ! 声明插入结点
|
||
type(linkedList), pointer, intent(inout) :: ptr ! 声明当前检测的结点
|
||
if ( .not. associated(ptr) ) then ! 如果检测结点不存在
|
||
ptr => newNode ! 则将检测结点指向新节点
|
||
else ! 如果检测结点存在
|
||
if ( newNode%value > ptr%value ) then ! 如果输入数据大于结点值
|
||
call LinkedListAdd(newNode, ptr%next) ! 递归调用
|
||
else ! 如果输入数据小于结点值
|
||
newNode%next => ptr ! 定义插入结点下一个结点为当前结点
|
||
ptr => newNode ! 将当前结点指针指向插入结点
|
||
end if
|
||
end if
|
||
end subroutine LinkedListAdd
|
||
end module Linked_List_real
|
||
module ModTimePast
|
||
implicit none
|
||
private
|
||
public :: set_timer, elapsed_time
|
||
integer, parameter :: sgl=selected_real_kind(p=1) ! 单精度类型数
|
||
integer, dimension(8) :: timeNow ! 计算时间用
|
||
integer, dimension(8) :: timeOld ! 计算时间用
|
||
contains
|
||
subroutine set_timer ! 创建子程序1
|
||
call DATE_AND_TIME(values=timeNow) ! 调用当前时间子程序
|
||
! write(*, *) timeNow
|
||
end subroutine set_timer ! 结束子程序1
|
||
subroutine elapsed_time(timePast) ! 创建子程序2
|
||
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 ModTimePast
|
||
subroutine Exercises15_14
|
||
use Binary_Tree, only: binaryTreeName, BinaryTreeNameAdd, BinaryTreeNamePrint
|
||
use Linked_List_real, only: linkedList, LinkedListAdd
|
||
use ModTimePast, only: set_timer, elapsed_time
|
||
implicit none
|
||
integer, parameter :: sgl=selected_real_kind(p=1) ! 单精度类型数
|
||
real(sgl) :: timeBTree, timeLLink, timeArray ! 声明各部分运行时间
|
||
type(binaryTreeName), pointer :: bTreeNode => null() ! 声明二叉树插入结点
|
||
type(binaryTreeName), pointer :: bTreeRoot => null() ! 声明二叉树根结点
|
||
type(linkedList), pointer :: lLinkNode => null() ! 声明链表插入结点
|
||
type(linkedList), pointer :: lLinkHead => null() ! 声明链表根节点
|
||
integer :: i ! 循环参数
|
||
integer :: errorLevel ! 错误状态码
|
||
real(sgl), dimension(50000) :: randomArray ! 随机数组
|
||
call set_timer ! 统计创造随机数组所需时间
|
||
do i = 1, 50000
|
||
call random_number(randomArray(i)) ! 给随机数组赋值
|
||
end do
|
||
call elapsed_time(timeArray)
|
||
call set_timer ! 统计二叉树排序所需时间
|
||
do i = 1, 50000
|
||
allocate(bTreeNode, stat=errorLevel) ! 创建插入结点
|
||
if ( errorLevel /= 0 ) stop "" ! 创建失败, 报错并退出
|
||
bTreeNode%var1 = randomArray(i) ! 给结点赋值
|
||
bTreeNode%before => null() ! 令插入结点前一结点为空
|
||
bTreeNode%next => null() ! 令插入结点后一结点为空
|
||
call BinaryTreeNameAdd(bTreeNode, bTreeRoot) ! 插入该结点
|
||
end do
|
||
call elapsed_time(timeBTree)
|
||
call set_timer ! 统计链表排序所需时间
|
||
do i = 1, 50000
|
||
allocate(lLinkNode, stat=errorLevel) ! 创建插入结点
|
||
if ( errorLevel /= 0 ) stop "" ! 创建失败, 报错并退出
|
||
lLinkNode%value = randomArray(i) ! 给结点赋值
|
||
lLinkNode%next => null() ! 令插入结点后一结点为空
|
||
call LinkedListAdd(lLinkNode, lLinkHead) ! 插入该结点
|
||
end do
|
||
call elapsed_time(timeLLink)
|
||
write(*, '(A, ES12.5, A)') &
|
||
&'创建数组共花费时间: ', timeArray, 's', &
|
||
&'排序二叉树共花费时间: ', timeBTree, 's', &
|
||
&'排序链表共花费时间: ', timeLLink, 's' ! 输出结果
|
||
! bTreeRoot => null()
|
||
! do i = 1, 50
|
||
! allocate(bTreeNode, stat=errorLevel)
|
||
! if ( errorLevel /= 0 ) stop ""
|
||
! bTreeNode%var1 = randomArray(i)
|
||
! bTreeNode%before => null()
|
||
! bTreeNode%next => null()
|
||
! call BinaryTreeNameAdd(bTreeNode, bTreeRoot)
|
||
! end do
|
||
! call BinaryTreeNamePrint(bTreeRoot)
|
||
end subroutine Exercises15_14
|
||
! 习题15-17 返回数组最大值指针
|
||
subroutine Exercises15_17
|
||
implicit none
|
||
interface ! 函数接口块
|
||
function MaxPtr(arrayInput) result(result)
|
||
implicit none
|
||
integer, parameter :: sgl=selected_real_kind(p=1)
|
||
real(sgl), intent(in), dimension(:), target :: arrayInput
|
||
integer :: i
|
||
integer :: maxLocate=1
|
||
real(sgl), pointer :: result
|
||
real(sgl) :: maxValue
|
||
end function MaxPtr
|
||
end interface
|
||
integer, parameter :: sgl=selected_real_kind(p=1) ! 单精度类型
|
||
integer :: i ! 循环参数
|
||
real(sgl), dimension(10), target :: randomArray ! 随机数组
|
||
real(sgl), pointer :: maxLocPtr => null() ! 最大值指针
|
||
do i = 1, 10
|
||
call random_number(randomArray(i)) ! 给随机数组赋值
|
||
end do
|
||
maxLocPtr => MaxPtr(randomArray) ! 计算最大值指针位置
|
||
write(*, *) 'The max value is ', maxLocPtr ! 输出结果
|
||
end subroutine Exercises15_17
|
||
function MaxPtr(arrayInput) result(result)
|
||
implicit none
|
||
integer, parameter :: sgl=selected_real_kind(p=1) ! 单精度类型
|
||
real(sgl), intent(in), dimension(:), target :: arrayInput ! 输入数组
|
||
integer :: i ! 循环参数
|
||
integer :: maxLocate=1 ! 最大值位置
|
||
real(sgl), pointer :: result ! 最大值指针(返回值)
|
||
do i = 2, ubound(arrayInput, 1) - lbound(arrayInput, 1) + 1
|
||
if ( arrayInput(maxLocate) < arrayInput(i) ) then
|
||
maxLocate = i ! 如果当前值比已有的最大值大, 那么最大值位置为当前位置
|
||
end if
|
||
end do
|
||
result => arrayInput(maxLocate) ! 将最大值指针指向输入数组最大值位置
|
||
end function MaxPtr
|
||
! 习题15-18 返回数组类型指针的最大值指针
|
||
subroutine Exercises15_18
|
||
implicit none
|
||
interface ! 函数接口块
|
||
function MaxPtr1(arrayInput) result(result)
|
||
implicit none
|
||
integer, parameter :: sgl=selected_real_kind(p=1)
|
||
real(sgl), intent(in), dimension(:), pointer :: arrayInput
|
||
integer :: i
|
||
integer :: maxLocate=1
|
||
real(sgl), pointer :: result
|
||
real(sgl) :: maxValue
|
||
end function MaxPtr1
|
||
end interface
|
||
integer, parameter :: sgl=selected_real_kind(p=1) ! 单精度类型
|
||
integer :: i ! 循环参数
|
||
real(sgl), dimension(:), pointer :: randomArray => null() ! 随机数组
|
||
real(sgl), pointer :: maxLocPtr => null() ! 最大值指针
|
||
integer :: errorLevel
|
||
allocate(randomArray(10), stat=errorLevel)
|
||
if ( errorLevel /= 0 ) stop
|
||
do i = 1, 10
|
||
call random_number(randomArray(i)) ! 给随机数组赋值
|
||
end do
|
||
maxLocPtr => MaxPtr1(randomArray) ! 计算最大值指针位置
|
||
write(*, *) 'The max value is ', maxLocPtr ! 输出结果
|
||
end subroutine Exercises15_18
|
||
function MaxPtr1(arrayInput) result(result)
|
||
implicit none
|
||
integer, parameter :: sgl=selected_real_kind(p=1) ! 单精度类型
|
||
real(sgl), intent(in), dimension(:), pointer :: arrayInput ! 输入数组
|
||
integer :: i ! 循环参数
|
||
integer :: maxLocate=1 ! 最大值位置
|
||
real(sgl), pointer :: result ! 最大值指针(返回值)
|
||
do i = 2, ubound(arrayInput, 1) - lbound(arrayInput, 1) + 1
|
||
if ( arrayInput(maxLocate) < arrayInput(i) ) then
|
||
maxLocate = i ! 如果当前值比已有的最大值大, 那么最大值位置为当前位置
|
||
end if
|
||
end do
|
||
result => arrayInput(maxLocate) ! 将最大值指针指向输入数组最大值位置
|
||
end function MaxPtr1
|
||
! 习题15-19 线性最小二乘拟合
|
||
! 程序过程:
|
||
! 1.打开一个临时文件, 并向其中写入数据
|
||
! 2.读取数据, 并将其添入链表
|
||
! 3.传递链表头指针给子程序, 子程序返回相应数值
|
||
module ModPoint
|
||
implicit none
|
||
integer, parameter :: sgl=selected_real_kind(p=1)
|
||
type :: point
|
||
real(sgl) :: x
|
||
real(sgl) :: y
|
||
type(point), pointer :: next
|
||
end type
|
||
end module ModPoint
|
||
subroutine Exercises15_19
|
||
use ModPoint
|
||
implicit none
|
||
interface ! 定义接口块
|
||
subroutine LeastSquaresMethodPtr(head, slope, intercept, correlationCoefficient)
|
||
use ModPoint
|
||
implicit none
|
||
type(point), intent(in), pointer :: head
|
||
real(sgl), intent(out) :: slope
|
||
real(sgl), intent(out) :: intercept
|
||
real(sgl), intent(out) :: correlationCoefficient
|
||
end subroutine LeastSquaresMethodPtr
|
||
end interface
|
||
type(point), pointer :: temp => null() ! 储存插入结点的临时值
|
||
type(point), pointer :: ptr => null() ! 操作结点
|
||
type(point), pointer :: head => null() ! 首结点
|
||
integer :: errorLevel ! 错误状态码
|
||
real :: m, b, r ! 最小二乘拟合参数
|
||
open(unit=1, status='scratch', iostat=errorLevel) ! 打开一个临时文件
|
||
if ( errorLevel /= 0 ) stop "" ! 打开失败, 报错退出
|
||
write(1, '(A)') & ! 输入文件值
|
||
&" -4.91, -8.18", &
|
||
&" -3.84, -7.49", &
|
||
&" -2.41, -7.11", &
|
||
&" -2.62, -6.15", &
|
||
&" -3.78, -5.62", &
|
||
&" -0.52, -3.30", &
|
||
&" -1.83, -2.05", &
|
||
&" -2.01, -2.83", &
|
||
&" -0.28, -1.16", &
|
||
&" +1.08, +0.52"
|
||
rewind(unit=1, iostat=errorLevel) ! 回到文件开头
|
||
if ( errorLevel /= 0 ) stop "" ! 操作失败, 报错退出
|
||
do
|
||
allocate(temp, stat=errorLevel) ! 给了临时结点分配内存
|
||
if ( errorLevel /= 0 ) stop "" ! 分配失败, 报错退出
|
||
temp%next => null() ! 临时节点的下一节点为空
|
||
read(1, *, iostat=errorLevel) temp%x, temp%y ! 给临时结点赋值
|
||
if ( errorLevel /= 0 ) then ! 如果没有输入值
|
||
deallocate(temp, stat=errorLevel) ! 释放临时结点的内存
|
||
if ( errorLevel /= 0 ) stop "" ! 释放内存失败, 报错退出
|
||
exit ! 释放内粗成功, 结束循环
|
||
end if
|
||
if ( .not. associated(head) ) then
|
||
head => temp ! 如果没有首结点, 则首结点指向临时节点
|
||
end if
|
||
if ( .not. associated(ptr) ) then
|
||
ptr => temp ! 如果操作结点不存在, 则操作结点指向临时节点
|
||
else
|
||
ptr%next => temp ! 如果操作结点存在, 则操作结点的下一个结点指向临时节点
|
||
ptr => ptr%next ! 操作结点指向临时节点
|
||
end if
|
||
end do
|
||
call LeastSquaresMethodPtr(head, 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/)
|
||
write(*,1) m, b, r ! 输出结果
|
||
1 format(1X, '计算得到的拟合方程为: y = ', F5.2, ' * x + ', F5.2, ' , 相关系数r为: ', F5.3)
|
||
end subroutine Exercises15_19
|
||
subroutine LeastSquaresMethodPtr(head, slope, intercept, correlationCoefficient)
|
||
use ModPoint
|
||
implicit none
|
||
type(point), intent(in), pointer :: head ! 首结点
|
||
real(sgl), intent(out) :: slope ! 斜率
|
||
real(sgl), intent(out) :: intercept ! 截距
|
||
real(sgl), intent(out) :: correlationCoefficient ! 相关系数
|
||
type(point), pointer :: ptr ! 操作结点
|
||
integer :: num=0 ! 结点总数
|
||
real :: x_bar, y_bar ! xy均值
|
||
real :: x_sum=0, y_sum=0 ! xy总和
|
||
real :: x2_sum=0, xy_sum=0, y2_sum=0 ! 各种参数
|
||
ptr => head ! 操作结点指向首结点
|
||
do
|
||
if ( associated(ptr) ) then ! 如果操作结点已关联
|
||
num = num + 1 ! 结点总数递增
|
||
x_sum = x_sum + ptr%x ! 计算各类参数
|
||
y_sum = y_sum + ptr%y
|
||
x2_sum = x2_sum + ptr%x**2
|
||
y2_sum = y2_sum + ptr%y**2
|
||
xy_sum = xy_sum + ptr%x*ptr%y
|
||
ptr => ptr%next ! 操作结点指向当前操作结点的下一个结点
|
||
else
|
||
exit ! 如果操作结点未关联, 则结束循环
|
||
end if
|
||
end do
|
||
x_bar = x_sum/real(num) ! x均值
|
||
y_bar = y_sum/real(num) ! y均值
|
||
slope = ( xy_sum - x_sum*y_bar )/( x2_sum - x_sum*x_bar ) ! 斜率
|
||
intercept = y_bar - slope*x_bar ! 截距
|
||
correlationCoefficient = ( real(num)*xy_sum - x_sum*y_sum )/& ! 相关系数
|
||
&sqrt( (real(num)*x2_sum - x_sum**2 )*( real(num)*y2_sum - y_sum**2 ) )
|
||
end subroutine LeastSquaresMethodPtr
|
||
! 习题15-20 双向链表
|
||
module ModDoLinkList
|
||
implicit none
|
||
integer, parameter :: sgl=selected_real_kind(p=1)
|
||
type :: doNode
|
||
real(sgl) :: var1
|
||
type(doNode), pointer :: before
|
||
type(doNode), pointer :: next
|
||
end type
|
||
contains
|
||
recursive subroutine DoNodeAdd(newNode, ptr)
|
||
type(doNode), intent(inout), pointer :: newNode
|
||
type(doNode), intent(inout), pointer :: ptr
|
||
if ( .not. associated(newNode) ) stop ""
|
||
if ( associated(ptr) ) then
|
||
if ( associated(ptr%next) ) then
|
||
call DoNodeAdd(newNode, ptr%next)
|
||
else
|
||
ptr%next => newNode
|
||
newNode%before => ptr
|
||
end if
|
||
else
|
||
ptr => newNode
|
||
end if
|
||
end subroutine DoNodeAdd
|
||
recursive subroutine DoNodeSort(ptr) ! 排序链表
|
||
implicit none
|
||
type(doNode), intent(inout), pointer :: ptr ! 操作指针
|
||
type(doNode), pointer :: newNode ! 需要变更的指针
|
||
type(doNode), pointer :: temp
|
||
integer :: errorLevel
|
||
write(*, '(A)', advance='no') ' 3'
|
||
if ( associated(ptr) .and. associated(ptr%next) ) then ! 如果操作指针及操作指针的下一个指针已关联
|
||
if ( ptr%var1 > ptr%next%var1 ) then ! 如果操作结点值大于下一个结点值
|
||
! allocate(newNode, stat=errorLevel)
|
||
! if ( errorLevel /= 0 ) stop ""
|
||
newNode => ptr%next ! 将变更指针 => 下一个结点
|
||
if ( associated(ptr%next%next) ) then ! 如果下一个结点不是最后一个结点
|
||
newNode%next%before => ptr ! 将变更结点的下一个结点的前指针 => 操作结点
|
||
ptr%next => newNode%next ! 操作结点的后指针 => 变更结点的下一个结点
|
||
else ! 如果下一个结点是最后一个结点
|
||
ptr%next => null() ! 操作结点的后指针 => 空
|
||
end if
|
||
newNode%before => null() ! 变更结点的前指针 => 空
|
||
newNode%next => null() ! 变更结点的后指针 => 空
|
||
write(*, '(A)', advance='no') '4'
|
||
! temp => ptr
|
||
call DoNodeSortForword(newNode, ptr%before) ! 将变更结点排序插入操作结点之前的链表
|
||
! ptr => temp
|
||
write(*, '(A)', advance='no') '5'
|
||
end if
|
||
write(*, '(A)', advance='no') '6'
|
||
if ( associated(ptr%next) ) then
|
||
call DoNodeSort(ptr%next) ! 对操作结点的下一个结点递归调用
|
||
end if
|
||
write(*, '(A)', advance='no') '7'
|
||
end if
|
||
end subroutine DoNodeSort
|
||
recursive subroutine DoNodeSortBackword(newNode, ptr)
|
||
implicit none
|
||
type(doNode), intent(in), pointer :: newNode
|
||
type(doNode), intent(inout), pointer :: ptr
|
||
if ( .not. associated(newNode) ) then
|
||
stop ""
|
||
else
|
||
if ( .not. associated(ptr) ) then
|
||
ptr => newNode
|
||
else
|
||
if ( newNode%var1 > ptr%var1 ) then
|
||
call DoNodeSortBackword(newNode, ptr%next)
|
||
else
|
||
newNode%before => ptr%before
|
||
ptr%before%next => newNode
|
||
newNode%next => ptr
|
||
ptr%before => newNode
|
||
end if
|
||
end if
|
||
end if
|
||
end subroutine DoNodeSortBackword
|
||
subroutine test1(value, ptr)
|
||
type(doNode), intent(inout), target :: value
|
||
type(doNode), intent(inout), pointer :: ptr
|
||
type(doNode), pointer :: temp => null()
|
||
type(doNode), target :: a
|
||
type(doNode), pointer :: newNode => null()
|
||
allocate(newNode)
|
||
newNode%var1 = 200.
|
||
newNode%before => null()
|
||
newNode%next => null()
|
||
a%var1 = 100.
|
||
a%before => null()
|
||
a%next => null()
|
||
temp => value%before
|
||
temp%next => a
|
||
write(*, *)
|
||
write(*, *) '如果传递的是值, 则 ', value%var1
|
||
temp => ptr%before
|
||
ptr%before%next => a
|
||
write(*, *) '如果传递的是指针, 则 ', ptr%var1
|
||
newNode%before => ptr ! 插入结点前指针 => 操作结点
|
||
temp => ptr%next
|
||
temp%before => newNode ! 操作结点后指针指向的结点的前指针 => 插入结点
|
||
newNode%next => temp ! 插入结点的后指针 => 操作结点后指针指向的结点
|
||
ptr%next => newNode
|
||
end subroutine
|
||
recursive subroutine DoNodeSortForword(newNode, ptr) ! 向前排序
|
||
implicit none
|
||
type(doNode), intent(inout), target :: newNode ! 插入结点
|
||
type(doNode), intent(inout), target :: ptr ! 操作结点
|
||
type(doNode), pointer :: temp
|
||
if ( newNode%var1 < ptr%var1 ) then ! 如果插入结点值比操作结点值小
|
||
if ( associated(ptr%before) ) then ! 如果操作结点前指针已关联
|
||
call DoNodeSortForword(newNode, ptr%before) ! 递归调用
|
||
else ! 如果操作结点前指针为空
|
||
ptr%before => newNode ! 操作结点前指针 => 插入结点
|
||
newNode%next => ptr ! 插入结点后指针 => 操作节点
|
||
end if
|
||
else ! 如果插入结点值比操作结点值大
|
||
newNode%before => ptr ! 插入结点前指针 => 操作结点
|
||
newNode%next => ptr%next
|
||
ptr%next => newNode
|
||
newNode%next%before => newNode
|
||
end if
|
||
end subroutine DoNodeSortForword
|
||
recursive subroutine DoNodeSortForword1(newNode, ptr) ! 向前排序
|
||
implicit none
|
||
type(doNode), intent(inout), pointer :: newNode ! 插入结点
|
||
type(doNode), intent(inout), pointer :: ptr ! 操作结点
|
||
type(doNode), pointer :: temp
|
||
write(*, *) '当前操作结点为: ', ptr%var1, '; 当前插入结点为:', newNode%var1
|
||
if ( .not. associated(newNode) ) then ! 如果插入结点未关联
|
||
stop "" ! 报错退出
|
||
else ! 如果插入结点已关联
|
||
write(*, *) ' 插入结点存在'
|
||
if ( newNode%var1 < ptr%var1 ) then ! 如果插入结点值比操作结点值小
|
||
write(*, *) ' 插入结点值小于操作结点值'
|
||
if ( associated(ptr%before) ) then ! 如果操作结点前指针已关联
|
||
write(*, *) ' 由于操作结点值前指针已关联, 检测前一结点'
|
||
call DoNodeSortForword1(newNode, ptr%before) ! 递归调用
|
||
else ! 如果操作结点前指针为空
|
||
write(*, *) ' 由于操作结点值前指针未关联, 则在最前端插入插入节点'
|
||
ptr%before => newNode ! 操作结点前指针 => 插入结点
|
||
newNode%next => ptr ! 插入结点后指针 => 操作节点
|
||
end if
|
||
else ! 如果插入结点值比操作结点值大
|
||
write(*, *) ' 插入结点值大于操作结点值, 将结点插入操作结点之后'
|
||
newNode%before => ptr ! 插入结点前指针 => 操作结点
|
||
write(*, *) ' 插入结点前指针指向: ', newNode%before%var1
|
||
temp => ptr%next
|
||
! ptr%next => newNode ! 操作结点的后指针 => 插入结点
|
||
temp%before => newNode ! 操作结点后指针指向的结点的前指针 => 插入结点
|
||
write(*, *) ' 操作结点后结点前指针指向:', temp%before%var1
|
||
newNode%next => temp ! 插入结点的后指针 => 操作结点后指针指向的结点
|
||
write(*, *) ' 插入结点后指针指向: ', newNode%next%var1
|
||
ptr%next => newNode
|
||
write(*, *) ' 操作结点后指针指向: ', ptr%next%var1
|
||
end if
|
||
! if ( .not. associated(ptr) ) then ! 如果操作结点前指针为空
|
||
! write(*, '(A)', advance='no') '10'
|
||
! ptr%before => newNode !
|
||
! newNode%next => ptr
|
||
! else
|
||
! write(*, '(A)', advance='no') '11'
|
||
! if ( newNode%var1 < ptr%var1 ) then
|
||
! call DoNodeSortForword(newNode, ptr%before)
|
||
! else
|
||
! newNode%before => ptr
|
||
! ptr%next%before => newNode
|
||
! newNode%next => ptr%next
|
||
! ptr%next => newNode
|
||
! end if
|
||
! end if
|
||
! newNode => null()
|
||
! call DoNodePrint1(ptr)
|
||
! write(*, *)
|
||
! ptr => null()
|
||
end if
|
||
end subroutine DoNodeSortForword1
|
||
recursive subroutine DoNodePrint(ptr)
|
||
type(doNode), intent(in), pointer :: ptr
|
||
if ( associated(ptr) ) then
|
||
write(*, '(F6.2)', advance='no') ptr%var1
|
||
call DoNodePrint(ptr%next)
|
||
end if
|
||
end subroutine DoNodePrint
|
||
recursive subroutine DoNodePrint1(ptr)
|
||
type(doNode), intent(in), pointer :: ptr
|
||
if ( associated(ptr) ) then
|
||
write(*, '(F6.2)', advance='no') ptr%var1
|
||
call DoNodePrint1(ptr%before)
|
||
end if
|
||
end subroutine DoNodePrint1
|
||
end module ModDoLinkList
|
||
subroutine Test
|
||
use ModDoLinkList
|
||
implicit none
|
||
type(doNode), pointer :: newNode => null()
|
||
type(doNode), pointer :: head => null()
|
||
type(doNode), pointer :: tail => null()
|
||
type(doNode), pointer :: ptr => null()
|
||
real(sgl) :: temp
|
||
integer :: i
|
||
integer :: errorLevel
|
||
do i = 1, 21
|
||
allocate(newNode)
|
||
newNode%var1 = real(i)
|
||
newNode%before => null()
|
||
newNode%next => null()
|
||
if ( .not. associated(head) ) head => newNode
|
||
! if ( .not. associated(head) ) then
|
||
! head => newNode
|
||
! write(*, *) '已插入首结点 ', newNode%var1
|
||
! else
|
||
! call DoNodeAdd(newNode, head)
|
||
! write(*, *) '已插入结点 ', newNode%var1
|
||
! end if
|
||
call DoNodeAdd(newNode, tail)
|
||
tail => newNode
|
||
end do
|
||
allocate(newNode)
|
||
newNode%var1 = 17.5
|
||
newNode%before => null()
|
||
newNode%next => null()
|
||
ptr => head
|
||
do
|
||
if ( associated(ptr) ) then
|
||
write(*, '(F6.2)', advance='no') ptr%var1
|
||
ptr => ptr%next
|
||
else
|
||
exit
|
||
end if
|
||
end do
|
||
write(*, *)
|
||
ptr => tail
|
||
call DoNodeSortForword1(newNode, ptr)
|
||
call DoNodePrint(head)
|
||
write(*, *)
|
||
call DoNodePrint1(tail)
|
||
write(*, *)
|
||
do
|
||
if ( associated(head%before) ) then
|
||
head => head%before
|
||
else
|
||
exit
|
||
end if
|
||
end do
|
||
ptr => tail
|
||
ptr => head
|
||
write(*, *)
|
||
do
|
||
if ( associated(ptr) ) then
|
||
write(*, '(F6.2)', advance='no') ptr%var1
|
||
! write(*, *) '当前结点值为:', ptr%var1, '; 下一结点值为:', ptr%before%var1
|
||
! ptr => ptr%before
|
||
ptr => ptr%next
|
||
else
|
||
exit
|
||
end if
|
||
end do
|
||
ptr => tail%before
|
||
call test1(ptr, ptr)
|
||
write(*, *) ptr%before%var1, ptr%var1, ptr%next%var1, ptr%next%next%var1
|
||
end subroutine Test
|
||
subroutine Exercises15_20
|
||
use ModDoLinkList
|
||
implicit none
|
||
integer :: i
|
||
type(doNode), pointer :: newNode => null()
|
||
type(doNode), pointer :: head => null()
|
||
type(doNode), pointer :: tail => null()
|
||
type(doNode), pointer :: ptr => null()
|
||
real(sgl) :: temp
|
||
integer :: errorLevel
|
||
open(unit=1, status='scratch', iostat=errorLevel)
|
||
if ( errorLevel /= 0 ) stop ""
|
||
do i = 1, 20
|
||
call random_number(temp)
|
||
temp = temp*200_sgl - 100_sgl
|
||
write(1, *, iostat=errorLevel) temp
|
||
if ( errorLevel /= 0 ) stop ""
|
||
end do
|
||
rewind(unit=1, iostat=errorLevel)
|
||
if ( errorLevel /= 0 ) stop ""
|
||
do
|
||
read(1, *, iostat=errorLevel) temp
|
||
if ( errorLevel /= 0 ) exit
|
||
allocate(newNode, stat=errorLevel)
|
||
if ( errorLevel /= 0 ) stop ""
|
||
newNode%var1 = temp
|
||
newNode%before => null()
|
||
newNode%next => null()
|
||
if ( .not. associated(head) ) then
|
||
head => newNode
|
||
end if
|
||
if ( .not. associated(ptr) ) then
|
||
ptr => newNode
|
||
else
|
||
ptr%next => newNode
|
||
newNode%before => ptr
|
||
ptr => newNode
|
||
end if
|
||
tail => ptr
|
||
end do
|
||
ptr => head
|
||
write(*, *) "从前向后排列:"
|
||
do
|
||
if ( associated(ptr) ) then
|
||
write(*, '(F10.5)', advance='no') ptr%var1
|
||
ptr => ptr%next
|
||
else
|
||
write(*, *) ''
|
||
exit
|
||
end if
|
||
end do
|
||
ptr => tail
|
||
write(*, *) "从后向前排列:"
|
||
do
|
||
if ( associated(ptr) ) then
|
||
write(*, '(F10.5)', advance='no') ptr%var1
|
||
ptr => ptr%before
|
||
else
|
||
write(*, *) ''
|
||
exit
|
||
end if
|
||
end do
|
||
end subroutine Exercises15_20
|
||
subroutine Exercises15_21
|
||
use ModDoLinkList
|
||
implicit none
|
||
integer :: i
|
||
type(doNode), pointer :: newNode => null()
|
||
type(doNode), pointer :: head => null()
|
||
type(doNode), pointer :: tail => null()
|
||
type(doNode), pointer :: ptr => null()
|
||
real(sgl) :: temp
|
||
integer :: errorLevel
|
||
open(unit=1, status='scratch', iostat=errorLevel)
|
||
if ( errorLevel /= 0 ) stop ""
|
||
do i = 1, 50
|
||
call random_number(temp)
|
||
temp = temp*2000_sgl - 1000_sgl
|
||
write(1, *, iostat=errorLevel) temp
|
||
if ( errorLevel /= 0 ) stop ""
|
||
end do
|
||
rewind(unit=1, iostat=errorLevel)
|
||
if ( errorLevel /= 0 ) stop ""
|
||
do
|
||
read(1, *, iostat=errorLevel) temp
|
||
if ( errorLevel /= 0 ) exit
|
||
allocate(newNode, stat=errorLevel)
|
||
if ( errorLevel /= 0 ) stop ""
|
||
newNode%var1 = temp
|
||
newNode%before => null()
|
||
newNode%next => null()
|
||
if ( .not. associated(head) ) then
|
||
head => newNode
|
||
end if
|
||
if ( .not. associated(ptr) ) then
|
||
ptr => newNode
|
||
else
|
||
ptr%next => newNode
|
||
newNode%before => ptr
|
||
ptr => newNode
|
||
end if
|
||
tail => ptr
|
||
end do
|
||
ptr => head
|
||
write(*, *) "从前向后排列:"
|
||
do
|
||
if ( associated(ptr) ) then
|
||
write(*, '(F10.5)', advance='no') ptr%var1
|
||
ptr => ptr%next
|
||
else
|
||
write(*, *) ''
|
||
exit
|
||
end if
|
||
end do
|
||
ptr => head
|
||
write(*, *) 1
|
||
call DoNodeSort(ptr)
|
||
write(*, *) 2
|
||
ptr => head
|
||
do
|
||
if ( associated(ptr%before) ) then
|
||
ptr => ptr%before
|
||
else
|
||
head => ptr
|
||
exit
|
||
end if
|
||
end do
|
||
ptr => tail
|
||
do
|
||
if ( associated(ptr%next) ) then
|
||
ptr => ptr%next
|
||
else
|
||
tail => ptr
|
||
exit
|
||
end if
|
||
end do
|
||
ptr => head
|
||
write(*, *) "升序排列:"
|
||
do
|
||
if ( associated(ptr) ) then
|
||
write(*, '(F10.4)', advance='no') ptr%var1
|
||
ptr => ptr%next
|
||
else
|
||
write(*, *) ''
|
||
exit
|
||
end if
|
||
end do
|
||
ptr => tail
|
||
write(*, *) "降序排列:"
|
||
do
|
||
if ( associated(ptr) ) then
|
||
write(*, '(F10.4)', advance='no') ptr%var1
|
||
ptr => ptr%before
|
||
else
|
||
write(*, *) ''
|
||
exit
|
||
end if
|
||
end do
|
||
end subroutine Exercises15_21
|
||
module ModDuLinkList
|
||
implicit none
|
||
private
|
||
type :: duNode
|
||
|
||
end module ModDuLinkList
|
||
subroutine Exercises15_21new
|
||
use ModDuLinkList
|
||
implicit none
|
||
end subroutine Exercises15_21new |