- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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…
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
@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
Link Copied
- « Previous
-
- 1
- 2
- Next »
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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.)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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.

- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page
- « Previous
-
- 1
- 2
- Next »