Finalizer in Fortran sometimes makes error when it is compiled with oneAPI

28 Views Asked by At

I have created a linked list structure used to store four members: ID, row, column, value. The type named MeshGrid is created with five instant variables, two member functions, and finalizers in the Module MeshGrid. When the ii,jj are both set to value 10 in the Main program, the compilation success. But compilation failed when ii, jj are both set to value 100.

The error message is "dbghelp.pdb contains the debug information required to find the source for the module dbghelp.dll". Here is an Image about this error details

So appreciated for any help. Thanks a lot.

    MODULE MeshGrid
    IMPLICIT NONE
    INTEGER, PARAMETER :: DBL = 8
    TYPE, PUBLIC :: ArraysSparse
        INTEGER :: ID
        INTEGER :: Row, Column
        COMPLEX(KIND = DBL) :: Value
        TYPE(ArraysSparse), POINTER :: Ptr
    CONTAINS
        PROCEDURE, PASS :: GetArray => GetArray
        PROCEDURE, PASS :: GetArrays => GetArraysSparse
        FINAL :: MemoryFree        
    END TYPE ArraysSparse        

    ! used for the coordinate format about the sparse matrix 
    INTEGER, ALLOCATABLE, DIMENSION(:) :: Rows, Columns
    COMPLEX(KIND = DBL), ALLOCATABLE, DIMENSION(:) :: Values
    INTEGER :: NumElements = 0
    
    PRIVATE :: GetArray, GetArraysSparse, MemoryFree    
    CONTAINS
    ! ----------------- interfaces about operation of the derived type for the formation grid----------------------
    SUBROUTINE PresparseMatrix(head, tail, row, column, value)
    ! Purpose:
    !   This function is used to creat the linked list for three array: rows, columns, and values about the sparse matrix coordinate format 
    !
    ! Record of revisoions:
    !     Date                  Programmer                  Discriptionof change
    !     ====                  ==========                  ====================
    !    7/15/23                Yanjun Chen                    Original code
    !
    IMPLICIT NONE
    ! Date dictionary : declare calling parameter types and definitions
    TYPE(ArraysSparse), POINTER :: head, tail
    INTEGER :: row, column
    COMPLEX(KIND = 8) :: value
    ! Date dictionary : declare local variable types and definitions
    INTEGER :: iStat
 
    NumElements = NumElements+1
    IF(.NOT. ASSOCIATED(head))THEN
        ALLOCATE(head, STAT = iStat)
        tail => head
        tail%ID = NumElements
        tail%Row = row
        tail%Column = column
        tail%Value = value
        NULLIFY(tail%Ptr)
    ELSE
        ALLOCATE(tail%Ptr, STAT= iStat)
        tail => tail%Ptr
        tail%ID = NumElements
        tail%Row = row
        tail%Column = column
        tail%Value = value
        NULLIFY(tail%Ptr)        
    END IF      
    END SUBROUTINE
    
    SUBROUTINE GetArraysSparse(this)
    ! Purpose:
    !   This function is used to create three arrays: rows, columns, and values from the saved linked list 
    !
    ! Record of revisoions:
    !     Date                  Programmer                  Discriptionof change
    !     ====                  ==========                  ====================
    !    7/15/23                Yanjun Chen                    Original code
    !    
    IMPLICIT NONE
    ! Date dictionary : declare calling parameter types and definitions
    CLASS(ArraysSparse), TARGET :: this
    ! Date dictionary : declare local variable types and definitions
    TYPE(ArraysSparse), POINTER :: ptr    
    INTEGER :: ii, iStat
    INTEGER :: numElementsTemp
    
    numElementsTemp = 0
    ALLOCATE(Rows(NumElements),Columns(NumElements),Values(NumElements))
    ! read the arrays about the sparse matrix from the linked list
    ptr => this
    DO WHILE(ASSOCIATED(ptr))
        numElementsTemp = numElementsTemp+1
        Rows(numElementsTemp) = ptr%Row
        Columns(numElementsTemp) = ptr%Column
        Values(numElementsTemp) = ptr%Value
        IF(numElementsTemp == NumElements)THEN
            WRITE(*,*)ptr%ID
        END IF        
        ptr => ptr%Ptr
    END DO
    !OPEN(11, FILE = 'arrays_Sparse.txt', STATUS = 'UNKNOWN')
    !WRITE(11,*) 'Index ', 'row ', 'column ',  'value '
    !DO ii = 1, numElementsTemp
    !    WRITE(11,"(I10,2X,I10,2X,I10,2X,40(E16.8,1X))")ii, rows(ii), columns(ii), values(ii)
    !END DO
    !CLOSE(11)    
    END SUBROUTINE
    
    FUNCTION GetArray(this, ID) RESULT(ptr)
    ! Purpose:
    !   This function is used to get three arrays: rows, columns, and values for the ID provided 
    !
    ! Record of revisoions:
    !     Date                  Programmer                  Discriptionof change
    !     ====                  ==========                  ====================
    !    7/15/23                Yanjun Chen                    Original code
    ! 
    IMPLICIT NONE
    ! Date dictionary : declare calling parameter types and definitions
    CLASS(ArraysSparse), TARGET :: this
    INTEGER :: ID
    TYPE(ArraysSparse), POINTER :: ptr
    ! Date dictionary : declare local variable types and definitions
    INTEGER :: numElementsTemp
    numElementsTemp = 1
    ptr => this
    DO WHILE(numElementsTemp < ID)
        numElementsTemp = numElementsTemp+1
        ptr => ptr%Ptr
    END DO    
    END FUNCTION
    
    SUBROUTINE MemoryFree(this)
    ! Purpose:
    !   This function is used to free the memory where the linked list is saved 
    !
    ! Record of revisoions:
    !     Date                  Programmer                  Discriptionof change
    !     ====                  ==========                  ====================
    !    7/15/23                Yanjun Chen                    Original code
    !     
    IMPLICIT NONE
    ! Date dictionary : declare calling parameter types and definitions
    TYPE(ArraysSparse) :: this
    !TARGET :: this
    ! Date dictionary : declare local variable types and definitions
    INTEGER :: iStat
    INTEGER, SAVE :: IDTemp = 1
    !TYPE(ArraysSparse), POINTER :: ptrTemp1, ptrTemp2
    !ptrTemp1 => this%Ptr
    WRITE(*,*) IDTemp
    IDTemp = IDTemp+1   
    IF(ASSOCIATED(this%Ptr))THEN
        !IF(IDTemp == 4)THEN
        !END IF        
        !ptrTemp1 => this%Ptr        
        DEALLOCATE(this%Ptr, STAT = iStat)
        !ptrTemp1 => ptrTemp2
    END IF 
    END SUBROUTINE
    END MODULE MeshGrid    
    
    PROGRAM Finalizer
    ! Purpose:
    !   To creat the linked list and free its memory
    !
    ! Record of revisoions:
    !     Date                  Programmer                  Discriptionof change
    !     ====                  ==========                  ====================
    !    7/15/23                Yanjun Chen                    Original code
    !
    USE MeshGrid
    IMPLICIT NONE
    ! Date dictionary : declare local variable types and definitions
    INTEGER :: ii, jj, iStat
    TYPE(ArraysSparse), POINTER :: head, tail
    DO ii = 1, 100
        DO jj = 1, 100
            CALL PresparseMatrix(head, tail, ii, jj, (0.1_DBL,0.2_DBL))
        END DO
    END DO
    DEALLOCATE(head, STAT = iStat)
    PAUSE
    STOP
    END PROGRAM Finalizer    

I compiled the above with oneAPI.

0

There are 0 best solutions below