0

我正在转换旧代码并使用可分配数组

现在一个子程序（STIFFR）调用另一个需要工作空间和公差指定数组的子程序（RADaU5）。由于这些取决于问题的维度（传递给 STIFFR），所有数组都在 STIFFR 中声明为可分配的，连同它们的维度一起传递给 RADAU5，然后释放。它是在释放 gfortran 崩溃的最后一个。

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 下一行是违规行，无论我是否检查是否已分配

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

接下来，我尝试了 gdb，它在调用 deallocate 时抱怨缺少例程，而 deallocated 之前被多次调用，没有任何明显的问题：

     (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)

关于可能是什么问题的任何想法？

4

0 回答 0