! *
! **********************************************************************************
! * INTEL CORPORATION                                                              *
! *                                                                                *
! * Copyright 2002-2011 Intel Corporation All Rights Reserved.                     *
! *                                                                                *
! * Portions Copyright 1992-2002, Hewlett-Packard 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.                                      *
! **********************************************************************************
! *
!DEC$ FREEFORM


!DEC$ IF .NOT. DEFINED(__IFCORE_INCLUDE)
MODULE ifcore
!DEC$ ENDIF

! 
! This is a copy of fpeflags.for.
! 
	INTEGER(4), PARAMETER :: FOR_K_FPE_CNT_UNDERFLOW = '00000001'X
	INTEGER(4), PARAMETER :: FOR_K_FPE_CNT_OVERFLOW = '00000002'X
	INTEGER(4), PARAMETER :: FOR_K_FPE_CNT_DIVIDE0 = '00000003'X
	INTEGER(4), PARAMETER :: FOR_K_FPE_CNT_INVALID = '00000004'X
	INTEGER(4), PARAMETER :: FOR_K_FPE_CNT_ARRAY_MAX = '00000004'X
	INTEGER(4), PARAMETER :: FPE_M_TRAP_UND = '00000001'X
	INTEGER(4), PARAMETER :: FPE_M_TRAP_OVF = '00000002'X
	INTEGER(4), PARAMETER :: FPE_M_TRAP_DIV0 = '00000004'X
	INTEGER(4), PARAMETER :: FPE_M_TRAP_INV = '00000008'X
	INTEGER(4), PARAMETER :: FPE_M_RESERVED_00 = '00000010'X
	INTEGER(4), PARAMETER :: FPE_M_RESERVED_01 = '00000020'X
	INTEGER(4), PARAMETER :: FPE_M_RESERVED_02 = '00000040'X
	INTEGER(4), PARAMETER :: FPE_M_RESERVED_03 = '00000080'X
	INTEGER(4), PARAMETER :: FPE_M_MSG_OVF = '00000100'X
	INTEGER(4), PARAMETER :: FPE_M_MSG_UND = '00000200'X
	INTEGER(4), PARAMETER :: FPE_M_MSG_DIV0 = '00000400'X
	INTEGER(4), PARAMETER :: FPE_M_MSG_INV = '00000800'X
	INTEGER(4), PARAMETER :: FPE_M_RESERVED_04 = '00001000'X
	INTEGER(4), PARAMETER :: FPE_M_RESERVED_05 = '00002000'X
	INTEGER(4), PARAMETER :: FPE_M_RESERVED_06 = '00004000'X
	INTEGER(4), PARAMETER :: FPE_M_RESERVED_07 = '00008000'X
	INTEGER(4), PARAMETER :: FPE_M_ABRUPT_UND = '00010000'X
	INTEGER(4), PARAMETER :: FPE_M_ABRUPT_OVF = '00020000'X
	INTEGER(4), PARAMETER :: FPE_M_ABRUPT_DIV0 = '00040000'X
	INTEGER(4), PARAMETER :: FPE_M_ABRUPT_INV = '00080000'X
        INTEGER(4), PARAMETER :: FPE_M_RESERVED_08 = Z'00100000' !keep for legacy
        INTEGER(4), PARAMETER :: FPE_M_ABRUPT_DMZ  = Z'00100000'
	INTEGER(4), PARAMETER :: FPE_M_RESERVED_09 = '00200000'X
	INTEGER(4), PARAMETER :: FPE_M_RESERVED_10 = '00400000'X
	INTEGER(4), PARAMETER :: FPE_M_RESERVED_11 = '00800000'X
	INTEGER(4), PARAMETER :: FPE_M_RESERVED_12 = '01000000'X
	INTEGER(4), PARAMETER :: FPE_M_RESERVED_13 = '02000000'X
	INTEGER(4), PARAMETER :: FPE_M_RESERVED_14 = '04000000'X
	INTEGER(4), PARAMETER :: FPE_M_RESERVED_15 = '08000000'X
	INTEGER(4), PARAMETER :: FPE_M_RESERVED_16 = '10000000'X
	INTEGER(4), PARAMETER :: FPE_M_RESERVED_17 = '20000000'X
	INTEGER(4), PARAMETER :: FPE_M_RESERVED_18 = '40000000'X
	INTEGER(4), PARAMETER :: FPE_M_RESERVED_19 = '80000000'X
	STRUCTURE /for_fpe_flags/
	    PARAMETER FPE_S_TRAP_UND = 1
	    PARAMETER FPE_V_TRAP_UND = 0
	    PARAMETER FPE_S_TRAP_OVF = 1
	    PARAMETER FPE_V_TRAP_OVF = 1
	    PARAMETER FPE_S_TRAP_DIV0 = 1
	    PARAMETER FPE_V_TRAP_DIV0 = 2
	    PARAMETER FPE_S_TRAP_INV = 1
	    PARAMETER FPE_V_TRAP_INV = 3
	    PARAMETER FPE_S_RESERVED_00 = 1
	    PARAMETER FPE_V_RESERVED_00 = 4
	    PARAMETER FPE_S_RESERVED_01 = 1
	    PARAMETER FPE_V_RESERVED_01 = 5
	    PARAMETER FPE_S_RESERVED_02 = 1
	    PARAMETER FPE_V_RESERVED_02 = 6
	    PARAMETER FPE_S_RESERVED_03 = 1
	    PARAMETER FPE_V_RESERVED_03 = 7
	    PARAMETER FPE_S_MSG_OVF = 1
	    PARAMETER FPE_V_MSG_OVF = 8
	    PARAMETER FPE_S_MSG_UND = 1
	    PARAMETER FPE_V_MSG_UND = 9
	    PARAMETER FPE_S_MSG_DIV0 = 1
	    PARAMETER FPE_V_MSG_DIV0 = 10
	    PARAMETER FPE_S_MSG_INV = 1
	    PARAMETER FPE_V_MSG_INV = 11
	    PARAMETER FPE_S_RESERVED_04 = 1
	    PARAMETER FPE_V_RESERVED_04 = 12
	    PARAMETER FPE_S_RESERVED_05 = 1
	    PARAMETER FPE_V_RESERVED_05 = 13
	    PARAMETER FPE_S_RESERVED_06 = 1
	    PARAMETER FPE_V_RESERVED_06 = 14
	    PARAMETER FPE_S_RESERVED_07 = 1
	    PARAMETER FPE_V_RESERVED_07 = 15
	    PARAMETER FPE_S_ABRUPT_UND = 1
	    PARAMETER FPE_V_ABRUPT_UND = 16
	    PARAMETER FPE_S_ABRUPT_OVF = 1
	    PARAMETER FPE_V_ABRUPT_OVF = 17
	    PARAMETER FPE_S_ABRUPT_DIV0 = 1
	    PARAMETER FPE_V_ABRUPT_DIV0 = 18
	    PARAMETER FPE_S_ABRUPT_INV = 1
	    PARAMETER FPE_V_ABRUPT_INV = 19
	    PARAMETER FPE_S_RESERVED_08 = 1
	    PARAMETER FPE_V_RESERVED_08 = 20
	    PARAMETER FPE_S_RESERVED_09 = 1
	    PARAMETER FPE_V_RESERVED_09 = 21
	    PARAMETER FPE_S_RESERVED_10 = 1
	    PARAMETER FPE_V_RESERVED_10 = 22
	    PARAMETER FPE_S_RESERVED_11 = 1
	    PARAMETER FPE_V_RESERVED_11 = 23
	    PARAMETER FPE_S_RESERVED_12 = 1
	    PARAMETER FPE_V_RESERVED_12 = 24
	    PARAMETER FPE_S_RESERVED_13 = 1
	    PARAMETER FPE_V_RESERVED_13 = 25
	    PARAMETER FPE_S_RESERVED_14 = 1
	    PARAMETER FPE_V_RESERVED_14 = 26
	    PARAMETER FPE_S_RESERVED_15 = 1
	    PARAMETER FPE_V_RESERVED_15 = 27
	    PARAMETER FPE_S_RESERVED_16 = 1
	    PARAMETER FPE_V_RESERVED_16 = 28
	    PARAMETER FPE_S_RESERVED_17 = 1
	    PARAMETER FPE_V_RESERVED_17 = 29
	    PARAMETER FPE_S_RESERVED_18 = 1
	    PARAMETER FPE_V_RESERVED_18 = 30
	    PARAMETER FPE_S_RESERVED_19 = 1
	    PARAMETER FPE_V_RESERVED_19 = 31
	    BYTE %FILL (4)
	END STRUCTURE   ! for_fpe_flags
! 
! These are the unit numbers used for special asterisk (*) IO.
! 
	integer(4), parameter:: FOR_K_PRINT_UNITNO  = -1
	integer(4), parameter:: FOR_K_TYPE_UNITNO   = -2
	integer(4), parameter:: FOR_K_ACCEPT_UNITNO = -3
	integer(4), parameter:: FOR_K_READ_UNITNO   = -4

! 
! This is a copy of forreent.for.
! 
	INTEGER(4), PARAMETER :: FOR_K_REENTRANCY_NONE     = '00000000'X
	INTEGER(4), PARAMETER :: FOR_K_REENTRANCY_ASYNCH   = '00000001'X
	INTEGER(4), PARAMETER :: FOR_K_REENTRANCY_THREADED = '00000002'X
	INTEGER(4), PARAMETER :: FOR_K_REENTRANCY_INFO     = '00000003'X

!
! The prefetch parameters:
!
	INTEGER, PARAMETER :: FOR_K_PREFETCH_T0  = 0
	INTEGER, PARAMETER :: FOR_K_PREFETCH_T1  = 1
	INTEGER, PARAMETER :: FOR_K_PREFETCH_T2  = 2
	INTEGER, PARAMETER :: FOR_K_PREFETCH_NTA = 3
!
! The parameters that follow support the MEMREF_CONTROL directive:
!
	INTEGER*4, PARAMETER :: FOR_K_LOCALITY_L1  = 1
	INTEGER*4, PARAMETER :: FOR_K_LOCALITY_L2  = 2
	INTEGER*4, PARAMETER :: FOR_K_LOCALITY_L3  = 3
	INTEGER*4, PARAMETER :: FOR_K_LOCALITY_MEM = 4
	INTEGER*4, PARAMETER :: FOR_K_LATENCY_L1   = 1
	INTEGER*4, PARAMETER :: FOR_K_LATENCY_L2   = 2
	INTEGER*4, PARAMETER :: FOR_K_LATENCY_L3   = 3
	INTEGER*4, PARAMETER :: FOR_K_LATENCY_MEM  = 4


! Now, the routines...
      INTERFACE
       INTEGER(4) FUNCTION FOR_SET_FPE(ENABLE_MASK)
!DEC$ ATTRIBUTES DEFAULT, DECORATE, ALIAS:'for_set_fpe_' :: FOR_SET_FPE
       INTEGER(4) ENABLE_MASK
       END FUNCTION
      END INTERFACE
      INTERFACE
       INTEGER(4) FUNCTION  FOR_SET_REENTRANCY(NEW_MODE)
!DEC$ ATTRIBUTES DEFAULT, DECORATE, ALIAS:'for_set_reentrancy' :: FOR_SET_REENTRANCY
       INTEGER(4) NEW_MODE
       END FUNCTION
      END INTERFACE
      INTERFACE
       INTEGER(4) FUNCTION  FOR_GET_FPE()
!DEC$ ATTRIBUTES DEFAULT, DECORATE, ALIAS:'for_get_fpe_' :: FOR_GET_FPE
       END FUNCTION
      END INTERFACE
      INTERFACE
       SUBROUTINE FOR_CHECK_FLAWED_PENTIUM()
!DEC$ ATTRIBUTES DEFAULT, DECORATE, ALIAS:'for_check_flawed_pentium' :: FOR_CHECK_FLAWED_PENTIUM
       END SUBROUTINE
      END INTERFACE
! End of new routines...
      INTERFACE
	LOGICAL(4) FUNCTION COMMITQQ(UNIT)
!DEC$ ATTRIBUTES DEFAULT :: COMMITQQ
	  INTEGER(4) UNIT
	END FUNCTION
      END INTERFACE

      INTERFACE
	LOGICAL(4) FUNCTION FLUSHQQ(UNIT)
!DEC$ ATTRIBUTES DEFAULT :: FLUSHQQ
	  INTEGER(4) UNIT
	END FUNCTION
      END INTERFACE

!DEC$ IF DEFINED(_WIN32)
      INTERFACE
        FUNCTION  GETEXCEPTIONPTRSQQ()
!DEC$ ATTRIBUTES DEFAULT, DECORATE, ALIAS: 'GETEXCEPTIONPTRSQQ'   ::  GETEXCEPTIONPTRSQQ
        INTEGER, PARAMETER :: FOR_POINTER_LEN = INT_PTR_KIND()
        INTEGER(FOR_POINTER_LEN) GETEXCEPTIONPTRSQQ
       END FUNCTION
      END INTERFACE
!DEC$ ENDIF

      INTERFACE
        SUBROUTINE GERROR(ERRMSG)
          !DEC$ ATTRIBUTES DEFAULT, DECORATE, ALIAS:'for_gerror_' :: GERROR
          CHARACTER(LEN=*), INTENT(OUT) :: ERRMSG
        END SUBROUTINE

! PRINT A MESSAGE ON STDERR
        SUBROUTINE PERROR(ERRMSG)
          !DEC$ ATTRIBUTES DEFAULT, DECORATE, ALIAS:'for_perror_' :: PERROR
          CHARACTER(LEN=*), INTENT(IN) :: ERRMSG
        END SUBROUTINE

! GET CHARACTER FROM CONSOLE
        CHARACTER(LEN=1) FUNCTION GETCHARQQ()
          !DEC$ ATTRIBUTES DEFAULT :: GETCHARQQ
        END FUNCTION GETCHARQQ

! TEST FOR CONSOLE INPUT
        LOGICAL(4) FUNCTION PEEKCHARQQ()
          !DEC$ ATTRIBUTES DEFAULT :: PEEKCHARQQ
        END FUNCTION PEEKCHARQQ

! GET A STRING FROM THE CONSOLE
        INTEGER(4) FUNCTION GETSTRQQ(BUFFER)
          !DEC$ ATTRIBUTES DEFAULT :: GETSTRQQ
          CHARACTER(LEN=*) BUFFER
        END FUNCTION

    ! -----------------------------------------------------------------
    ! Unused Routine -- simply returns,used to avoid "unused" warnings
    ! -----------------------------------------------------------------
    	SUBROUTINE UNUSEDQQ()
          !DEC$ ATTRIBUTES DEFAULT :: UNUSEDQQ
          !DEC$ ATTRIBUTES DECORATE,C,REFERENCE,VARYING,ALIAS:"_FFunusedqq" ::  UNUSEDQQ
    	END SUBROUTINE
      END INTERFACE
          
!DEC$ IF DEFINED(_WIN32)
      INTERFACE
	SUBROUTINE TRACEBACKQQ(STRING, USER_EXIT_CODE, STATUS, EPTR)
	USE IFWINTY,ONLY:T_EXCEPTION_POINTERS
!DEC$ ATTRIBUTES DEFAULT :: TRACEBACKQQ
	  CHARACTER*(*), INTENT(IN), OPTIONAL :: STRING
	  INTEGER(4), INTENT(IN), OPTIONAL :: USER_EXIT_CODE
	  INTEGER(4), INTENT(OUT), OPTIONAL :: STATUS
	  OPTIONAL EPTR
	  TYPE(T_EXCEPTION_POINTERS) :: EBASE
	  POINTER(EPTR,EBASE)
	END SUBROUTINE
      END INTERFACE
!DEC$ ELSE
      INTEGER, PARAMETER :: FOR_POINTER_LEN = INT_PTR_KIND()
      INTEGER, PARAMETER :: FOR_PTR_SIZE   = FOR_POINTER_LEN
      TYPE T_EXCEPTION_POINTERS
         SEQUENCE
           INTEGER(FOR_PTR_SIZE) SIGINFO_PTR
           INTEGER(FOR_PTR_SIZE) SIGCONTEXT_PTR
      END TYPE

      INTERFACE
         SUBROUTINE TRACEBACKQQ(STRING, USER_EXIT_CODE, STATUS, EPTR)
         INTEGER, PARAMETER :: FOR_POINTER_LEN = INT_PTR_KIND()
         INTEGER, PARAMETER :: FOR_PTR_SIZE   = FOR_POINTER_LEN
         TYPE T_EXCEPTION_POINTERS
           SEQUENCE
             INTEGER(FOR_PTR_SIZE) SIGINFO_PTR
             INTEGER(FOR_PTR_SIZE) SIGCONTEXT_PTR
         END TYPE
!DEC$ ATTRIBUTES DEFAULT :: TRACEBACKQQ
         CHARACTER*(*), INTENT(IN), OPTIONAL :: STRING
         INTEGER(4), INTENT(IN), OPTIONAL :: USER_EXIT_CODE
         INTEGER(4), INTENT(OUT), OPTIONAL :: STATUS
         OPTIONAL EPTR
         TYPE(T_EXCEPTION_POINTERS) :: EBASE
         POINTER(EPTR,EBASE)
         END SUBROUTINE
      END INTERFACE

!DEC$ ENDIF

! -----------------------------------------------------------------
! Data Type Codes
! -----------------------------------------------------------------
      INTEGER(4), PARAMETER :: TY$REAL4   = 1
      INTEGER(4), PARAMETER :: TY$REAL8   = 2
      INTEGER(4), PARAMETER :: TY$CMPLX8  = 3
      INTEGER(4), PARAMETER :: TY$CMPLX16 = 4
! -----------------------------------------------------------------
! Random Numbers
! -----------------------------------------------------------------
      INTEGER(4), PARAMETER :: RND$TIMESEED = -1
! ----------------------------------------------------------------
! Configuration
! ----------------------------------------------------------------
      INTEGER(4), PARAMETER :: CFG$WINNT  = #00000001
 
!********************************************************************************************
!
INTEGER, PARAMETER :: FOR_DESCRIPTOR_MAX_RANK         = 7    
INTEGER, PARAMETER :: FOR_DESCRIPTOR_ARRAY_DEFINED    = 1
INTEGER, PARAMETER :: FOR_DESCRIPTOR_ARRAY_NODEALLOC  = 2
INTEGER, PARAMETER :: FOR_DESCRIPTOR_ARRAY_CONTIGUOUS = 4
    
TYPE FOR_DIMS_INFO
    INTEGER(4) :: LOWERBOUND
    INTEGER(4) :: UPPERBOUND
    INTEGER(4) :: STRIDE
END TYPE FOR_DIMS_INFO
    
! End additions for FOR_DESCRIPTOR_ASSIGN

INTERFACE
    SUBROUTINE FOR_DESCRIPTOR_ASSIGN(DP,BASE,SIZE,RESERVED,RANK,DIMS_INFO)
!DEC$ ATTRIBUTES DEFAULT, DECORATE, ALIAS:'for_descriptor_assign' :: FOR_DESCRIPTOR_ASSIGN
    INTEGER, POINTER :: DP(:)
!DEC$ ATTRIBUTES NO_ARG_CHECK :: DP
    INTEGER(INT_PTR_KIND()) :: BASE
!DEC$ ATTRIBUTES VALUE :: BASE
    INTEGER(4) :: SIZE
!DEC$ ATTRIBUTES VALUE :: SIZE
    INTEGER(4) :: RESERVED
!DEC$ ATTRIBUTES VALUE :: RESERVED
    INTEGER(4) :: RANK
!DEC$ ATTRIBUTES VALUE :: RANK
    
    TYPE FOR_DIMS_INFO
	INTEGER(4) :: LOWERBOUND
        INTEGER(4) :: UPPERBOUND
	INTEGER(4) :: STRIDE
    END TYPE FOR_DIMS_INFO
    
    TYPE(FOR_DIMS_INFO) :: DIMS_INFO(RANK)
    END SUBROUTINE
END INTERFACE


!DEC$ IF .NOT. DEFINED(__IFCORE_INCLUDE)
END MODULE ifcore
!DEC$ ENDIF

