Skip to content

Instantly share code, notes, and snippets.

@Groostav
Last active April 17, 2025 05:18
Show Gist options
  • Save Groostav/d20736e920c60d5fef9d3c2b813adde3 to your computer and use it in GitHub Desktop.
Save Groostav/d20736e920c60d5fef9d3c2b813adde3 to your computer and use it in GitHub Desktop.
intel ifx 2024 and 2025 compiler crash
module SSCCE_1
USE IFPORT
USE IFCORE
USE ISO_C_BINDING
USE, INTRINSIC :: IEEE_ARITHMETIC
IMPLICIT NONE
! Define interface of call-back routine.
ABSTRACT INTERFACE
TYPE(C_PTR) FUNCTION evaluatorCallback(inputMat,matM,matN,chosenFunctions,length)&
BIND(C)
USE, INTRINSIC :: ISO_C_BINDING
TYPE(C_PTR), INTENT(IN), VALUE :: inputMat, chosenFunctions
INTEGER(C_INT), INTENT(IN), VALUE :: matM, matN, length
END FUNCTION
end interface
CONTAINS
end module
module SSCCE_2
USE IFPORT
USE IFCORE
USE ISO_C_BINDING
use SSCCE_1
USE, INTRINSIC :: IEEE_ARITHMETIC
IMPLICIT NONE
contains
SUBROUTINE evaluateObjectivesSinglePoint(x,evaluatedX,numFuns, &
evaluator, &
objectives)
REAL*8,DIMENSION(:),ALLOCATABLE,INTENT(IN) :: x
REAL*8,DIMENSION(:,:),ALLOCATABLE,INTENT(IN) :: evaluatedX
INTEGER,INTENT(IN) :: numFuns
PROCEDURE(evaluatorCallback),POINTER,INTENT(IN) :: evaluator
REAL*8,DIMENSION(:),ALLOCATABLE,INTENT(OUT) :: objectives
!method vars
REAL(C_DOUBLE),DIMENSION(:),ALLOCATABLE,TARGET :: evaluatePoint
REAL(C_DOUBLE),DIMENSION(:),POINTER :: resultPoints
INTEGER :: i
REAL*8 :: largeNum
LOGICAL(C_BOOL),DIMENSION(:),ALLOCATABLE,TARGET :: chosenFuns
!REAL*8,DIMENSION(:),ALLOCATABLE :: evaluatePoint
!REAL*8,DIMENSION(:),ALLOCATABLE :: evaluatePointF
LOGICAL :: evaluate
IF(SIZE(x)>0)THEN
ALLOCATE(evaluatePoint(SIZE(x)))
evaluatePoint = x
ALLOCATE(chosenFuns(numFuns))
chosenFuns = .TRUE.
CALL C_F_POINTER(evaluator(C_LOC(evaluatePoint),SIZE(x),1,C_LOC(chosenFuns),numFuns), &
resultPoints,[numFuns])
ALLOCATE(objectives(1))
IF(IEEE_IS_NAN(resultPoints(1)))THEN
DEALLOCATE(objectives)
CALL freeMemory(C_LOC(resultPoints))
NULLIFY(resultPoints)
RETURN
ENDIF
IF(IEEE_IS_FINITE(resultPoints(1)))THEN
objectives(1) = resultPoints(1)
ELSE
objectives(1) = HUGE(largeNum)
ENDIF
CALL freeMemory(C_LOC(resultPoints))
NULLIFY(resultPoints)
ENDIF
END SUBROUTINE
end module
compile SSCCE_1.f90:
------ Build started: Project: v2025, Configuration: Debug|x64 ------
Compiling with Intel® Fortran Compiler 2025.1.0 [Intel(R) 64]...
SSCCE_1.f90
Build log written to "file://C:/Users/geoff/Code/lgo/v2025/x64/Debug/BuildLog.htm"
v2025 - 0 error(s), 0 warning(s)
---------------------- Done ----------------------
compile SSCCE_2.f90:
------ Build started: Project: v2025, Configuration: Debug|x64 ------
Compiling with Intel® Fortran Compiler 2025.1.0 [Intel(R) 64]...
SSCCE_2.f90
xfortcom: Fatal: There has been an internal compiler error (C0000005).
compilation aborted for C:\Users\geoff\Code\lgo\v2025\SSCCE_2.f90 (code 1)
Build log written to "file://C:/Users/geoff/Code/lgo/v2025/x64/Debug/BuildLog.htm"
v2025 - 1 error(s), 0 warning(s)
---------------------- Done ----------------------
Compiling with Intel® Fortran Compiler 2025.1.0 [Intel(R) 64]...
ifx /nologo /debug:full /Od /fpp /warn:interfaces /module:"x64\Debug\\" /object:"x64\Debug\\" /traceback /check:bounds /check:stack /libs:dll /threads /dbglibs /Qmkl:sequential /c -I"%MKLROOT%\include" /Qlocation,link,"C:\Program Files\Microsoft Visual Studio\2022\Community\VC\Tools\MSVC\14.41.34120\bin\HostX64\x64" /Qm64 "C:\Users\geoff\Code\lgo\v2025\SSCCE_2.f90"
xfortcom: Fatal: There has been an internal compiler error (C0000005).
compilation aborted for C:\Users\geoff\Code\lgo\v2025\SSCCE_2.f90 (code 1)
v2025 - 1 error(s), 0 warning(s)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment