Back to home page

EIC code displayed by LXR
 
 

    

File indexing completed on 2025-02-21 10:05:32 

0001 /*
0002  *  qp_exe_fun_double_math.h  --
0003  *
0004  *  Original: 13-Feb-1995 15:23
0005  *
0006  *  Author:   Maarten Ballintijn <Maarten.Ballintijn@cern.ch>
0007  *
0008  *  $Id$
0009  *
0010  *  $Log$
0011  *  Revision 1.7  1996/05/09 10:21:13  maartenb
0012  *  - Bugfix for two argument functions
0013  *
0014  *  Revision 1.6  1996/04/23 18:38:30  maartenb
0015  *  - Add RCS keywords
0016  *
0017  *
0018  */
0019 case FC_DSIN:
0020 {
0021     n = frame_size[framep];
0022     o1 = (Float64 *) &stack[frame[framep]];
0023     for ( ; n > 0 ; n--, o1++ ) {
0024         *o1 = sin( *o1 );
0025     }
0026     break;
0027 }
0028 
0029 case FC_DCOS:
0030 {
0031     n = frame_size[framep];
0032     o1 = (Float64 *) &stack[frame[framep]];
0033     for ( ; n > 0 ; n--, o1++ ) {
0034         *o1 = cos( *o1 );
0035     }
0036     break;
0037 }
0038 
0039 case FC_DSQRT:
0040 {
0041     n = frame_size[framep];
0042     o1 = (Float64 *) &stack[frame[framep]];
0043     for ( ; n > 0 ; n--, o1++ ) {
0044         if ( *o1 < 0. ) {
0045             sf_report( "Sqrt of negative number\n" );
0046             *errp = R_MATH_ERROR;
0047             running = FALSE;
0048         } else {
0049             *o1 = sqrt( *o1 );
0050         }
0051     }
0052     break;
0053 }
0054 
0055 case FC_DEXP:
0056 {
0057     n = frame_size[framep];
0058     o1 = (Float64 *) &stack[frame[framep]];
0059     for ( ; n > 0 ; n--, o1++ ) {
0060         *o1 = exp( *o1 );
0061     }
0062     break;
0063 }
0064 
0065 case FC_DLOG:
0066 {
0067     n = frame_size[framep];
0068     o1 = (Float64 *) &stack[frame[framep]];
0069     for ( ; n > 0 ; n--, o1++ ) {
0070         if ( *o1 <= 0. ) {
0071             sf_report( "Log of zero or negative number\n" );
0072             *errp = R_MATH_ERROR;
0073             running = FALSE;
0074         } else {
0075             *o1 = log( *o1 );
0076         }
0077     }
0078     break;
0079 }
0080 
0081 case FC_DATAN:
0082 {
0083     n = frame_size[framep];
0084     o1 = (Float64 *) &stack[frame[framep]];
0085     for ( ; n > 0 ; n--, o1++ ) {
0086         *o1 = atan( *o1 );
0087     }
0088     break;
0089 }
0090 
0091 case FC_DABS:
0092 {
0093     n = frame_size[framep];
0094     o1 = (Float64 *) &stack[frame[framep]];
0095     for ( ; n > 0 ; n--, o1++ ) {
0096         *o1 = fabs( *o1 );
0097     }
0098     break;
0099 }
0100 
0101 case FC_DLOG10:
0102 {
0103     n = frame_size[framep];
0104     o1 = (Float64 *) &stack[frame[framep]];
0105     for ( ; n > 0 ; n--, o1++ ) {
0106         if ( *o1 <= 0. ) {
0107             sf_report( "Log10 of zero or negative number\n" );
0108             *errp = R_MATH_ERROR;
0109             running = FALSE;
0110         } else {
0111             *o1 = log10( *o1 );
0112         }
0113     }
0114     break;
0115 }
0116 
0117 case FC_DTANH:
0118 {
0119     n = frame_size[framep];
0120     o1 = (Float64 *) &stack[frame[framep]];
0121     for ( ; n > 0 ; n--, o1++ ) {
0122         *o1 = tanh( *o1 );
0123     }
0124     break;
0125 }
0126 
0127 case FC_DACOS:
0128 {
0129     n = frame_size[framep];
0130     o1 = (Float64 *) &stack[frame[framep]];
0131     for ( ; n > 0 ; n--, o1++ ) {
0132         if ( *o1 < -1. || *o1 > 1.) {
0133             sf_report( "Acos domain error\n" );
0134             *errp = R_MATH_ERROR;
0135             running = FALSE;
0136         } else {
0137             *o1 = acos( *o1 );
0138         }
0139     }
0140     break;
0141 }
0142 
0143 case FC_DASIN:
0144 {
0145     n = frame_size[framep];
0146     o1 = (Float64 *) &stack[frame[framep]];
0147     for ( ; n > 0 ; n--, o1++ ) {
0148         if ( *o1 < -1. || *o1 > 1.) {
0149             sf_report( "Asin domain error\n" );
0150             *errp = R_MATH_ERROR;
0151             running = FALSE;
0152         } else {
0153             *o1 = asin( *o1 );
0154         }
0155     }
0156     break;
0157 }
0158 
0159 case FC_DTAN:
0160 {
0161     n = frame_size[framep];
0162     o1 = (Float64 *) &stack[frame[framep]];
0163     for ( ; n > 0 ; n--, o1++ ) {
0164         *o1 = tan( *o1 );
0165     }
0166     break;
0167 }
0168 
0169 case FC_DSINH:
0170 {
0171     n = frame_size[framep];
0172     o1 = (Float64 *) &stack[frame[framep]];
0173     for ( ; n > 0 ; n--, o1++ ) {
0174         *o1 = sinh( *o1 );
0175     }
0176     break;
0177 }
0178 
0179 case FC_DCOSH:
0180 {
0181     n = frame_size[framep];
0182     o1 = (Float64 *) &stack[frame[framep]];
0183     for ( ; n > 0 ; n--, o1++ ) {
0184         *o1 = cosh( *o1 );
0185     }
0186     break;
0187 }
0188 
0189 case FC_DMOD:
0190 {
0191     n = 1;
0192     if ( frame_size[framep] == 1 ) {
0193         o1_tmp = *(Float64 *) &stack[frame[framep]];
0194         o1 = &o1_tmp;
0195         o1_inc = 0;
0196     } else {
0197         o1 = (Float64 *) &stack[frame[framep]];
0198         o1_inc = 1;
0199         n = frame_size[framep];
0200     }
0201     if ( frame_size[framep-1] == 1 ) {
0202         o2_tmp = *(Float64 *) &stack[frame[framep-1]];
0203         o2 = &o2_tmp;
0204         o2_inc = 0;
0205     } else {
0206         o2 = (Float64 *) &stack[frame[framep-1]];
0207         o2_inc = 1;
0208         n = frame_size[framep-1];
0209     }
0210 
0211     POP_FRAME(2);
0212     NEW_FRAME(D_DOUBLE,n,r);
0213 
0214     o1 += o1_inc * (n-1);
0215     o2 += o2_inc * (n-1);
0216     r += (n-1);
0217     for ( ; n > 0 ; n-- ) {
0218         if ( *o2 == 0 ) {
0219             sf_report( "Mod with divisor of zero\n" );
0220             *errp = R_MATH_ERROR;
0221             running = FALSE;
0222         } else {
0223             *r = fmod( *o1, *o2 );
0224         }
0225         o1 -= o1_inc;
0226         o2 -= o2_inc;
0227         r -= 1;
0228     }
0229     break;
0230 }
0231 
0232 case FC_DATAN2:
0233 {
0234     n = 1;
0235     if ( frame_size[framep] == 1 ) {
0236         o1_tmp = *(Float64 *) &stack[frame[framep]];
0237         o1 = &o1_tmp;
0238         o1_inc = 0;
0239     } else {
0240         o1 = (Float64 *) &stack[frame[framep]];
0241         o1_inc = 1;
0242         n = frame_size[framep];
0243     }
0244     if ( frame_size[framep-1] == 1 ) {
0245         o2_tmp = *(Float64 *) &stack[frame[framep-1]];
0246         o2 = &o2_tmp;
0247         o2_inc = 0;
0248     } else {
0249         o2 = (Float64 *) &stack[frame[framep-1]];
0250         o2_inc = 1;
0251         n = frame_size[framep-1];
0252     }
0253 
0254     POP_FRAME(2);
0255     NEW_FRAME(D_DOUBLE,n,r);
0256 
0257     o1 += o1_inc * (n-1);
0258     o2 += o2_inc * (n-1);
0259     r += (n-1);
0260     for ( ; n > 0 ; n-- ) {
0261         *r = atan2( *o1, *o2 );
0262         o1 -= o1_inc;
0263         o2 -= o2_inc;
0264         r -= 1;
0265     }
0266     break;
0267 }
0268 
0269 case FC_DSIGN:
0270 {
0271     n = 1;
0272     if ( frame_size[framep] == 1 ) {
0273         o1_tmp = *(Float64 *) &stack[frame[framep]];
0274         o1 = &o1_tmp;
0275         o1_inc = 0;
0276     } else {
0277         o1 = (Float64 *) &stack[frame[framep]];
0278         o1_inc = 1;
0279         n = frame_size[framep];
0280     }
0281     if ( frame_size[framep-1] == 1 ) {
0282         o2_tmp = *(Float64 *) &stack[frame[framep-1]];
0283         o2 = &o2_tmp;
0284         o2_inc = 0;
0285     } else {
0286         o2 = (Float64 *) &stack[frame[framep-1]];
0287         o2_inc = 1;
0288         n = frame_size[framep-1];
0289     }
0290 
0291     POP_FRAME(2);
0292     NEW_FRAME(D_DOUBLE,n,r);
0293 
0294     o1 += o1_inc * (n-1);
0295     o2 += o2_inc * (n-1);
0296     r += (n-1);
0297     for ( ; n > 0 ; n-- ) {
0298         if ( *o2 > 0. ) {
0299             *r = fabs( *o1 );
0300         } else {
0301             *r = -fabs( *o1 );
0302         }
0303         o1 -= o1_inc;
0304         o2 -= o2_inc;
0305         r -= 1;
0306     }
0307     break;
0308 }
0309 
0310 case FC_DINT:
0311 {
0312     n = frame_size[framep];
0313     o1 = (Float64 *) &stack[frame[framep]];
0314     for ( ; n > 0 ; n--, o1++ ) {
0315         if ( fabs( *o1 ) > DOUBLE_INT_LIMIT ) {
0316             *o1 = *o1;
0317         } else if ( *o1 > 0. ) {
0318             *o1 = floor( *o1 );
0319         } else {
0320             *o1 = ceil( *o1 );
0321         }
0322     }
0323     break;
0324 }
0325 
0326 case FC_DFRAC:
0327 {
0328     n = frame_size[framep];
0329     o1 = (Float64 *) &stack[frame[framep]];
0330     for ( ; n > 0 ; n--, o1++ ) {
0331         if ( fabs( *o1 ) < DOUBLE_INT_LIMIT ) {
0332             *o1 = fmod( (double) *o1, (double) 1. );
0333         } else {
0334             *o1 = 0;
0335         }
0336     }
0337     break;
0338 }
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated by the 2.3.7 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!