MIDI Pipeline Reference Manual  2.8.3
statistics.c
1 /******************************************************************************
2 *******************************************************************************
3 * European Southern Observatory
4 * VLTI MIDI Data Reduction Software
5 *
6 * Module name: statistics.c
7 * Description: Contains routines for all statistical computations
8 *
9 * History:
10 * 22-Dec-03 (csabet) Created
11 *******************************************************************************
12 ******************************************************************************/
13 
14 /******************************************************************************
15 * Compiler directives
16 ******************************************************************************/
17 
18 /******************************************************************************
19 * Include files
20 ******************************************************************************/
21 #include <math.h>
22 #include <stdio.h>
23 #include <cpl.h>
24 #include <stdlib.h>
25 #include "errorHandling.h"
26 #include "midiGlobal.h"
27 #include "diagnostics.h"
28 #include "statistics.h"
29 
30 /**********************************************************
31 * Constant definitions
32 **********************************************************/
33 #define ITMAX (100)
34 #define EPS (3.0e-7)
35 #define FPMIN (1.0e-30)
36 static float sqrarg;
37 #define SQR(a) ((sqrarg=(a)) == 0.0 ? 0.0 : sqrarg*sqrarg)
38 
39 /**********************************************************
40 * Global Variables
41 **********************************************************/
42 
43 /*============================ C O D E A R E A ===========================*/
44 
45 
46 
47 
48 /******************************************************************************
49 * European Southern Observatory
50 * VLTI MIDI Data Reduction Software
51 *
52 * Module name: makeStats
53 * Input/Output: See function arguments to avoid duplication
54 * Description:
55 *
56 * History:
57 * 25-Aug-04 (JM) Created
58 * 16-Jan-05 (csabet) Cleaned up and integrated into MIDI pipeline
59 ******************************************************************************/
60 void makeStats(
61  float *data,
62  int numdata,
63  float *mean,
64  float *rms)
65 {
66 
67  /* Local Declarations
68  --------------------*/
69  const char routine[] = "makeStats";
70  float accum = 0.F;
71  float accum2 = 0.F;
72  int i;
73 
74  /* Algorithm
75  -----------*/
76  if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking routine '%s' \n", routine);
77  if (diagnostic > 4) fprintf (midiReportPtr, "Invoking routine '%s' \n", routine);
78  *rms = 0.F; // Usually changed below
79  *mean = 0.F; // Usually changed below
80  if (numdata < 1) return; // just in case
81  for (i = 0; i < numdata; i++)
82  {
83  accum += data[i];
84  accum2 += data[i] * data[i];
85  }
86  *mean = accum/numdata;
87  if (numdata < 2) return; // just in case
88  accum2 -= *mean * *mean * numdata;
89  if (accum2 < 0.F) return;
90  *rms = sqrt(accum2/((float) (numdata-1)));
91 
92  return;
93 }
94 /*****************************************************************************/
95 
96 
97 /******************************************************************************
98 * European Southern Observatory
99 * VLTI MIDI Data Reduction Software
100 *
101 * Module name: removeDc
102 * Input/Output: See function arguments to avoid duplication
103 * Description: Removes DC from the input array. The arrays are
104 * 1D linear. Hence the routine can be used for linear
105 * images
106 *
107 * History:
108 * 19-May-06 (csabet) Created
109 ******************************************************************************/
110 void removeDc (
111  int size, // In: Size of the image
112  float *inArray, // In: Input array
113  float *outArray) // Ou: Output array with DC removed
114 {
115 
116  /* Local Declarations
117  --------------------*/
118  const char routine[] = "removeDc";
119  int i;
120  float max;
121 
122  /* Algorithm
123  -----------*/
124  if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking routine '%s' \n", routine);
125  if (diagnostic > 4) fprintf (midiReportPtr, "Invoking routine '%s' \n", routine);
126 
127  max = 0.0;
128  for (i = 0; i < size; i++)
129  {
130  if (inArray[i] > max) max = inArray[i];
131  }
132  for (i = 0; i < size; i++)
133  outArray[i] = inArray[i] - max;
134 
135  return;
136 }
137 /*****************************************************************************/
138 
139 
140 /******************************************************************************
141 * European Southern Observatory
142 * VLTI MIDI Data Reduction Software
143 *
144 * Module name: signalMean
145 * Input/Output: See function arguments to avoid duplication
146 * Description: Computes mean of a signal
147 * History:
148 * 22-Dec-03 (csabet) Created
149 ******************************************************************************/
150 float signalMean ( /* Ou: Mean of the signal */
151  float *signal, /* In: Pointer to an array containing the signal */
152  int start, /* In: Start point */
153  int end) /* In: End point */
154 {
155 
156  /* Local Declarations
157  --------------------*/
158  const char routine[] = "signalMean";
159  float mean = 0.0;
160  int i;
161 
162  /* Algorithm
163  -----------*/
164  if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking routine '%s' \n", routine);
165  if (diagnostic > 4) fprintf(midiReportPtr, "Invoking routine '%s' \n", routine);
166 
167  for (i = start; i < end; i++)
168  mean += signal[i];
169 
170  if ((end - start) != 0) /* Singularity check */
171  mean /= ((float) (end - start));
172  else
173  mean /= ((float) (VERY_SMALL_INT));
174 
175 
176  return (mean);
177 }
178 /*****************************************************************************/
179 
180 
181 /******************************************************************************
182 * European Southern Observatory
183 * VLTI MIDI Data Reduction Software
184 *
185 * Module name: signalPeak
186 * Input/Output: See function arguments to avoid duplication
187 * Description: Computes peak and its index
188 * History:
189 * 11-Apr-06 (csabet) Created
190 ******************************************************************************/
191 float signalPeak ( // Ou: Peak of the signal
192  float *signal, // In: Pointer to an array containing the signal
193  int start, // In: Begin of array section
194  int end, // In: End of array section
195  int *peakIndex) // Ou: Peak index
196 {
197 
198  // Local Declarations
199  // ------------------
200  const char routine[] = "signalPeak";
201  float peak, *sigPtr;
202  int i, length;
203 
204  /* Algorithm
205  -----------*/
206  if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking routine '%s' \n", routine);
207  if (diagnostic > 4) fprintf(midiReportPtr, "Invoking routine '%s' \n", routine);
208 
209  // Singularity check
210  length = end - start;
211  if (length <= 0) midiReportError (midiReportPtr, routine, __FILE__, __LINE__, "Invalid length");
212 
213  peak = 0.0;
214  *peakIndex = 0;
215  sigPtr = signal + start;
216  for (i = 0; i < length; i++)
217  {
218  if (*sigPtr > peak)
219  {
220  peak = *sigPtr;
221  *peakIndex = i;
222  }
223  sigPtr++;
224  }
225 
226  return (peak);
227 }
228 /*****************************************************************************/
229 
230 
231 /******************************************************************************
232 * European Southern Observatory
233 * VLTI MIDI Data Reduction Software
234 *
235 * Module name: signalVariance
236 * Input/Output: See function arguments to avoid duplication
237 * Description: Computes variance and standard deviation of a signal
238 * History:
239 * 22-Dec-03 (csabet) Created
240 ******************************************************************************/
241 float signalVariance ( /* Ou: Variance of the signal */
242  float *signal, /* In: Pointer to an array containing the signal */
243  int start, /* In: Start point */
244  int end, /* In: End point */
245  float *standDev) /* Ou: Standard deviation */
246 {
247 
248  /* Local Declarations
249  --------------------*/
250  const char routine[] = "signalVariance";
251  float mean, variance, diffCumSqr = 0.0, diff;
252  int i, length, length_1;
253 
254  /* Algorithm
255  -----------*/
256  if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking routine '%s' \n", routine);
257  if (diagnostic > 4) fprintf(midiReportPtr, "Invoking routine '%s' \n", routine);
258 
259  /* Compute mean */
260  mean = signalMean (signal, start, end);
261 
262  for (i = start; i < end; i++)
263  {
264  diff = signal[i] - mean;
265  diffCumSqr += (diff * diff);
266  }
267 
268  length = end - start;
269  length_1 = end - start - 1;
270 
271  if (length == 0) /* Singularity check */
272  length = VERY_SMALL_INT;
273  if (length_1 == 0) /* Singularity check */
274  length_1 = VERY_SMALL_INT;
275 
276  variance = diffCumSqr / (float) length_1;
277  *standDev = sqrt (variance);
278 
279  return (variance);
280 }
281 /*****************************************************************************/
282 
283 
284 /******************************************************************************
285 * European Southern Observatory
286 * VLTI MIDI Data Reduction Software
287 *
288 * Module name: signalMedian
289 * Input/Output: See function arguments to avoid duplication
290 * Description: Computes median a signal
291 * History:
292 * 22-Dec-03 (csabet) Created
293 ******************************************************************************/
294 float signalMedian ( // Ou: Median of the signal
295  float *signal, // In: Pointer to an array containing the signal
296  int start, // In: Start point
297  int end) // In: End point
298 {
299 
300  // Local Declarations
301  // ------------------
302  const char routine[] = "signalMedian";
303  float remainder, median, *buffer, *sigPtr, *bufPtr;
304  int i, length, lengthHalf;
305 
306  // Algorithm
307  // ---------
308  if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking routine '%s' \n", routine);
309  if (diagnostic > 4) fprintf(midiReportPtr, "Invoking routine '%s' \n", routine);
310 
311  // Singularity check
312  length = end - start;
313  if (length <= 0) midiReportError (midiReportPtr, routine, __FILE__, __LINE__, "Invalid length");
314 
315  // Allocate memory
316  buffer = (float *) calloc (length, sizeof (float));
317  bufPtr = buffer;
318  sigPtr = signal + start;
319 
320  // Load into buffer
321  for (i = 0; i < length; i++)
322  *bufPtr++ = *sigPtr++;
323 
324  // Sort the signal
325  signalSort (buffer, 0, length);
326 
327  // Check if odd or even
328  remainder = (length % 2);
329  if (remainder) // It is odd
330  {
331  lengthHalf = 0.5 * (length -1);
332  median = buffer[lengthHalf];
333  }
334  else // It is even
335  {
336  lengthHalf = 0.5 * length;
337  median = 0.5 * (buffer[lengthHalf-1] + buffer[lengthHalf]);
338  }
339 
340  // Release memory
341  free (buffer);
342 
343  return (median);
344 }
345 /*****************************************************************************/
346 
347 
348 /******************************************************************************
349 * European Southern Observatory
350 * VLTI MIDI Data Reduction Software
351 *
352 * Module name: signalSortInt
353 * Input/Output: See function arguments to avoid duplication
354 * Description: Sorts a signal
355 * History:
356 * 22-Dec-03 (csabet) Created
357 ******************************************************************************/
358 void signalSortInt (
359  int *signal, /* In: Pointer to an array containing the signal */
360  int start, /* In: Start point */
361  int end) /* In: End point */
362 {
363 
364  /* Local Declarations
365  --------------------*/
366  const char routine[] = "signalSortInt";
367  int i, j, searchStart, foundIndex;
368  int min, signalStart;
369  FILE *tempFilePtr;
370  char *tempFileName;
371 
372  /* Algorithm
373  -----------*/
374  if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking routine '%s' \n", routine);
375  if (diagnostic > 4) fprintf(midiReportPtr, "Invoking routine '%s' \n", routine);
376 
377  searchStart = start;
378  foundIndex = start;
379  for (j = start; j < end; j++)
380  {
381  signalStart = signal[j];
382  min = signal[searchStart];
383  for (i = searchStart; i < end; i++)
384  {
385  if (signal[i] <= min)
386  {
387  min = signal[i];
388  foundIndex = i;
389  }
390  }
391  searchStart++;
392  signal[j] = signal[foundIndex];
393  signal[foundIndex] = signalStart;
394  }
395 
396  /* Diagnostics */
397  if (diagnostic > 4)
398  {
399  /* Allocate memory */
400  tempFileName = (char *) calloc (MAX_STRING_LENGTH, sizeof (char));
401 
402  sprintf (tempFileName, "%s%s.MedianSortInt.log", outFileDir, outRootName);
403  tempFilePtr = fopen(tempFileName, "w");
404  for (i = start; i < end; i++)
405  fprintf (tempFilePtr, "%d\n", signal[i]);
406 
407  /* Close file */
408  fclose (tempFilePtr);
409 
410  /* Release memory */
411  free (tempFileName);
412  }
413 
414  return;
415 }
416 /*****************************************************************************/
417 
418 
419 
420 /******************************************************************************
421 * European Southern Observatory
422 * VLTI MIDI Data Reduction Software
423 *
424 * Module name: signalSort
425 * Input/Output: See function arguments to avoid duplication
426 * Description: Sorts a signal
427 * History:
428 * 22-Dec-03 (csabet) Created
429 ******************************************************************************/
430 void signalSort (
431  float *signal, // In: Pointer to an array containing the signal
432  int start, // In: Start point
433  int end) // In: End point
434 {
435 
436  // Local Declarations
437  // ------------------
438  const char routine[] = "signalSort";
439  int i, j, searchStart, foundIndex;
440  float min, signalStart;
441 
442  // Algorithm
443  //-----------
444  if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking routine '%s' \n", routine);
445  if (diagnostic > 4) fprintf(midiReportPtr, "Invoking routine '%s' \n", routine);
446 
447  if ((end - start) <= 0) midiReportError (midiReportPtr, routine, __FILE__, __LINE__, "Invalid length");
448 
449  searchStart = start;
450  foundIndex = start;
451  for (j = start; j < end; j++)
452  {
453  signalStart = signal[j];
454  min = signal[searchStart];
455  for (i = searchStart; i < end; i++)
456  {
457  if (signal[i] <= min)
458  {
459  min = signal[i];
460  foundIndex = i;
461  }
462  }
463  searchStart++;
464  signal[j] = signal[foundIndex];
465  signal[foundIndex] = signalStart;
466  }
467 
468  // Diagnostics
469  if (diagnostic > 4) midiCreatePlotFile2D ("SortedSignal", "Sorted Signal", "x", "y",
470  1, signal, start, end, 1, 0);
471 
472  return;
473 }
474 /*****************************************************************************/
475 
476 
477 /******************************************************************************
478 * European Southern Observatory
479 * VLTI MIDI Data Reduction Software
480 *
481 * Module name: sqrtp
482 * Input/Output: See function arguments to avoid duplication
483 * Description:
484 *
485 * History:
486 * 21-Jul-03 (JM)
487 * 20-Jan-05 (csabet) Integrated
488 ******************************************************************************/
489 float sqr(float x)
490 {
491  return x*x ;
492 }
493 /*****************************************************************************/
494 
495 
496 
497 /******************************************************************************
498 * European Southern Observatory
499 * VLTI MIDI Data Reduction Software
500 *
501 * Module name: sqrtp
502 * Input/Output: See function arguments to avoid duplication
503 * Description:
504 *
505 * History:
506 * 21-Jul-03 (JM)
507 * 20-Jan-05 (csabet) Integrated
508 ******************************************************************************/
509 float sqrtp (
510  float x)
511 {
512  if (x <= 0.F) return 0.F;
513  return (float) sqrt(x);
514 }
515 /*****************************************************************************/
516 
517 
518 /******************************************************************************
519 * European Southern Observatory
520 * VLTI MIDI Maintenance Templates Software
521 *
522 * Module name: midiGetLinearFit
523 * Input/Output: See function arguments to avoid duplication
524 * Description: This is a least-squares fit data to a straight line by
525 * minimising chi-squared. It returns uncertainties for
526 * all the coefficients, the goodness-of-fit and the value
527 * of the chi-squared
528 *
529 * History:
530 * 14-June-05 (csabet) Adapted from the Numerical Recipes
531 ******************************************************************************/
532 void midiGetLinearFit (
533  double *x, // In: Array of elements along X
534  double *y, // In: array of elements along Y
535  int ndata, // In: Number of input points
536  float sig, // In: Spread (Standard Deviation) assumed identical for all points
537  int mwt, // In: 0 or 1, 0 = Standard deviation not supplied
538  float *a, // Ou: coefficient
539  float *b, // Ou: coefficient
540  float *siga, // Ou: Uncertainty
541  float *sigb, // Ou: Uncertainty
542  float *chi2, // Ou: Chi-squared
543  float *q, // Ou: Goodness-of-fit
544  int *error) // Ou: Error status
545 
546 {
547 
548  // Local Declarations
549  // ------------------
550  const char routine[] = "midiGetLinearFit";
551  int i;
552  double arg, wt, t, sxoss, sx=0.0, sy=0.0, st2=0.0, ss, sigdat;
553 
554  // Algorithm
555  // ---------
556  if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking routine '%s' \n", routine);
557  if (diagnostic > 4) fprintf (midiReportPtr, "Invoking routine '%s' \n", routine);
558 
559  // Reset status
560  *error = 0;
561 
562  *b = 0.0;
563  if (mwt)
564  {
565  ss = 0.0;
566  for (i = 0; i < ndata; i++)
567  {
568  wt = 1.0 / SQR(sig);
569  ss += wt;
570  sx += x[i] * wt;
571  sy += y[i] * wt;
572  }
573  }
574  else
575  {
576  for (i = 0; i < ndata; i++)
577  {
578  sx += x[i];
579  sy += y[i];
580  }
581  ss = ndata;
582  }
583  sxoss = sx / ss;
584  if (mwt)
585  {
586  for (i = 0; i < ndata; i++)
587  {
588  t = (x[i] - sxoss) / sig;
589  st2 += t * t;
590  *b += t * y[i] / sig;
591  }
592  }
593  else
594  {
595  for (i = 0; i < ndata; i++)
596  {
597  t = x[i] - sxoss;
598  st2 += t * t;
599  *b += t * y[i];
600  }
601  }
602  *b /= st2;
603  *a = (sy - sx * (*b)) / ss;
604  *siga = sqrt ((1.0 + sx * sx / (ss * st2)) /ss);
605  *sigb = sqrt (1.0 / st2);
606  *chi2 = 0.0;
607  *q = 1.0;
608  if (mwt == 0)
609  {
610  for (i = 0; i < ndata; i++)
611  *chi2 += SQR(y[i] - (*a) - (*b) * x[i]);
612 
613  sigdat = sqrt ((*chi2) / (ndata - 2));
614  *siga *= sigdat;
615  *sigb *= sigdat;
616  }
617  else
618  {
619  for (i = 0; i < ndata; i++)
620  {
621  arg = (y[i] - (*a) - (*b) * x[i]) / sig;
622  *chi2 += SQR((y[i] - (*a) - (*b) * x[i]) / sig);
623  }
624  if (ndata > 2) *q = midiGoodnessOfFit (0.5 * (ndata - 2), 0.5 * (*chi2), error);
625  if (*error)
626  {
627  sprintf (midiMessage, "Cannot compute goodness-of-fit in routine '%s'", routine);
628  midiReportWarning (midiReportPtr, routine, __FILE__, __LINE__, midiMessage);
629  return;
630  }
631  }
632 
633  return;
634 }
635 /*****************************************************************************/
636 
637 
638 /******************************************************************************
639 * European Southern Observatory
640 * VLTI MIDI Maintenance Templates Software
641 *
642 * Module name: midiGoodnessOfFit
643 * Input/Output: See function arguments to avoid duplication
644 * Description: Computes the goodness-of-fit
645 *
646 * History:
647 * 14-June-05 (csabet) Adapted from the Numerical recipes
648 ******************************************************************************/
649 float midiGoodnessOfFit ( // Ou: Goodness-of-fit
650  float a, // In: Argument for the number of data
651  float x, // In: Argument relating to the Chi-squared
652  int *error) // Ou: Error status
653 
654 {
655 
656  // Local Declarations
657  // ------------------
658  const char routine[] = "midiGoodnessOfFit";
659  float gamser, gammcf, gln;
660 
661  // Algorithm
662  // ---------
663  if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking routine '%s' \n", routine);
664  if (diagnostic > 4) fprintf (midiReportPtr, "Invoking routine '%s' \n", routine);
665 
666  // Reset status
667  *error = 0;
668 
669  if (x < 0.0 || a <= 0.0)
670  {
671  *error = 1;
672  sprintf (midiMessage, "Invalid arguments in routine '%s'", routine);
673  midiReportWarning (midiReportPtr, routine, __FILE__, __LINE__, midiMessage);
674  return (0.0);
675  }
676  if (x < (a + 1.0))
677  {
678  gser (&gamser, a, x, &gln, error);
679  if (*error)
680  {
681  sprintf (midiMessage, "Invalid arguments in routine '%s'", routine);
682  midiReportWarning (midiReportPtr, routine, __FILE__, __LINE__, midiMessage);
683  return (0.0);
684  }
685  return (1.0-gamser);
686  }
687  else
688  {
689  gcf (&gammcf, a, x, &gln, error);
690  if (*error)
691  {
692  sprintf (midiMessage, "Invalid arguments in routine '%s'", routine);
693  midiReportWarning (midiReportPtr, routine, __FILE__, __LINE__, midiMessage);
694  return (0.0);
695  }
696  return (gammcf);
697  }
698 
699  return (0.0);
700 }
701 /*****************************************************************************/
702 
703 
704 
705 /******************************************************************************
706 * European Southern Observatory
707 * VLTI MIDI Maintenance Templates Software
708 *
709 * Module name: gser
710 * Input/Output: See function arguments to avoid duplication
711 * Description:
712 *
713 * History:
714 * 14-June-05 (csabet) Adapted from the Numerical recipes
715 ******************************************************************************/
716 void gser (
717  float *gamser,
718  float a,
719  float x,
720  float *gln,
721  int *error)
722 
723 {
724 
725  // Local Declarations
726  // ------------------
727  const char routine[] = "gser";
728  int n;
729  float sum, del, ap;
730 
731  // Algorithm
732  // ---------
733  if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking routine '%s' \n", routine);
734  if (diagnostic > 4) fprintf (midiReportPtr, "Invoking routine '%s' \n", routine);
735 
736  // Reset status
737  *error = 0;
738 
739  *gln = gammln(a);
740  if (x <= 0.0)
741  {
742  if (x < 0.0)
743  {
744  *error = 1;
745  sprintf (midiMessage, "Invalid arguments in routine '%s'", routine);
746  midiReportWarning (midiReportPtr, routine, __FILE__, __LINE__, midiMessage);
747  return;
748  }
749  *gamser=0.0;
750  }
751  else
752  {
753  ap = a;
754  del = sum = 1.0 / a;
755  for (n = 0; n < ITMAX; n++)
756  {
757  ++ap;
758  del *= x/ap;
759  sum += del;
760  if (fabs(del) < fabs(sum) * EPS)
761  {
762  *gamser = sum * exp (-x + a * log(x) - (*gln));
763  return;
764  }
765  }
766  *error = 1;
767  sprintf (midiMessage, "Invalid arguments in routine '%s'", routine);
768  midiReportWarning (midiReportPtr, routine, __FILE__, __LINE__, midiMessage);
769  return;
770  }
771 
772  return;
773 }
774 /*****************************************************************************/
775 
776 
777 /******************************************************************************
778 * European Southern Observatory
779 * VLTI MIDI Maintenance Templates Software
780 *
781 * Module name: gammln
782 * Input/Output: See function arguments to avoid duplication
783 * Description:
784 *
785 * History:
786 * 14-June-05 (csabet) Adapted from the Numerical recipes
787 ******************************************************************************/
788 float gammln (
789  float xx)
790 
791 {
792 
793  // Local Declarations
794  // ------------------
795  const char routine[] = "gammln";
796  double x, y, tmp, ser;
797  static double cof[6] = {76.18009172947146,-86.50532032941677,
798  24.01409824083091,-1.231739572450155,
799  0.1208650973866179e-2,-0.5395239384953e-5};
800  int j;
801 
802  // Algorithm
803  // ---------
804  if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking routine '%s' \n", routine);
805  if (diagnostic > 4) fprintf (midiReportPtr, "Invoking routine '%s' \n", routine);
806 
807  y = x = xx;
808  tmp = x + 5.5;
809  tmp -= (x + 0.5) * log(tmp);
810  ser = 1.000000000190015;
811  for (j = 0; j <= 5; j++) ser += cof[j] / (++y);
812 
813  return (-tmp + log (2.5066282746310005 * ser / x));
814 
815 }
816 /*****************************************************************************/
817 
818 
819 
820 /******************************************************************************
821 * European Southern Observatory
822 * VLTI MIDI Maintenance Templates Software
823 *
824 * Module name: gcf
825 * Input/Output: See function arguments to avoid duplication
826 * Description:
827 *
828 * History:
829 * 14-June-05 (csabet) Adapted from the Numerical recipes
830 ******************************************************************************/
831 void gcf (
832  float *gammcf,
833  float a,
834  float x,
835  float *gln,
836  int *error)
837 
838 {
839 
840  // Local Declarations
841  // ------------------
842  const char routine[] = "gcf";
843  int i;
844  float an, b, c, d, del, h;
845 
846  // Algorithm
847  // ---------
848  if (diagnostic > 4)cpl_msg_info(cpl_func,"Invoking routine '%s' \n", routine);
849  if (diagnostic > 4) fprintf (midiReportPtr, "Invoking routine '%s' \n", routine);
850 
851  // Reset status
852  *error = 0;
853 
854 
855  *gln = gammln(a);
856  b = x + 1.0 - a;
857  c = 1.0 / FPMIN;
858  d = 1.0 / b;
859  h = d;
860  for (i = 0; i < ITMAX; i++)
861  {
862  an = -i * (i - a);
863  b += 2.0;
864  d = an * d + b;
865  if (fabs(d) < FPMIN) d = FPMIN;
866  c = b + an / c;
867  if (fabs(c) < FPMIN) c = FPMIN;
868  d = 1.0 / d;
869  del = d * c;
870  h *= del;
871  if (fabs (del - 1.0) < EPS) break;
872  }
873 
874  if (i > ITMAX)
875  {
876  *error = 1;
877  sprintf (midiMessage, "Invalid arguments in routine '%s'", routine);
878  midiReportWarning (midiReportPtr, routine, __FILE__, __LINE__, midiMessage);
879  return;
880  }
881 
882  *gammcf = exp (-x + a * log(x) - (*gln)) * h;
883 
884  return;
885 }
886 /*****************************************************************************/