Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.

Allocatable character problem

Göttinger__Michael
5,510 Views

Hi,

We have found a serious problem with allocateable character in Intel® Parallel Studio XE 2018 Update 3 Composer Edition for Fortran Windows.

 

It seems that a move from types in an array causes gigantic memory leaks. It does not work either if a custom finalize stuff is added to the type and frees all memory from allocated characters.

 

When you run the small code, you will see that in the second loop where the data is moved the memory problem occurs. You will see that the small stuff needs about 500MB on the heap!!

 

          TEST1: block 
            type :: TestData
              character(len=20)               :: UID = ' '      ! Name of global variable
              character(:) , allocatable      :: strVal         ! Value of variable dynamic string
             !character(len=80)               :: strVal         ! Value of variable constant string
              integer(2)                      :: Container = 0
            end type TestData

            type(TestData), pointer :: pData(:)
            type(TestData)          :: item
            integer                 :: i, n, nItems, nAdd
            character(len=20)       :: strNum

            nItems = 10000
            nAdd = 2000

            allocate( pData(nItems+nAdd) )

            do n=1,nItems
              write(strNum,FMT='(I8)') n
              item % UID = '#V'//adjustl(strNum)
              item % strVal = 'xyz'
              pData(n) = item
            end do

            continue

            do n=1,nAdd-1
              write(strNum,FMT='(I8)') n
              item % UID = '#A'//adjustl(strNum)
              item % strVal = 'Hallo'
              pData(n+1:nItems+n+1) = pData(n:nItems+n)
            end do

          end block TEST1

Just for information, the same code compiled with Intel® Parallel Studio XE 2016 works fine.

 

BTW: problem is was already submitted to intel support too, but maybe someone here has the same problem and a possible solution for it…

0 Kudos
1 Solution
FortranFan
Honored Contributor III
5,477 Views

@Gottlinger, Michael:

I concur with yours and others' assessments in this thread (e.g., with Quote #14) there has been a regression with Intel Fortran compiler 18.0 version compared to, say, version corresponding to Intel Parallel Studio 2016.  Hopefully you will feedback comments from this thread at your support incident at the Intel OSC and Intel support team will then work with Intel developers to address your problem,

In the meantime, I will suggest a workaround for you which is to go with defined assignment for your data structure(s) (derived type); as one's 'classes' get bigger and more and more complicated in terms of the data they encapsulate, such defined assignment may be an option to consider in your actual code(s), especially as they can provide control in terms of shallow copy vs deep copy, etc.

! -----------------------------------------------------------------------------
!
!  PROGRAM: TestFTN
!
!  PURPOSE:  Show a serious heap error problem in Intel Fortran Composer 2018.
!            Note, this stuff works fine in older versions.
!
!  AUTHOR:   Michael Göttlinger
!

! -----------------------------------------------------------------------------
module WinStuff
   use ISO_C_BINDING
   implicit none

contains

   !DEC$ IF DEFINED(_WIN32)
   ! Get heap memory of process
   function ChkMemory()
      use IFWINTY
      use KERNEL32
      use PSAPI
      implicit none

      integer         :: ChkMemory
      integer(DWORD)  :: processID
      integer(HANDLE) :: hProc
      integer(DWORD)  :: dwRet
      type(T_PROCESS_MEMORY_COUNTERS) :: pmc

      ChkMemory = 0

      processID = GetCurrentProcessId()
      hProc = OpenProcess (ior(PROCESS_QUERY_INFORMATION, PROCESS_VM_READ), FALSE, processID)
      if( hProc /= null ) then
         dwRet = GetProcessMemoryInfo( hProc, pmc, sizeof(pmc) )
         if( dwRet /= 0 ) then
            !write (*, '(2X,A,1X,I0)') &
               !  "PageFaultCount:", pmc%PageFaultCount, &
               !  "PeakWorkingSetSize:", pmc%PeakWorkingSetSize, &
               !  "WorkingSetSize:", pmc%WorkingSetSize, &
               !  "QuotaPeakPagedPoolUsage:", pmc%QuotaPeakPagedPoolUsage, &
               !  "QuotaPeakNonPagedPoolUsage:", pmc%QuotaPeakNonPagedPoolUsage, &
               !  "QuotaNonPagedPoolUsage:", pmc%QuotaNonPagedPoolUsage, &
               !  "PagefileUsage:", pmc%PagefileUsage, &
               !  "PeakPagefileUsage:", pmc%PeakPagefileUsage
            ChkMemory = pmc%WorkingSetSize / 1024
         end if
         dwRet = CloseHandle( hProc )
      end if
   end function ChkMemory
   !DEC$ ELSE
   ! Get heap memory of process
   function ChkMemory()
      implicit none
      integer :: ChkMemory
      ChkMemory = 0
   end function ChkMemory
   !DEC$ ENDIF
end module WinStuff

module m

   ! Small type with automatically allocatable character
   type :: TestData
      character(len=20)               :: UID = ' '      ! Name of global variable
      character(:) , allocatable      :: strVal         ! Value of variable dynamic string
      !character(len=80)               :: strVal         ! Value of variable constant string
      integer(2)                      :: Container = 0
   contains
      private
      procedure, pass(this) :: assign_t
      generic, public :: assignment(=) => assign_t
   end type TestData

contains

   elemental subroutine assign_t( this, rhs )

      ! Argument list
      class(TestData), intent(inout) :: this
      type(TestData), intent(in)     :: rhs

      this%UID = rhs%UID
      if ( allocated(rhs%strVal) ) this%strVal = rhs%strVal
      this%Container = rhs%Container

   end subroutine assign_t

end module

! -----------------------------------------------------------------------------
program TestFTN

   use, intrinsic :: iso_fortran_env, only : compiler_version
   use m, only : TestData
   use WinStuff, only : ChkMemory
   
   implicit none

   ! Variables
   !type(TestData), allocatable :: pData(:)
   type(TestData), pointer     :: pData(:) => null()
   type(TestData)              :: item
   integer                     :: i, n, nItems, nAdd
   character(len=20)           :: strNum

   print *, "Compiler Version: ", compiler_version()
   
   nItems = 10000
   nAdd = 2000

   99 format(A,', heap ',I0,' KB')

   ! Before alloc
   write(*, 99) 'Before alloc', ChkMemory()

   allocate( pData(nItems+nAdd) )

   ! After alloc
   write(*, 99) 'After alloc', ChkMemory()

   ! Assign data to the vector
   do n=1,nItems
      write(strNum,fmt='(I0)') n
      item % UID = '#V'//trim(strNum)
      item % strVal = 'xyz'//trim(strNum)
      pData(n) = item
   end do

   ! After assignment
   write(*, 99) 'Data assignment done', ChkMemory()

   ! Move of data in the vector, should simulate data shift in when sorted
   do n=1,nAdd-1
      write(strNum,fmt='(I0)') n
      item % UID = '#A'//trim(strNum)
      item % strVal = 'abc'//trim(strNum)
      ! Here the heap memory leak occurs, nothing helps to fix it: loop, dealloc, ...
      pData(n+1:nItems+n+1) = pData(n:nItems+n)
      !do i=n+nItems, n, -1
      !  if( allocated(pData(i+1) % strVal) ) deallocate( pData(i+1) % strVal )
      !  pData(i+1) = pData(i)
      !end do
      !if( allocated(pData(n) % strVal) ) deallocate( pData(n) % strVal )
      pData(n) = item
   end do

   ! After move
   write(*, 99) 'Data move done', ChkMemory()

   deallocate( pData )

   write(*, 99) 'Deallocate done', ChkMemory()

end program TestFTN

Upon execution,

 Compiler Version:
 Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on IA-32,

  Version 18.0.3.210 Build 20180410
Before alloc, heap 3156 KB
After alloc, heap 3732 KB
Data assignment done, heap 4164 KB
Data move done, heap 4264 KB
Deallocate done, heap 3440 KB

 

Separately, take a look at this thread and note Fortran language standard has limitations when it comes to move semantics and therefore, if you need to 'move' large amounts of data within or across arrays such as with your statements

    pData(n+1:nItems+n+1) = pData(n:nItems+n) 

you need to consider the consequences in terms of memory requirements and ponder over  (code design) options to overcome issues:

https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/701985

View solution in original post

0 Kudos
25 Replies
jimdempseyatthecove
Honored Contributor III
737 Views

FF

>>Please see Quote #18, answered nicely there.

Huh? #18 was my post, which follows 10.43, and which on the surface seems contradictory to line 5 of #19

Steve,

RE: #20

When reallocate lhs was introduced, legacy assignment behavior was completely upended. Do you know why simple assignment of a deallocated array on rhs to an allocated array on lhs did not deallocate the lhs? (as it does for component assignment). It seems like reallocate lhs was half implemented.

Jim Dempsey

0 Kudos
Steve_Lionel
Honored Contributor III
737 Views

Jim, I don't know what you're referring to.

In Fortran 90 and 95, the standard required that an allocatable LHS must already be allocated to the proper shape before assignment. Fortran 2003 introduced the reallocation rules, which added unnecessary overhead for programs written to F90/F95, so the default was to not do the reallocate and you could enable the F03 behavior with realloc_lhs. 

As the years went by, more and more users, whose programs assumed F03 semantics, would get errors with ifort and they'd complain. Other compilers changed to do the new behavior by default. Eventually, ifort changed as well (but you could turn it off if you wanted.) 

As to why assignment of a deallocated array doesn't just deallocate the LHS - well, the standard doesn't say that's what should happen, and it never has. You're correct that in assignment of derived types with allocatable components operate differently. For reference, here's what the F2018 draft says for array assignments:

If the variable is an unallocated allocatable array, expr shall have the same rank. If the variable is an allocated
allocatable variable, it is deallocated if expr is an array of different shape, any corresponding length type parameter
values of the variable and expr differ, or the variable is polymorphic and the dynamic type or any corresponding
kind type parameter values of the variable and expr differ. If the variable is or becomes an unallocated allocatable
variable, it is then allocated with
• the same dynamic type and kind type parameter values as expr if the variable is polymorphic,
• each deferred type parameter equal to the corresponding type parameter of expr,
• the same bounds as before if the variable is an array and expr is scalar, and
• the shape of expr with each lower bound equal to the corresponding element of LBOUND (expr) if expr is
an array.

And here's what it says about assignment of a derived type:

An intrinsic assignment where the variable is of derived type is performed as if each component of the variable
were assigned from the corresponding component of expr using pointer assignment (10.2.2) for each pointer
component, defined assignment for each nonpointer nonallocatable component of a type that has a type-bound
defined assignment consistent with the component, intrinsic assignment for each other nonpointer nonallocatable
component, and intrinsic assignment for each allocated coarray component. For unallocated coarray components,
the corresponding component of the variable shall be unallocated. For a noncoarray allocatable component the
following sequence of operations is applied.
(1) If the component of the variable is allocated, it is deallocated.
(2) If the component of the value of expr is allocated, the corresponding component of the variable is
allocated with the same dynamic type and type parameters as the component of the value of expr.
If it is an array, it is allocated with the same bounds. The value of the component of the value of
expr is then assigned to the corresponding component of the variable using defined assignment if the
declared type of the component has a type-bound defined assignment consistent with the component,
and intrinsic assignment for the dynamic type of that component otherwise.

Note that in the derived type case, the component being assigned to is automatically deallocated, whether or not it has the same shape. Might it have made sense to make these symmetrical? Perhaps - I wasn't on the committee at the time. But "legacy assignment was completely upended"? I don't see that. A F90 program that followed the F90 rules would behave exactly the same in the new rules. (Note that allocatable components didn't exist until F2003.)

Intel Fortran is now, by default, doing exactly what the standard requires (absent bugs.)

0 Kudos
CTOptimizer
Beginner
737 Views

Thanks Steve,

Agreed that "symmetry" is a better adjective than "defect" in this instance (duly edited).  The disparate evolution of the two concepts has led to the current state.  It would be nice to "make these symmetrical" in future versions (of the standard) assuming the issue is as obvious as it seems here  (which I'm betting it isn't) - and I'm also betting I'd quickly let this one go in favor of supporting the many new ideas already solicited for 202X.

So, in our defined assignments we'll need the few extra keystrokes that FF has shown in order to match the deep-copy behavior (for allocatable components) that occurs for intrinsic assignment of derived types.

0 Kudos
jimdempseyatthecove
Honored Contributor III
737 Views

Steve,

In the first quote in #23: If the variable is or becomes an unallocated allocatable variable...

the "variable" is the lhs, what is the purpose of (interpretation of) the text "or becomes" if the rhs is not permitted to be a non-expression unallocated array?

It would seem that "or becomes" is not possible.

Jim Dempsey

0 Kudos
Steve_Lionel
Honored Contributor III
737 Views

Jim, the second sentence (prior to the one you quote) gives the condition under which the variable "becomes" unallocated": 

I would not be in favor of changing the behavior here.

0 Kudos
Reply