    !****************************************************************************
    !
    !  PROGRAM: DynamicArrayMemoryLeak
    !
    !  PURPOSE:  Entry point for the console application.
    !
    !****************************************************************************
 
    program DynamicArrayMemoryLeak
 
    implicit none
 
    ! Define A_Type
    TYPE A_Type
        INTEGER               :: N   = 250
        INTEGER,ALLOCATABLE   :: C(:)
    END TYPE A_Type
 
    TYPE (A_Type),ALLOCATABLE :: B(:)
 
    integer, parameter :: million = 1000000
    INTEGER :: M,K,n, num_tests
    INTEGER :: Error=0
    real    :: mb
 
    do num_tests = 1,20
    write (*,1) num_tests
1   format (///' TESTING PASS ',i0/1x)
!
    Call Memory_Total_Test (0)    !   The available memory is about 2 GB.
!
! Apply for B
    M = 2*million
    ALLOCATE (B(M),STAT=Error)
    Write (*,*) 'allocate error for B(M)', m, Error
!
    n = 0
    DO K=1,M
       ALLOCATE ( B(K)%C(B(K)%N), STAT=Error)
       if (error==0) then
          n = n+1
       else
          Write (*,*) 'allocate error for B(K)%C(B(K)%N)', k, B(K)%N, Error
       end if
    END DO
    mb = m*B(1)%N*4. /(1024.*1024.)
    write (*,*) n,' allocated ', mb,' mb'
 
    Call Memory_Total_Test (1)
 
! Free B
    n = 0
    DO K=1,M
!    DO K=M,1,-1                                 ! this returns more memory
        IF ( ALLOCATED (B)) THEN
           IF(ALLOCATED(B(K)%C )) DEALLOCATE(B(K)%C)
           n = n+1
        END IF
    END DO
    IF (ALLOCATED(B)) DEALLOCATE (B)
    write (*,*) n,' deallocated'
 
! All have been deallocated~
 
    Call Memory_Total_Test (2)
    end do
 
    ! But the available memory  decreases to 660 MB.
 
    end program DynamicArrayMemoryLeak
 
 
    !****************************************************************************
    !
    !  PROGRAM: Memory_Test
    !
    !  PURPOSE: Get the memory amount that could be used !
    !
    !****************************************************************************
 
    SUBROUTINE Memory_Total_Test (N_Position)
!
    INTEGER, INTENT(IN) :: N_Position
!
    REAL, ALLOCATABLE :: Temp(:)
!
    integer           :: byte_size, mb, pass, fail, nt, dn, n, error
!
    byte_size = size ( transfer (1.0, (/ 'A' /)) ) 
    mb        = 2**20 / byte_size        ! 1mb
    pass      = 0
    fail      = 2*1024*mb                ! 2gb  for 32-bit compiler
    nt        = 0                        ! number of tests
    DO
       dn = (fail - pass) / 2
        if (dn < 2) exit
       n = pass + dn
 
       ALLOCATE ( Temp(N), STAT=Error)
       nt = nt+1
       IF (Error /= 0) THEN
          fail = n
       ELSE
          DEALLOCATE (Temp)
          pass = n
       END IF
    END DO
!
    WRITE (*,1) N_Position, pass / mb, nt
1   format (' Position = ', i0, ' : Memory that could be used ',i0,' mb  (',i0,')' )
!
    END SUBROUTINE Memory_Total_Test
 
