Sorry, the wrong version of the file seemed to have gone out :(
Hello,
I have been struggling with a very misterious bug all morning and cannot
figure it out. The attached program is the smallest example I could
reproduce it on. The problem line seems to be line 79, a deallocation of
a pointer of a type which has down underneath an allocatable component
array (line 13). If I change the allocatable array component to a
pointer, the problem dissapears, and same if I just comment out line 79.
So the problem is something with the rules for deep copy and/or
automatic deallocation of allocatable components. But I am not sure what
exactly the problem is.
The NAG compiler fails to compile unless line 79 is commented out, Lahey
compiles but produces the wrong result at the last line unless line 79
is commented out:
[1577 Common_lf95 @ atom]$ Bug.Types.x
Before: The values of the partitioned array are: 1.00000000 1.00000000
1.00000000 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000
1.00000000 1.00000000
After 1: The values of the partitioned array are: 1.00000000 1.00000000
1.00000000 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000
1.00000000 1.00000000
After 2: The values of the partitioned array are: -NaN 0.00000000E+00
0.00000000E+00 0.00000000E+00 0.00000000E+00 0.00000000E+00
0.00000000E+00 0.00000000E+00 0.00000000E+00 0.00000000E+00
I am not sure if this is just my coding or bugs in implementations of
TR15881?
Thanks,
Aleksandar
--
__________________________________
Aleksandar Donev
Complex Materials Theory Group (http://cherrypit.princeton.edu/)
Princeton Materials Institute & Program in Applied and Computational
Mathematics
@ Princeton University
Address:
419 Bowen Hall, 70 Prospect Avenue
Princeton University
Princeton, NJ 08540-5211
E-mail: [log in to unmask]
WWW: http://atom.princeton.edu/donev
Phone: (609) 258-2775
Fax: (609) 258-6878
__________________________________
MODULE Vector_Types
IMPLICIT NONE
PRIVATE
TYPE, PUBLIC :: Eucledian_Vector
INTEGER :: n_elements = 0
INTEGER :: time_stamp = - 1
END TYPE
TYPE, PUBLIC :: Serial_Array
TYPE (Eucledian_Vector) :: vector
! This must be ALLOCATABLE for the problem to occur:
REAL, DIMENSION (:), ALLOCATABLE :: values
INTEGER :: lb = 0, ub = 0
END TYPE
TYPE, PUBLIC :: Distributed_Array
TYPE (Serial_Array) :: contiguous_array
INTEGER :: communicator = 0
END TYPE
PUBLIC :: Eucledian_Vector_polymorphic_pointer
TYPE :: Eucledian_Vector_polymorphic_pointer
TYPE (Eucledian_Vector), POINTER :: Eucledian_Vector_pointer => NULL ()
TYPE (Serial_Array), POINTER :: Serial_Array_pointer => NULL ()
TYPE (Distributed_Array), POINTER :: Distributed_Array_pointer => NULL ()
END TYPE
PUBLIC :: Serial_Array_polymorphic_pointer
TYPE :: Serial_Array_polymorphic_pointer
TYPE (Serial_Array), POINTER :: Serial_Array_pointer => NULL ()
TYPE (Distributed_Array), POINTER :: Distributed_Array_pointer => NULL ()
END TYPE
PUBLIC :: Distributed_Array_polymorphic_pointer
TYPE :: Distributed_Array_polymorphic_pointer
TYPE (Distributed_Array), POINTER :: Distributed_Array_pointer => NULL ()
END TYPE
END MODULE Vector_Types
PROGRAM Test_OOP
USE Precision
USE Vector_Types
IMPLICIT NONE
INTEGER :: n = 10
TYPE (Eucledian_Vector), TARGET :: vector
TYPE (Distributed_Array), TARGET :: partitioned_array
REAL (KIND=r_wp) :: vector_norm
TYPE :: Distributed_Vector
TYPE (Distributed_Array), POINTER :: partitioned_array => NULL ()
TYPE (Distributed_Array_polymorphic_pointer) :: partitioned_array_target
END TYPE
TYPE (Eucledian_Vector), POINTER :: abstract_vector => NULL ()
TYPE (Eucledian_Vector_polymorphic_pointer) :: abstract_vector_target
TYPE (Distributed_Vector) :: partitioned_vector
vector%n_elements = 2 * n
partitioned_array%contiguous_array%vector%n_elements = n
partitioned_array%contiguous_array%lb = 1
partitioned_array%contiguous_array%ub = n
ALLOCATE (partitioned_array%contiguous_array%values(0:2*n))
partitioned_array%contiguous_array%values (partitioned_array%contiguous_array%lb:partitioned_array%contiguous_array%ub) = &
& 1.0_r_wp
partitioned_array%contiguous_array%vector%time_stamp = 0
WRITE (*,*) "Before: The values of the partitioned array are:", &
& partitioned_array%contiguous_array%values(partitioned_array%contiguous_array%lb:partitioned_array%contiguous_array%ub)
ALLOCATE (abstract_vector_target%Serial_Array_pointer)
abstract_vector_target%Serial_Array_pointer = partitioned_array%contiguous_array
abstract_vector => abstract_vector_target%Serial_Array_pointer%vector
NULLIFY (abstract_vector)
IF (ASSOCIATED(abstract_vector_target%Serial_Array_pointer)) THEN
! This is the problematic line:
DEALLOCATE (abstract_vector_target%Serial_Array_pointer)
END IF
WRITE (*,*) "After 1: The values of the partitioned array are:", &
& partitioned_array%contiguous_array%values(partitioned_array%contiguous_array%lb:partitioned_array%contiguous_array%ub)
ALLOCATE (partitioned_vector%partitioned_array_target%Distributed_Array_pointer)
partitioned_vector%partitioned_array => partitioned_vector%partitioned_array_target%Distributed_Array_pointer
WRITE (*,*) "After 2: The values of the partitioned array are:", &
& partitioned_array%contiguous_array%values(partitioned_array%contiguous_array%lb:partitioned_array%contiguous_array%ub)
END PROGRAM Test_OOP
|