Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.
Announcements
Welcome to the Intel Community. If you get an answer you like, please mark it as an Accepted Solution to help others. Thank you!
26745 Discussions

procedure pointer in derived type gets unassociated

Meyer__Knut_Andreas
111 Views

Hi.

In my program I have several procedure pointers in a large derived type (with sub derived types). However, the pointers seem to become unassociated for some specific cases and I don't understand why. I would be very grateful if someone can give me hints on what I'm doing wrong and how a more stable behavior can be achieved!

Below is an as small example as I was able to create to show the behavior.

I get the following output depending on my settings (A,B,C):

A: As below
B: Comment out line 28
C: Comment out line 90 and 92, remove comment on line 89

Earlier in the digging down I also experienced a case D, but I haven't been able to reproduce this in a smaller example...

 Setting                              =  A | B | C | D
 get_lev2_2, lev2_2%addr              :  T   T   T   T
 get_lev1_2, lev1_2_tmp(1)%lev2_2%addr:  F   T   T   T
 get_lev1_2, lev1_2(1)%lev2_2%addr    :  F   T   F   T
 get_main, main%lev1_2(1)%lev2_2%addr :  F   T   F   T
 get_main, main%lev1_1%addr           :  T   T   T   T
 top_level, main%lev1_1%addr          :  T   T   T   T
 top_level, main%lev1_2(1)%lev2_2%addr:  F   T   F   F

This is running with Visual Studio 2012 and ifort 14.0.1.139

Running the same example on linux with ifort 18.0.1 and  gfortran 7.3.0 all tests are true.

module tmpl_mod
    implicit none
    abstract interface       
        subroutine sub_template(x,f)
            double precision, intent(in) :: x(:)
            double precision :: f(size(x))
        end subroutine
    end interface
    
    contains 
        
end module tmpl_mod
    
module types_mod
use tmpl_mod
    implicit none

    type lev1_1_typ
        integer                                :: k1
        procedure(sub_template),pointer,nopass :: addr
    end type
    
    type lev2_2_typ
        procedure(sub_template),pointer,nopass:: addr
    end type
    
    type lev1_2_typ 
        integer                        :: k1
        type(lev2_2_typ)               :: lev2_2
    end type
    
    type main_typ
        type(lev1_1_typ)                  :: lev1_1
        type(lev1_2_typ), allocatable     :: lev1_2(:)
    end type main_typ
    
end module types_mod
    
module ass_mod
    use tmpl_mod
    implicit none   
                
    character(len=4), parameter     :: lib_ext = '.dll'
    
    contains
    
    subroutine sub(x,f)
        double precision, intent(in) :: x(:)
        double precision :: f(size(x))
        f = 2.d0*x
    end subroutine
    
    subroutine ass_sub(proc_ptr)
    implicit none
        procedure (sub_template), pointer   :: proc_ptr
        proc_ptr => sub
    end subroutine
    
end module ass_mod
    
    
module get_mod
    use types_mod
    use ass_mod
    implicit none
    
    contains

subroutine get_main(main)
    implicit none
    type(main_typ) :: main
    
    call get_lev1_1(main%lev1_1)
    call get_lev1_2(main%lev1_2)
    write(*,*) 'get_main, main%lev1_2(1)%lev2_2%addr: ', associated(main%lev1_2(1)%lev2_2%addr)
    write(*,*) 'get_main, main%lev1_1%addr          : ', associated(main%lev1_1%addr)
    
end subroutine

subroutine get_lev1_1(lev1_1)
    implicit none
    type(lev1_1_typ)                  :: lev1_1
    call ass_sub(lev1_1%addr)
end subroutine

subroutine get_lev1_2(lev1_2)
    implicit none
    type(lev1_2_typ), allocatable       :: lev1_2(:)
   !type(lev1_2_typ)                    :: lev1_2_tmp(3)
    type(lev1_2_typ), allocatable       :: lev1_2_tmp(:)
    integer                             :: stype, k1
    allocate(lev1_2_tmp(3))
    k1 = 1
    call get_lev2_2(lev1_2_tmp(k1)%lev2_2)
    allocate(lev1_2(k1))
    lev1_2 = lev1_2_tmp(1:k1)
    write(*,*) 'get_lev1_2, lev1_2_tmp(1)%lev2_2%addr:', associated(lev1_2_tmp(1)%lev2_2%addr)
    write(*,*) 'get_lev1_2, lev1_2(1)%lev2_2%addr    : ', associated(lev1_2(1)%lev2_2%addr)
    
end subroutine

subroutine get_lev2_2(lev2_2)
    implicit none
    type(lev2_2_typ), intent(inout)        :: lev2_2
    
    call ass_sub(lev2_2%addr)
    write(*,*) 'get_lev2_2, lev2_2%addr: ', associated(lev2_2%addr)
    
end subroutine

end module get_mod
    
program top_level 
    use types_mod
    use get_mod
    implicit none
    type(main_typ)                 :: main
    
    call get_main(main)
    write(*,*) 'top_level, main%lev1_1%addr          : ', associated(main%lev1_1%addr)
    write(*,*) 'top_level, main%lev1_2(1)%lev2_2%addr: ', associated(main%lev1_2(1)%lev2_2%addr)
    
end program

 

0 Kudos
1 Solution
Steve_Lionel
Black Belt Retired Employee
111 Views

It seems you already solved the problem by not using a five-year-old compiler. It would appear that you encountered a bug in the 14.0 compiler. 

View solution in original post

2 Replies
Steve_Lionel
Black Belt Retired Employee
112 Views

It seems you already solved the problem by not using a five-year-old compiler. It would appear that you encountered a bug in the 14.0 compiler. 

View solution in original post

Meyer__Knut_Andreas
111 Views

Thank you Steve, that's good news that you think this is the reason!

I was afraid that my code was written in a bad way causing it to be unstable (I've learnt to never blame compiler bugs as it is usually my own bugs...)

//Knut

Reply