fortran66のブログ

fortran について書きます。

IEEE

PROGRAM test
USE, INTRINSIC :: ieee_arithmetic
USE, INTRINSIC :: ieee_exceptions
USE, INTRINSIC :: ieee_features
IMPLICIT NONE
TYPE (IEEE_FEATURES_TYPE), PARAMETER :: ieee_feat(11) = [ IEEE_DATATYPE, IEEE_DENORMAL, IEEE_DIVIDE, IEEE_HALTING, &
               IEEE_INEXACT_FLAG, IEEE_INF, IEEE_INVALID_FLAG, IEEE_NAN, IEEE_ROUNDING, IEEE_SQRT, IEEE_UNDERFLOW_FLAG ]

TYPE (IEEE_FLAG_TYPE), PARAMETER :: ieee_u(3) = [ IEEE_OVERFLOW, IEEE_DIVIDE_BY_ZERO, IEEE_INVALID ], &
                                      ieee_a(5) = [ ieee_usual, IEEE_UNDERFLOW, IEEE_INEXACT ]
TYPE (IEEE_STATUS_TYPE) :: sret            
INTEGER :: i
LOGICAL :: lret, lrets(5)

DO i = 1, SIZE(IEEE_ALL)
 PRINT *, IEEE_SUPPORT_FLAG(IEEE_ALL(i)), IEEE_SUPPORT_HALTING(IEEE_ALL(i))
END DO


!CALL IEEE_SET_FLAG(IEEE_ALL, .TRUE.)
CALL IEEE_GET_STATUS(sret)

!
CALL IEEE_GET_HALTING_MODE(IEEE_ALL, lrets)
PRINT *, 'HALTING_MODE ', lrets
CALL IEEE_SET_HALTING_MODE(IEEE_ALL, .NOT. lrets)
CALL IEEE_GET_HALTING_MODE(IEEE_ALL, lrets)
PRINT *, 'HALTING_MODE ', lrets
!
print *
!
CALL IEEE_GET_HALTING_MODE(IEEE_ALL, lrets)
PRINT *, 'HALTING_MODE ', lrets
CALL IEEE_SET_HALTING_MODE(IEEE_ALL, .NOT. lrets)
CALL IEEE_GET_HALTING_MODE(IEEE_ALL, lrets)
PRINT *, 'HALTING_MODE ', lrets
!
CALL IEEE_GET_FLAG(IEEE_ALL, lrets)
PRINT *, 'FLAG ', lrets
CALL IEEE_SET_FLAG(IEEE_ALL, .NOT. lrets)
CALL IEEE_GET_FLAG(IEEE_ALL, lrets)
PRINT *, 'FLAG ', lrets
!
CALL IEEE_GET_FLAG(IEEE_ALL, lrets)
PRINT *, 'FLAG ', lrets
CALL IEEE_SET_FLAG(IEEE_ALL, .NOT. lrets)
CALL IEEE_GET_FLAG(IEEE_ALL, lrets)
PRINT *, 'FLAG ', lrets
!
!
!
CALL IEEE_GET_FLAG(IEEE_ALL, lrets)
PRINT *, 'FLAG ', lrets
CALL IEEE_SET_FLAG(IEEE_ALL, .NOT. lrets)
CALL IEEE_GET_FLAG(IEEE_ALL, lrets)
PRINT *, 'FLAG ', lrets
!
CALL IEEE_GET_HALTING_MODE(IEEE_ALL, lrets)
PRINT *, 'HALTING_MODE ', lrets
CALL IEEE_SET_HALTING_MODE(IEEE_ALL, .NOT. lrets)
CALL IEEE_GET_HALTING_MODE(IEEE_ALL, lrets)
PRINT *, 'HALTING_MODE ', lrets
!
CALL IEEE_SET_STATUS(sret)
!
CALL IEEE_GET_FLAG(IEEE_ALL, lrets)
PRINT *, 'FLAG ', lrets
CALL IEEE_SET_FLAG(IEEE_ALL, .NOT. lrets)
CALL IEEE_GET_FLAG(IEEE_ALL, lrets)
PRINT *, 'FLAG ', lrets
!
CALL IEEE_GET_HALTING_MODE(IEEE_ALL, lrets)
PRINT *, 'HALTING_MODE ', lrets
CALL IEEE_SET_HALTING_MODE(IEEE_ALL, .NOT. lrets)
CALL IEEE_GET_HALTING_MODE(IEEE_ALL, lrets)
PRINT *, 'HALTING_MODE ', lrets
!
!


STOP
!
PRINT *, IEEE_SUPPORT_UNDERFLOW_CONTROL()
PRINT *, IEEE_SUPPORT_DENORMAL()
CALL IEEE_SET_UNDERFLOW_MODE(.TRUE.)
DO i = 1, 24
 PRINT *, NEAREST(0.0, 1.0) / 2**i
END DO
CALL IEEE_SET_UNDERFLOW_MODE(.FALSE.)
DO i = 1, 24
 PRINT *, NEAREST(0.0, 1.0) / 2**i
END DO
STOP
END PROGRAM test