Community
cancel
Showing results for 
Search instead for 
Did you mean: 
Highlighted
New Contributor I

class dummy argument causes problems with non contiguous array

Hello,

i got a problem with object members of arrays beeing passed to a subroutine. In the following example everything works fine a long as the dummy argument arr_arg of foo is defined as type. But as soon as it is defined as class it breaks. Dependent on compiler options (/Od) access violations are detected or (/O2) unpredictable behavior occours. This can cause difficult to find errors later on.

The code-example gives 4 cases: Type/Class and Variant 1/2

Surprisingly variant 2 works for the type definition ( and for the class with /O2), where i thought it should not as the brackets produce a copy of the objects(?)

Greetings

Wolf

program MAIN
  implicit none

  ! Inner Type
  type T_B
    integer, allocatable :: arr_real(:,:)
    integer              :: dummy_1b
  end type

  ! Outer Type
  type T_A
    type(T_B)         :: arr_T_B
    integer           :: dummy_1a
    real, allocatable :: dummy_3a(:)
  end type


  type(T_A)        :: bar(1:2)
  integer, pointer :: ptr_outer(:)


  allocate(bar(1)%arr_T_B%arr_real(10,2))
  allocate(bar(2)%arr_T_B%arr_real(10,2))
  bar(1)%arr_T_B%arr_real(:,1) = [10:19]+1000
  bar(1)%arr_T_B%arr_real(:,2) = [10:19]+2000
  bar(2)%arr_T_B%arr_real(:,1) = [20:29]+1000
  bar(2)%arr_T_B%arr_real(:,2) = [20:29]+2000

  write(*,'("0x",Z8.8)')LOC(bar(1)%arr_T_B)
  write(*,'("0x",Z8.8)')LOC(bar(2)%arr_T_B)
  write(*,*)LOC(bar(2)%arr_T_B) - LOC(bar(1)%arr_T_B) !< Always 92
  write(*,*)

  ! Variant 1
  call foo(bar(1:2)%arr_T_B, ptr_outer)

  ! Variant 2
!  call foo([bar(1)%arr_T_B,bar(2)%arr_T_B], ptr_outer)

    write(*,*)"Extern"
    write(*,'(*(I6))')ptr_outer


    bar(2)%arr_T_B%arr_real(:,2) = [1:10]
    write(*,*)
    write(*,*)"Pointer modified"
    write(*,'(*(I6))')ptr_outer ! Surprisingly Variant 2 with "Type" works

  contains


  subroutine foo(arr_arg, ptr_inner)
!    type(T_B), target, intent(in   ) :: arr_arg(1:2)  !< Works
    class(T_B), target, intent(in   ) :: arr_arg(1:2)  !< Does not work

    integer,   pointer, intent(  out) :: ptr_inner(:)

    ! New(V1&V2) address for type      -> Old(V1) | New(V2) address for class
    write(*,'("0x",Z8.8)')LOC(arr_arg(1))

    ! New(V1&V2) address for type(+92) -> Old(V1) | New(V2) address for class(+52)
    write(*,'("0x",Z8.8)')LOC(arr_arg(2))

    write(*,*)LOC(arr_arg(2)) - LOC(arr_arg(1)) !< Always 52;

    write(*,*)"is_contiguous?", is_contiguous(arr_arg) ! Seems to be correct
    write(*,*)"Intern"

    ptr_inner => arr_arg(2)%arr_real(:,2)
    write(*,'(*(I6))')ptr_inner !< Printed results are wrong

    write(*,'(*(I6))')arr_arg(2)%arr_real(:,2) !< Error is thrown here

  end subroutine

end program

 

0 Kudos