Deallocation now required?

[van_der_merwe__ben]

We have a lot of Fortran code, which compiled and run fine under Intel Fortran 12.1 (Windows). However, under version 16.0,  we find some runtime errors around arrays having been already allocated.

Intel's help and the Fortran standard say that these deallocate statements should not be necessary:

If a RETURN or END statement terminates a procedure, an allocatable array has one of the following allocation statuses:

• It keeps its previous allocation and association status if the following is true:
  • It has the SAVE attribute.
  • It is in the scoping unit of a module that is accessed by another scoping unit which is currently executing.
  • It is accessible by host association.
  • It remains allocated if it is accessed by use association.

Otherwise, its allocation status is deallocated.

As best I can tell none of the above allocation statuses are true, meaning the code should fall back to the Otherwise clause.  In other words this code should not be failing.

Has there been any sort of change made? Is there any reason in the code below why the arrays allocated need to be deallocated?

(We have a large number of commercial paid Fortran licenses, so I could also log this with support if need be?)

----

!DEC$ ATTRIBUTES STDCALL :: c_checkcanstillrunwithdata
      INTERFACE
	 subroutine  c_checkcanstillrunwithdata
     + (
     + nItems_,daArray_,iSect_,nParams_,nSect_,iSSect_,
     + iaDim_,iaUnit_,iStatus_
     + )    
	 INTEGER nItems_,iSect_,nParams_,nSect_,iStatus_
	 integer iaDim_(nItems_),iaUnit_(nItems_),iSSect_
	 double precision daArray_(nItems_)
!DEC$  ATTRIBUTES VALUE :: nItems_
!DEC$  ATTRIBUTES REFERENCE :: daArray_
!DEC$  ATTRIBUTES VALUE :: iSect_
!DEC$  ATTRIBUTES VALUE :: nParams_
!DEC$  ATTRIBUTES VALUE :: nSect_
!DEC$  ATTRIBUTES VALUE :: iSSect_
!DEC$  ATTRIBUTES REFERENCE :: iaDim_
!DEC$  ATTRIBUTES REFERENCE :: iaUnit_
!DEC$  ATTRIBUTES REFERENCE :: iStatus_
       
       END subroutine  c_checkcanstillrunwithdata
      END INTERFACE 
!DEC$ ATTRIBUTES STDCALL :: c_checkcanstillrun
      INTERFACE
	 subroutine  c_checkcanstillrun
     + (
     + iStatus__
     + )    
	 INTEGER iStatus__
!DEC$  ATTRIBUTES REFERENCE :: iStatus__
       
       END subroutine  c_checkcanstillrun
      END INTERFACE 

      integer iSect,krs_FindSection,nParam,krs_GetNumParam_U,nSect,
     +        i,ipt,nRet,ip,iplist,iaa,pdimc,attrib,ndi,nExpected,
     +        nosubs
      logical madeCall,bSet
      integer, allocatable :: iaDim(:),iaUnit(:)
      
      include 'switch_keys.inc'
      include 'indexs.com'
      include 'sys_mindexsizes.inc'
      include 'dimension_keys.inc'
!
! -----------------------------------------------------------------------------
! find StatusMonitor section in current model
      iSect = krs_FindSection('STATUSMONITORS')
      
      madeCall = .false.
	if(iSect.gt.0) then
         nParam = krs_GetNumParam_U(iSect)
         nSect  = nosubs(iSect,1)
         if(iSSect.eq.0) then
            nExpected = nParam*nSect
         else
            nExpected = nParam
         endif
         if(nExpected.eq.nItems) then
         
            !set up return structure to hold data items, copying approach in krs_GetResults
            !we do not need to post the values though, just pass through
            allocate(iaDim(nParam))
            allocate(iaUnit(nParam))
            
            !fill in structure, looking up dimension codes as we go
            !code assumes each parameter has one argument only
            i   = mindex(psclst+2*iSect) + moffst
            ipt = mindex(i+3)
            
            nRet = 0
            do ip = 1, nParam
               iplist = ipt + moffst                !parameter entry
               ipt    = mindex(iplist)              !next in list
               iaa    = mindex(iplist+4) + moffst   !argument entry

               pdimc = DKNULL
               if(mindex(iaa+2).gt.0) then
                  attrib = mindex(iaa+2) + moffst
                  if(mindex(iaa+1).eq.fixldf.or.mindex(iaa+1).eq.3) then
                     !get dimension
                     call krs_gattrc (attrib,SWDIM,ndi,pdimc,bSet)
                  endif
               endif
               
               iaDim(ip) = pdimc
               iaUnit(ip) = 1
            end do                  

         	call c_checkcanstillrunwithdata (nItems,daArray,
     +                                       iSect,nParam,nSect,iSSect,
     +                                       iaDim,iaUnit,iStatus)
            madeCall = .true.
         endif
      endif
      
      if (.not.madeCall) then
         !error in setup: fallback to basic method sans data
         call c_checkcanstillrun(iStatus)
      endif
	end

[mecej4]

The include files are not provided, and some lines of code have statements starting before column 7. Please provide compilable code.

[FortranFan · Accepted solution]

Do you by any chance /Qsave in effect now?  https://software.intel.com/en-us/node/579563

[van_der_merwe__ben]

We do use Qsave, how does that impact allocatable arrays as in the way they are declared here?

[FortranFan]

benifkc wrote:

We do use Qsave, how does that impact allocatable arrays as in the way they are declared here?

module m

   implicit none

contains

   subroutine sub()

      integer, allocatable :: iarr(:)
      integer :: istat
      character(len=80) :: erralloc

      allocate( iarr(2), source=[ 1, 2 ], stat=istat, errmsg=erralloc)
      if (istat == 0) then
         print *, " iarr = ", iarr
      else
         print *, " allocation failed. istat = ", istat, " errmsg = ", erralloc
      end if

      return

   end subroutine sub

end module m

program p

   use m, only : sub

   implicit none

   integer :: i
   
   do i = 1, 2
      call sub()
   end do

   stop

end program p

Compiled with /Qsave and run:

  iarr =  1 2
  allocation failed. istat =  151  errmsg =
 allocatable array is already allocated


Press any key to continue . . .

Compiled with default or /Qauto and run:

  iarr =  1 2
  iarr =  1 2
Press any key to continue . . .

[mecej4]

To see the effect of /Qsave, you can run the following program twice, once without and again with /Qsave

program allocs
implicit none
integer i

do i=1,3
   call sub(i)
end do

contains
   subroutine sub(k)
   integer, intent(in) :: k
   integer, allocatable :: x(:)
   write(*,*)'Entered sub with k = ',k
   if(allocated(x))then
      write(*,*)'x is allocated, size = ',size(x)
      deallocate(x)
   else
      write(*,*)'x is not allocated'
   endif
   allocate(x(k))
   write(*,*)'(Re)allocated x with size ',size(x)
   return
   end subroutine
end program

[van_der_merwe__ben]

Hmm, it is beginning to look like one of those "why did this ever work" type situations? Well we only have 273 files where Fortran arrays are dynamically deallocated, so we can review them and clean this up. (That is a tiny fraction of our code, trust me, 273 is nothing)

[mecej4]

benifkc wrote:

... trust me, 273 is nothing)

Precisely, since 273 K = -0.15 °C, which can be rounded to "nothing"!

[van_der_merwe__ben]

Allocate is called in 280 Fortran files, but deallocate is only called in 207 files. So the cleanup might not be that bad. Hahahaha. You gotta laugh when you can.