PGI User Forum
 SearchSearch   MemberlistMemberlist     RegisterRegister   ProfileProfile    Log inLog in 

CUDA-x86.

Double linked list problem (type is not judged correctly)

 
Post new topic   Reply to topic    PGI User Forum Forum Index -> Programming and Compiling
View previous topic :: View next topic  
Author Message
dongli



Joined: 26 May 2009
Posts: 2

PostPosted: Sun Nov 11, 2012 12:30 am    Post subject: Double linked list problem (type is not judged correctly) Reply with quote

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 ---------------------------
Code:

! ----------------------------------------------------------------------------
! 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 ---------------------------
Code:

! ----------------------------------------------------------------------------
! 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 ---------------------------
Code:

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:
Code:

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
Back to top
View user's profile
dongli



Joined: 26 May 2009
Posts: 2

PostPosted: Sun Nov 11, 2012 6:22 pm    Post subject: Reply with quote

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.
Back to top
View user's profile
mleair



Joined: 19 Jul 2004
Posts: 67
Location: Portland Group

PostPosted: Thu Nov 15, 2012 11:16 am    Post subject: RE: doubly linked list Reply with quote

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():

Code:
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():

Code:

        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:

http://www.pgroup.com/lit/articles/insider/v3n2a2.htm


-Mark
Back to top
View user's profile
Display posts from previous:   
Post new topic   Reply to topic    PGI User Forum Forum Index -> Programming and Compiling All times are GMT - 7 Hours
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © phpBB Group