I would like to implement a generic double linked list in Fortran for saving codes, using PGI Fortran compiler version 12.10-0 in Mac OS X 10.8.2. Here is my prototype, including 3 files:
---> File 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
---> File 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
---> File 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
The running result is:
MacBook-Pro:sandbox dongli$ ./test_variable
---> Register a 1D variable "a".
---> Unknown variable type "a".
Why after appending a list, the type of var is changed into a type that is unknown, and how could I achieve the expected functionality?
