I am using GET_STORAGE@ to grab 240Mb of memory and then releasing it with RETURN_STORAGE@, but when I try and get the same amount of memory again I find it is not available. I have narrowed it down to a small program as follows and I am using John Campbells 'report_free_memory_chunks' routine. If GET_MEMORY and FREE_MEMORY are commented out, this reports that the largest memory block available is 1502Mb, but after a call to GET_MEMORY, it reports the same figure of 1262Mb whether FREE_MEMORY is called or not. i.e. The number doesn't revert back or show up in any other free blocks. Am I missing something ?

    PROGRAM MEMTST

*------------------------

• Implicit definition * *------------------------

•   IMPLICIT INTEGER (A-Z)
  

•   TOTAL=31488861
    CALL GET_MEMORY(TOTAL,8,IERROR)
    CALL FREE_MEMORY
    call report_free_memory_chunks(0)
    STOP
    END
  

•   SUBROUTINE GET_MEMORY(NCELLS,ISIZE,IERROR)
  

•   +---------------------------------------------------+
  

•   | Subroutine :  GET_MEMORY                          |
  

•   | Description:  Get virtual memory                  |
  

•   +---------------------------------------------------+
  

*------------------------

• Implicit definition * *------------------------

•   IMPLICIT INTEGER (A-Z)
    SAVE         COREADDRESS
  

*----------------------------

• Compute memory required * *----------------------------

•   NREQUIRED=(NCELLS+1)*ISIZE
  

*-----------------------

• Get virtual memory * *-----------------------

•   CALL GET_STORAGE@(COREADDRESS,NREQUIRED)
    write(*,*)'GET:  coreaddress = ',coreaddress
    IF(COREADDRESS.EQ.-1) THEN
      IERROR=1
      RETURN
    END IF
  

*------------

• Success * *------------

•   IERROR=0
    RETURN
  

•   +---------------------------------------------------+
  

•   | Entry      :  FREE_MEMORY                         |
  

•   | Description:  Free virtual memory                 |
  

•   +---------------------------------------------------+
  

•   ENTRY FREE_MEMORY
  

*------------------------

• Free virtual memory * *------------------------

•   write(*,*)'FREE:  coreaddress = ',coreaddress
    CALL RETURN_STORAGE@(COREADDRESS)
    RETURN
    END
  

Kevin,

I would suggest you use implicit none in all routines. You should be using INTEGER(7) :: COREADDRESS

This implies a 4-byte integer address for 32-bit or an 8-byte address for 64-bit. I could not see if you selected /64 or not.

I am not familiar with using these routines, as once you have 'coreaddress' it can be difficult to use it in general Fortran code.

ALLOCATE is much easier to use.

I will look at this and see if I can reproduce your problem. Should I comment on ENTRY ?

Kevin,

I modified your code to not use ENTRY by using a module and use IMPLICIT NONE. I could not find my routine 'report_free_memory_chunks' so used a similar routine. The following code does not show appear to memory leakage, but I may be missing the first allocate. Let me know if this helps ?

PROGRAM MEMTST
!*
!*------------------------
!* Implicit definition *
!*------------------------
!*
IMPLICIT NONE
  integer :: total, ierror, i
!*
  do i = 1,5
   write (*,fmt='(/' test ',i0)') i
   TOTAL = 31488861
   CALL GET_MEMORY ( TOTAL, 8, IERROR )
   CALL FREE_MEMORY
!z   call report_free_memory_chunks (0)
   call report_memory_usage ( ' xxx' , -1)
  end do
   STOP
END

module mem_info
  integer(7) :: COREADDRESS
end modulemem_info

   SUBROUTINE GET_MEMORY ( NCELLS,ISIZE,IERROR)
    use mem_info
!*
!* +---------------------------------------------------+
!* | Subroutine : GET_MEMORY |
!* | Description: Get virtual memory |
!* +---------------------------------------------------+
!*
!*------------------------
!* Implicit definition *
!*------------------------
!*
!z IMPLICIT INTEGER (A-Z)
   integer :: NCELLS,ISIZE,IERROR
   integer :: NREQUIRED
!*
!*----------------------------
!* Compute memory required *
!*----------------------------
!*
     NREQUIRED=(NCELLS+1)*ISIZE
!*
!*-----------------------
!* Get virtual memory *
!*-----------------------
!*
   CALL GET_STORAGE@ (COREADDRESS, NREQUIRED)
   write(*,*)'GET: coreaddress = ',coreaddress
   IF (COREADDRESS == -1) THEN
     IERROR=1
     RETURN
   END IF
!*
!*------------
!* Success *
!*------------
!*
   IERROR=0
   RETURN
   end SUBROUTINE GET_MEMORY
!*
!* +---------------------------------------------------+
!* | Entry : FREE_MEMORY |
!* | Description: Free virtual memory |
!* +---------------------------------------------------+
!*
   SUBROUTINE FREE_MEMORY
    use mem_info
!*
!*------------------------
!* Free virtual memory *
!*------------------------
!*
   write(*,*)'FREE: coreaddress = ',coreaddress
   CALL RETURN_STORAGE@ (COREADDRESS)
   
   RETURN
   END SUBROUTINE FREE_MEMORY

this is a memory usage report routine subroutine report_memory_usage (string, key) ! use ISO_C_BINDING ! use memstat

!      interface
!        function GlobalMemoryStatusEx(mdata) bind(C, name='GlobalMemoryStatusEx')
!          use ISO_C_BINDING
!!          use memstat
!          !GCC$ ATTRIBUTES STDCALL :: GLOBALMEMORYSTATUSEX
!          logical(C_BOOL) GLOBALMEMORYSTATUSEX
!          integer(C_LONG) mdata(16)
!        end function GlobalMemoryStatusEx
!      end interface
!
      character string*(*)
      integer :: key
!
      stdcall GlobalMemoryStatusEx 'GlobalMemoryStatusEx'(REF):logical 
!      logical, external :: GlobalMemoryStatusEx
!
     integer*4 :: mdata(16)
       integer*4 dwLength
       integer*4 dwMemoryLoad
       integer*8 ullTotalPhys
       integer*8 ullAvailPhys
       integer*8 ullTotalPageFile
       integer*8 ullAvailPageFile
       integer*8 ullTotalVirtual
       integer*8 ullAvailVirtual
       integer*8 ullAvailExtendedVirtual
       equivalence ( mdata( 1), dwLength )
       equivalence ( mdata( 2), dwMemoryLoad )
       equivalence ( mdata( 3), ullTotalPhys )
       equivalence ( mdata( 5), ullAvailPhys )
       equivalence ( mdata( 7), ullTotalPageFile )
       equivalence ( mdata( 9), ullAvailPageFile )
       equivalence ( mdata(11), ullTotalVirtual )
       equivalence ( mdata(13), ullAvailVirtual )
       equivalence ( mdata(15), ullAvailExtendedVirtual )

     integer*8 :: lastAvailPhys = -1
      
     dwLength = 64 
    
     if ( GlobalMemoryStatusEx(mdata) ) then 
    
       write (*,11) 'Memory report at ', string, ' Mem_avail= ', ullAvailPhys

       if ( lastAvailPhys == -1 ) lastAvailPhys = ullAvailPhys+1

     if ( key > 0 ) then
       print *,  'Percentage of physical memory in use        ', dwMemoryLoad, ' %'
       print 10, 'Amount of actual physical memory            ', Mb (ullTotalPhys), ' Mb'
       print 10, 'Amount of physical memory available         ', Mb (ullAvailPhys), ' Mb'
       print 10, 'Committed memory limit                      ', Mb (ullTotalPageFile), ' Mb'
       print 10, 'Amount of memory current process can commit ', Mb (ullAvailPageFile), ' Mb'
       print 10, 'Size of virtual address space               ', Mb (ullTotalVirtual), ' Mb'
       print 10, 'Amount of unreserved/uncommitted memory     ', Mb (ullAvailVirtual), ' Mb'
      end if
       print 10, 'Change in physical memory available         ', Mb (ullAvailPhys-lastAvailPhys), ' Mb'
    
      lastAvailPhys = ullAvailPhys
    
     else 
       print*,'Report Memory Failed ', string  
     end if 
    
  10 format(1x,a,f0.3, a) 
!  11 format (/a,a,2x,a,B'---,---,---,--#')
  11 format (/a,a,2x,a,i0)
     
    contains

      real*8 function Gb ( memory )
        integer*8 memory
        Gb = dble(memory) / (1024.**3)
      end function Gb
      real*8 function Mb ( memory )
        integer*8 memory
        Mb = dble(memory) / (1024.**2)
      end function Mb

    end subroutine report_memory_usage

PROGRAM MEMTST
!*
!*------------------------
!* Implicit definition *
!*------------------------
!*
IMPLICIT NONE
  integer :: total, i ! , ierror
  integer(7) :: blocks(10)
  integer(7), external :: get_memory
!*
  do i = 1,5
    write (*,fmt='(/' get block ',i0)') i
    TOTAL = 31488861
    blocks(i) = GET_MEMORY ( TOTAL, 8 )
    call report_memory_usage ( ' build  ' , -1)
  end do

  do i = 5,1,-1
    write (*,fmt='(/' release ',i0)') i
    CALL FREE_MEMORY ( blocks(i) )
    call report_memory_usage ( ' release' , -1)
  end do

   STOP
END

module mem_info
  integer(7) :: COREADDRESS
end modulemem_info

   INTEGER(7) FUNCTION GET_MEMORY ( NCELLS, ISIZE )
    use mem_info
!*
!* +---------------------------------------------------+
!* | Subroutine : GET_MEMORY |
!* | Description: Get virtual memory |
!* +---------------------------------------------------+
!*
!*------------------------
!* Implicit definition *
!*------------------------
!*
!z IMPLICIT INTEGER (A-Z)
   integer :: NCELLS,ISIZE   ! ,IERROR
   integer :: NREQUIRED
!*
!*----------------------------
!* Compute memory required *
!*----------------------------
!*
     NREQUIRED = (NCELLS+1)*ISIZE
!*
!*-----------------------
!* Get virtual memory *
!*-----------------------
!*
   CALL GET_STORAGE@ (COREADDRESS, NREQUIRED)
   write(*,*)'GET: coreaddress = ',coreaddress
   IF (COREADDRESS == -1) THEN
     GET_MEMORY = -1
     RETURN
   END IF
!*
!*------------
!* Success *
!*------------
!*
   GET_MEMORY = COREADDRESS
   RETURN
   end Function GET_MEMORY
!*
!* +---------------------------------------------------+
!* | Entry : FREE_MEMORY |
!* | Description: Free virtual memory |
!* +---------------------------------------------------+
!*
   SUBROUTINE FREE_MEMORY ( block_address )
    use mem_info
    integer(7) :: block_address
!*
!*------------------------
!* Free virtual memory *
!*------------------------
!*
   write(*,*)'FREE: coreaddress = ',block_address
   CALL RETURN_STORAGE@ ( block_address )
   
   RETURN
   END SUBROUTINE FREE_MEMORY

Kevin,

This is another test. It does not show the memory available changing ? Could it be like ALLOCATE, where memory addresses are provided but the memory is not being given physical memory until it is 'used'. The test program does not actually use the memory provided. ( I am not familiar with using this memory address to write a quick test ! )

You could change to ' call report_memory_usage ( ' build ' , 1) ' to report other values or actually use the memory address returned.

We need to clarify Physical and Virtual memory used/available. Virtual memory available should change with 32-bit, but 64-bit can be a very large number. Something to review ?

Kevin

I have tested your code which appears to be for Win32 (32 bits). I removed the call to the missing routine and repeated the call to GET_STORAGE@.

For me there is no problem. GET_STORAGE@ works a second time. This suggests that there is more memory available on my machine. I have a good amount of RAM but I don't know if this makes a difference.

Anyway, in this context, a block of memory that is released may not be available for re-allocation.

I have had a brief look at the 32 bit implementation of GET_STORAGE@ and it takes chunks of memory from a main block that is allocated via VirtualAlloc (i.e. virtual memory). As I recall, the 64 bit implementation of GET_STORAGE@ is different.

Like John Campbell, I suggest that you avoid using GET_STORAGE@ which is very old and was designed at a time when machines had very limited memory.

In contrast the FTN95 ALLOCATE statement calls on HeapAlloc (for both 32 and 64 bits) where the operating system directly manages the global heap.

I did some more changes to the test

PROGRAM MEMTST

 IMPLICIT NONE
  integer :: total, i, pass, n
  integer(7) :: blocks(10)
  integer(7), external :: get_memory

  call report_memory_usage ( ' start  ' , -1)
  do pass = 1,3
    n = 3+pass
    do i = 1,n
      write (*,fmt='(/' get block ',i0)') i
      TOTAL = 31488861
      blocks(i) = GET_MEMORY ( TOTAL, 8 )
      call report_memory_usage ( ' build  ' , -1)
    end do

    do i = n,1,-1
      write (*,fmt='(/' release ',i0)') i
      if ( blocks(i) == -1 ) cycle
      CALL FREE_MEMORY ( blocks(i) )
      call report_memory_usage ( ' release' , -1)
    end do
  end do

   STOP
END PROGRAM MEMTST

I also changed bits of subroutine report_memory_usage to report changes to 'Amount of unreserved/uncommitted memory ', which is relevant to 32-bit integer8 :: lastAvailPhys = -1 integer8 :: lastAvailVirtual = -1

     dwLength = 64 
    
     if ( GlobalMemoryStatusEx(mdata) ) then 
    
       write (*,11) 'Memory report at ', string, ' Mem_avail= ', ullAvailPhys

       if ( lastAvailPhys == -1 ) lastAvailPhys = ullAvailPhys+1

     if ( key > 0 ) then
       print *,  'Percentage of physical memory in use        ', dwMemoryLoad, ' %'
       print 10, 'Amount of actual physical memory            ', Mb (ullTotalPhys), ' Mb '
       print 10, 'Amount of physical memory available         ', Mb (ullAvailPhys), ' Mb '
       print 10, 'Committed memory limit                      ', Mb (ullTotalPageFile), ' Mb '
       print 10, 'Amount of memory current process can commit ', Mb (ullAvailPageFile), ' Mb '
       print 10, 'Size of virtual address space               ', Mb (ullTotalVirtual), ' Mb '
      end if
       print 10, 'Amount of unreserved/uncommitted memory     ', Mb (ullAvailVirtual), ' Mb ',  &
                                                                 Mb (ullAvailVirtual-lastAvailVirtual),
       print 10, 'Change in physical memory available         ', Mb (ullAvailPhys-lastAvailPhys), ' Mb '
    
      lastAvailPhys    = ullAvailPhys
      lastAvailVirtual = ullAvailVirtual
    
     else 
       print*,'Report Memory Failed ', string  
     end if 
    
  10 format(1x,a,f0.3, a,f0.3) 

These changes identify that RETURN_STORAGE@ returns the allocated memory to the allocatable pool, but does not change the uncommitted memory for the program. Pass runs 3 times with, committing 4,5 then 6 blocks. pass 2 and 3 only demands 1 extra block, with the earlier blocks being allocated. Although RETURN_STORAGE@ does not release the memory, it is still appears to be available for re-use by GET_STORAGE@. Changing the value of TOTAL may show if it updates the available pool for each pass.

There was a bug in the 64-bit RETURN_GSTORAGE@ not returning memory that is fixed in 8.90.

I am not sure you can use GlobalMemoryStatusEx to see the changes. RETURN_STORAGE@ doesn't necessarily return the memory to the system.

I have tried to investigate the difference between ALLOCATE and GET_STORAGE@.

I have extended the program above, to:

test ALLOCATE to compare memory usage reporting.

use DCORE8 to access the memory from GET_STORAGE@ to see if using the memory changes the report.

This test code is valid for 32-bit only (use of LOC) but could be modified for 64-bit ?

I have found that :

ALLOCATE reports memory usage differently.

By using GET_STORAGE@ memory via DCORE8, the use does appear to change the memory usage

DEALLOCATE does appear to return the memory

By using GET_STORAGE@, I allocated 6 x 240 MB of memory, which appears to be more than 150 MBytes documented as available.

I would suggest ALLOCATE is a better option for most usages.

I note FTN95 now provides easier access to GLOBALMEMORYSTATUS@. See FTN95 help.

I am attaching a link to the latest code and the log of the run. I built it with ftn95 test_memory /lgo > test_memory.log

my ftn95.cfg is: /ERROR_NUMBERS /ECHO_OPTIONS /IMPLICIT_NONE /INTL /LOGL

https://www.dropbox.com/s/coyyfhv4wy0ic2a/test_memory.log?dl=0 https://www.dropbox.com/s/20vemp07o8iz9d8/test_memory.f90?dl=0

Thanks for all of your replies. Apologies for the code - it is taken from an F77 program that hasn't been changed for many many years. It is only 32-bit and was obviously written before ALLOCATE was available. I had noticed that the memory shown in the task manager didn't actually reduce until the memory was actually used as implied above. I will implement some of the above suggestions and see if they help, but changing over to using ALLOCATE could be a big task!

Just to confirm that in this small example program, I have no problem with repeated calls to GET_STORAGE@. But in my large program, my 2nd call fails and I assumed that the memory was not getting returned by RETURN_STORAGE@ due to the numbers being shown. I do make lots of calls to GET_STORAGE@ (each with an associated RETURN_STORAGE@), but unfortunately asking for lots of small chunks before asking for a big chunk, so I guess that even though it is getting returned, the contiguous strip is getting smaller and is eventually too small for my requirements. My other problem with moving to F95 is that my arrays are equivalenced which is not allowed with ALLOCATE.

Quoted from Kevin but changing over to using ALLOCATE could be a big task!

It can be, but typically the use of GET_STORAGE@ should be very local, as the use of DCORE8 etc is very combersome, except for being used in a subroutine call (F77 wrapper), where it becomes a named array.

The other problem, is that, as your example demonstrates, GET_STORAGE@ is being used to allocate a block of memory, which may later be split up for multiple arrays. You need to check for this, as using ALLOCATE for each array would be clearer code.

I would try to map it out the GET arrays first.

ALLOCATE does not have all the functionality that F77 memory tricks used (eg simple resize), but it does have most and produces code that is more robust and easier to used in SDBG. Mixed type arrays are also often an issue.

Future enhancements could include 64-bit and using IMPLICIT NONE !

Quoted from Kevin My other problem with moving to F95 is that my arrays are equivalenced which is not allowed with ALLOCATE.

There are always F77 wrappers to cut up the blocks, although that is making the code more difficult to maintain.

Check why the equivalencing is being used as it could be better to use multiple ALLOCATE's if array proximity is not needed. (I am wondering how Get_Storage@ blocks can be equivalenced ? as this is limited to declared arrays.

Placing arrays in modules can also assist.