! *
! **********************************************************************************
! * INTEL CORPORATION                                                              *
! * Copyright 2006-2011 Intel Corporation All Rights Reserved.                     *
! *                                                                                *
! * The source code contained or described herein and all documents related to     *
! * the source code ("Material") are owned by Intel Corporation or its suppliers   *
! * or licensors. Title to the Material remains with Intel Corporation or its      *
! * suppliers and licensors. The Material contains trade secrets and proprietary   *
! * and confidential information of Intel or its suppliers and licensors. The      *
! * Material is protected by worldwide copyright and trade secret laws and         *
! * treaty provisions. No part of the Material may be used, copied, reproduced,    *
! * modified, published, uploaded, posted, transmitted, distributed, or            *
! * disclosed in any way without Intel's prior express written permission.         *
! *                                                                                *
! * No license under any patent, copyright, trade secret or other intellectual     *
! * property right is granted to or conferred upon you by disclosure or delivery   *
! * of the Materials, either expressly, by implication, inducement, estoppel or    *
! * otherwise. Any license under such intellectual property rights must be         *
! * express and approved by Intel in writing.                                      *
! **********************************************************************************
! *

!
! **************************** Edit History ****************************************
!
! Jan-29-2008  Created
! Sep-29-2008  Fix C_ASSOCIATED(C_NULL_PTR) returns true in mixed-language. This
!              .obj file is moved from libifcore builds to a new ifmodintr.lib library.
! Jan-15-2009  Added BIND(C) attribute to global constant definition for portability.
! Jan-17-2009  Removed BIND(C) attribute from global constant definition.
! Mar-30-2010  Added DEFAULT attribute to global constant definition for portability.
! **********************************************************************************

MODULE IEEE_FEATURES

!DEC$ IF DEFINED(_WIN32) .OR. DEFINED(_WIN64)
!DEC$ OBJCOMMENT LIB:"ifmodintr.lib"
!DEC$ ENDIF

    IMPLICIT NONE

    PRIVATE
    PUBLIC :: &
! Derived types and constants
        IEEE_FEATURES_TYPE, &
        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

    INTEGER (KIND=4), PARAMETER, PUBLIC :: IEEE_FEATURES_VERSION = 100
  
    INCLUDE 'fordef.for'

! -------------------------------------------------------------------------
! IEEE Exception derived types
! -------------------------------------------------------------------------    
    
! Derived type for expressing the need for particular IEEE features.   
    TYPE IEEE_FEATURES_TYPE
        PRIVATE
        INTEGER(4) :: IEEE_FEATURES 
    END TYPE IEEE_FEATURES_TYPE

! -------------------------------------------------------------------------
! IEEE Features
! -------------------------------------------------------------------------

! The following named constants specifying particular IEEE features in the 
! module are the only possible values of the IEEE_FEATURES_TYPE type:

!DEC$ OPTIONS /NOALIGN
! IEEE arithmetic is supported for a particular kind of real.
    TYPE(IEEE_FEATURES_TYPE), PARAMETER :: IEEE_DATATYPE = IEEE_FEATURES_TYPE(FOR_FP_FEATURE_DATATYPE)
    !DEC$ ATTRIBUTES DEFAULT :: IEEE_DATATYPE
! Denormalised values are supported.     
    TYPE(IEEE_FEATURES_TYPE), PARAMETER :: IEEE_DENORMAL = IEEE_FEATURES_TYPE(FOR_FP_FEATURE_DENORMAL)
    !DEC$ ATTRIBUTES DEFAULT :: IEEE_DENORMAL
! Processor support divide with accuracy specified by the IEEE International 
! Standard. 
    TYPE(IEEE_FEATURES_TYPE), PARAMETER :: IEEE_DIVIDE = IEEE_FEATURES_TYPE(FOR_FP_FEATURE_DIVIDE)
    !DEC$ ATTRIBUTES DEFAULT :: IEEE_DIVIDE 
! Halting mode is supported.
    TYPE(IEEE_FEATURES_TYPE), PARAMETER :: IEEE_HALTING = IEEE_FEATURES_TYPE(FOR_FP_FEATURE_HALTING)
    !DEC$ ATTRIBUTES DEFAULT :: IEEE_HALTING
! Inexact exception is available.
    TYPE(IEEE_FEATURES_TYPE), PARAMETER :: IEEE_INEXACT_FLAG = IEEE_FEATURES_TYPE(FOR_FP_FEATURE_INEXACT_F)
    !DEC$ ATTRIBUTES DEFAULT :: IEEE_INEXACT_FLAG
! Infinity values are supported.
    TYPE(IEEE_FEATURES_TYPE), PARAMETER :: IEEE_INF = IEEE_FEATURES_TYPE(FOR_FP_FEATURE_INF)
    !DEC$ ATTRIBUTES DEFAULT :: IEEE_INF
! Invalid exception is available.
    TYPE(IEEE_FEATURES_TYPE), PARAMETER :: IEEE_INVALID_FLAG = IEEE_FEATURES_TYPE(FOR_FP_FEATURE_INVALID_F)
    !DEC$ ATTRIBUTES DEFAULT :: IEEE_INVALID_FLAG
! Nan values are supported.
    TYPE(IEEE_FEATURES_TYPE), PARAMETER :: IEEE_NAN = IEEE_FEATURES_TYPE(FOR_FP_FEATURE_NAN)
    !DEC$ ATTRIBUTES DEFAULT :: IEEE_NAN
! Rounding mode is supported.
    TYPE(IEEE_FEATURES_TYPE), PARAMETER :: IEEE_ROUNDING = IEEE_FEATURES_TYPE(FOR_FP_FEATURE_ROUNDING)
    !DEC$ ATTRIBUTES DEFAULT :: IEEE_ROUNDING
! Sqrt is implemented in accordance with the IEEE International Standard.
    TYPE(IEEE_FEATURES_TYPE), PARAMETER :: IEEE_SQRT = IEEE_FEATURES_TYPE(FOR_FP_FEATURE_SQRT)
    !DEC$ ATTRIBUTES DEFAULT :: IEEE_SQRT
! Underflow exception is available.
    TYPE(IEEE_FEATURES_TYPE), PARAMETER :: IEEE_UNDERFLOW_FLAG = IEEE_FEATURES_TYPE(FOR_FP_FEATURE_UNDERFLOW_F)
    !DEC$ ATTRIBUTES DEFAULT :: IEEE_UNDERFLOW_FLAG
!DEC$ END OPTIONS  

END MODULE IEEE_FEATURES
