1 /* 2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab 3 * Copyright (C) 2008-2008 - DIGITEO - Antoine ELIAS 4 * 5 * Copyright (C) 2012 - 2016 - Scilab Enterprises 6 * 7 * This file is hereby licensed under the terms of the GNU GPL v2.0, 8 * pursuant to article 5.3.4 of the CeCILL v.2.1. 9 * This file was originally licensed under the terms of the CeCILL v2.1, 10 * and continues to be available under such terms. 11 * For more information, see the COPYING file which you should have received 12 * along with this program. 13 * 14 */ 15 16 #ifndef __COMMON_H__ 17 #define __COMMON_H__ 18 19 #include "core_math.h" 20 21 #include "abs.h" 22 #include "cos.h" 23 #include "exp.h" 24 #include "log.h" 25 #include "pythag.h" 26 #include "sin.h" 27 #include "tan.h" 28 #include "sqrt.h" 29 #include "sign.h" 30 31 /* 32 'E' or 'e', DLAMCH := eps ( relative machine precision ) 33 'S' or 's , DLAMCH := sfmin ( safe minimum, such that 1/sfmin does not overflow ) 34 'B' or 'b', DLAMCH := base ( base of the machine ) 35 'P' or 'p', DLAMCH := eps*base ( eps*base ) 36 'N' or 'n', DLAMCH := t ( number of (base) digits in the mantissa ) 37 'R' or 'r', DLAMCH := rnd ( 1.0 when rounding occurs in addition, 0.0 otherwis ) 38 'M' or 'm', DLAMCH := emin ( minimum exponent before (gradual) underflow ) 39 'U' or 'u', DLAMCH := rmin ( underflow threshold - base**(emin-1) ) 40 'L' or 'l', DLAMCH := emax ( largest exponent before overflow ) 41 'O' or 'o', DLAMCH := rmax ( overflow threshold - (base**emax)*(1-eps) ) 42 */ 43 44 #include <stdlib.h> 45 #include "machine.h" 46 47 #include "doublecomplex.h" 48 #include "numericconstants_interface.h" 49 50 #ifdef __cplusplus 51 #define isRealZero(x) (fabs(static_cast<double>(x)) <= nc_eps()) 52 #define ZeroIsZero(x) (fabs(static_cast<double>(x)) <= nc_eps() ? 0 : static_cast<double>(x)) 53 #else 54 #define isZero(x) (fabs((double)x) <= nc_eps()) 55 #define ZeroIsZero(x) (fabs((double)x) <= nc_eps() ? 0 : (double)x) 56 #endif 57 58 #define getUnderflowThreshold() nc_double_min() 59 #define getOverflowThreshold() nc_double_max() 60 #define isEqual(x,y) fabs((double)x - (double)y) <= nc_eps() 61 62 extern double C2F(dlamch) (const char *_pszCommand, unsigned long int); 63 extern double C2F(logp1) (double *_pdblVal); 64 65 // dger performs the rank 1 operation 66 extern int C2F(dger) (int *M, int *N, double* alpha, double* DX, int* incx, double* DY, int* incy, double *DA, int *lda); 67 extern int C2F(dgemm) (char *_pstTransA, char *_pstTransB, int *_piN, int *_piM, int *_piK, double *_pdblAlpha, double *_pdblA, int *_piLdA, 68 double *_pdblB, int *_piLdB, double *_pdblBeta, double *_pdblC, int *_piLdC); 69 extern int C2F(zgemm) (char *_pstTransA, char *_pstTransB, int *_piN, int *_piM, int *_piK, double *_pdblAlpha, double *_pdblA, int *_piLdA, 70 double *_pdblB, int *_piLdB, double *_pdblBeta, double *_pdblC, int *_piLdC); 71 extern int C2F(dswap) (int *_piSize, double *_pdblX, int *_piIncX, double *_pdblY, int *_piIncY); 72 extern double C2F(dasum) (int *_iSize, double *_pdbl, int *_iInc); 73 extern int C2F(dcopy) (int *_iSize, double *_pdblSrc, int *_piIncSrc, double *_pdblDest, int *_piDest); 74 extern int C2F(dscal) (int *_iSize, double *_pdblVal, double *_pdblDest, int *_iInc); 75 extern int C2F(zscal) (int *_iSize, doublecomplex * _pdblVal, doublecomplex * _pdblDest, int *_iInc); 76 extern int C2F(dset) (int *_iSize, double *_pdblVal, double *_pdblDest, int *_iInc); 77 extern double C2F(dlange) (char *_pstNorm, int *_piM, int *_piN, double *_pdblA, int *_piLdA, double *_pdblWork); 78 extern int C2F(dlacpy) (char *_pstUplo, int *piM, int *_piN, double *_pdblA, int *_piLdA, double *_pdblB, int *_piLdB); 79 extern int C2F(dtrcon) (char *_pstNORM, char*uplo, char *diag, int *_piN, double *_pdblA, int *_piLDA, double *_pdblRCOND, double *_pdblWORK, 80 int *_piIWORK, int *_piINFO); 81 extern int C2F(dgecon) (char *_pstNORM, int *_piN, double *_pdblA, int *_piLDA, double *_pdblANORM, double *_pdblRCOND, double *_pdblWORK, 82 int *_piIWORK, int *_piINFO); 83 extern int C2F(dgelsy1) (int *_piM, int *_piN, int *_piNRHS, double *_pdblA, int *_piLDA, double *_pdblB, int *_piLDB, int *_piJPVT, 84 double *_pdblRCOND, int *_piRANK, double *_pdblWORK, int *_piLWORK, int *_piINFO); 85 extern double C2F(zlange) (char *_pstNORM, int *_piM, int *_piN, double *_pdblA, int *_piLDA, double *_pdblWORK); 86 extern int C2F(zlacpy) (char *_pstUPLO, int *_piM, int *_piN, double *_pdblA, int *_piLDA, double *_pdblB, int *_piLDB); 87 extern void C2F(zgecon) (char *_pstNORM, int *_piN, doublecomplex * _pdblA, int *_piLDA, double *_pdblANORM, double *_pdblRNORM, 88 doublecomplex * _pdblWORK, double *_pdblRWORD, int *_piINFO); 89 extern int C2F(ztrcon) (char *_pstNORM, char*uplo, char *diag, int *_piN, doublecomplex *_pdblA, int *_piLDA, double *_pdblRCOND, double *_pdblWORK, 90 double *_pdblRWORD, int *_piINFO); 91 extern int C2F(zgelsy1) (int *_piM, int *_piN, int *_piNRHS, doublecomplex * pdblA, int *_piLDA, doublecomplex * _pdblB, int *_piLDB, int *_piJPVT, 92 double *_pdblRCOND, int *_piRANK, doublecomplex * _pdblWORK, int *_piLWORK, double *_pdblRWORK, int *_piINFO); 93 extern double C2F(ddot) (int *_ipSize, double *_pdblVal1, int *_piInc1, double *_pdblVal2, int *_piInc2); 94 extern void C2F(wmul) (double *ar, double *ai, double *br, double *bi, double *cr, double *ci); 95 extern void C2F(wdiv) (double *ar, double *ai, double *br, double *bi, double *cr, double *ci); 96 extern void C2F(dad) (double *a, int *na, int *i1, int *i2, int *j1, int *j2, double *r, int *isw); 97 extern int C2F(entier) (int *_iSize, double *_pdbl, int *_pi); 98 extern int C2F(simple) (int *_iSize, double *_pdbl, float *_pf); 99 extern double C2F(nearfloat) (double*, double*); 100 extern int C2F(daxpy)(int* N, double* DA, double* DX, int* INCX, double* DY, int* INCY); 101 extern int C2F(zaxpy)(int* N, doublecomplex* ZA, doublecomplex* ZX, int* INCX, doublecomplex* ZY, int* INCY); 102 extern int C2F(dsymv)(char* UPLO, int* N, double* ALPHA, double* A, int* LDA, double* X, int* INCX, double* BETA, double* Y, int* INCY); 103 104 // dgemv performs matrix-vector operations 105 extern int C2F(dgemv) (char* trans, int* m, int* n, double* alpha, double* A, int* lda, 106 double* x, int* incx, double* beta, double* y, int* incy); 107 extern int C2F(zgemv) (char* trans, int* m, int* n, doublecomplex* alpha, doublecomplex* A, 108 int* lda, doublecomplex* x, int* incx, doublecomplex* beta, doublecomplex* y, int* incy); 109 110 // dgetrf computes an LU factorization of a general M by N matrix A (double) using partial pivoting with row interchanges 111 extern int C2F(dgetrf)(int* m, int* n, double* A, int* lda, int* ipiv, int* info); 112 113 // dgetrs solves a linear system using the factors computed by dgetrf 114 extern int C2F(dgetrs) (char* trans, int* n, int* nrhs, double* A, int *lda, int* ipiv, double* B, int* ldb, int* info); 115 116 // dpotrf computes the cholesky factorization of a real symmetric positive definite matrix A 117 extern int C2F(dpotrf)(char* uplo, int* n, double* A, int* lda, int* info); 118 119 // zpotrf computes the cholesky factorization of a real hermitian positive definite matrix A 120 extern int C2F(zpotrf)(char* uplo, int* n, doublecomplex* A, int* lda, int* info); 121 122 // dtrsm solves a triangular linear system 123 extern int C2F(dtrsm) (char* side, char* uplo, char* trans, char* diag, int* m, int* n, double* alpha, double* A, int* lda, double* B, int* ldb); 124 // ztrsm solve a triangular linear system 125 extern int C2F(ztrsm) (char* side, char* uplo, char* trans, char* diag, int* m, int* n, doublecomplex* alpha, doublecomplex* A, int* lda, doublecomplex* B, int* ldb); 126 // dsyrk does a rank k symmetric update 127 extern int C2F(dsyrk) (char* uplo, char* trans, int* n, int* k, double* alpha, 128 double* A, int* lda, double* beta, double* B, int* ldb); 129 // dsyr performs the symmetric rank 1 operation 130 extern int C2F(dsyr) (char* uplo, int* n, double* alpha, double *x, int* incx, double* A, int* lda); 131 // ztrmm multiply by a triangular matrix 132 extern int C2F(ztrmm) (char* side, char* uplo, char* trans, char* diag, int* m, int* n, doublecomplex* alphac, 133 doublecomplex* A, int* lda, doublecomplex* B, int* ldb); 134 // ztrmv multiply a vector by a triangular matrix 135 extern int C2F(ztrmv) (char* uplo, char* trans, char* diag, int* n, doublecomplex* A, int* lda, doublecomplex* x, int* incx); 136 // dtrmv multiply a vector by a triangular matrix 137 extern int C2F(dtrmv) (char* uplo, char* trans, char* diag, int* n, double* A, int* lda, double* x, int* incx); 138 // zgetrs solves a linear system using the factors computed by zgetrf 139 extern int C2F(zgetrs) (char *_pstTRANS, int *_piN, int *_piNRHS, doublecomplex *_pdblA, int *_piLDA, int *_piIPIV, doublecomplex *_pdblB, int *_piLDB, 140 int *_piINFO); 141 // zgetrf computes an LU factorization of a general M by N matrix A (complex*16) using partial pivoting with row interchanges 142 extern int C2F(zgetrf) (int *_piM, int *_piN, doublecomplex *_pdblA, int *_piLDA, int *_piIPIV, int *_piINFO); 143 144 #endif /* __COMMON_H__ */ 145