Problem with deallocate allocatable arrays in Fortran

209 Views Asked by At

I am converting a legacy code and employing allocatable arrays

Now a subroutine(STIFFR) calls another subroutine(RADaU5) which needs workspace and tolerance specifying arrays. Since these depend on the dimensionality of the problem (passed to STIFFR), all arrays are declared allocatable in STIFFR, passed, along with their dimensions to RADAU5, and then deallocated. It's on deallocating the last that gfortran crashes.

SUBROUTINE STIFFR(FCN ,OUTSLA,DJAC ,NEQ,Y, DU,DUDUM,PD
 z ,LDATIMES,NIWRKRAD,NRWRKRAD,TIMES,NSUP,URESUR,URESUI,
 z ITOT  ,KEY )


      IMPLICIT DOUBLE PRECISION(A-h,o-z)
         EXTERNAL FCN,OUTSLA,djac, SOLOUT,DUMMAS

    DIMENSION Y(NEQ),IPAR(1),RPAR(1),
 z INFO(15) ,DU(NEQ),DUDUM(NEQ)

   DIMENSION TIMES(LDATIMES),URESUI(NSUP,NSUP,LDATIMES),
 z URESUR(NSUP,NSUP,LDATIMES),ITOT(NSUP),PD(NEQ,NEQ)

   DOUBLE PRECISION, dimension(:), ALLOCATABLE :: ATOL ,RTOL   
    DOUBLE PRECISION, dimension(:), ALLOCATABLE ::  WORK
   integer, DIMENSION(:), allocatable :: IWORK 
     LOGICAL FLAGODE
       COMMON/ODEFLAG/FLAGODE
      COMMON/ISTAT/IPT
      COMMON/IOUTCOM/IOUT
         FLAGODE=.FALSE.
       NTIMES=LDATIMES-1
           idiD=-35
       NDM=NEQ
       allocate (RTOL(NEQ ), stat=iaLLOCATEstatus)
      if (IALLOCATEstatUS /= 0) then
  write(6,*)'ERROR trying to allocate rtol in solve0U0'
         stop 1
       end if
     allocate (ATOL(NEQ ), stat=iaLLOCATEstatus)
      if (IALLOCATEstatUS /= 0) then
  write(6,*)'ERROR trying to allocate atol in solve0U0'
         stop 1
       end if      
           
  allocate (WORK(NRWRKRAD), stat=iaLLOCATEstatus)
      if (IALLOCATEstatUS /= 0) then
  write(6,*)'ERROR trying to allocate  WORK  in solveOU0'
         stop 1
       end if
     allocate (IWORK(NIWRKRAD), stat=iaLLOCATEstatus)
      if (IALLOCATEstatUS /= 0) then
  write(6,*)'ERROR trying to allocate IWORK  in solve0U0'
         stop 1
       end if  
             DO 33 K=1,NTIMES-1
               T=TIMES(K)
                TOUT=TIMES(K+1)
     

......................

22      CALL RADAU5( NEQ,FCN,
 z T,Y,TOUT,H,
 &                  RTOL,ATOL,ITOL,
 &                  DJAC,
 & IJAC,MLJAC,MUJAC,
 &                  DUMMAS,
 z  IMAS,MLMAS,MUMAS,
 &                  SOLOUT,0, 
 z          LDATIMES,NSUP,URESUR,URESUI,
 &                 WORK,NRWRKRAD,
 z IWORK,NIWRKRAD,RPAR,IPAR,
 z IDID)  

...............

33      CONTINUE

....

         deallocate (IWORK , stat=IALLOCATEstatus)
     deallocate ( WORK , stat=IALLOCATEstatus)
     deallocate (ATOL, stat=IALLOCATEstatus)

c The next line is the offending line, whether or not I check if alocated

    if(allocated(rtol))     deallocate (RTOL, stat=IALLOCATEstatus)  
                  RETURN
                  END
  

Next, I tried gdb, which complains about a missing routine when calling deallocate, whereas deallocated was called many times before without any apparent problems:

     (gdb) p rtol
$5 = (0.00010000000000000007, 0.0001, 0.0001, 0.0001, 0.0001, 0.0001, 0.0001, 0.0001)
(gdb) p allocated(rtol)
No symbol "allocated" in current context.
(gdb) next
free(): invalid pointer
Program received signal SIGABRT, Aborted.
__GI_raise (sig=sig@entry=6) at ../sysdeps/unix/sysv/linux/raise.c:51
51  ../sysdeps/unix/sysv/linux/raise.c: No such file or directory.
(gdb)  

Any ideas on what might be the problem??

0

There are 0 best solutions below