我想在Fortran中实现一个通用的双链表来保存代码，使用Mac OS X 10.8.2中的PGI Fortran编译器版本12.10-0。这是我的原型，包括3个文件：
---＆GT;文件1：
! ----------------------------------------------------------------------------
! Description:
!
! This module provides several basic data structures, e.g. double linked list.
!
! Authors:
!
! Li Dong <dongli@lasg.iap.ac.cn> - 2012-11-11
! ----------------------------------------------------------------------------
module basic_data_structure
implicit none
private
public list_elem_t, list_t
type list_elem_t
class(list_elem_t), pointer :: prev, next
end type list_elem_t
type list_t
integer :: num_elem = 0
class(list_elem_t), pointer :: head, tail
contains
procedure :: append => list_append
procedure :: insert => list_insert
procedure :: final => list_final
end type list_t
contains
! ------------------------------------------------------------------------
! Description:
!
! The following list_* are the type-bound procedures of double linked
! list data structure.
!
! Authors:
!
! Li Dong - <dongli@lasg.iap.ac.cn> - 2012-11-11
! ------------------------------------------------------------------------
subroutine list_append(this, elem)
class(list_t), intent(inout) :: this
class(list_elem_t), intent(out), pointer :: elem
character(50), parameter :: sub_name = "list_append"
allocate(elem)
if (this%num_elem == 0) then
this%head => elem
nullify(this%head%prev)
this%tail => this%head
else
this%tail%next => elem
elem%prev => this%tail
this%tail => elem
end if
nullify(this%tail%next)
this%num_elem = this%num_elem+1
end subroutine list_append
subroutine list_insert(this, existed_elem, elem)
class(list_t), intent(inout) :: this
class(list_elem_t), intent(inout), pointer :: existed_elem
class(list_elem_t), intent(out), pointer :: elem
character(50), parameter :: sub_name = "list_insert"
! TODO: Check existed_elem is allocated.
! TODO: Check existed_elem is one element of this.
allocate(elem)
elem%prev => existed_elem
elem%next => existed_elem%next
if (associated(existed_elem%next)) then
existed_elem%next%prev => elem
existed_elem%next => elem
end if
this%num_elem = this%num_elem+1
end subroutine list_insert
subroutine list_final(this)
class(list_t), intent(inout) :: this
class(list_elem_t), pointer :: elem
integer i
elem => this%head
do i = 1, this%num_elem-1
elem => elem%next
if (associated(elem%prev)) deallocate(elem%prev)
end do
deallocate(this%tail)
end subroutine list_final
end module basic_data_structure
---＆GT;文件2
! ----------------------------------------------------------------------------
! Description:
!
! This module manages the model variables.
!
! Authors:
!
! Li Dong <dongli@lasg.iap.ac.cn> - 2012-11-11
! ----------------------------------------------------------------------------
module variable
use basic_data_structure
implicit none
private
public variable_register
public variable_final
public var_t, var_1d_t
integer, parameter :: A_GRID = 1
integer, parameter :: B_GRID = 2
integer, parameter :: C_GRID = 3
type, extends(list_elem_t) :: var_t
character(10) name
character(50) long_name
character(20) units
integer grid_type
end type var_t
type, extends(var_t) :: var_1d_t
real(8), allocatable :: array(:)
end type var_1d_t
type, extends(var_t) :: var_2d_t
real(8), allocatable :: array(:,:)
end type var_2d_t
type(list_t) var_list
contains
! ------------------------------------------------------------------------
! Description:
!
! Register a variable.
!
! Authors:
!
! Li Dong <dongli@lasg.iap.ac.cn> - 2012-11-11
! ------------------------------------------------------------------------
subroutine variable_register(name, var)
character(*), intent(in) :: name
class(var_t), intent(inout), pointer :: var
character(50), parameter :: sub_name = "variable_register"
select type (var)
type is (var_1d_t)
print *, "---> Register a 1D variable """//trim(name)//"""."
type is (var_2d_t)
print *, "---> Register a 2D variable """//trim(name)//"""."
type is (var_t)
print *, "---> Oh, no!"
class default
print *, "---> Unknown variable type """//trim(name)//"""."
end select
call var_list%append(var)
! -------------------------------> PROBLEM IS HERE
select type (var)
type is (var_1d_t)
print *, "---> Register a 1D variable """//trim(name)//"""."
type is (var_2d_t)
print *, "---> Register a 2D variable """//trim(name)//"""."
type is (var_t)
print *, "---> Oh, no!"
class default
print *, "---> Unknown variable type """//trim(name)//"""."
end select
end subroutine variable_register
! ------------------------------------------------------------------------
! Description:
!
! Clean the registered variables.
!
! Authors:
!
! Li Dong <dongli@lasg.iap.ac.cn> - 2012-11-11
! ------------------------------------------------------------------------
subroutine variable_final()
character(50), parameter :: sub_name = "variable_final"
call var_list%final()
end subroutine variable_final
end module variable
---＆GT;文件3：
program test_variable
use variable
implicit none
type(var_1d_t), pointer :: a
call variable_register("a", a)
call variable_final()
end program test_variable
运行结果是：
MacBook-Pro:sandbox dongli$ ./test_variable
---> Register a 1D variable "a".
---> Unknown variable type "a".
为什么在添加列表后，var的类型会更改为未知类型，以及如何实现预期的功能？
答案 0 :(得分：1)
F2008 12.5.2.5 p2在指针和可分配的伪参数方面表示：“当且仅当关联的伪参数是多态的时，实际参数才是多态的。”。
variable_register中的伪参数var是一个多态指针。主程序中的实际参数a不是。您的程序出错并且Fortran处理器不需要诊断此错误（尽管它应该很容易在这种特定情况下检测到这一点）。
F2008 12.5.2.5中的同一段继续说“......实际参数的声明类型应与伪参数的声明类型相同。” list_append中的伪参数是声明类型list_elem_t的多态指针。实际参数是声明类型var_t的多态指针。它们不一样 - 你的程序更加错误。同样，Fortran处理器不需要对此进行诊断，但在这种情况下它应该很容易实现。
因为您的程序出错可能会发生任何事情，但在相关的注释中 - list_append的elem参数被声明为INTENT(OUT)。这意味着在该过程开始时，elem的指针关联状态未定义 - 您不知道它指向的是什么（或其动态类型）。 list_append中的allocate语句然后分配声明类型为elem的对象，即list_elem_t（事实上，作为最终参数的指针和作为“中间”参数的指针现在已经被指出其各自声明类型的父母是上述12.5.2.5中引用的限制的原因 - 阅读F2008中的注释12.27）。您的选择类型不会检查该选项。