Question

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 <[e-mail]> - 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 - <[e-mail]> - 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 <[e-mail]> - 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 <[e-mail]> - 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 <[e-mail]> - 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?

Answer 1

F2008 12.5.2.5 p2 says in terms of pointer and allocatable dummy arguments: “The actual argument shall be polymorphic if and only if the associated dummy argument is polymorphic…”.

The dummy argument var in variable_register is a polymorphic pointer. The actual argument a in the main program is not. Your program is in error and the Fortran processor is not required to diagnose this error (though it should be easy enough for it to detect this in this particular case).

The same paragraph in F2008 12.5.2.5 then goes on to say “…the declared type of the actual argument shall be the same as the declared type of the dummy argument.” The dummy argument in list_append is a polymorphic pointer of declared type list_elem_t. The actual argument is a polymorphic pointer of declared type var_t. They are not the same – your program is even more in error. Again, the Fortran processor is not required to diagnose this, but it should be easy enough for it to do so in this case.

Because your program is in error anything can happen, but on a related note – the elem argument to list_append is declared INTENT(OUT). That means that at the start of that procedure, the pointer association status of elem is undefined – you don’t know what it is pointing at (or its dynamic type). The allocate statement in list_append then allocates an object of the declared type of elem, i.e. list_elem_t (the fact that the pointer that is the ultimate argument and the pointer that is the “intermediate” argument have now been pointed at a parent of their respective declared types is the reason that the restrictions quoted above in 12.5.2.5 exist – read Note 12.27 in F2008). Your select type doesn’t check for that option.