Thanks @FortranFan. I made the destructor impure elemental. For the code
module m
!
type :: vec
real, pointer :: x(:) => null()
contains
final :: destructor
end type vec
!
contains
!
impure elemental subroutine destructor(v)
type(vec), intent(in out) :: v
logical :: assoc_init
assoc_init = associated(v%x)
if (assoc_init) deallocate (v%x)
write (*,*) "leaving destructor, assoc_init, assoc_final =",assoc_init,associated(v%x)
end subroutine destructor
!
subroutine sub_alloc()
type(vec) :: v
allocate (v%x(2))
v%x = [10.0,20.0]
print*,"in sub_alloc, v%x =",v%x
end subroutine sub_alloc
!
subroutine sub_automatic()
type(vec) :: v
allocate (v%x(2))
v%x = [10.0,20.0]
print*,"in sub_automatic, v%x =",v%x
end subroutine sub_automatic
!
end module m
!
program main
use m, only: vec, sub_alloc, sub_automatic
implicit none
b1: block
type(vec) :: v
allocate (v%x(2))
print*,"exiting b1 for scalar v"
end block b1
b2: block
type(vec), allocatable :: v(:)
allocate (v(2))
print*,"exiting b2, size(v) =",size(v)
end block b2
b3: block
type(vec), allocatable :: v(:)
allocate (v(2))
deallocate (v)
print*,"exiting b3, allocated(v) =",allocated(v)
end block b3
b4: block
type(vec), pointer :: v(:) => null()
allocate (v(2))
print*,"exiting b4, size(v)=",size(v)
end block b4
print*,"calling sub_alloc()"
call sub_alloc()
print*,"calling sub_automatic()"
call sub_automatic()
end program main
I get output with gfortran and Intel Fortran of
exiting b1 for scalar v
leaving destructor, assoc_init, assoc_final = T F
exiting b2, size(v) = 2
leaving destructor, assoc_init, assoc_final = F F
leaving destructor, assoc_init, assoc_final = F F
leaving destructor, assoc_init, assoc_final = F F
leaving destructor, assoc_init, assoc_final = F F
exiting b3, allocated(v) = F
exiting b4, size(v)= 2
calling sub_alloc()
in sub_alloc, v%x = 10.0000000 20.0000000
leaving destructor, assoc_init, assoc_final = T F
calling sub_automatic()
in sub_automatic, v%x = 10.0000000 20.0000000
leaving destructor, assoc_init, assoc_final = T F
When exiting b2, I wonder why the destructor is called 4 times rather than twice, when size(v) = 2.