// -*- C++ -*-
#ifndef XM_FINTRINSICS_H_

// C++ versions of common Fortran intrinsics, to ease primitive conversion.
//
// Author:  Based on X-Midas 4.6.1 fintrinsics.h
// 2020-06-26 Major update for GFC support - contributed by Duy Huang

// System includes
#include <cmath>    // std::floor, std::ceil

// Midas includes
#include "cdefs.h"  // int_*, real_*

// ///// Functions that duplicate needed Fortran elemental functions
// ///// for integer truncation and rounding

// Truncate the fractional part of the real value passed in, returning
// an integer.

inline int_4 INT(real_4 x) { return int_4(x); }
inline int_4 INT(real_8 x) { return int_4(x); }
inline int_4 JINT(real_4 x) { return int_4(x); }

inline int_2 IINT(real_4 x) { return int_2(x); }
inline int_2 IIFIX(real_4 x) { return int_2(x); }
inline int_2 HFIX(real_4 x) { return int_2(x); }

inline int_4 IFIX(real_4 x) { return int_4(x); }
inline int_4 JFIX(real_4 x) { return int_4(x); }
inline int_4 JFIX(real_8 x) { return int_4(x); }

inline int_8 KIFIX(real_4 x) { return int_8(x); }
inline int_8 KINT(real_4 x) { return int_8(x); }

inline int_2 IIDINT(real_8 x) { return int_2(x); }
inline int_4 IDINT(real_8 x) { return int_4(x); }
inline int_4 JIDINT(real_8 x) { return int_4(x); }
inline int_8 KIDINT(real_8 x) { return int_8(x); }


// Truncate the fractional part of the real value passed in, returning
// a real number.

inline real_4 AINT(real_4 x) { return (x > 0) ? std::floor(x) : std::ceil(x); }
inline real_8 DINT(real_8 x) { return (x > 0) ? std::floor(x) : std::ceil(x); }


// Round the real value passed in to the nearest integer, returning an
// integer.  The nearest integer to 12.5 is 13, the nearest integer to
// -12.5 is -13.

#ifdef _GFC
// GFORTRAN conforms to the behavior of the math library.  To keep these
// functions consistent we use the same math functions GFC does.
inline int_2 ININT(real_4 x) { return int_2(lroundf(x)); }
inline int_4 NINT (real_4 x) { return int_4(lroundf(x)); }
inline int_4 JNINT(real_4 x) { return int_4(lroundf(x)); }
inline int_8 KNINT(real_4 x) { return int_8(lroundf(x)); }

inline int_2 IIDNNT(real_8 x) { return int_2(lround(x)); }
inline int_4 IDNINT(real_8 x) { return int_4(lround(x)); }
inline int_4 JIDNNT(real_8 x) { return int_4(lround(x)); }
inline int_8 KIDNNT(real_8 x) { return int_8(lround(x)); }
#else
inline int_2 ININT(real_4 x) { return  x > 0 ?
				 int_2(x + 0.5) : int_2(x - 0.5); }
inline int_4 NINT(real_4 x) { return  x > 0 ?
				int_4(x + 0.5) : int_4(x - 0.5); }
inline int_4 JNINT(real_4 x) { return  x > 0 ?
				 int_4(x + 0.5) : int_4(x - 0.5); }
inline int_8 KNINT(real_4 x) { return  x > 0 ?
				 int_8(x + 0.5) : int_8(x - 0.5); }

inline int_2 IIDNNT(real_8 x) { return  x > 0 ?
				  int_2(x + 0.5) : int_2(x - 0.5); }
inline int_4 IDNINT(real_8 x) { return  x > 0 ?
				  int_4(x + 0.5) : int_4(x - 0.5); }
inline int_4 JIDNNT(real_8 x) { return  x > 0 ?
				  int_4(x + 0.5) : int_4(x - 0.5); }
inline int_8 KIDNNT(real_8 x) { return  x > 0 ?
				  int_8(x + 0.5) : int_8(x - 0.5); }
#endif


// Round the real value passed in to the nearest integer, returning a
// real number.  The nearest integer to 12.5 is 13, the nearest
// integer to -12.5 is -13.

inline real_4 ANINT(real_4 x)
{
  return (x >= 0) ? std::floor(x + 0.5f) : std::ceil(x - 0.5f);
}

inline real_8 DNINT(real_8 x)
{
  return (x >= 0) ? std::floor(x + 0.5) : std::ceil(x - 0.5);
}

// Find the ceiling of the real value passed in, returning a
// real number.  The ceiling of 12.5 is 13.0, the ceiling of -12.5
// is -12.0.
inline real_4 CEILING(real_4 x)
{
  return std::ceil(x);
}

inline real_8 CEILING(real_8 x)
{
  return std::ceil(x);
}

// Find the floor of the real value passed in, returning a
// real number.  The floor of 12.5 is 12.0, the floor of -12.5
// is -13.0.
inline real_4 FLOOR(real_4 x)
{
  return std::floor(x);
}

inline real_8 FLOOR(real_8 x)
{
  return std::floor(x);
}

inline bool BTEST(int_4 x, int_4 y)
{
  int_4 tpow = (1 << y);
  return (x & tpow) == tpow;
}

inline int_4 IBSET(int_4 bitv, int_4 which_bit)
{
  return bitv | (1 << which_bit);
}

inline int_4 IBCLR(int_4 bitv, int_4 which_bit)
{
  int_4 mask = 1 << which_bit;
  return bitv & (~mask);
}


#define XM_FINTRINSICS_H_
#endif // XM_FINTRINSICS_H_
