include/ntuple/qp_eval_fun_single_math.h

0001 /*
0002  *  qp_eval_fun_single_math.h  --
0003  *  Implement the math functions for single precision.
0004  *
0005  *  Original:  8-Jan-1995 15:19
0006  *
0007  *  Author:   Maarten Ballintijn <Maarten.Ballintijn@cern.ch>
0008  *
0009  *  $Id$
0010  *
0011  *  $Log$
0012  *  Revision 1.9  1996/05/13 08:19:07  maartenb
0013  *  - Removed remaining warning message about pow() operator.
0014  *
0015  *  Revision 1.8  1996/05/13 07:53:55  maartenb
0016  *  - Fix domain checking for log() and log10().
0017  *
0018  *  Revision 1.7  1996/04/23 18:38:20  maartenb
0019  *  - Add RCS keywords
0020  *
0021  *
0022  */
0023     case FC_FSIN:
0024         r->u.fval = sin( valv[0]->u.fval );
0025         r->d = dim_new( D_FLOAT );
0026         break;
0027
0028     case FC_FCOS:
0029         r->u.fval = cos( valv[0]->u.fval );
0030         r->d = dim_new( D_FLOAT );
0031         break;
0032
0033     case FC_FSQRT:
0034         if ( valv[0]->u.fval >= 0 ) {
0035             r->u.fval = sqrt( valv[0]->u.fval );
0036         } else {
0037             sf_report( "Sqrt of negative number\n" );
0038             *err = R_MATH_ERROR;
0039             r->u.fval = 0;
0040         }
0041         r->d = dim_new( D_FLOAT );
0042         break;
0043
0044     case FC_FEXP:
0045         r->u.fval = exp( valv[0]->u.fval );
0046         r->d = dim_new( D_FLOAT );
0047         break;
0048
0049     case FC_FLOG:
0050         if ( valv[0]->u.fval > 0 ) {
0051             r->u.fval = log( valv[0]->u.fval );
0052         } else {
0053             sf_report( "Log() of non positive number\n");
0054             *err = R_MATH_ERROR;
0055             r->u.fval = 0;
0056         }
0057         r->d = dim_new( D_FLOAT );
0058         break;
0059
0060     case FC_FATAN:
0061         r->u.fval = atan( valv[0]->u.fval );
0062         r->d = dim_new( D_FLOAT );
0063         break;
0064
0065     case FC_FABS:
0066         r->u.fval =  fabs( valv[0]->u.fval );
0067         r->d = dim_new( D_FLOAT );
0068         break;
0069
0070     case FC_FLOG10:
0071         if ( valv[0]->u.fval > 0 ) {
0072             r->u.fval = log10( valv[0]->u.fval );
0073         } else {
0074             sf_report( "Log10() of non positive number\n");
0075             *err = R_MATH_ERROR;
0076             r->u.fval = 0;
0077         }
0078         r->d = dim_new( D_FLOAT );
0079         break;
0080
0081     case FC_FTANH:
0082         r->u.fval = tanh( valv[0]->u.fval );
0083         r->d = dim_new( D_FLOAT );
0084         break;
0085
0086     case FC_FACOS:
0087     {
0088         Float32     x;
0089
0090         x = valv[0]->u.fval;
0091
0092         if ( (x < 1.) && (x >-1.) ) {
0093             r->u.fval = acos( x );
0094         } else {
0095             sf_report( "Acos domain error\n" );
0096             *err = R_MATH_ERROR;
0097             r->u.fval = 0;
0098         }
0099         r->d = dim_new( D_FLOAT );
0100         break;
0101
0102     }
0103
0104     case FC_FASIN:
0105     {
0106         Float32     x;
0107
0108         x = valv[0]->u.fval;
0109
0110         if ( (x < 1.) && (x >-1.) ) {
0111             r->u.fval = asin( x );
0112         } else {
0113             sf_report( "Asin domain error\n" );
0114             *err = R_MATH_ERROR;
0115             r->u.fval = 0;
0116         }
0117         r->d = dim_new( D_FLOAT );
0118         break;
0119
0120     }
0121
0122     case FC_FTAN:
0123         r->u.fval = tan( valv[0]->u.fval );
0124         r->d = dim_new( D_FLOAT );
0125         break;
0126
0127     case FC_FSINH:
0128         r->u.fval = sinh( valv[0]->u.fval );
0129         r->d = dim_new( D_FLOAT );
0130         break;
0131
0132     case FC_FCOSH:
0133         r->u.fval = cosh( valv[0]->u.fval );
0134         r->d = dim_new( D_FLOAT );
0135         break;
0136
0137
0138     case FC_FMOD:
0139         if ( valv[1]->u.fval != 0 ) {
0140             r->u.fval = fmod( valv[0]->u.fval, valv[1]->u.fval );
0141         } else {
0142             sf_report( "Mod with divisor of zero\n" );
0143             *err = R_MATH_ERROR;
0144             r->u.fval = 0;
0145         }
0146         r->d = dim_new( D_FLOAT );
0147         break;
0148
0149     case FC_FATAN2:
0150         r->u.fval = atan2( valv[0]->u.fval, valv[1]->u.fval );
0151         r->d = dim_new( D_FLOAT );
0152         break;
0153
0154     case FC_FSIGN:
0155         if ( valv[1]->u.fval > 0. ) {
0156             r->u.fval = fabs(valv[0]->u.fval);
0157         } else {
0158             r->u.fval = -fabs(valv[0]->u.fval);
0159         }
0160         r->d = dim_new( D_FLOAT );
0161         break;
0162
0163
0164     case FC_FINT:
0165         if ( fabs(valv[0]->u.fval) > FLOAT_INT_LIMIT ) {
0166             r->u.fval = valv[0]->u.fval;
0167         } else if ( valv[0]->u.fval > 0. ) {
0168             r->u.fval = floor( valv[0]->u.fval );
0169         } else {
0170             r->u.fval = ceil( valv[0]->u.fval );
0171         }
0172         r->d = dim_new( D_FLOAT );
0173         break;
0174
0175     case FC_FFRAC:
0176         if ( fabs(valv[0]->u.fval)  < FLOAT_INT_LIMIT ) {
0177             r->u.fval = fmod( (double) valv[0]->u.fval, (double) 1. );
0178         } else {
0179             r->u.fval = 0.;
0180         }
0181         r->d = dim_new( D_FLOAT );
0182         break;
0183
0184