Double linked list problem (type is not judged correctly)

dongli · November 11, 2012, 7:30am

Dear all,

I would like to implement a generic double linked list in Fortran for saving codes. 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?

Any help is appreciated!

Li

dongli · November 12, 2012, 1:22am

I think the problem is the allocate(elem), where elem is declared as a class(list_elem_t), pointer. Fortran loses the memory that elem is a type of type(var_1d_t). So we can not make list manage the memory, but the user.

mleair · November 15, 2012, 6:16pm

Hi Dongli,

Your allocate statement in list_append() creates an instance of list_elem_t not var_1d_t. By definition, an allocate statement will default to the declared type unless you use F2003’s typed allocation or sourced allocation. Therefore, in this case, the type of elem in list_append() will be list_elem_t.

A quick fix would be to remove the allocate(elem) statement in list_append() and add a typed allocation statement before the call to append() in variable_register():

allocate(var_1d_t::var)
call var_list%append(var)

You could also incorporate this into the select type statement prior to the call to append() in variable_register():

        select type (v=>var)
        type is (var_1d_t)
            allocate(var_1d_t::var)
            print *, "---> Register a 1D variable """//trim(name)//"""."
        type is (var_2d_t)
            allocate(var_2d_t::var)
            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)

Note that the select type statement now uses an associate-name called “v” and a selector called “var” (i.e., select type(v=>var) versus select type(var) ). We need to use both an associate-name and a selector so we allocate the pointer “var”, not the associate-name “var”.

If the list_append() procedure had access to the var_1d_t and var_2d_t types (they’re defined in the second file, not the first file), then you could move the select type and allocate statement into the list_append() procedure.

You could also use a wrapper routine in the second file that performs the select type/allocation prior to the call to list_append().

Finally, there’s a PGI Insider article that covers generic linked lists. Feel free to check it out for other ideas on how to implement linked lists in Fortran. Below is the link to the article:

-Mark