I’m getting the following error/warning with pgfortran on the attached code:
PGF90-W-0000-Internal compiler error. sym_is_refd:bad sty 405 (internal_error.f90: 308)
0 inform, 1 warnings, 0 severes, 0 fatal for hf2002
The error is a bit weird, since the referenced line in the error message is just a standard assignment of a real value. I have added several !DEBUG statements throughout the code. The ICE goes away if I comment out the first line after any of those statements. This issue might be related to my previous post, but I add it as new topic since the compiler warning is different.
I’m running on openSUSE Tumbleweed with
pgfortran --version
pgfortran 16.10-0 64-bit target on x86-64 Linux -tp haswell
MODULE HS2Kinds
USE ISO_FORTRAN_ENV, ONLY: INT8, INT16, INT32, INT64
USE ISO_FORTRAN_ENV, ONLY: REAL32, REAL64
IMPLICIT NONE
PUBLIC
INTEGER, PARAMETER :: I1B = INT8 !SELECTED_INT_KIND(2)
INTEGER, PARAMETER :: I2B = INT16 !SELECTED_INT_KIND(4)
INTEGER, PARAMETER :: I4B = INT32 !SELECTED_INT_KIND(9)
INTEGER, PARAMETER :: L1B = KIND(.TRUE.) !LOGICAL_KINDS(1)
INTEGER, PARAMETER :: LP = REAL32
INTEGER, PARAMETER :: HP = REAL64
INTEGER, PARAMETER :: WP = HP
INTEGER(I1B), PARAMETER :: MAXI1B = HUGE(1_I1B)
INTEGER(I2B), PARAMETER :: MAXI2B = HUGE(1_I2B)
INTEGER(I4B), PARAMETER :: MAXI4B = HUGE(1_I4B)
END MODULE HS2Kinds
!------------------------------------------------------------------------------
! !
! HS2Variant !
! !
!------------------------------------------------------------------------------
MODULE HS2Variant
USE HS2Kinds
IMPLICIT NONE
PRIVATE
PUBLIC :: HSVariant
TYPE HSVariant
INTEGER(I4B) :: id = MAXI4B
END TYPE HSVariant
END MODULE HS2Variant
!------------------------------------------------------------------------------
! !
! HS2List !
! !
!------------------------------------------------------------------------------
MODULE HS2List
USE HS2Kinds
USE HS2Variant, ONLY: HSVariant
IMPLICIT NONE
PRIVATE
PUBLIC :: HSList
TYPE :: HSLink
CLASS(HSVariant), PRIVATE, POINTER :: v => NULL()
CLASS(HSLink), PRIVATE, POINTER :: next => NULL()
CONTAINS
! DEBUG: Comment out next line and ICE disappears.
FINAL:: finalizeLink
END TYPE HSLink
TYPE :: HSList
CLASS(HSLink), PRIVATE, POINTER :: firstLink => NULL()
CLASS(HSLink), PRIVATE, POINTER :: lastLink => NULL()
CLASS(HSLink), PRIVATE, POINTER :: currentLink => NULL()
INTEGER(I4B), PRIVATE :: LEN = 0
CONTAINS
PROCEDURE, PASS :: appendList
PROCEDURE, PASS :: clear
END TYPE HSList
CONTAINS
RECURSIVE SUBROUTINE finalizeLink(this)
TYPE(HSLink), INTENT(INOUT) :: this
CHARACTER(LEN=32) :: err
INTEGER(I4B) :: i
IF (ASSOCIATED(this%v)) THEN
DEALLOCATE(this%v)
this%v => NULL()
END IF
IF (ASSOCIATED(this%next)) THEN
DEALLOCATE(this%next, STAT=i)
IF (i /= 0) THEN
WRITE(err,*) i
WRITE(*,"(A)") "HSLink::finalizeLink():: Failed to deallocate " // &
& "link with STAT = " // TRIM(err)
STOP 134
END IF
END IF
END SUBROUTINE finalizeLink
SUBROUTINE appendList(this, list)
CLASS(HSList), INTENT(INOUT) :: this
CLASS(HSList), INTENT(IN) :: list
! Does nothing
RETURN
END SUBROUTINE appendList
SUBROUTINE clear(this)
CLASS(HSList), INTENT(INOUT) :: this
this%LEN = 0
IF (.NOT.ASSOCIATED(this%firstLink)) RETURN
this%lastLink => NULL()
DEALLOCATE(this%firstLink)
this%firstLink => NULL()
RETURN
END SUBROUTINE clear
END MODULE HS2List
!------------------------------------------------------------------------------
! !
! HS2String !
! !
!------------------------------------------------------------------------------
MODULE HS2String
USE HS2Kinds
USE HS2Variant, ONLY: HSVariant
USE HS2List, ONLY: HSList
IMPLICIT NONE
PRIVATE
SAVE
PUBLIC :: HSString
TYPE, EXTENDS(HSVariant) :: HSString
CHARACTER(LEN=:), PRIVATE, ALLOCATABLE :: str
INTEGER(I4B), PRIVATE :: LEN = 0
CONTAINS
! DEBUG: Comment out next line and ICE disappears
PROCEDURE, PASS :: splitHSString
GENERIC :: ASSIGNMENT(=) => setAscii!
PROCEDURE, PASS :: setAscii
END TYPE HSString
TYPE, EXTENDS(HSList) :: HSStringList
CONTAINS
GENERIC :: ASSIGNMENT(=) => setHSList
PROCEDURE, PASS :: setHSList
END TYPE HSStringList
CONTAINS
ELEMENTAL SUBROUTINE setAscii(this, str)
CLASS(HSString), INTENT(INOUT) :: this
CHARACTER(LEN=*), INTENT(IN) :: str
INTEGER(I4B) :: l
l = LEN(str)
this%LEN = l
IF (ALLOCATED(this%str)) DEALLOCATE(this%str)
IF (this%LEN == 0) RETURN
ALLOCATE(CHARACTER(LEN=l)::this%str)
this%str(1:this%LEN) = str(1:this%LEN)
RETURN
END SUBROUTINE setAscii
FUNCTION splitHSString(this, sep, keepEmpty,caseSensitive) RESULT(answ)
CLASS(HSString), INTENT(IN) :: this
TYPE(HSString), INTENT(IN) :: sep
LOGICAL(L1B), OPTIONAL, INTENT(IN) :: keepEmpty, caseSensitive
TYPE(HSStringList) :: answ
CALL answ%clear()
END FUNCTION splitHSString
SUBROUTINE setHSList(this, from)
CLASS(HSStringList), INTENT(INOUT) :: this
TYPE(HSStringList), INTENT(IN) :: from
CALL this%clear()
CALL this%HSlist%appendList(from)
RETURN
END SUBROUTINE setHSList
END MODULE HS2String
!------------------------------------------------------------------------------
! !
! HS2DateTime !
! !
!------------------------------------------------------------------------------
MODULE HS2DateTime
USE HS2Kinds
USE HS2String, ONLY: HSString
IMPLICIT NONE
PRIVATE
SAVE
TYPE HSTimeSpec
INTEGER(I1B), PRIVATE :: val = 2
CONTAINS
! DEBUG: Comment out next line and ICE disappears
PROCEDURE, PASS :: specToString
GENERIC :: ASSIGNMENT(=) => setTimeSpecTS
GENERIC :: OPERATOR(==) => timeSpecsAreEqual
PROCEDURE, PRIVATE, PASS :: setTimeSpecTS
PROCEDURE, PRIVATE, PASS :: timeSpecsAreEqual
END TYPE HSTimeSpec
TYPE(HSTimeSpec), PARAMETER :: HSUTC = HSTimeSpec(0)
TYPE(HSTimeSpec), PARAMETER :: HSTAI = HSTimeSpec(1)
TYPE(HSTimeSpec), PARAMETER :: HSGPS = HSTimeSpec(2)
TYPE(HSTimeSpec), PARAMETER :: HSTT = HSTimeSpec(3)
TYPE(HSTimeSpec), PARAMETER :: HSTCG = HSTimeSpec(4)
TYPE(HSTimeSpec), PARAMETER :: HSTCB = HSTimeSpec(5)
TYPE(HSTimeSpec), PARAMETER :: HSTDB = HSTimeSpec(6)
TYPE HSJulianDay
INTEGER(I4B) :: JDN = 2451545
REAL(HP) :: FD = 0.0_HP
TYPE(HSTimeSpec) :: spec = HSUTC
CONTAINS
PROCEDURE, PASS :: setJulianDay
GENERIC :: ASSIGNMENT(=) => setJulianDay
END TYPE HSJulianDay
CONTAINS
FUNCTION specToString(this) RESULT(answ)
CLASS(HSTimeSpec), INTENT(IN) :: this
TYPE(HSString) :: answ
answ = "Unknown timescale"
END FUNCTION specToString
ELEMENTAL SUBROUTINE setTimeSpecTS(this, from)
CLASS(HSTimeSpec), INTENT(INOUT) :: this
TYPE(HSTimeSpec), INTENT(IN) :: from
this%val = from%val
RETURN
END SUBROUTINE setTimeSpecTS
ELEMENTAL FUNCTION timeSpecsAreEqual(a, b) RESULT(answ)
CLASS(HSTimeSpec), INTENT(IN) :: a
TYPE(HSTimeSpec), INTENT(IN) :: b
LOGICAL(L1B) :: answ
answ = (a%val == b%val)
RETURN
END FUNCTION timeSpecsAreEqual
ELEMENTAL SUBROUTINE setJulianDay(this, from)
CLASS(HSJulianDay), INTENT(INOUT) :: this
CLASS(HSJulianDay), INTENT(IN) :: from
this%JDN = from%JDN
this%FD = from%FD
this%spec = from%spec
IF (this%FD < 0.0_HP) THEN
DO
IF (this%FD >= 0.0_HP) EXIT
this%JDN = this%JDN - 1
this%FD = this%FD + 1.0_HP
END DO
END IF
IF (this%FD >= 1.0_HP) THEN
DO
IF (this%FD < 1.0_HP) EXIT
this%JDN = this%JDN + 1
this%FD = this%FD - 1.0_HP
END DO
END IF
RETURN
END SUBROUTINE setJulianDay
ELEMENTAL FUNCTION HF2002(tdb) RESULT (answ)
CLASS(HSJulianDay), INTENT(IN) :: tdb
REAL(WP) :: answ
! DEBUG: No ICE if I comment out the next line
TYPE(HSJulianDay), PARAMETER :: TSTART = HSJulianDay(2305450,0.5_HP,HSTT)
! DEBUG: Internal compiler error here??? No ICE if I comment out the
! next line.
answ = 1.0_WP
RETURN
END FUNCTION HF2002
END MODULE HS2DateTime
PROGRAM test_hsdatetime
USE HS2DateTime
WRITE(*,*) "compiled successfully"
END PROGRAM test_hsdatetime