PROGRAM TESTE 
!USE ISO_FORTRAN_ENV
  IMPLICIT NONE
  CALL TIPOS(3)  ! Argument of TIPOS indicates the size to be (re)allocated
  CALL TIPOS(5)
! CALL TIPOS(8)
 CONTAINS
  SUBROUTINE TIPOS(n1)
   INTEGER :: n1,n2
   TYPE D1
     REAL, ALLOCATABLE :: A(:)  !Allocatables trigger the bug
!    REAL, POINTER :: A(:) => NULL() !Pointers does not trigger the bug
   END TYPE D1
   TYPE D2
     TYPE(D1), ALLOCATABLE :: B(:)
   END TYPE D2
   TYPE(D2), ALLOCATABLE, SAVE :: C(:)
   INTEGER :: i, j, k, kB
   n2=SIZE(C)
   IF(.NOT. ALLOCATED(C)) THEN
     ALLOCATE(C(n1))
     DO j=1,n1
       ALLOCATE(C(j)%B(n1-j+1))
       DO k=1,n1-j+1
    !    ALLOCATE(C(j)%B(k)%A(5)) !Using pointers => no bug
         C(j)%B(k)%A=[(REAL(i),i=1,5)] !Using allocatable => BUG
       ENDDO
     ENDDO
   ELSE
     C=[C,(D2(),i=1,n1-n2)]
     DO i=1,n2
       kB = SIZE(C(i)%B)
       WRITE(*,*) kB, "before, size of C(#)%B"
       DO j=1,kB
         WRITE(*,*) j,"Sum of A before reallocation of C(#)%B",SUM(C(i)%B(j)%A) !Verifying the sum of A before reallocation of C(#)%B
       ENDDO
       C(i)%B=[C(i)%B,(D1(),j=1,n1-n2)]
       DO j=1,kB
         WRITE(*,*) j,"Sum of A after reallocation of C(#)%B",SUM(C(i)%B(j)%A) !A changes as a result of the reallocation of C(#)%B!!!
       ENDDO
       DO j=kB+1,n1-i+1
  !      ALLOCATE(C(i)%B(j)%A(5))  ! Uncomment this to test with the POINTERS => no BUG!
         C(i)%B(j)%A=[(REAL(k)/i,k=1,5)]
       ENDDO
       WRITE(*,*) SIZE(C(i)%B), "after"
     ENDDO
     DO i=n2+1,n1
       ALLOCATE(C(i)%B(n1-i+1))
       WRITE(*,*) SIZE(C(i)%B), "after", i
       DO j=1,n1-i+1
 !       ALLOCATE(C(i)%B(j)%A(5)) !Using pointers => no bug
         C(i)%B(j)%A=[(REAL(k)/i,k=1,5)] !Using allocatable => BUG
       ENDDO
     ENDDO
   ENDIF
   WRITE(*,*) SIZE(C)
   DO i=1,SIZE(C)
     WRITE(*,*) "i=",i,SIZE(C(i)%B)
     DO j=1,SIZE(C(i)%B)
       WRITE(*,*) "j=",j
       WRITE(*,*) C(i)%B(j)%A
     ENDDO
   ENDDO
  END SUBROUTINE TIPOS
END PROGRAM TESTE 
