1: /*
  2:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  3:    SLEPc - Scalable Library for Eigenvalue Problem Computations
  4:    Copyright (c) 2002-, Universitat Politecnica de Valencia, Spain

  6:    This file is part of SLEPc.
  7:    SLEPc is distributed under a 2-clause BSD license (see LICENSE).
  8:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  9: */
 10: /*
 11:    SLEPc mathematics include file. Defines basic operations and functions.
 12:    This file is included by slepcsys.h and should not be used directly.
 13: */

 15: #pragma once

 17: /* SUBMANSEC = Sys */

 19: /*
 20:     Default tolerance for the different solvers, depending on the precision
 21: */
 22: #if PetscDefined(USE_REAL_SINGLE)
 23: #  define SLEPC_DEFAULT_TOL   1e-5
 24: #elif PetscDefined(USE_REAL_DOUBLE)
 25: #  define SLEPC_DEFAULT_TOL   1e-8
 26: #elif PetscDefined(USE_REAL___FLOAT128)
 27: #  define SLEPC_DEFAULT_TOL   1e-16
 28: #elif PetscDefined(USE_REAL___FP16)
 29: #  define SLEPC_DEFAULT_TOL   1e-2
 30: #endif

 32: static inline PetscReal SlepcDefaultTol(PetscReal tol)
 33: {
 34:   return tol == (PetscReal)PETSC_DETERMINE ? SLEPC_DEFAULT_TOL : tol;
 35: }

 37: /*@
 38:    SlepcAbs - Returns $\sqrt{x^2+y^2}$, taking care not to cause unnecessary
 39:    overflow. It is based on LAPACK's `DLAPY2`.

 41:    Not Collective

 43:    Input parameters:
 44: +  x - the first real number
 45: -  y - the second real number

 47:    Output parameter:
 48: .  return - the result

 50:    Fortran Note:
 51:    This function is not available from Fortran.

 53:    Level: developer
 54: @*/
 55: static inline PetscReal SlepcAbs(PetscReal x,PetscReal y)
 56: {
 57:   PetscReal w,z,t,xabs=PetscAbs(x),yabs=PetscAbs(y);

 59:   w = PetscMax(xabs,yabs);
 60:   z = PetscMin(xabs,yabs);
 61:   if (PetscUnlikely(z == PetscRealConstant(0.0))) return w;
 62:   t = z/w;
 63:   return w*PetscSqrtReal(PetscRealConstant(1.0)+t*t);
 64: }

 66: /*MC
 67:    SlepcAbsEigenvalue - Returns the absolute value of a complex number given
 68:    its real and imaginary parts.

 70:    Synopsis:
 71: #include <slepcmath.h>
 72:    PetscReal SlepcAbsEigenvalue(PetscScalar x, PetscScalar y)

 74:    Not Collective

 76:    Input parameters:
 77: +  x - the real part of the complex number
 78: -  y - the imaginary part of the complex number

 80:    Notes:
 81:    This function computes $\sqrt{x^2+y^2}$, taking care not to cause unnecessary
 82:    overflow. It is based on LAPACK's `DLAPY2`.

 84:    In complex scalars, only the first argument is used, i.e., the result is $|x|$.

 86:    Fortran Note:
 87:    This function is not available from Fortran.

 89:    Level: developer

 91: .seealso: `PetscAbsScalar()`
 92: M*/
 93: #if !PetscDefined(USE_COMPLEX)
 94: #define SlepcAbsEigenvalue(x,y) SlepcAbs((x),(y))
 95: #else
 96: #define SlepcAbsEigenvalue(x,y) PetscAbsScalar(x)
 97: #endif

 99: /*@
100:    SlepcSetFlushToZero - Set the FTZ flag in floating-point arithmetic.

102:    Logically Collective

104:    Output Parameter:
105: .  state - the value before setting the flag

107:    Level: developer

109: .seealso: `SlepcResetFlushToZero()`
110: @*/
111: static inline PetscErrorCode SlepcSetFlushToZero(unsigned int *state)
112: {
113:   PetscFunctionBegin;
114: #if PetscDefined(HAVE_XMMINTRIN_H) && defined(_MM_FLUSH_ZERO_ON) && defined(__SSE__)
115:   *state = _MM_GET_FLUSH_ZERO_MODE();
116:   _MM_SET_FLUSH_ZERO_MODE(_MM_FLUSH_ZERO_ON);
117: #else
118:   *state = 0;
119: #endif
120:   PetscFunctionReturn(PETSC_SUCCESS);
121: }

123: /*@
124:    SlepcResetFlushToZero - Reset the FTZ flag in floating-point arithmetic.

126:    Logically Collective

128:    Input Parameter:
129: .  state - the value to be restored

131:    Level: developer

133: .seealso: `SlepcResetFlushToZero()`
134: @*/
135: static inline PetscErrorCode SlepcResetFlushToZero(unsigned int *state)
136: {
137:   PetscFunctionBegin;
138: #if PetscDefined(HAVE_XMMINTRIN_H) && defined(_MM_FLUSH_ZERO_MASK) && defined(__SSE__)
139:   _MM_SET_FLUSH_ZERO_MODE(*state & _MM_FLUSH_ZERO_MASK);
140: #else
141:   *state = 0;
142: #endif
143:   PetscFunctionReturn(PETSC_SUCCESS);
144: }