Boo-boo again,
This last version of the file is what I meant to send out (it gets rid of needing the module Precision...)
Sorry,
Aleks
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 Vector_Types
IMPLICIT NONE
INTEGER :: n = 10
TYPE (Eucledian_Vector), TARGET :: vector
TYPE (Distributed_Array), TARGET :: partitioned_array
REAL :: 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
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
|