include/ntuple/qp_eval_fun_double_math.h

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