statistics.c

00001 /******************************************************************************
00002 *******************************************************************************
00003 *               European Southern Observatory
00004 *             VLTI MIDI Data Reduction Software
00005 *
00006 * Module name:  statistics.c
00007 * Description:  Contains routines for all statistical computations
00008 *
00009 * History:      
00010 * 22-Dec-03     (csabet) Created
00011 *******************************************************************************
00012 ******************************************************************************/
00013 
00014 /******************************************************************************
00015 *   Compiler directives
00016 ******************************************************************************/
00017 
00018 /******************************************************************************
00019 *   Include files
00020 ******************************************************************************/
00021 #include <math.h>
00022 #include <stdio.h>
00023 #include <cpl.h>
00024 #include <stdlib.h>
00025 #include "errorHandling.h"
00026 #include "midiGlobal.h"
00027 #include "diagnostics.h"
00028 #include "statistics.h"
00029 
00030 /**********************************************************
00031 *   Constant definitions
00032 **********************************************************/
00033 #define    ITMAX    (100)
00034 #define EPS        (3.0e-7)
00035 #define FPMIN     (1.0e-30)
00036 static float sqrarg;
00037 #define SQR(a) ((sqrarg=(a)) == 0.0 ? 0.0 : sqrarg*sqrarg)
00038 
00039 /**********************************************************
00040 *   Global Variables 
00041 **********************************************************/
00042 
00043 /*============================ C O D E    A R E A ===========================*/
00044 
00045 
00046 
00047 
00048 /******************************************************************************
00049 *               European Southern Observatory
00050 *            VLTI MIDI Data Reduction Software
00051 *
00052 * Module name:    makeStats
00053 * Input/Output:    See function arguments to avoid duplication
00054 * Description:
00055 *
00056 * History:
00057 * 25-Aug-04        (JM) Created
00058 * 16-Jan-05        (csabet) Cleaned up and integrated into MIDI pipeline
00059 ******************************************************************************/
00060 void   makeStats(
00061     float    *data,
00062     int        numdata,
00063     float    *mean,
00064     float    *rms)
00065 {
00066 
00067     /*  Local Declarations
00068     --------------------*/
00069     const char        routine[] = "makeStats";
00070     float accum = 0.F;
00071     float accum2 = 0.F;
00072     int i;
00073 
00074     /*  Algorithm
00075     -----------*/
00076     if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking      routine   '%s' \n", routine);
00077     if (diagnostic > 4) fprintf (midiReportPtr, "Invoking      routine   '%s' \n", routine);
00078     *rms = 0.F;        // Usually changed below
00079     *mean = 0.F;    // Usually changed below
00080     if (numdata < 1) return;    // just in case
00081     for (i = 0; i < numdata; i++)
00082     {
00083         accum += data[i];
00084         accum2 += data[i] * data[i];
00085     }
00086     *mean = accum/numdata;
00087     if (numdata < 2) return;    // just in case
00088     accum2 -= *mean * *mean * numdata;
00089     if (accum2 < 0.F)  return;
00090     *rms = sqrt(accum2/((float) (numdata-1)));
00091     
00092     return;
00093 }
00094 /*****************************************************************************/
00095 
00096 
00097 /******************************************************************************
00098 *               European Southern Observatory
00099 *            VLTI MIDI Data Reduction Software
00100 *
00101 * Module name:    removeDc
00102 * Input/Output:    See function arguments to avoid duplication
00103 * Description:    Removes DC from the input array. The arrays are
00104 *                1D linear. Hence the routine can be used for linear
00105 *                images
00106 *
00107 * History:
00108 * 19-May-06        (csabet) Created
00109 ******************************************************************************/
00110 void removeDc (
00111     int        size,        // In: Size of the image
00112     float    *inArray,    // In: Input array
00113     float    *outArray)    // Ou: Output array with DC removed
00114 {
00115 
00116     /*  Local Declarations
00117     --------------------*/
00118     const char    routine[] = "removeDc";
00119     int         i;
00120     float        max;
00121     
00122     /*  Algorithm
00123     -----------*/
00124     if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking      routine   '%s' \n", routine);
00125     if (diagnostic > 4) fprintf (midiReportPtr, "Invoking      routine   '%s' \n", routine);
00126 
00127     max = 0.0;
00128     for (i = 0; i < size; i++)
00129     {
00130         if (inArray[i] > max) max = inArray[i];
00131     }
00132     for (i = 0; i < size; i++)
00133         outArray[i] = inArray[i] - max;
00134     
00135     return;
00136 }
00137 /*****************************************************************************/
00138 
00139 
00140 /******************************************************************************
00141 *               European Southern Observatory
00142 *            VLTI MIDI Data Reduction Software 
00143 *
00144 * Module name:  signalMean
00145 * Input/Output: See function arguments to avoid duplication
00146 * Description:  Computes mean of a signal
00147 * History:      
00148 * 22-Dec-03     (csabet) Created
00149 ******************************************************************************/
00150 float signalMean (        /*    Ou:    Mean of the signal */
00151     float    *signal,    /*    In:    Pointer to an array containing the signal */
00152     int        start,        /*    In:    Start point */
00153     int        end)        /*    In:    End point */
00154 {
00155 
00156     /*  Local Declarations
00157     --------------------*/
00158     const char    routine[] = "signalMean";
00159     float        mean = 0.0;
00160     int            i;
00161     
00162     /*  Algorithm
00163     -----------*/
00164     if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking      routine   '%s' \n", routine);
00165     if (diagnostic > 4) fprintf(midiReportPtr, "Invoking      routine   '%s' \n", routine);
00166     
00167     for (i = start; i < end; i++) 
00168         mean += signal[i];
00169     
00170     if ((end - start) != 0)    /*    Singularity check */
00171         mean /= ((float) (end - start));
00172     else
00173         mean /= ((float) (VERY_SMALL_INT));
00174         
00175 
00176     return (mean);
00177 }
00178 /*****************************************************************************/
00179 
00180 
00181 /******************************************************************************
00182 *               European Southern Observatory
00183 *            VLTI MIDI Data Reduction Software 
00184 *
00185 * Module name:  signalPeak
00186 * Input/Output: See function arguments to avoid duplication
00187 * Description:  Computes peak and its index
00188 * History:      
00189 * 11-Apr-06     (csabet) Created
00190 ******************************************************************************/
00191 float signalPeak (        //    Ou:    Peak of the signal
00192     float    *signal,    //    In:    Pointer to an array containing the signal
00193     int        start,        //    In:    Begin of array section
00194     int        end,        //    In: End of array section
00195     int        *peakIndex)    //    Ou:    Peak index
00196 {
00197  
00198     //    Local Declarations
00199     //    ------------------
00200     const char    routine[] = "signalPeak";
00201     float        peak, *sigPtr;
00202     int            i, length;
00203     
00204     /*  Algorithm
00205     -----------*/
00206     if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking      routine   '%s' \n", routine);
00207     if (diagnostic > 4) fprintf(midiReportPtr, "Invoking      routine   '%s' \n", routine);
00208     
00209     //    Singularity check
00210     length = end - start;
00211     if (length <= 0) midiReportError (midiReportPtr, routine, __FILE__, __LINE__, "Invalid length");
00212  
00213     peak = 0.0;
00214     *peakIndex = 0;
00215     sigPtr = signal + start;
00216     for (i = 0; i < length; i++)
00217     {
00218         if (*sigPtr > peak)
00219         {
00220             peak = *sigPtr;
00221             *peakIndex = i;
00222         }
00223         sigPtr++;
00224     } 
00225  
00226     return (peak);
00227 }
00228 /*****************************************************************************/
00229  
00230  
00231 /******************************************************************************
00232 *               European Southern Observatory
00233 *            VLTI MIDI Data Reduction Software 
00234 *
00235 * Module name:  signalVariance
00236 * Input/Output: See function arguments to avoid duplication
00237 * Description:  Computes variance and standard deviation of a signal
00238 * History:      
00239 * 22-Dec-03     (csabet) Created
00240 ******************************************************************************/
00241 float signalVariance (    /*    Ou:    Variance of the signal */
00242     float    *signal,    /*    In:    Pointer to an array containing the signal */
00243     int        start,        /*    In:    Start point */
00244     int        end,        /*    In:    End point */
00245     float    *standDev)    /*    Ou:    Standard deviation */
00246 {
00247 
00248     /*  Local Declarations
00249     --------------------*/
00250     const char    routine[] = "signalVariance";
00251     float        mean, variance, diffCumSqr = 0.0, diff;
00252     int            i, length, length_1;
00253     
00254     /*  Algorithm
00255     -----------*/
00256     if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking      routine   '%s' \n", routine);
00257     if (diagnostic > 4) fprintf(midiReportPtr, "Invoking      routine   '%s' \n", routine);
00258 
00259     /*    Compute mean */
00260     mean = signalMean (signal, start, end);
00261     
00262     for (i = start; i < end; i++)
00263     {
00264         diff = signal[i] - mean;
00265         diffCumSqr += (diff * diff);
00266     }
00267     
00268     length = end - start;
00269     length_1 = end - start - 1;
00270     
00271     if (length == 0)    /*    Singularity check */
00272         length = VERY_SMALL_INT;
00273     if (length_1 == 0)    /*    Singularity check */
00274         length_1 = VERY_SMALL_INT;
00275         
00276     variance = diffCumSqr / (float) length_1;
00277     *standDev = sqrt (variance);
00278 
00279     return (variance);
00280 }
00281 /*****************************************************************************/
00282 
00283 
00284 /******************************************************************************
00285 *               European Southern Observatory
00286 *            VLTI MIDI Data Reduction Software 
00287 *
00288 * Module name:  signalMedian
00289 * Input/Output: See function arguments to avoid duplication
00290 * Description:  Computes median a signal
00291 * History:      
00292 * 22-Dec-03     (csabet) Created
00293 ******************************************************************************/
00294 float signalMedian (    //    Ou:    Median of the signal
00295     float    *signal,    //    In:    Pointer to an array containing the signal
00296     int        start,        //    In:    Start point
00297     int        end)        //    In:    End point
00298 {
00299 
00300     //    Local Declarations
00301     //    ------------------
00302     const char    routine[] = "signalMedian";
00303      float        remainder, median, *buffer, *sigPtr, *bufPtr;
00304      int            i, length, lengthHalf;
00305      
00306     //    Algorithm
00307     //    ---------
00308     if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking      routine   '%s' \n", routine);
00309     if (diagnostic > 4) fprintf(midiReportPtr, "Invoking      routine   '%s' \n", routine);
00310 
00311     //    Singularity check
00312     length = end - start;
00313     if (length <= 0) midiReportError (midiReportPtr, routine, __FILE__, __LINE__, "Invalid length");
00314  
00315     //    Allocate memory
00316     buffer = (float *) calloc (length, sizeof (float));
00317     bufPtr = buffer;
00318     sigPtr = signal + start;
00319     
00320     //    Load into buffer
00321     for (i = 0; i < length; i++)
00322         *bufPtr++ = *sigPtr++;
00323     
00324     //    Sort the signal
00325     signalSort (buffer, 0, length);
00326     
00327     //    Check if odd or even
00328     remainder = (length % 2);
00329     if (remainder)    // It is odd
00330     {
00331         lengthHalf = 0.5 * (length -1);
00332         median = buffer[lengthHalf];
00333     }
00334     else            // It is even
00335     {
00336         lengthHalf = 0.5 * length;
00337         median = 0.5 * (buffer[lengthHalf-1] + buffer[lengthHalf]);
00338     }
00339     
00340     //    Release memory
00341     free (buffer);
00342  
00343     return (median);
00344 }
00345 /*****************************************************************************/
00346 
00347 
00348 /******************************************************************************
00349 *               European Southern Observatory
00350 *            VLTI MIDI Data Reduction Software 
00351 *
00352 * Module name:  signalSortInt
00353 * Input/Output: See function arguments to avoid duplication
00354 * Description:  Sorts a signal
00355 * History:      
00356 * 22-Dec-03     (csabet) Created
00357 ******************************************************************************/
00358 void signalSortInt (
00359     int    *signal,    /*    In:    Pointer to an array containing the signal */
00360     int    start,        /*    In:    Start point */
00361     int    end)        /*    In:    End point */
00362 {
00363 
00364     /*  Local Declarations
00365     --------------------*/
00366     const char    routine[] = "signalSortInt";
00367     int            i, j, searchStart, foundIndex;
00368     int            min, signalStart;
00369     FILE        *tempFilePtr;
00370     char        *tempFileName;
00371      
00372     /*  Algorithm
00373     -----------*/
00374     if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking      routine   '%s' \n", routine);
00375     if (diagnostic > 4) fprintf(midiReportPtr, "Invoking      routine   '%s' \n", routine);
00376 
00377     searchStart = start;
00378     foundIndex = start;
00379     for (j = start; j < end; j++)
00380     {
00381         signalStart = signal[j];
00382         min = signal[searchStart];
00383         for (i = searchStart; i < end; i++)
00384         {
00385             if (signal[i] <= min)
00386             {
00387                 min = signal[i];
00388                 foundIndex = i;
00389             }
00390         }
00391         searchStart++;
00392         signal[j] = signal[foundIndex];
00393         signal[foundIndex] = signalStart;
00394     }
00395     
00396     /*    Diagnostics */
00397     if (diagnostic > 4) 
00398     {
00399         /*    Allocate memory */
00400         tempFileName = (char *) calloc (MAX_STRING_LENGTH, sizeof (char));
00401 
00402         sprintf (tempFileName, "%s%s.MedianSortInt.log", outFileDir, outRootName);
00403         tempFilePtr = fopen(tempFileName, "w");    
00404         for (i = start; i < end; i++)
00405             fprintf (tempFilePtr, "%d\n", signal[i]);
00406     
00407         /*    Close file */
00408         fclose (tempFilePtr);
00409         
00410         /*    Release memory */
00411         free (tempFileName);
00412     }
00413     
00414     return;
00415 }
00416 /*****************************************************************************/
00417 
00418 
00419 
00420 /******************************************************************************
00421 *               European Southern Observatory
00422 *            VLTI MIDI Data Reduction Software 
00423 *
00424 * Module name:  signalSort
00425 * Input/Output: See function arguments to avoid duplication
00426 * Description:  Sorts a signal
00427 * History:      
00428 * 22-Dec-03     (csabet) Created
00429 ******************************************************************************/
00430 void signalSort (
00431     float    *signal,    //    In:    Pointer to an array containing the signal
00432     int        start,        //    In:    Start point
00433     int        end)        //    In:    End point
00434 {
00435 
00436     //    Local Declarations
00437     //    ------------------
00438     const char    routine[] = "signalSort";
00439     int            i, j, searchStart, foundIndex;
00440     float        min, signalStart;
00441      
00442     //    Algorithm
00443     //-----------
00444     if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking      routine   '%s' \n", routine);
00445     if (diagnostic > 4) fprintf(midiReportPtr, "Invoking      routine   '%s' \n", routine);
00446 
00447     if ((end - start) <= 0) midiReportError (midiReportPtr, routine, __FILE__, __LINE__, "Invalid length");
00448 
00449     searchStart = start;
00450     foundIndex = start;
00451     for (j = start; j < end; j++)
00452     {
00453         signalStart = signal[j];
00454         min = signal[searchStart];
00455         for (i = searchStart; i < end; i++)
00456         {
00457             if (signal[i] <= min)
00458             {
00459                 min = signal[i];
00460                 foundIndex = i;
00461             }
00462         }
00463         searchStart++;
00464         signal[j] = signal[foundIndex];
00465         signal[foundIndex] = signalStart;
00466     }
00467     
00468     //    Diagnostics
00469     if (diagnostic > 4) midiCreatePlotFile2D ("SortedSignal", "Sorted Signal", "x", "y", 
00470         1, signal, start, end, 1, 0);
00471     
00472     return;
00473 }
00474 /*****************************************************************************/
00475 
00476 
00477 /******************************************************************************
00478 *               European Southern Observatory
00479 *            VLTI MIDI Data Reduction Software
00480 *
00481 * Module name:  sqrtp
00482 * Input/Output: See function arguments to avoid duplication
00483 * Description:    
00484 *
00485 * History:
00486 * 21-Jul-03     (JM)
00487 * 20-Jan-05        (csabet) Integrated
00488 ******************************************************************************/
00489 float sqr(float x)
00490 {
00491     return x*x ;
00492 }    
00493 /*****************************************************************************/
00494 
00495 
00496 
00497 /******************************************************************************
00498 *               European Southern Observatory
00499 *            VLTI MIDI Data Reduction Software
00500 *
00501 * Module name:  sqrtp
00502 * Input/Output: See function arguments to avoid duplication
00503 * Description:    
00504 *
00505 * History:
00506 * 21-Jul-03     (JM)
00507 * 20-Jan-05        (csabet) Integrated
00508 ******************************************************************************/
00509 float sqrtp (
00510     float    x)
00511 {
00512     if (x <= 0.F)  return 0.F;
00513     return (float) sqrt(x);
00514 }
00515 /*****************************************************************************/
00516 
00517 
00518 /******************************************************************************
00519 *               European Southern Observatory
00520 *          VLTI MIDI Maintenance Templates Software
00521 *
00522 * Module name:  midiGetLinearFit
00523 * Input/Output: See function arguments to avoid duplication
00524 * Description:  This is a least-squares fit data to a straight line by
00525 *                minimising chi-squared. It returns uncertainties for
00526 *                all the coefficients, the goodness-of-fit and the value
00527 *                of the chi-squared
00528 *
00529 * History:      
00530 * 14-June-05    (csabet) Adapted from the Numerical Recipes
00531 ******************************************************************************/
00532 void midiGetLinearFit (
00533     double    *x,        // In: Array of elements along X
00534     double    *y,        // In: array of elements along Y
00535     int        ndata,    // In: Number of input points
00536     float    sig,    // In: Spread (Standard Deviation) assumed identical for all points
00537     int        mwt,    // In: 0 or 1, 0 = Standard deviation not supplied
00538     float    *a,        // Ou: coefficient
00539     float    *b,        // Ou: coefficient
00540     float    *siga,    // Ou: Uncertainty
00541     float    *sigb,    // Ou: Uncertainty
00542     float    *chi2,    // Ou: Chi-squared
00543     float    *q,        // Ou: Goodness-of-fit
00544     int        *error)    // Ou: Error status
00545 
00546 {
00547 
00548     //  Local Declarations
00549     //    ------------------
00550     const char    routine[] = "midiGetLinearFit";
00551     int         i;
00552     double         arg, wt, t, sxoss, sx=0.0, sy=0.0, st2=0.0, ss, sigdat;
00553     
00554     //  Algorithm
00555     //    ---------
00556     if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking      routine   '%s' \n", routine);
00557     if (diagnostic > 4) fprintf (midiReportPtr, "Invoking      routine   '%s' \n", routine);
00558 
00559     //    Reset status
00560     *error = 0;
00561 
00562     *b = 0.0;
00563     if (mwt)
00564     {
00565         ss = 0.0;
00566         for (i = 0; i < ndata; i++) 
00567         {
00568             wt = 1.0 / SQR(sig);
00569             ss += wt;
00570             sx += x[i] * wt;
00571             sy += y[i] * wt;
00572         }
00573     } 
00574     else 
00575     {
00576         for (i = 0; i < ndata; i++) 
00577         {
00578             sx += x[i];
00579             sy += y[i];
00580         }
00581         ss = ndata;
00582     }
00583     sxoss = sx / ss;
00584     if (mwt) 
00585     {
00586         for (i = 0; i < ndata; i++) 
00587         {
00588             t = (x[i] - sxoss) / sig;
00589             st2 += t * t;
00590             *b += t * y[i] / sig;
00591         }
00592     } 
00593     else 
00594     {
00595         for (i = 0; i < ndata; i++) 
00596         {
00597             t = x[i] - sxoss;
00598             st2 += t * t;
00599             *b += t * y[i];
00600         }
00601     }
00602     *b /= st2;
00603     *a = (sy - sx * (*b)) / ss;
00604     *siga = sqrt ((1.0 + sx * sx / (ss * st2)) /ss);
00605     *sigb = sqrt (1.0 / st2);
00606     *chi2 = 0.0;
00607     *q = 1.0;
00608     if (mwt == 0) 
00609     {
00610         for (i = 0; i < ndata; i++)
00611             *chi2 += SQR(y[i] - (*a) - (*b) * x[i]);
00612 
00613         sigdat = sqrt ((*chi2) / (ndata - 2));
00614         *siga *= sigdat;
00615         *sigb *= sigdat;
00616     } 
00617     else 
00618     {
00619         for (i = 0; i < ndata; i++)
00620         {
00621             arg = (y[i] - (*a) - (*b) * x[i]) / sig;
00622             *chi2 += SQR((y[i] - (*a) - (*b) * x[i]) / sig);
00623         }
00624         if (ndata > 2) *q = midiGoodnessOfFit (0.5 * (ndata - 2), 0.5 * (*chi2), error);
00625         if (*error)
00626         {
00627             sprintf (midiMessage, "Cannot compute goodness-of-fit in routine '%s'", routine);
00628             midiReportWarning (midiReportPtr, routine, __FILE__, __LINE__, midiMessage);
00629             return;
00630         }
00631     }
00632 
00633     return; 
00634 }
00635 /*****************************************************************************/
00636 
00637 
00638 /******************************************************************************
00639 *               European Southern Observatory
00640 *          VLTI MIDI Maintenance Templates Software
00641 *
00642 * Module name:  midiGoodnessOfFit
00643 * Input/Output: See function arguments to avoid duplication
00644 * Description:  Computes the goodness-of-fit
00645 *
00646 * History:      
00647 * 14-June-05    (csabet) Adapted from the Numerical recipes
00648 ******************************************************************************/
00649 float midiGoodnessOfFit (    // Ou: Goodness-of-fit
00650     float    a,                // In: Argument for the number of data
00651     float    x,                // In: Argument relating to the Chi-squared
00652     int        *error)            // Ou: Error status
00653 
00654 {
00655 
00656     //  Local Declarations
00657     //    ------------------
00658     const char    routine[] = "midiGoodnessOfFit";
00659     float        gamser, gammcf, gln;
00660 
00661     //  Algorithm
00662     //    ---------
00663     if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking      routine   '%s' \n", routine);
00664     if (diagnostic > 4) fprintf (midiReportPtr, "Invoking      routine   '%s' \n", routine);
00665 
00666     //    Reset status
00667     *error = 0;
00668 
00669     if (x < 0.0 || a <= 0.0) 
00670     {
00671         *error = 1;
00672         sprintf (midiMessage, "Invalid arguments in routine '%s'", routine);
00673         midiReportWarning (midiReportPtr, routine, __FILE__, __LINE__, midiMessage);
00674         return (0.0);
00675     }
00676     if (x < (a + 1.0)) 
00677     {
00678         gser (&gamser, a, x, &gln, error);
00679         if (*error)
00680         {
00681             sprintf (midiMessage, "Invalid arguments in routine '%s'", routine);
00682             midiReportWarning (midiReportPtr, routine, __FILE__, __LINE__, midiMessage);
00683             return (0.0);
00684         }
00685         return (1.0-gamser);
00686     } 
00687     else 
00688     {
00689         gcf (&gammcf, a, x, &gln, error);
00690         if (*error)
00691         {
00692             sprintf (midiMessage, "Invalid arguments in routine '%s'", routine);
00693             midiReportWarning (midiReportPtr, routine, __FILE__, __LINE__, midiMessage);
00694             return (0.0);
00695         }
00696         return (gammcf);
00697     }
00698 
00699     return (0.0); 
00700 }
00701 /*****************************************************************************/
00702 
00703 
00704 
00705 /******************************************************************************
00706 *               European Southern Observatory
00707 *          VLTI MIDI Maintenance Templates Software
00708 *
00709 * Module name:  gser
00710 * Input/Output: See function arguments to avoid duplication
00711 * Description:  
00712 *
00713 * History:      
00714 * 14-June-05    (csabet) Adapted from the Numerical recipes
00715 ******************************************************************************/
00716 void gser (
00717     float    *gamser,
00718     float    a,
00719     float    x,
00720     float    *gln,
00721     int        *error)
00722 
00723 {
00724 
00725     //  Local Declarations
00726     //    ------------------
00727     const char    routine[] = "gser";
00728     int         n;
00729     float         sum, del, ap;
00730 
00731     //  Algorithm
00732     //    ---------
00733     if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking      routine   '%s' \n", routine);
00734     if (diagnostic > 4) fprintf (midiReportPtr, "Invoking      routine   '%s' \n", routine);
00735 
00736     //    Reset status
00737     *error = 0;
00738 
00739     *gln = gammln(a);
00740     if (x <= 0.0) 
00741     {
00742         if (x < 0.0) 
00743         {
00744             *error = 1;
00745             sprintf (midiMessage, "Invalid arguments in routine '%s'", routine);
00746             midiReportWarning (midiReportPtr, routine, __FILE__, __LINE__, midiMessage);
00747             return;
00748         }
00749         *gamser=0.0;
00750     } 
00751     else 
00752     {
00753         ap = a;
00754         del = sum = 1.0 / a;
00755         for (n = 0; n < ITMAX; n++) 
00756         {
00757             ++ap;
00758             del *= x/ap;
00759             sum += del;
00760             if (fabs(del) < fabs(sum) * EPS) 
00761             {
00762                 *gamser = sum * exp (-x + a * log(x) - (*gln));
00763                 return;
00764             }
00765         }
00766         *error = 1;
00767         sprintf (midiMessage, "Invalid arguments in routine '%s'", routine);
00768         midiReportWarning (midiReportPtr, routine, __FILE__, __LINE__, midiMessage);
00769         return;
00770     }
00771 
00772     return; 
00773 }
00774 /*****************************************************************************/
00775 
00776 
00777 /******************************************************************************
00778 *               European Southern Observatory
00779 *          VLTI MIDI Maintenance Templates Software
00780 *
00781 * Module name:  gammln
00782 * Input/Output: See function arguments to avoid duplication
00783 * Description:  
00784 *
00785 * History:      
00786 * 14-June-05    (csabet) Adapted from the Numerical recipes
00787 ******************************************************************************/
00788 float gammln (
00789     float    xx)
00790 
00791 {
00792 
00793     //  Local Declarations
00794     //    ------------------
00795     const char    routine[] = "gammln";
00796     double        x, y, tmp, ser;
00797     static        double cof[6] = {76.18009172947146,-86.50532032941677,
00798                                 24.01409824083091,-1.231739572450155,
00799                                 0.1208650973866179e-2,-0.5395239384953e-5};
00800     int         j;
00801 
00802     //  Algorithm
00803     //    ---------
00804     if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking      routine   '%s' \n", routine);
00805     if (diagnostic > 4) fprintf (midiReportPtr, "Invoking      routine   '%s' \n", routine);
00806 
00807     y = x = xx;
00808     tmp = x + 5.5;
00809     tmp -= (x + 0.5) * log(tmp);
00810     ser = 1.000000000190015;
00811     for (j = 0; j <= 5; j++) ser += cof[j] / (++y);
00812     
00813     return (-tmp + log (2.5066282746310005 * ser / x));
00814 
00815 }
00816 /*****************************************************************************/
00817 
00818 
00819 
00820 /******************************************************************************
00821 *               European Southern Observatory
00822 *          VLTI MIDI Maintenance Templates Software
00823 *
00824 * Module name:  gcf
00825 * Input/Output: See function arguments to avoid duplication
00826 * Description:  
00827 *
00828 * History:      
00829 * 14-June-05    (csabet) Adapted from the Numerical recipes
00830 ******************************************************************************/
00831 void gcf (
00832     float    *gammcf,
00833     float    a,
00834     float    x,
00835     float    *gln,
00836     int        *error)
00837 
00838 {
00839 
00840     //  Local Declarations
00841     //    ------------------
00842     const char    routine[] = "gcf";
00843     int            i;
00844     float         an, b, c, d, del, h;
00845 
00846     //  Algorithm
00847     //    ---------
00848     if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking      routine   '%s' \n", routine);
00849     if (diagnostic > 4) fprintf (midiReportPtr, "Invoking      routine   '%s' \n", routine);
00850 
00851     //    Reset status
00852     *error = 0;
00853 
00854 
00855     *gln = gammln(a);
00856     b = x + 1.0 - a;
00857     c = 1.0 / FPMIN;
00858     d = 1.0 / b;
00859     h = d;
00860     for (i = 0; i < ITMAX; i++) 
00861     {
00862         an = -i * (i - a);
00863         b += 2.0;
00864         d = an * d + b;
00865         if (fabs(d) < FPMIN) d = FPMIN;
00866         c = b + an / c;
00867         if (fabs(c) < FPMIN) c = FPMIN;
00868         d = 1.0 / d;
00869         del = d * c;
00870         h *= del;
00871         if (fabs (del - 1.0) < EPS) break;
00872     }
00873     
00874     if (i > ITMAX)
00875     {
00876         *error = 1;
00877         sprintf (midiMessage, "Invalid arguments in routine '%s'", routine);
00878         midiReportWarning (midiReportPtr, routine, __FILE__, __LINE__, midiMessage);
00879         return;
00880     }
00881     
00882     *gammcf = exp (-x + a * log(x) - (*gln)) * h;
00883 
00884     return; 
00885 }
00886 /*****************************************************************************/

Generated on 15 Mar 2012 for MIDI Pipeline Reference Manual by  doxygen 1.6.1