SINFONI Pipeline Reference Manual  2.5.2
sinfo_focus.c
1 /*
2  * This file is part of the ESO SINFONI Pipeline
3  * Copyright (C) 2004,2005 European Southern Observatory
4  *
5  * This program is free software; you can redistribute it and/or modify
6  * it under the terms of the GNU General Public License as published by
7  * the Free Software Foundation; either version 2 of the License, or
8  * (at your option) any later version.
9  *
10  * This program is distributed in the hope that it will be useful,
11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13  * GNU General Public License for more details.
14  *
15  * You should have received a copy of the GNU General Public License
16  * along with this program; if not, write to the Free Software
17  * Foundation, 51 Franklin St, Fifth Floor, Boston, MA 02111-1307 USA
18  */
19 /*******************************************************************************
20 * E.S.O. - VLT project
21 *
22 *
23 *
24 * who when what
25 * -------- -------- ----------------------------------------------
26 * schreib 16/01/02 created
27 */
28 
29 /************************************************************************
30 * NAME
31 * sinfo_focus.c -
32 * routines to determine the focus position of the detector
33 *
34 * SYNOPSIS
35 * #include "sinfo_focus.h"
36 *
37 * 1) double sinfo_new_gaussian_ellipse ( double * xdat, double * parlist )
38 * 2) void sinfo_new_gaussian_ellipse_deriv( double * xdat,
39  double * parlist,
40  double * dervs )
41 * 3) static int new_inv_mat (void)
42 * 4) static void new_get_mat ( double * xdat,
43 * int * xdim,
44 * double * ydat,
45 * double * wdat,
46 * int * ndat,
47 * double * fpar,
48 * double * epar,
49 * int * npar )
50 * 5) static int new_get_vec ( double * xdat,
51 * int * xdim,
52 * double * ydat,
53 * double * wdat,
54 * int * ndat,
55 * double * fpar,
56 * double * epar,
57 * int * npar )
58 * 6) int new_lsqfit ( double * xdat,
59 * int * xdim,
60 * double * ydat,
61 * double * wdat,
62 * int * ndat,
63 * double * fpar,
64 * double * epar,
65 * int * mpar,
66 * int * npar,
67 * double * tol ,
68 * int * its ,
69 * double * lab )
70 * 7) int sinfo_new_fit_2d_gaussian( cpl_image * lineImage,
71 * double * fit_par,
72 * double * derv_par
73 * int * mpar,
74 * int lleftx,
75 * int llefty,
76 * int halfbox_x,
77 * int halfbox_y, int* check )
78 * 8) cpl_image * sinfo_new_plot_gaussian ( cpl_image * image,
79 * double * parlist )
80 * 9) static int new_gauss2ellipse ( double * parlist ,
81 * 10) float sinfo_new_determine_conversion_factor ( cpl_imagelist * cube,
82 * float mag,
83 * float exptime,
84 * int lleftx,
85 * int llefty,
86 * int halfbox_x,
87 * int halfbox_y,
88 * int* check )
89 *
90 * DESCRIPTION
91 * 1) Compute the value of a 2d Gaussian function at a given point.
92 * The ellptical 2D Gaussian is:
93 * F(x,y) = par(2) * EXP( -4.0*log(2.0)*[(xr/par(4))^2+(yr/par(5))^2]) +
94  par(3),
95 * where: xr = xo * cos(par(6)) + yo * sin(par(6))
96 * yr = -xo * sin(par(6)) + yo * cos(par(6))
97 * and: x0 = x - par(0)
98 * y0 = y - par(1)
99 * 2) calculates the partial derivatives for a 2d Gaussian function with
100 * parameters parlist at position xdat
101 * 3) calculates the inverse of matrix2. The algorithm used
102 * is the Gauss-Jordan algorithm described in Stoer,
103 * Numerische Mathematik, 1. Teil.
104 * 4) builds the sinfo_matrix
105 * 5) calculates the correction sinfo_vector. The sinfo_matrix has been
106 * built by get_mat(), we only have to rescale it for the
107 * current value of labda. The sinfo_matrix is rescaled so that
108 * the diagonal gets the value 1 + labda.
109 * Next we calculate the inverse of the sinfo_matrix and then
110 * the correction sinfo_vector.
111 * 6) this is a routine for making a least-squares fit of a
112 * function to a set of data points. The method used is
113 * described in: Marquardt, J.Soc.Ind.Appl.Math. 11. 431 (1963).
114 * This method is a mixture of the steepest descent method
115 * and the Taylor method.
116 * 7) fits the image of a point source by using a 2-D Gaussian
117 * fit.
118 * 8) plots an image of a given 2D-Gaussian
119 * 9) converts gauss parameters to ellipse parameters.
120 * 10) determines an intensity conversion factor for the instrument
121 * by fitting a 2D-Gaussian to an collapsed image of a standard star
122 * with known brightness (only for non-AO observations).
123 * Then the resulting Gaussian is integrated and the counts
124 * are divided by the exposure time (Fits header information)
125 *
126 * FILES
127 *
128 * ENVIRONMENT
129 *
130 * RETURN VALUES
131 *
132 * CAUTIONS
133 *
134 * EXAMPLES
135 *
136 * SEE ALSO
137 *
138 * BUGS
139 *
140 *------------------------------------------------------------------------
141 */
142 
143 #ifdef HAVE_CONFIG_H
144 # include <config.h>
145 #endif
146 #include "sinfo_vltPort.h"
147 
148 /*
149  * System Headers
150  */
151 
152 /*
153  * Local Headers
154  */
155 
156 #include "sinfo_focus.h"
157 #include "sinfo_recipes.h"
158 #include <float.h>
159 
160 /*----------------------------------------------------------------------------
161  * Defines
162  *--------------------------------------------------------------------------*/
163 
164 #define XDIMG 2 /* dimension of the x values */
165 #define TOLG 0.001 /* fitting tolerance */
166 #define LABG 0.1 /* labda parameter */
167 #define ITSG 200 /* maximum number of iterations */
168 #define LABFACG 10.0 /* labda step factor */
169 #define LABMAXG 1.0e+10 /* maximum value for labda */
170 #define LABMING 1.0e-10 /* minimum value for labda */
171 #define NPAR 7 /* number of fit parameters */
172 #define PI_NUMB (3.1415926535897932384626433832795) /* pi */
173 
174 
175 /*----------------------------------------------------------------------------
176  * Local variables
177  *--------------------------------------------------------------------------*/
178 
179 static double chi1 ; /* old reduced chi-squared */
180 static double chi2 ; /* new reduced chi-squared */
181 static double labda ; /* mixing parameter */
182 static double vec[NPAR] ; /* correction sinfo_vector */
183 static double matrix1[NPAR][NPAR] ; /* original sinfo_matrix */
184 static double matrix2[NPAR][NPAR] ; /* inverse of matrix1 */
185 static int nfree ; /* number of free parameters */
186 static int parptr[NPAR] ; /* parameter pointer */
187 
188 /*----------------------------------------------------------------------------
189  * Functions private to this module
190  *--------------------------------------------------------------------------*/
191 
192 static int new_inv_mat (void) ;
193 
194 static void new_get_mat ( double * xdat,
195  int * xdim,
196  double * ydat,
197  double * wdat,
198  int * ndat,
199  double * fpar,
200  double * epar/*,
201  int * npar */) ;
202 
203 static int new_get_vec ( double * xdat,
204  int * xdim,
205  double * ydat,
206  double * wdat,
207  int * ndat,
208  double * fpar,
209  double * epar,
210  int * npar ) ;
211 
212 static int new_gauss2Ellipse ( double * parlist ) ;
221 /*----------------------------------------------------------------------------
222  * Function codes
223  *--------------------------------------------------------------------------*/
224 
225 /*-------------------------------------------------------------------------*/
249 /*--------------------------------------------------------------------------*/
250 
251 double sinfo_new_gaussian_ellipse(double * xdat, double * parlist)
252 {
253  double result ;
254  double x ;
255  double y ;
256  double fwhmx ;
257  double fwhmy ;
258  double costheta ;
259  double sintheta ;
260  double argX ; /* arguments in the exponent */
261  double argY ;
262 
263  /* some abbreviations */
264  x = xdat[0] - parlist[0] ;
265  y = xdat[1] - parlist[1] ;
266 
267  fwhmx = fabs(parlist[4]) ;
268  fwhmy = fabs(parlist[5]) ;
269 
270  costheta = cos ( parlist[6] ) ;
271  sintheta = sin ( parlist[6] ) ;
272 
273  argX = x * costheta + y * sintheta ;
274  argY = -x * sintheta + y * costheta ;
275 
276  /* function */
277  result = parlist[2] * exp(-4.*log(2.0)*((argX/fwhmx)*(argX/fwhmx)+
278  (argY/fwhmy)*(argY/fwhmy))) +
279  parlist[3] ;
280 
281  return result ;
282 }
283 
308 void
309 sinfo_new_gaussian_ellipse_deriv(double * xdat,
310  double * parlist,
311  double * dervs )
312 {
313  double x ;
314  double y ;
315  double fwhmx ;
316  double fwhmy ;
317  double argX ;
318  double argY ;
319  double expon ;
320  double e8log2 ;
321  double fwx2 ;
322  double fwy2 ;
323  double costheta ;
324  double sintheta ;
325 
326  /* some abbreviations */
327  x = xdat[0] - parlist[0] ;
328  y = xdat[1] - parlist[1] ;
329 
330  fwhmx = fabs(parlist[4]) ;
331  fwhmy = fabs(parlist[5]) ;
332  fwx2 = fwhmx * fwhmx ;
333  fwy2 = fwhmy * fwhmy ;
334 
335  costheta = cos ( parlist[6] ) ;
336  sintheta = sin ( parlist[6] ) ;
337 
338  argX = x * costheta + y * sintheta ;
339  argY = -x * sintheta + y * costheta ;
340 
341  expon = exp ( -4.0 * log(2.0) * ((argX/fwhmx)*(argX/fwhmx) +
342  (argY/fwhmy)*(argY/fwhmy)) ) ;
343  e8log2 = expon * 8.0 * log(2.0) ;
344 
345  /* determine the derivatives */
346  /* partial derivative x-position */
347  dervs[0] = -parlist[2]*e8log2 * (-argX*costheta/fwx2 + argY*sintheta/fwy2);
348  /* partial derivative y-position */
349  dervs[1] = -parlist[2]*e8log2 * (-argX*sintheta/fwx2 - argY*costheta/fwy2);
350  /* partial derivative amplitude */
351  dervs[2] = expon ;
352  /* partial derivative background */
353  dervs[3] = 1. ;
354  /* partial derivative fwhmx */
355  dervs[4] = parlist[2]*e8log2 * argX*argX/(fwx2*fwhmx) ;
356  /* partial derivative fwhmy */
357  dervs[5] = parlist[2]*e8log2 * argY*argY/(fwy2*fwhmy) ;
358  /* partial derivative theta */
359  dervs[6] = -parlist[2]*e8log2 * argY * argX * (1.0/fwx2 - 1.0/fwy2) ;
360 
361 }
362 
373 static int new_inv_mat (void)
374 {
375  double even ;
376  double hv[NPAR] ;
377  double mjk ;
378  double rowmax ;
379  int evin ;
380  int i, j, k, row ;
381  int per[NPAR] ;
382 
383  /* set permutation array */
384  for ( i = 0 ; i < nfree ; i++ )
385  {
386  per[i] = i ;
387  }
388 
389  for ( j = 0 ; j < nfree ; j++ ) /* in j-th column */
390  {
391  /* determine largest element of a row */
392  rowmax = fabs ( matrix2[j][j] ) ;
393  row = j ;
394 
395  for ( i = j + 1 ; i < nfree ; i++ )
396  {
397  if ( fabs ( matrix2[i][j] ) > rowmax )
398  {
399  rowmax = fabs( matrix2[i][j] ) ;
400  row = i ;
401  }
402  }
403 
404  /* determinant is zero! */
405  if ( matrix2[row][j] == 0.0 )
406  {
407  return -6 ;
408  }
409 
410  /* if the largest element is not on the diagonal,
411  then permutate rows */
412  if ( row > j )
413  {
414  for ( k = 0 ; k < nfree ; k++ )
415  {
416  even = matrix2[j][k] ;
417  matrix2[j][k] = matrix2[row][k] ;
418  matrix2[row][k] = even ;
419  }
420  /* keep track of permutation */
421  evin = per[j] ;
422  per[j] = per[row] ;
423  per[row] = evin ;
424  }
425 
426  /* modify column */
427  even = 1.0 / matrix2[j][j] ;
428  for ( i = 0 ; i < nfree ; i++ )
429  {
430  matrix2[i][j] *= even ;
431  }
432  matrix2[j][j] = even ;
433 
434  for ( k = 0 ; k < j ; k++ )
435  {
436  mjk = matrix2[j][k] ;
437  for ( i = 0 ; i < j ; i++ )
438  {
439  matrix2[i][k] -= matrix2[i][j] * mjk ;
440  }
441  for ( i = j + 1 ; i < nfree ; i++ )
442  {
443  matrix2[i][k] -= matrix2[i][j] * mjk ;
444  }
445  matrix2[j][k] = -even * mjk ;
446  }
447 
448  for ( k = j + 1 ; k < nfree ; k++ )
449  {
450  mjk = matrix2[j][k] ;
451  for ( i = 0 ; i < j ; i++ )
452  {
453  matrix2[i][k] -= matrix2[i][j] * mjk ;
454  }
455  for ( i = j + 1 ; i < nfree ; i++ )
456  {
457  matrix2[i][k] -= matrix2[i][j] * mjk ;
458  }
459  matrix2[j][k] = -even * mjk ;
460  }
461  }
462 
463  /* finally, repermute the columns */
464  for ( i = 0 ; i < nfree ; i++ )
465  {
466  for ( k = 0 ; k < nfree ; k++ )
467  {
468  hv[per[k]] = matrix2[i][k] ;
469  }
470  for ( k = 0 ; k < nfree ; k++ )
471  {
472  matrix2[i][k] = hv[k] ;
473  }
474  }
475 
476  /* all is well */
477  return 0 ;
478 }
479 
495 static void new_get_mat ( double * xdat,
496  int * xdim,
497  double * ydat,
498  double * wdat,
499  int * ndat,
500  double * fpar,
501  double * epar/*,
502  int * npar */)
503 {
504  double wd ;
505  double wn ;
506  double yd ;
507  int i, j, n ;
508 
509  for ( j = 0 ; j < nfree ; j++ )
510  {
511  vec[j] = 0.0 ; /* zero sinfo_vector */
512  for ( i = 0 ; i<= j ; i++ ) /* zero sinfo_matrix only on
513  and below diagonal */
514  {
515  matrix1[j][i] = 0.0 ;
516  }
517  }
518  chi2 = 0.0 ; /* reset reduced chi-squared */
519 
520  /* loop through data points */
521  for ( n = 0 ; n < (*ndat) ; n++ )
522  {
523  wn = wdat[n] ;
524  if ( wn > 0.0 ) /* legal weight ? */
525  {
526  yd=ydat[n] - sinfo_new_gaussian_ellipse(&xdat[(*xdim) * n],fpar) ;
527  sinfo_new_gaussian_ellipse_deriv( &xdat[(*xdim) * n], fpar, epar ) ;
528  chi2 += yd * yd * wn ; /* add to chi-squared */
529  for ( j = 0 ; j < nfree ; j++ )
530  {
531  wd = epar[parptr[j]] * wn ; /* weighted derivative */
532  vec[j] += yd * wd ; /* fill sinfo_vector */
533  for ( i = 0 ; i <= j ; i++ ) /* fill sinfo_matrix */
534  {
535  matrix1[j][i] += epar[parptr[i]] * wd ;
536  }
537  }
538  }
539  }
540 }
541 
542 
568 static int new_get_vec ( double * xdat,
569  int * xdim,
570  double * ydat,
571  double * wdat,
572  int * ndat,
573  double * fpar,
574  double * epar,
575  int * npar )
576 {
577  double dj ;
578  double dy ;
579  double mii ;
580  double mji ;
581  double mjj ;
582  double wn ;
583  int i, j, n, r ;
584 
585  /* loop to modify and scale the sinfo_matrix */
586  for ( j = 0 ; j < nfree ; j++ )
587  {
588  mjj = matrix1[j][j] ;
589  if ( mjj <= 0.0 ) /* diagonal element wrong */
590  {
591  return -5 ;
592  }
593  mjj = sqrt( mjj ) ;
594  for ( i = 0 ; i < j ; i++ )
595  {
596  mji = matrix1[j][i] / mjj / sqrt( matrix1[i][i] ) ;
597  matrix2[i][j] = matrix2[j][i] = mji ;
598  }
599  matrix2[j][j] = 1.0 + labda ; /* scaled value on diagonal */
600  }
601 
602  if ( (r = new_inv_mat()) ) /* sinfo_invert sinfo_matrix inlace */
603  {
604  return r ;
605  }
606 
607  for ( i = 0 ; i < (*npar) ; i ++ )
608  {
609  epar[i] = fpar[i] ;
610  }
611 
612  /* loop to calculate correction sinfo_vector */
613  for ( j = 0 ; j < nfree ; j++ )
614  {
615  dj = 0.0 ;
616  mjj = matrix1[j][j] ;
617  if ( mjj <= 0.0) /* not allowed */
618  {
619  return -7 ;
620  }
621  mjj = sqrt ( mjj ) ;
622  for ( i = 0 ; i < nfree ; i++ )
623  {
624  mii = matrix1[i][i] ;
625  if ( mii <= 0.0 )
626  {
627  return -7 ;
628  }
629  mii = sqrt( mii ) ;
630  dj += vec[i] * matrix2[j][i] / mjj / mii ;
631  }
632  epar[parptr[j]] += dj ; /* new parameters */
633  }
634  chi1 = 0.0 ; /* reset reduced chi-squared */
635 
636  /* loop through the data points */
637  for ( n = 0 ; n < (*ndat) ; n++ )
638  {
639  wn = wdat[n] ; /* get weight */
640  if ( wn > 0.0 ) /* legal weight */
641  {
642  dy=ydat[n] - sinfo_new_gaussian_ellipse(&xdat[(*xdim) * n],epar);
643  chi1 += wdat[n] * dy * dy ;
644  }
645  }
646  return 0 ;
647 }
648 
649 
650 
698 int sinfo_new_lsqfitd ( double * xdat,
699  int * xdim,
700  double * ydat,
701  double * wdat,
702  int * ndat,
703  double * fpar,
704  double * epar,
705  int * mpar,
706  int * npar,
707  double * tol ,
708  int * its ,
709  double * lab )
710 {
711  int i, n, r ;
712  int itc ; /* fate of fit */
713  int found ; /* fit converged: 1, not yet converged: 0 */
714  int nuse ; /* number of useable data points */
715  double tolerance ; /* accuracy */
716 
717  itc = 0 ; /* fate of fit */
718  found = 0 ; /* reset */
719  nfree = 0 ; /* number of free parameters */
720  nuse = 0 ; /* number of legal data points */
721 
722  if ( *tol < (DBL_EPSILON * 10.0 ) )
723  {
724  tolerance = DBL_EPSILON * 10.0 ; /* default tolerance */
725  }
726  else
727  {
728  tolerance = *tol ; /* tolerance */
729  }
730 
731  labda = fabs( *lab ) * LABFACG ; /* start value for mixing parameter */
732  for ( i = 0 ; i < (*npar) ; i++ )
733  {
734  if ( mpar[i] )
735  {
736  if ( nfree > NPAR ) /* too many free parameters */
737  {
738  return -1 ;
739  }
740  parptr[nfree++] = i ; /* a free parameter */
741  }
742  }
743 
744  if (nfree == 0) /* no free parameters */
745  {
746  return -2 ;
747  }
748 
749  for ( n = 0 ; n < (*ndat) ; n++ )
750  {
751  if ( wdat[n] > 0.0 ) /* legal weight */
752  {
753  nuse ++ ;
754  }
755  }
756 
757  if ( nfree >= nuse )
758  {
759  return -3 ; /* no degrees of freedom */
760  }
761  if ( labda == 0.0 ) /* linear fit */
762  {
763  /* initialize fpar array */
764  for ( i = 0 ; i < nfree ; fpar[parptr[i++]] = 0.0 ) ;
765  new_get_mat ( xdat, xdim, ydat, wdat, ndat, fpar, epar/*, npar */) ;
766  r = new_get_vec ( xdat, xdim, ydat, wdat, ndat, fpar, epar, npar ) ;
767  if ( r ) /* error */
768  {
769  return r ;
770  }
771  for ( i = 0 ; i < (*npar) ; i++ )
772  {
773  fpar[i] = epar[i] ; /* save new parameters */
774  epar[i] = 0.0 ; /* and set errors to zero */
775  }
776  chi1 = sqrt( chi1 / (double) (nuse - nfree) ) ;
777  for ( i = 0 ; i < nfree ; i++ )
778  {
779  if ( (matrix1[i][i] <= 0.0 ) || (matrix2[i][i] <= 0.0) )
780  {
781  return -7 ;
782  }
783  epar[parptr[i]] = chi1 * sqrt( matrix2[i][i] ) /
784  sqrt( matrix1[i][i] ) ;
785  }
786  }
787  else /* non-linear fit */
788  {
789  /*----------------------------------------------------------------
790  * the non-linear fit uses the steepest descent method in combination
791  * with the Taylor method. The mixing of these methods is controlled
792  * by labda. In the outer loop ( called the iteration loop ) we build
793  * the matrix and calculate the correction sinfo_vector. In the
794  inner loop
795  * (called the interpolation loop) we check whether we have obtained a
796  * better solution than the previous one. If so, we leave the inner loop
797  * else we increase lambda ( give more weight to the steepest descent
798  * method) calculate the correction vector and check again. After the
799  * inner loop
800  * we do a final check on the goodness of the fit and if this satisfies
801  * the tolerance we calculate the errors of the fitted parameters.
802  */
803  while ( !found ) /* iteration loop */
804  {
805  if ( itc++ == (*its) ) /* increase iteration counter */
806  {
807  return -4 ;
808  }
809  new_get_mat( xdat, xdim, ydat, wdat, ndat, fpar, epar/*, npar*/ ) ;
810 
811  /*-------------------------------------------------------------
812  * here we decrease labda since we may assume that each iteration
813  * brings us closer to the answer.
814  */
815  if ( labda > LABMING )
816  {
817  labda = labda / LABFACG ; /* decrease labda */
818  }
819  r = new_get_vec ( xdat, xdim, ydat, wdat, ndat, fpar, epar, npar ) ;
820 
821  if ( r ) /* error */
822  {
823  return r ;
824  }
825 
826  while ( chi1 >= chi2 ) /* interpolation loop */
827  {
828  /*-----------------------------------------------------------
829  * The next statement is based on experience, not on the
830  * mathematics of the problem. It is assumed that we have
831  * reached convergence when the pure steepest descent method
832  * does not produce a better solution.
833  */
834  if ( labda > LABMAXG ) /* assume solution found */
835  {
836  break ;
837  }
838  labda = labda * LABFACG ; /* increase mixing parameter */
839  r = new_get_vec(xdat,xdim,ydat,wdat,ndat,fpar,epar,npar) ;
840 
841  if ( r ) /* error */
842  {
843  return r ;
844  }
845  }
846 
847  if ( labda <= LABMAXG ) /* save old parameters */
848  {
849  for ( i = 0 ; i < *npar ; i++ )
850  {
851  fpar[i] = epar[i] ;
852  }
853  }
854  if ( (fabs( chi2 - chi1 ) <= (tolerance * chi1)) ||
855  (labda > LABMAXG) )
856  {
857  /*-----------------------------------------------------------
858  * we have a satisfying solution, so now we need to calculate
859  * the correct errors of the fitted parameters. This we do by
860  * using the pure Taylor
861  * method because we are very close to the real solution.
862  */
863  labda = LABMING ; /* for Taylor solution */
864  new_get_mat(xdat,xdim,ydat,wdat,ndat,fpar,epar/*, npar */) ;
865  r=new_get_vec(xdat,xdim,ydat,wdat,ndat,fpar,epar,npar ) ;
866 
867  if ( r ) /* error */
868  {
869  return r ;
870  }
871  for ( i = 0 ; i < (*npar) ; i++ )
872  {
873  epar[i] = 0.0 ; /* set error to zero */
874  }
875  chi2 = sqrt ( chi2 / (double) (nuse - nfree) ) ;
876 
877  for ( i = 0 ; i < nfree ; i++ )
878  {
879  if ( (matrix1[i][i] <= 0.0) || (matrix2[i][i] <= 0.0) )
880  {
881  return -7 ;
882  }
883  epar[parptr[i]] = chi2 * sqrt( matrix2[i][i] ) /
884  sqrt( matrix1[i][i] ) ;
885  }
886  found = 1 ; /* we found a solution */
887  }
888  }
889  }
890  return itc ; /* return number of iterations */
891 }
892 
922 int
923 sinfo_new_fit_2d_gaussian ( cpl_image * image,
924  double * fit_par,
925  double * derv_par,
926  int * mpar,
927  int lleftx,
928  int llefty,
929  int halfbox_x,
930  int halfbox_y,
931  int* check )
932 {
933  int i, j, n ;
934  int col, row ;
935  int boxi, boxj ;
936  int iters ;
937  int ndata ;
938  int xdim ;
939  int npar ;
940  int its ;
941  double lab ;
942  double tol ;
943  double maxval ;
944  double background ;
945  double amplitude ;
946  float * backarray=NULL ;
947  double M, Mx, My ;
948  double Mxx, Mxy, Myy ;
949  double X0, Y0 ;
950  double xydat[4 *halfbox_x*halfbox_y][XDIMG] ;
951  double zdat[4*halfbox_x*halfbox_y] ;
952  double wdat[4*halfbox_x*halfbox_y] ;
953  double xco, yco ;
954  double value ;
955  double denom ;
956  double temp ;
957  int llx, lly ;
958  int foundrow ;
959  int foundcol ;
960  int k ;
961  int ilx=0;
962  int ily=0;
963  float* pidata=NULL;
964 
965  memset(&wdat[0], 0, (4*halfbox_x*halfbox_y)* sizeof(double));
966 
967  if ( NULL == image )
968  {
969  sinfo_msg_error("no image given") ;
970  return -1 ;
971  }
972  ilx=cpl_image_get_size_x(image);
973  ily=cpl_image_get_size_y(image);
974 
975  if ( NULL == fit_par )
976  {
977  sinfo_msg_error("no fit parameters given") ;
978  return -1 ;
979  }
980  if ( NULL == derv_par )
981  {
982  sinfo_msg_error("no derivatives of fit parameters given") ;
983  return -1 ;
984  }
985  if ( lleftx < 0 || lleftx + 2*halfbox_x >= ilx ||
986  llefty < 0 || llefty + 2*halfbox_y >= ily )
987  {
988  sinfo_msg_error("wrong lower left point of fitting box given!") ;
989  return -1 ;
990  }
991  if ( halfbox_x <= 1 || halfbox_y <= 1 )
992  {
993  sinfo_msg_error("wrong box dimensions given") ;
994  return -1 ;
995  }
996  /* allocate memory */
997  if ( NULL == (backarray = (float*) cpl_calloc(4*halfbox_x+4*halfbox_y,
998  sizeof(float) ) ) )
999  {
1000  sinfo_msg_error("could not allocate memory") ;
1001  return -1 ;
1002  }
1003 
1004  /* -------------------------------------------------------------------
1005  * find the initial estimates for the free parameters
1006  */
1007 
1008  /* first search for the position of the maximum intensity */
1009  foundrow = 0 ;
1010  foundcol = 0 ;
1011  maxval = -SINFO_DBL_MAX ;
1012  pidata=cpl_image_get_data_float(image);
1013  for ( col = lleftx ; col < lleftx + 2*halfbox_x ; col++ )
1014  {
1015  for ( row = llefty ; row < llefty + 2*halfbox_y ; row++ )
1016  {
1017  if ( isnan(pidata[col+row*ilx]) )
1018  {
1019  continue ;
1020  }
1021  if ( maxval < pidata[col+row*ilx] )
1022  {
1023  maxval = pidata[col+row*ilx] ;
1024  foundrow = row ;
1025  foundcol = col ;
1026  }
1027  }
1028  }
1029 
1030  if ( foundrow == 0 || foundcol == 0 || maxval <= 0. ||
1031  foundrow == ilx-1 || foundcol == ily-1 )
1032  {
1033  sinfo_msg_warning("no maximum found") ;
1034  cpl_free(backarray) ;
1035  return -1 ;
1036  }
1037 
1038  /* determine the lower left sinfo_edge of the fitting box, center it
1039  on the maximum value */
1040  llx = foundcol - halfbox_x ;
1041  lly = foundrow - halfbox_y ;
1042  if ((foundcol - halfbox_x) > 0) {
1043  llx = (foundcol - halfbox_x);
1044  } else {
1045  llx=1;
1046  check++;
1047  }
1048 
1049  if ((foundrow - halfbox_y) > 0) {
1050  lly = (foundrow - halfbox_y);
1051  } else {
1052  lly=1;
1053  check++;
1054  }
1055 
1056  if ( ( llx + 2*halfbox_x) < ilx-1 ) {
1057  //halfbox_x=halfbox_x;
1058  } else {
1059  halfbox_x=(int) (ilx-2-llx)/2;
1060  check++;
1061  }
1062 
1063  if ( ( lly + 2*halfbox_y) < ily-1 ) {
1064  //halfbox_y= halfbox_y;
1065  } else {
1066  halfbox_y=(int) (ily-2-lly)/2;
1067  check++;
1068  }
1069 
1070  if ( llx <= 0 || lly < 0 || llx + 2*halfbox_x >= ilx-1 ||
1071  lly + 2*halfbox_y >= ily )
1072  {
1073  sinfo_msg_error("box does not fit into image") ;
1074  cpl_free(backarray) ;
1075  return -1 ;
1076  }
1077 
1078  /* determine the zeroth and first order moments of the image
1079  within the fitting box */
1080  M = Mx = My = 0. ;
1081  n = 0 ;
1082  boxi = boxj = 0 ;
1083  for ( j = lly ; j < lly + 2*halfbox_y ; j++ )
1084  {
1085  boxj = j - lly ;
1086  for ( i = llx ; i < llx + 2*halfbox_x ; i++ )
1087  {
1088  boxi = i - llx ;
1089  if ( !isnan(pidata[i+j*ilx]) )
1090  {
1091  M += pidata[i+j*ilx] ;
1092  Mx += (double)boxi * pidata[i+j*ilx] ;
1093  My += (double)boxj * pidata[i+j*ilx] ;
1094  /*-----------------------------------------------------------
1095  * estimate the amplitude and the background
1096  * go through the margins of the fitting box
1097  * and calculate the clean mean to
1098  * determine the background
1099  */
1100  if ( i == llx || i == llx + 2*halfbox_x -1 ||
1101  j == lly || j == lly + 2*halfbox_y -1 )
1102  {
1103  backarray[n] = pidata[i+j*ilx] ;
1104  n++ ;
1105  }
1106  }
1107  }
1108  }
1109  if ( M <= 0. )
1110  {
1111  sinfo_msg_warning("only negative or zero values") ;
1112  cpl_free(backarray) ;
1113  return -1 ;
1114  }
1115  if ( n < 3 )
1116  {
1117  sinfo_msg_error("not enough data points to calculate background") ;
1118  cpl_free(backarray) ;
1119  return -1 ;
1120  }
1121  /* determine the background as sinfo_median of the surrounding pixels */
1122  if (FLT_MAX==(background=sinfo_new_clean_mean(backarray,n,10.,10.)))
1123  {
1124  sinfo_msg_error("it was not possible to compute the "
1125  "clean mean of the background values") ;
1126  cpl_free(backarray) ;
1127  return -1 ;
1128  }
1129  cpl_free (backarray) ;
1130  /* now calculate the amplitude estimation */
1131  amplitude = maxval - background ;
1132  if ( amplitude < 1e-12 )
1133  {
1134  sinfo_msg_warning("amplitude is too small") ;
1135  return -1 ;
1136  }
1137 
1138  /* determine the center of gravity = centroid */
1139  X0 = Mx / M ;
1140  Y0 = My / M ;
1141  /* if one of the values is outside the fitting box return with error */
1142  if ( X0 <= 0. || Y0 <= 0. || X0 >= 2.*(double)halfbox_x ||
1143  Y0 >= 2.*(double)halfbox_y )
1144  {
1145  sinfo_msg_warning("center of gravity is outside the fitting box!") ;
1146  return -1 ;
1147  }
1148 
1149  /*------------------------------------------------------------------------
1150  * put the data in the 2-d array xydat[][] (pixel position) and zdat[]
1151  * (data values) additionally, determine the second order momentum
1152  */
1153  n = 0 ;
1154  M = Mx = Mxx = My = Myy = Mxy = 0. ;
1155  boxi = boxj = 0 ;
1156  for ( j = lly ; j < lly + 2*halfbox_y ; j++ )
1157  {
1158  boxj = j - lly ;
1159  for ( i = llx ; i < llx + 2*halfbox_x ; i++ )
1160  {
1161  boxi = i - llx ;
1162  value = pidata[i+j*ilx] ;
1163  if ( !isnan(value) )
1164  {
1165  xydat[n][0] = (double) boxi ;
1166  xydat[n][1] = (double) boxj ;
1167  zdat[n] = value ;
1168  wdat[n] = 1. ;
1169  n++ ;
1170 
1171  /* now calculate the moments without background in the
1172  centroid coordinate system */
1173  value -= background ;
1174  xco = (double) boxi - X0 ;
1175  yco = (double) boxj - Y0 ;
1176  M += value ;
1177  Mx += xco * value ;
1178  My += yco * value ;
1179  Mxx += xco * xco * value ;
1180  Myy += yco * yco * value ;
1181  Mxy += xco * yco * value ;
1182  }
1183  }
1184  }
1185  if ( M <= 0. )
1186  {
1187  sinfo_msg_warning("only negative or zero values") ;
1188  return -1 ;
1189  }
1190 
1191  /* ----------------------------------------------------------------
1192  * estimate the fwhm_x and fwhm_y and theta
1193  */
1194 
1195  /* first scale the moments */
1196  /* TODO: why use Mx is later this is never used? */
1197  Mx /= M ;
1198  My /= M ;
1199  Mxx /= M ;
1200  Myy /= M ;
1201  Mxy /= M ;
1202 
1203  denom = 2. * (Mxx*Myy - Mxy*Mxy) ;
1204  if ( denom == 0. )
1205  {
1206  sinfo_msg_error("denominator is zero!") ;
1207  return -1 ;
1208  }
1209 
1210  /* now associate the parameter list with the found estimates */
1211  fit_par[0] = X0 ;
1212  fit_par[1] = Y0 ;
1213  fit_par[2] = amplitude ;
1214  fit_par[3] = background ;
1215  fit_par[4] = Myy/denom ;
1216  fit_par[5] = Mxx/denom ;
1217  fit_par[6] = -Mxy/denom ;
1218 
1219  /* convert the moments to ellipse paramters */
1220  if ( 0 > new_gauss2Ellipse (fit_par) )
1221  {
1222  sinfo_msg_warning("gauss2Ellipse does not run!") ;
1223  return -1 ;
1224  }
1225 
1226  /* total number of data points */
1227  ndata = 4 * halfbox_x * halfbox_y ;
1228  xdim = XDIMG ; /* dimension of xydat array */
1229  npar = NPAR ; /* number of parameters in the fit */
1230  its = ITSG ;
1231  lab = LABG ;
1232  tol = TOLG ;
1233  for ( i = 0 ; i < NPAR ; i++ )
1234  {
1235  derv_par[i] = 0. ;
1236  }
1237 
1238  if ( 0 > ( iters = sinfo_new_lsqfitd ( &xydat[0][0],
1239  &xdim,
1240  zdat,
1241  wdat,
1242  &ndata,
1243  fit_par,
1244  derv_par,
1245  mpar,
1246  &npar,
1247  &tol,
1248  &its,
1249  &lab )) )
1250  {
1251  sinfo_msg_warning(" least squares fit failed, error no: %d!", iters) ;
1252  return -1 ;
1253  }
1254 
1255  /* exclude impossible fit results */
1256  if ( fit_par[2] <= 0. || fit_par[4] < 0. || fit_par[5] < 0. )
1257  {
1258  sinfo_msg_error("sorry, some impossible negative fit results!") ;
1259  return -1 ;
1260  }
1261  fit_par[0] += llx ;
1262  fit_par[1] += lly ;
1263  if ( fit_par[0] < llx || fit_par[0] >= llx + 2*halfbox_x ||
1264  fit_par[1] < lly || fit_par[1] >= lly + 2*halfbox_y )
1265  {
1266  sinfo_msg_error("sorry, centroid after the fit "
1267  "outside the fitting box") ;
1268  return -1 ;
1269  }
1270 
1271  /* exchange fwhmx and fwhmy if |theta| is bigger than
1272  pi/4 and subtract pi/2 from theta */
1273  if ( fabs ( fit_par[6] ) > PI_NUMB / 4. )
1274  {
1275  /* first convert angle to smaller than 2 pi */
1276  if ( fabs (fit_par[6]) >= 2. * PI_NUMB )
1277  {
1278  k = (int) (fit_par[6] / (2.*PI_NUMB)) ;
1279  if ( k > 0 )
1280  {
1281  fit_par[6] -= k*2.*PI_NUMB ;
1282  }
1283  else
1284  {
1285  fit_par[6] += k*2.*PI_NUMB ;
1286  }
1287  }
1288  /* first convert angle to smaller than pi/2 */
1289  if ( fabs (fit_par[6]) > PI_NUMB / 2. )
1290  {
1291  if ( fit_par[6] > 0. )
1292  {
1293  fit_par[6] -= PI_NUMB ;
1294  }
1295  else
1296  {
1297  fit_par[6] += PI_NUMB ;
1298  }
1299  }
1300 
1301  if ( fabs (fit_par[6]) > PI_NUMB / 4. )
1302  {
1303  temp = fit_par[4] ;
1304  fit_par[4] = fit_par[5] ;
1305  fit_par[5] = temp ;
1306  if ( fit_par[6] < 0. )
1307  {
1308  fit_par[6] += PI_NUMB / 2. ;
1309  }
1310  else
1311  {
1312  fit_par[6] -= PI_NUMB / 2. ;
1313  }
1314  }
1315  }
1316 
1317  return iters ;
1318 }
1319 
1329 cpl_image *
1330 sinfo_new_plot_gaussian (cpl_image * image,
1331  double * parlist )
1332 {
1333  int col, row ;
1334  cpl_image * retImage ;
1335  double xdat[2] ;
1336  int ilx=0;
1337  int ily=0;
1338  float* podata=NULL;
1339 
1340  if ( image == NULL )
1341  {
1342  sinfo_msg_error("no input image given!") ;
1343  return NULL ;
1344  }
1345  ilx=cpl_image_get_size_x(image);
1346  ily=cpl_image_get_size_y(image);
1347 
1348  if ( parlist == NULL )
1349  {
1350  sinfo_msg_error("no Gaussian parameters given!") ;
1351  return NULL ;
1352  }
1353 
1354  retImage = cpl_image_new (ilx, ily, CPL_TYPE_FLOAT) ;
1355  podata=cpl_image_get_data_float(retImage);
1356  for ( row = 0 ; row < ily ; row++ )
1357  {
1358  for ( col = 0 ; col < ilx ; col++ )
1359  {
1360  xdat[0] = (double) col ;
1361  xdat[1] = (double) row ;
1362  podata[col+row*ilx] = sinfo_new_gaussian_ellipse( xdat , parlist) ;
1363  }
1364  }
1365 
1366  return retImage ;
1367 }
1368 
1376 static int new_gauss2Ellipse ( double * parlist )
1377 {
1378  double a, b, c ;
1379  double ellipseconst ;
1380  double axisX, axisY, phi ;
1381  double p ;
1382 
1383  if ( parlist == NULL )
1384  {
1385  sinfo_msg_error(" no parameters given!\n") ;
1386  return -1 ;
1387  }
1388 
1389  a = parlist[4] ; /* fwhmx */
1390  b = parlist[5] ; /* fwhmy */
1391  c = parlist[6] ; /* theta */
1392 
1393  ellipseconst = 2. * log(2.) ;
1394 
1395  if ( a*b - c*c <= 0. )
1396  {
1397  sinfo_msg_warning("estimates of moments are unusable, "
1398  "they do not make an ellipse!") ;
1399  return -1 ;
1400  }
1401 
1402  if ( a == b )
1403  {
1404  phi = 0. ;
1405  }
1406  else
1407  {
1408  phi = 0.5 * atan( 2. * c / (a-b) ) ;
1409  }
1410 
1411  p = sqrt ( (a-b) * (a-b) + 4. * c*c ) ;
1412 
1413  if ( a > b )
1414  {
1415  axisX = 2. * sqrt ( ellipseconst / (a+b+p) ) ;
1416  axisY = 2. * sqrt ( ellipseconst / (a+b-p) ) ;
1417  }
1418  else
1419  {
1420  axisX = 2. * sqrt ( ellipseconst / (a+b-p) ) ;
1421  axisY = 2. * sqrt ( ellipseconst / (a+b+p) ) ;
1422  }
1423 
1424  parlist[4] = axisX ;
1425  parlist[5] = axisY ;
1426  parlist[6] = phi ;
1427 
1428  return 0 ;
1429 }
1430 
1454 float sinfo_new_determine_conversion_factor ( cpl_imagelist * cube,
1455  float mag,
1456  float exptime,
1457  int llx,
1458  int lly,
1459  int halfbox_x,
1460  int halfbox_y,
1461  int* check )
1462 {
1463  int row, col, i ;
1464  int first_row, first_col ;
1465  int last_row, last_col ;
1466  float factor ;
1467  int mpar[7] ;
1468  double fit_par[7] ;
1469  double derv_par[7] ;
1470  int fitInd ;
1471  double sum ;
1472  double xdat[2] ;
1473  cpl_image * summedIm ;
1474 
1475  int ilx=0;
1476  int ily=0;
1477  //int inp=0;
1478 
1479  if ( NULL == cube )
1480  {
1481  sinfo_msg_error(" no cube given!\n") ;
1482  return -FLT_MAX ;
1483  }
1484 
1485  ilx=cpl_image_get_size_x(cpl_imagelist_get(cube,0));
1486  ily=cpl_image_get_size_y(cpl_imagelist_get(cube,0));
1487  //inp=cpl_imagelist_get_size(cube);
1488 
1489  if ( halfbox_x <= 0 || halfbox_y <= 0 ||
1490  2*halfbox_x > ilx || 2*halfbox_y > ily)
1491  {
1492  sinfo_msg_error(" wrong width of halfbox given!") ;
1493  return -FLT_MAX ;
1494  }
1495  if ( exptime <= 0. )
1496  {
1497  sinfo_msg_error(" impossible exposure time given !") ;
1498  return -FLT_MAX ;
1499  }
1500 
1501  /* collapse the cube to be able to do 2D-Gaussian fitting */
1502  if ( NULL == (summedIm = sinfo_new_sum_cube_to_image(cube)) )
1503  {
1504  sinfo_msg_error(" sinfo_averageCubeToImage failed!") ;
1505  return -FLT_MAX ;
1506  }
1507 
1508  /* call the 2D-Gaussian fit routine */
1509  for ( i = 0 ; i < 7 ; i++ )
1510  {
1511  mpar[i] = 1 ;
1512  }
1513  if ( -1 == (fitInd = sinfo_new_fit_2d_gaussian(summedIm, fit_par, derv_par,
1514  mpar, llx, lly, halfbox_x,
1515  halfbox_y, check)) )
1516  {
1517  sinfo_msg_warning("sinfo_fit2dGaussian failed!") ;
1518  cpl_image_delete( summedIm) ;
1519  return -FLT_MAX ;
1520  }
1521  cpl_image_delete(summedIm) ;
1522 
1523  /* now integrate the found 2D Gaussian by first
1524  subtracting the background */
1525  if ((fit_par[0] - halfbox_x) < 0) {
1526  first_col=0;
1527  check++;
1528  } else {
1529  first_col=(fit_par[0] - halfbox_x);
1530  }
1531 
1532  if ((fit_par[0] + halfbox_x) < ilx) {
1533  last_col = (fit_par[0] + halfbox_x);
1534  } else {
1535  last_col = (ilx-1) ;
1536  check++;
1537  }
1538 
1539  if ((fit_par[1] - halfbox_y) < 0) {
1540  first_row=0;
1541  check++;
1542  } else {
1543  first_row=(fit_par[1] - halfbox_y) ;
1544  }
1545 
1546  if ((fit_par[1] + halfbox_y) < ily) {
1547  last_row=(fit_par[1] + halfbox_y);
1548  } else {
1549  last_row= (ily-1);
1550  check++;
1551  }
1552 
1553 
1554  if ( first_col < 0 || first_row < 0 || last_col >= ilx || last_row >= ily )
1555  {
1556  sinfo_msg_error("star badly centered in FOV or fitting box too big!") ;
1557  return -FLT_MAX ;
1558  }
1559  sum = 0. ;
1560  for ( row = first_row ; row < last_row ; row++ )
1561  {
1562  for( col = first_col ; col < last_col ; col++ )
1563  {
1564  xdat[0] = (double) col ;
1565  xdat[1] = (double) row ;
1566  sum += (sinfo_new_gaussian_ellipse( xdat, fit_par ) - fit_par[3]) ;
1567  }
1568  }
1569  if ( sum <= 0. )
1570  {
1571  sinfo_msg_error("zero or negative sum of counts!") ;
1572  return -FLT_MAX ;
1573  }
1574  factor = mag / (float)sum * exptime ;
1575  return factor ;
1576 }
1577 
1578 /*--------------------------------------------------------------------------*/