调用MKL_DSS无法保存结果到文件

fcode

这确实是一个很诡异的情况。

IVF 的错误列表上这样说：

severe (8):  Internal consistency  check  failure
FOR$IOS_BUG_CHECK.   Internal  error.   Please  check  that  the program is correct .  Recompile  if  an error existed  in  the  program.   If  this error persists, submit a problem report .

我想这个错误应该是 IVF 内部的缺陷导致的。而不是任何语法错误或调用方式错误。

通过更底层的一些逆向分析，得到一个比较奇特的“不正式”的解决方法：

（其中 !// ****** 是我修改后的行，不要问为什么，我也不知道，呵呵）

[Fortran] 纯文本查看 复制代码

      PROGRAM Test
      INCLUDE 'mkl_dss.f77'

      INTEGER tIU(:), tJU(:), Idum(1), ITER
      DOUBLE PRECISION tUM(:), tXDIFF(:), tX(:)
      ALLOCATABLE tIU, tJU, tUM, tXDIFF, tX
      real*8 :: av(3) = 58.0
      INTEGER nNonZeros,nRow
      
      INTEGER*8 handle
      INTEGER error

      OPEN (UNIT=10, FILE='testInfo.dat') 
      READ (10,7004) nNonZeros, nRow
      CLOSE(10)
    
      ALLOCATE(tIU(nRow+1))
      ALLOCATE(tXDIFF(nRow))
      ALLOCATE(tX(nRow))
      ALLOCATE(tJU(nNonZeros))
      ALLOCATE(tUM(nNonZeros))
      OPEN (UNIT=11, FILE='OutValues.dat') !// ****** 
      write(11,*)  !// ******
      write(*,*) 'Program Begin'!// ******
      OPEN (UNIT=10, FILE='columns.dat') 
      READ (10,7002) (tJU(II),II=1,nNonZeros)
      CLOSE(10)
      
      OPEN (UNIT=10, FILE='rowIndex.dat') 
      READ (10,7002) (tIU(II),II=1,nRow+1)
      CLOSE(10)
      
      OPEN (UNIT=10, FILE='values.dat') 
      READ (10,7001) (tUM(II),II=1,nNonZeros)
      CLOSE(10)
      
      OPEN (UNIT=10, FILE='loadVector.dat')
      READ (10,7001) (tXDIFF(II),II=1,nRow)
      CLOSE(10)   
      


      ITER=1
C---------------------------------------------------------------------------
C Initialize the solver
C---------------------------------------------------------------------------
      error = dss_create(handle, MKL_DSS_DEFAULTS+MKL_DSS_OOC_VARIABLE)
      IF (error .NE. MKL_DSS_SUCCESS ) GOTO 999
C---------------------------------------------------------------------------

C---------------------------------------------------------------------------
C Define the non-zero structure of the matrix
C---------------------------------------------------------------------------
      error = dss_define_structure( handle, MKL_DSS_NON_SYMMETRIC,
     & tIU, nRow, nRow, tJU, nNonZeros )
      IF (error .NE. MKL_DSS_SUCCESS ) GOTO 999
C---------------------------------------------------------------------------

C---------------------------------------------------------------------------
C Reorder the matrix
C---------------------------------------------------------------------------

      IF (ITER.EQ.1) THEN
          error = dss_reorder( handle, MKL_DSS_GET_ORDER, Idum)
          IF (error .NE. MKL_DSS_SUCCESS ) GOTO 999
      ELSE
          error = dss_reorder( handle, MKL_DSS_MY_ORDER, Idum)
          IF (error .NE. MKL_DSS_SUCCESS ) GOTO 999
      ENDIF

C---------------------------------------------------------------------------
C Factor the matrix
C---------------------------------------------------------------------------
      error = dss_factor_real( handle, MKL_DSS_DEFAULTS, tUM)
      IF (error .NE. MKL_DSS_SUCCESS ) GOTO 999
      
C---------------------------------------------------------------------------
C Get the solution vector
C---------------------------------------------------------------------------
      error = dss_solve_real( handle, MKL_DSS_DEFAULTS,
     & tXDIFF, 1, tX)
      IF (error .NE. MKL_DSS_SUCCESS ) GOTO 999
C---------------------------------------------------------------------------
     
C---------------------------------------------------------------------------
C Deallocate solver storage
C---------------------------------------------------------------------------
      
C---------------------------------------------------------------------------

      Rewind(11)  !// ******
      WRITE (11,7005) (tX(II),II=1,nRow) !// ******
      CLOSE(11) !// ******
      error = dss_delete( handle, MKL_DSS_DEFAULTS )
      IF (error .NE. MKL_DSS_SUCCESS ) GOTO 999
      GOTO 1999
      
7001  FORMAT(1X,F)     
7002  FORMAT(1X,I5)
7003  FORMAT(1X,I,1X,E)
7004  FORMAT(1X,I,1X,I)
7005  FORMAT(1X,D)
      
999   WRITE(*,*) "Solver returned error code ", error
      
1999  DEALLOCATE(tIU,tJU,tUM,tXDIFF,tX)
      write(*,*) 'Program End' !// ******
      END