UVES Pipeline Reference Manual  5.4.0
irplib_strehl.c
1 /* $Id: irplib_strehl.c,v 1.43 2009-11-18 21:37:48 llundin Exp $
2  *
3  * This file is part of the irplib package
4  * Copyright (C) 2002,2003 European Southern Observatory
5  *
6  * This program is free software; you can redistribute it and/or modify
7  * it under the terms of the GNU General Public License as published by
8  * the Free Software Foundation; either version 2 of the License, or
9  * (at your option) any later version.
10  *
11  * This program is distributed in the hope that it will be useful,
12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14  * GNU General Public License for more details.
15  *
16  * You should have received a copy of the GNU General Public License
17  * along with this program; if not, write to the Free Software
18  * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02111-1307 USA
19  */
20 
21 /*
22  * $Author: llundin $
23  * $Date: 2009-11-18 21:37:48 $
24  * $Revision: 1.43 $
25  * $Name: not supported by cvs2svn $
26  */
27 
28 #ifdef HAVE_CONFIG_H
29 #include <config.h>
30 #endif
31 
32 /*-----------------------------------------------------------------------------
33  Includes
34  -----------------------------------------------------------------------------*/
35 
36 #include "irplib_strehl.h"
37 #include "irplib_utils.h"
38 
39 #include <assert.h>
40 #include <stdint.h>
41 #include <math.h>
42 
43 /*----------------------------------------------------------------------------*/
47 /*----------------------------------------------------------------------------*/
48 
49 /*-----------------------------------------------------------------------------
50  Define
51  -----------------------------------------------------------------------------*/
52 
53 #ifndef IRPLIB_STREHL_RAD_CENTRAL
54 #define IRPLIB_STREHL_RAD_CENTRAL 5
55 #endif
56 
57 #ifndef IRPLIB_STREHL_DETECT_LEVEL
58 #define IRPLIB_STREHL_DETECT_LEVEL 5.0
59 #endif
60 
61 #define IRPLIB_DISK_BG_MIN_PIX_NB 30
62 #define IRPLIB_DISK_BG_REJ_LOW 0.1
63 #define IRPLIB_DISK_BG_REJ_HIGH 0.1
64 
65 #ifdef CPL_MIN
66 #define IRPLIB_MIN CPL_MIN
67 #else
68 #define IRPLIB_MIN(A,B) ((A) < (B) ? (A) : (B))
69 #endif
70 
71 #ifdef CPL_MAX
72 #define IRPLIB_MAX CPL_MAX
73 #else
74 #define IRPLIB_MAX(A,B) ((A) > (B) ? (A) : (B))
75 #endif
76 
77 /*-----------------------------------------------------------------------------
78  Functions prototypes
79  -----------------------------------------------------------------------------*/
80 
81 static cpl_image * irplib_strehl_generate_otf(double, double, double, double,
82  int, double);
83 static double PSF_H1(double, double, double);
84 static double PSF_H2(double, double);
85 static double PSF_G(double, double);
86 static double PSF_sinc_norm(double);
87 static double PSF_TelOTF(double, double);
88 
89 #ifndef IRPLIB_NO_FIT_GAUSSIAN
90 #ifdef IRPLIB_STREHL_USE_CPL_IMAGE_FIT_GAUSSIAN
91 static double irplib_gaussian_2d(double, double, double, double, double);
92 #endif
93 
94 #if defined CPL_VERSION_CODE && CPL_VERSION_CODE >= CPL_VERSION(6, 9, 1)
95 #define irplib_gaussian_eval_2d cpl_gaussian_eval_2d
96 #else
97 static double irplib_gaussian_eval_2d(const cpl_array *, double, double);
98 #endif
99 
100 static uint32_t irplib_roundup_power2(uint32_t v) CPL_ATTR_CONST;
101 
102 static
103 cpl_error_code irplib_gaussian_maxpos(const cpl_image *,
104  double,
105  double *,
106  double *,
107  double *);
108 #endif
109 
110 /*-----------------------------------------------------------------------------
111  Functions code
112  -----------------------------------------------------------------------------*/
115 /*----------------------------------------------------------------------------*/
145 /*----------------------------------------------------------------------------*/
146 cpl_error_code irplib_strehl_compute(const cpl_image * im,
147  double m1,
148  double m2,
149  double lam,
150  double dlam,
151  double pscale,
152  int size,
153  double xpos,
154  double ypos,
155  double r1,
156  double r2,
157  double r3,
158  int noise_box_sz,
159  int noise_nsamples,
160  double * strehl,
161  double * strehl_err,
162  double * star_bg,
163  double * star_peak,
164  double * star_flux,
165  double * psf_peak,
166  double * psf_flux,
167  double * bg_noise)
168 {
169  cpl_image * psf;
170  double star_radius, max_radius;
171 
172  /* FIXME: Arbitrary choice of image border */
173  const double window_size = (double)(IRPLIB_STREHL_RAD_CENTRAL);
174 
175  /* Determined empirically by C. Lidman for Strehl error computation */
176  const double strehl_error_coefficient = CPL_MATH_PI * 0.007 / 0.0271;
177  double ring[4];
178  /* cpl_flux_get_noise_ring() must succeed with this many tries */
179  int ring_tries = 3;
180 #ifndef IRPLIB_NO_FIT_GAUSSIAN
181  double xposfit, yposfit, peak;
182  cpl_error_code code;
183 #endif
184  cpl_errorstate prestate = cpl_errorstate_get();
185 
186  /* Check compile-time constant */
187  cpl_ensure_code(window_size > 0.0, CPL_ERROR_ILLEGAL_INPUT);
188 
189  /* Test inputs */
190  cpl_ensure_code(im != NULL, CPL_ERROR_NULL_INPUT);
191  cpl_ensure_code(strehl != NULL, CPL_ERROR_NULL_INPUT);
192  cpl_ensure_code(strehl_err != NULL, CPL_ERROR_NULL_INPUT);
193  cpl_ensure_code(star_bg != NULL, CPL_ERROR_NULL_INPUT);
194  cpl_ensure_code(star_peak != NULL, CPL_ERROR_NULL_INPUT);
195  cpl_ensure_code(star_flux != NULL, CPL_ERROR_NULL_INPUT);
196  cpl_ensure_code(psf_peak != NULL, CPL_ERROR_NULL_INPUT);
197  cpl_ensure_code(psf_flux != NULL, CPL_ERROR_NULL_INPUT);
198 
199  cpl_ensure_code(pscale > 0.0, CPL_ERROR_ILLEGAL_INPUT);
200 
201  cpl_ensure_code(r1 > 0.0, CPL_ERROR_ILLEGAL_INPUT);
202  cpl_ensure_code(r2 > 0.0, CPL_ERROR_ILLEGAL_INPUT);
203  cpl_ensure_code(r3 > r2, CPL_ERROR_ILLEGAL_INPUT);
204 
205  /* Computing a Strehl ratio is a story between an ideal PSF */
206  /* and a candidate image supposed to approximate this ideal PSF. */
207 
208  /* Generate first appropriate PSF to find max peak */
209  psf = irplib_strehl_generate_psf(m1, m2, lam, dlam, pscale, size);
210  if (psf == NULL) {
211  return cpl_error_set_where(cpl_func);
212  }
213 
214  /* Compute flux in PSF and find max peak */
215  *psf_peak = cpl_image_get_max(psf);
216  cpl_image_delete(psf);
217 
218  assert( *psf_peak > 0.0); /* The ideal PSF has a positive maximum */
219  *psf_flux = 1.0; /* The psf flux, cpl_image_get_flux(psf), is always 1 */
220 
221 #ifndef IRPLIB_NO_FIT_GAUSSIAN
222  code = irplib_gaussian_maxpos(im, IRPLIB_STREHL_DETECT_LEVEL,
223  &xposfit, &yposfit, &peak);
224  if (code) {
225  cpl_errorstate_set(prestate);
226  } else {
227  xpos = xposfit;
228  ypos = yposfit;
229  }
230 #endif
231 
232  /* Measure the background in the candidate image */
233  *star_bg = irplib_strehl_ring_background(im, xpos, ypos,
234  r2/pscale, r3/pscale,
235  IRPLIB_BG_METHOD_AVER_REJ);
236  if (!cpl_errorstate_is_equal(prestate)) {
237  return cpl_error_set_where(cpl_func);
238  }
239 
240  /* Compute star_radius in pixels */
241  star_radius = r1/pscale;
242 
243  /* Measure the flux on the candidate image */
244  *star_flux = irplib_strehl_disk_flux(im, xpos, ypos, star_radius, *star_bg);
245 
246  if (*star_flux <= 0.0) {
247  return cpl_error_set_message(cpl_func, CPL_ERROR_ILLEGAL_OUTPUT,
248  "Non-positive star flux=%g (Star "
249  "background=%g)", *star_flux, *star_bg);
250  }
251 
252  /* Find the peak value on the central part of the candidate image */
253  max_radius = window_size < star_radius ? window_size : star_radius;
254  cpl_ensure_code(!irplib_strehl_disk_max(im, xpos, ypos, max_radius,
255  star_peak), cpl_error_get_code());
256  *star_peak -= *star_bg;
257 
258  if (*star_flux <= 0.0) {
259  return cpl_error_set_message(cpl_func, CPL_ERROR_ILLEGAL_OUTPUT,
260  "Non-positive star peak=%g (Star "
261  "background=%g, Star flux=%g)",
262  *star_flux, *star_bg, *star_flux);
263  }
264 
265  /* Compute Strehl */
266  /* (StarPeak / StarFlux) / (PsfPeak / PsfFlux) */
267  *strehl = (*star_peak * *psf_flux ) / ( *star_flux * *psf_peak);
268 
269 #ifndef IRPLIB_NO_FIT_GAUSSIAN
270  if (code == CPL_ERROR_NONE && peak > *star_peak && *star_peak > 0.0 &&
271  *strehl * peak / *star_peak <= 1.0) {
272  cpl_msg_debug(cpl_func, "Increasing Strehl from %g: %g (%g)",
273  *strehl, *strehl * peak / *star_peak,
274  peak / *star_peak);
275  *strehl *= peak / *star_peak;
276  *star_peak = peak;
277  }
278 #endif
279 
280  /* Compute Strehl error */
281  ring[0] = xpos;
282  ring[1] = ypos;
283  ring[2] = r2/pscale;
284  ring[3] = r3/pscale;
285 
286  while (cpl_flux_get_noise_ring(im, ring, noise_box_sz, noise_nsamples,
287  bg_noise, NULL) && --ring_tries > 0);
288  if (ring_tries > 0) {
289  cpl_errorstate_set(prestate); /* Recover, if an error happened */
290  } else {
291  return cpl_error_set_where(cpl_func);
292  }
293 
294  *strehl_err = strehl_error_coefficient * (*bg_noise) * pscale *
295  star_radius * star_radius / *star_flux;
296 
297  if (*strehl > 1.0) {
298  cpl_msg_warning(cpl_func, "Extreme Strehl-ratio=%g (strehl-error=%g, "
299  "star_peak=%g, star_flux=%g, psf_peak=%g, psf_flux=%g)",
300  *strehl, *strehl_err, *star_peak, *star_flux, *psf_peak,
301  *psf_flux);
302  }
303 
304  /* This check should not be able to fail, but just to be sure */
305  return *strehl_err >= 0.0
306  ? CPL_ERROR_NONE
307  : cpl_error_set_message(cpl_func, CPL_ERROR_ILLEGAL_OUTPUT,
308  "Negative strehl-error=%g (Strehl-ratio=%g, "
309  "star_peak=%g, star_flux=%g, psf_peak=%g, "
310  "psf_flux=%g", *strehl_err, *strehl,
311  *star_peak, *star_flux, *psf_peak, *psf_flux);
312 }
313 
314 /*----------------------------------------------------------------------------*/
327 /*----------------------------------------------------------------------------*/
328 double irplib_strehl_disk_flux(const cpl_image * im,
329  double xpos,
330  double ypos,
331  double rad,
332  double bg)
333 {
334  const int nx = cpl_image_get_size_x(im);
335  const int ny = cpl_image_get_size_y(im);
336  /* Round down */
337  const int lx = (int)(xpos - rad);
338  const int ly = (int)(ypos - rad);
339  /* Round up */
340  const int ux = (int)(xpos + rad) + 1;
341  const int uy = (int)(ypos + rad) + 1;
342 
343  const double sqr = rad * rad;
344  double flux = 0.0;
345  int i, j;
346 
347 
348  /* Check entries */
349  cpl_ensure(im != NULL, CPL_ERROR_NULL_INPUT, 0.0);
350  cpl_ensure(rad > 0.0, CPL_ERROR_ILLEGAL_INPUT, 0.0);
351 
352  for (j = IRPLIB_MAX(ly, 0); j < IRPLIB_MIN(uy, ny-1); j++) {
353  const double yj = (double)j - ypos;
354  for (i = IRPLIB_MAX(lx, 0); i < IRPLIB_MIN(ux, nx-1); i++) {
355  const double xi = (double)i - xpos;
356  const double dist = yj * yj + xi * xi;
357  if (dist <= sqr) {
358  int isbad;
359  const double value = cpl_image_get(im, i+1, j+1, &isbad);
360 
361  if (!isbad ) {
362 
363  flux += value - bg;
364 
365  }
366  }
367  }
368  }
369 
370  return flux;
371 }
372 
373 /*----------------------------------------------------------------------------*/
385 /*----------------------------------------------------------------------------*/
386 double irplib_strehl_ring_background(const cpl_image * im,
387  double xpos,
388  double ypos,
389  double rad_int,
390  double rad_ext,
391  irplib_strehl_bg_method mode)
392 {
393  const int nx = cpl_image_get_size_x(im);
394  const int ny = cpl_image_get_size_y(im);
395  /* Round down */
396  const int lx = (int)(xpos - rad_ext);
397  const int ly = (int)(ypos - rad_ext);
398  /* Round up */
399  const int ux = (int)(xpos + rad_ext) + 1;
400  const int uy = (int)(ypos + rad_ext) + 1;
401  int mpix, npix;
402  const double sqr_int = rad_int * rad_int;
403  const double sqr_ext = rad_ext * rad_ext;
404  cpl_vector * pix_arr;
405  double flux = 0.0;
406  int i, j;
407 
408  /* Check entries */
409  cpl_ensure(im != NULL, CPL_ERROR_NULL_INPUT, 0.0);
410  cpl_ensure(rad_int > 0.0, CPL_ERROR_ILLEGAL_INPUT, 0.0);
411  cpl_ensure(rad_ext > rad_int, CPL_ERROR_ILLEGAL_INPUT, 0.0);
412 
413  cpl_ensure(mode == IRPLIB_BG_METHOD_AVER_REJ ||
414  mode == IRPLIB_BG_METHOD_MEDIAN,
415  CPL_ERROR_UNSUPPORTED_MODE, 0.0);
416 
417  mpix = (int)((2.0 * rad_ext + 1.0) * (2.0 * rad_ext + 1.0));
418 
419  /* Allocate pixel array to hold values in the ring */
420  pix_arr = cpl_vector_new(mpix);
421 
422  /* Count number of pixels in the ring */
423  /* Retrieve all pixels which belong to the ring */
424  npix = 0;
425  for (j = IRPLIB_MAX(ly, 0); j < IRPLIB_MIN(uy, ny-1); j++) {
426  const double yj = (double)j - ypos;
427  for (i = IRPLIB_MAX(lx, 0); i < IRPLIB_MIN(ux, nx-1); i++) {
428  const double xi = (double)i - xpos;
429  const double dist = yj * yj + xi * xi;
430  if (sqr_int <= dist && dist <= sqr_ext) {
431  int isbad;
432  const double value = cpl_image_get(im, i+1, j+1, &isbad);
433 
434  if (!isbad) {
435  cpl_vector_set(pix_arr, npix, value);
436  npix++;
437  }
438  }
439  }
440  }
441 
442  assert(npix <= mpix);
443 
444  if (npix < IRPLIB_DISK_BG_MIN_PIX_NB) {
445  cpl_vector_delete(pix_arr);
446  (void)cpl_error_set_message(cpl_func, CPL_ERROR_DATA_NOT_FOUND, "Need "
447  "at least %d (not %d <= %d) samples to "
448  "compute noise", IRPLIB_DISK_BG_MIN_PIX_NB,
449  npix, mpix);
450  return 0.0;
451  }
452 
453  /* Should not be able to fail now */
454 
455  /* Resize pixel array to actual number of values within the ring */
456  pix_arr = cpl_vector_wrap(npix, (double*)cpl_vector_unwrap(pix_arr));
457 
458  if (mode == IRPLIB_BG_METHOD_AVER_REJ) {
459  const int low_ind = (int)((double)npix * IRPLIB_DISK_BG_REJ_LOW);
460  const int high_ind = (int)((double)npix
461  * (1.0 - IRPLIB_DISK_BG_REJ_HIGH));
462 
463  /* Sort the array */
464  cpl_vector_sort(pix_arr, CPL_SORT_ASCENDING);
465 
466  for (i=low_ind; i<high_ind; i++) {
467  flux += cpl_vector_get(pix_arr, i);
468  }
469  if (high_ind - low_ind > 1) flux /= (double)(high_ind - low_ind);
470  } else /* if (mode == IRPLIB_BG_METHOD_MEDIAN) */ {
471  flux = cpl_vector_get_median(pix_arr);
472  }
473 
474  cpl_vector_delete(pix_arr);
475 
476  return flux;
477 }
478 
479 /*----------------------------------------------------------------------------*/
499 /*----------------------------------------------------------------------------*/
500 cpl_image * irplib_strehl_generate_psf(double m1,
501  double m2,
502  double lam,
503  double dlam,
504  double pscale,
505  int size)
506 {
507  cpl_image * otf_image = irplib_strehl_generate_otf(m1, m2, lam, dlam,
508  size, pscale);
509 
510  if (otf_image == NULL ||
511 
512  /* Transform back to real space
513  - Normalization is unnecessary, due to the subsequent normalisation.
514  - An OTF is point symmetric about its center, i.e. it is even,
515  i.e. the real space image is real.
516  - Because of this a forward FFT works as well.
517  - If the PSF ever needs to have its images halves swapped add
518  CPL_FFT_SWAP_HALVES to the FFT call.
519  */
520 
521  cpl_image_fft(otf_image, NULL, CPL_FFT_UNNORMALIZED) ||
522 
523  /* Compute absolute values of PSF */
524  cpl_image_abs(otf_image) ||
525 
526  /* Normalize PSF to get flux=1 */
527  cpl_image_normalise(otf_image, CPL_NORM_FLUX)) {
528 
529  (void)cpl_error_set_where(cpl_func);
530  cpl_image_delete(otf_image);
531  otf_image = NULL;
532  }
533 
534  return otf_image;
535 }
536 
539 /*----------------------------------------------------------------------------*/
555 /*----------------------------------------------------------------------------*/
556 static cpl_image * irplib_strehl_generate_otf(double m1,
557  double m2,
558  double lam,
559  double dlam,
560  int size,
561  double pscale)
562 {
563  double * otf_data;
564  /* Obscuration ratio, m1 / m2 */
565  const double obs_ratio = m1 != 0.0 ? m2 / m1 : 0.0;
566  /* pixel scale converted from Arsecond to radian */
567  const double rpscale = pscale * CPL_MATH_2PI / (double)(360 * 60 * 60);
568  /* Cut-off frequency in pixels per central wavelength (in m) */
569  const double f_max = m1 * rpscale * (double)size;
570 
571  /* Pixel corresponding to the zero frequency */
572  const int pix0 = size / 2;
573  int i, j;
574 
575 
576  cpl_ensure(m2 > 0.0, CPL_ERROR_ILLEGAL_INPUT, NULL);
577  cpl_ensure(m1 > m2, CPL_ERROR_ILLEGAL_INPUT, NULL);
578  cpl_ensure(dlam > 0.0, CPL_ERROR_ILLEGAL_INPUT, NULL);
579  cpl_ensure(pscale > 0.0, CPL_ERROR_ILLEGAL_INPUT, NULL);
580  cpl_ensure(size > 0, CPL_ERROR_ILLEGAL_INPUT, NULL);
581  /* Due the the FFT, size is actually required to be a power of two */
582  cpl_ensure(size % 2 == 0, CPL_ERROR_ILLEGAL_INPUT, NULL);
583 
584  /* Ensure positive lambda */
585  cpl_ensure(2.0 * lam > dlam, CPL_ERROR_ILLEGAL_INPUT, NULL);
586 
587  /* Convert wavelengths from micron to meter */
588  lam /= 1.0e6;
589  dlam /= 1.0e6;
590 
591  /* Allocate the output pixel buffer */
592  otf_data = (double*)cpl_malloc(size * size * sizeof(*otf_data));
593 
594  /* Convolution with the detector pixels */
595  /* The OTF is point symmetric so the whole image can be computed from the
596  values of a single octant. */
597  /* The image could be created with calloc() and j limited by
598  f_max / (mlam - mdlam * 0.5) but this is not faster */
599  for (j = 0; j <= pix0; j++) {
600  double sinc_y_9 = 0.0; /* Avoid uninit warning */
601  for (i = 0; i <= j; i++) {
602  if (i == 0 && j == 0) {
603  otf_data[size * pix0 + pix0] = 1.0;
604  } else {
605  const double x = (double)i;
606  const double y = (double)j;
607  const double sqdist = x * x + y * y;
608  double f_lambda, sinc_xy_9 = 0.0; /* Zero if OTF is zero */
609  double otfxy = 0.0;
610  int k;
611 
612  assert( j > 0 );
613 
614  /* 9 iterations on the wavelength */
615  /* Unrolling the loop is not faster (due to the break?) */
616  for (k = 4; k >= -4; k--) {
617  /* Compute intermediate cut-off frequency */
618  const double lambda = lam - dlam * (double)k / 8.0;
619 
620  /* A decreasing k ensures that we either enter on the first
621  iteration or not at all */
622  if (sqdist * lambda * lambda >= f_max * f_max) break;
623 
624  if (k == 4) {
625  f_lambda = sqrt(sqdist) / f_max;
626  if (i == 0) {
627  /* Sinc(x = 0) == 1 */
628  sinc_xy_9 = sinc_y_9 =
629  PSF_sinc_norm(y / (double)size) / 9.0;
630  } else {
631  sinc_xy_9 = sinc_y_9 *
632  PSF_sinc_norm(x / (double)size);
633  }
634  }
635 
636  otfxy += PSF_TelOTF(f_lambda * lambda, obs_ratio);
637  }
638  otfxy *= sinc_xy_9;
639 
640  /* When i == j the same value is written to the same
641  position twice. That's probably faster than a guard */
642  otf_data[size * (pix0 - j) + pix0 - i] = otfxy;
643  otf_data[size * (pix0 - i) + pix0 - j] = otfxy;
644  if (i < pix0) {
645  otf_data[size * (pix0 - j) + pix0 + i] = otfxy;
646  otf_data[size * (pix0 + i) + pix0 - j] = otfxy;
647  if (j < pix0) {
648  otf_data[size * (pix0 + j) + pix0 - i] = otfxy;
649  otf_data[size * (pix0 - i) + pix0 + j] = otfxy;
650  otf_data[size * (pix0 + j) + pix0 + i] = otfxy;
651  otf_data[size * (pix0 + i) + pix0 + j] = otfxy;
652  }
653  }
654  }
655  }
656  }
657 
658  return cpl_image_wrap_double(size, size, otf_data);
659 }
660 
661 /*----------------------------------------------------------------------------*
662  * H1 function
663  *----------------------------------------------------------------------------*/
664 static double PSF_H1(
665  double f,
666  double u,
667  double v)
668 {
669  const double e = fabs(1.0-v) > 0.0 ? -1.0 : 1.0; /* e = 1.0 iff v = 1.0 */
670 
671  return((v*v/CPL_MATH_PI)*acos((f/v)*(1.0+e*(1.0-u*u)/(4.0*f*f))));
672 }
673 
674 /*----------------------------------------------------------------------------*
675  * H2 function
676  *----------------------------------------------------------------------------*/
677 static double PSF_H2(double f,
678  double u)
679 {
680  const double tmp1 = (2.0 * f) / (1.0 + u);
681  const double tmp2 = (1.0 - u) / (2.0 * f);
682 
683  return -1.0 * (f/CPL_MATH_PI) * (1.0+u)
684  * sqrt((1.0-tmp1*tmp1)*(1.0-tmp2*tmp2));
685 }
686 
687 /*----------------------------------------------------------------------------*
688  * G function
689  *----------------------------------------------------------------------------*/
690 static double PSF_G(double f,
691  double u)
692 {
693  if (f <= (1.0-u)/2.0) return(u*u);
694  if (f >= (1.0+u)/2.0) return(0.0);
695  else return(PSF_H1(f,u,1.0) + PSF_H1(f,u,u) + PSF_H2(f,u));
696 }
697 
698 /*----------------------------------------------------------------------------*/
706 /*----------------------------------------------------------------------------*/
707 static double PSF_sinc_norm(double x)
708 {
709  return sin(x * CPL_MATH_PI) / (x * CPL_MATH_PI);
710 }
711 
712 /*----------------------------------------------------------------------------*
713  * Telescope OTF function
714  *----------------------------------------------------------------------------*/
715 static double PSF_TelOTF(double f,
716  double u)
717 {
718  return((PSF_G(f,1.0)+u*u*PSF_G(f/u,1.0)-2.0*PSF_G(f,u))/(1.0-u*u));
719 }
720 
721 /*----------------------------------------------------------------------------*/
732 /*----------------------------------------------------------------------------*/
733 cpl_error_code irplib_strehl_disk_max(const cpl_image * self,
734  double xpos,
735  double ypos,
736  double radius,
737  double * ppeak)
738 {
739 
740  const int nx = cpl_image_get_size_x(self);
741  const int ny = cpl_image_get_size_y(self);
742  /* Round down */
743  const int lx = (int)(xpos - radius);
744  const int ly = (int)(ypos - radius);
745  /* Round up */
746  const int ux = (int)(xpos + radius) + 1;
747  const int uy = (int)(ypos + radius) + 1;
748 
749  const double sqr = radius * radius;
750  cpl_boolean first = CPL_TRUE;
751  int i, j;
752 
753 
754  /* Check entries */
755  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
756  cpl_ensure_code(ppeak != NULL, CPL_ERROR_NULL_INPUT);
757  cpl_ensure_code(radius > 0.0, CPL_ERROR_ILLEGAL_INPUT);
758 
759 
760  for (j = IRPLIB_MAX(ly, 0); j < IRPLIB_MIN(uy, ny-1); j++) {
761  const double yj = (double)j - ypos;
762  for (i = IRPLIB_MAX(lx, 0); i < IRPLIB_MIN(ux, nx-1); i++) {
763  const double xi = (double)i - xpos;
764  const double dist = yj * yj + xi * xi;
765  if (dist <= sqr) {
766  int isbad;
767  const double value = cpl_image_get(self, i+1, j+1, &isbad);
768 
769  if (!isbad &&
770  (first || value > *ppeak)) {
771  first = CPL_FALSE;
772  *ppeak = value;
773  }
774  }
775  }
776  }
777 
778  return first
779  ? cpl_error_set(cpl_func, CPL_ERROR_DATA_NOT_FOUND)
780  : CPL_ERROR_NONE;
781 }
782 
783 #ifndef IRPLIB_NO_FIT_GAUSSIAN
784 #ifdef IRPLIB_STREHL_USE_CPL_IMAGE_FIT_GAUSSIAN
785 /*----------------------------------------------------------------------------*/
801 /*----------------------------------------------------------------------------*/
802 static double irplib_gaussian_2d(double x,
803  double y,
804  double norm,
805  double sig_x,
806  double sig_y)
807 {
808 
809  /* Copied from CPL */
810  return norm / (sig_x * sig_y * CPL_MATH_2PI *
811  exp(x * x / (2.0 * sig_x * sig_x) +
812  y * y / (2.0 * sig_y * sig_y)));
813 }
814 #endif
815 
816 #if defined CPL_VERSION_CODE && CPL_VERSION_CODE >= CPL_VERSION(6, 9, 1)
817 #else
818 /*----------------------------------------------------------------------------*/
837 /*----------------------------------------------------------------------------*/
838 static
839 double irplib_gaussian_eval_2d(const cpl_array * self, double x, double y)
840 {
841  cpl_errorstate prestate = cpl_errorstate_get();
842  const double B = cpl_array_get_double(self, 0, NULL);
843  const double A = cpl_array_get_double(self, 1, NULL);
844  const double R = cpl_array_get_double(self, 2, NULL);
845  const double M_x = cpl_array_get_double(self, 3, NULL);
846  const double M_y = cpl_array_get_double(self, 4, NULL);
847  const double S_x = cpl_array_get_double(self, 5, NULL);
848  const double S_y = cpl_array_get_double(self, 6, NULL);
849 
850  double value = 0.0;
851 
852  if (!cpl_errorstate_is_equal(prestate)) {
853  (void)cpl_error_set_where(cpl_func);
854  } else if (cpl_array_get_size(self) != 7) {
855  (void)cpl_error_set(cpl_func, CPL_ERROR_ILLEGAL_INPUT);
856  } else if (fabs(R) < 1.0 && S_x != 0.0 && S_y != 0.0) {
857  const double x_n = (x - M_x) / S_x;
858  const double y_n = (y - M_y) / S_y;
859 
860  value = B + A / (CPL_MATH_2PI * S_x * S_y * sqrt(1 - R * R)) *
861  exp(-0.5 / (1 - R * R) * ( x_n * x_n + y_n * y_n
862  - 2.0 * R * x_n * y_n));
863  } else if (fabs(R) > 1.0) {
864  (void)cpl_error_set_message(cpl_func, CPL_ERROR_ILLEGAL_OUTPUT,
865  "fabs(R=%g) > 1", R);
866  } else {
867  (void)cpl_error_set_message(cpl_func, CPL_ERROR_DIVISION_BY_ZERO,
868  "R=%g. Sigma=(%g, %g)", R, S_x, S_y);
869  }
870 
871  return value;
872 }
873 #endif
874 
875 /*----------------------------------------------------------------------------*/
882 /*----------------------------------------------------------------------------*/
883 static uint32_t irplib_roundup_power2(uint32_t v)
884 {
885  v |= v >> 1;
886  v |= v >> 2;
887  v |= v >> 4;
888  v |= v >> 8;
889  v |= v >> 16;
890 
891  return v + 1;
892 }
893 
894 
895 /*----------------------------------------------------------------------------*/
906 /*----------------------------------------------------------------------------*/
907 static
908 cpl_error_code irplib_gaussian_maxpos(const cpl_image * self,
909  double sigma,
910  double * pxpos,
911  double * pypos,
912  double * ppeak)
913 {
914 
915  const cpl_size nx = cpl_image_get_size_x(self);
916  const cpl_size ny = cpl_image_get_size_y(self);
917  int iretry = 3; /* Number retries with decreasing sigma */
918  int ifluxapert;
919  double med_dist;
920  const double median = cpl_image_get_median_dev(self, &med_dist);
921  cpl_mask * selection;
922  cpl_size nlabels = 0;
923  cpl_image * labels = NULL;
924  cpl_apertures * aperts;
925  cpl_size npixobj;
926  double objradius;
927  cpl_size winsize;
928  cpl_size xposmax, yposmax;
929  double xposcen, yposcen;
930  double valmax, valfit = -1.0;
931 #ifdef IRPLIB_STREHL_USE_CPL_IMAGE_FIT_GAUSSIAN
932  double norm, xcen, ycen, sig_x, sig_y, fwhm_x, fwhm_y;
933 #endif
934  cpl_array * gauss_parameters = NULL;
935  cpl_errorstate prestate = cpl_errorstate_get();
936  cpl_error_code code;
937 
938 
939  cpl_ensure_code( sigma > 0.0, CPL_ERROR_ILLEGAL_INPUT);
940 
941  selection = cpl_mask_new(nx, ny);
942 
943  for (; iretry > 0 && nlabels == 0; iretry--, sigma *= 0.5) {
944 
945  /* Compute the threshold */
946  const double threshold = median + sigma * med_dist;
947 
948 
949  /* Select the pixel above the threshold */
950  code = cpl_mask_threshold_image(selection, self, threshold, DBL_MAX,
951  CPL_BINARY_1);
952 
953  if (code) break;
954 
955  /* Labelise the thresholded selection */
956  cpl_image_delete(labels);
957  labels = cpl_image_labelise_mask_create(selection, &nlabels);
958  }
959  sigma *= 2.0; /* FIXME: unelegant */
960 
961  cpl_mask_delete(selection);
962 
963  if (code) {
964  cpl_image_delete(labels);
965  return cpl_error_set_where(cpl_func);
966  } else if (nlabels == 0) {
967  cpl_image_delete(labels);
968  return cpl_error_set(cpl_func, CPL_ERROR_DATA_NOT_FOUND);
969  }
970 
971  aperts = cpl_apertures_new_from_image(self, labels);
972 
973  /* Find the aperture with the greatest flux */
974  code = irplib_apertures_find_max_flux(aperts, &ifluxapert, 1);
975 
976  npixobj = cpl_apertures_get_npix(aperts, ifluxapert);
977  objradius = sqrt((double)npixobj * CPL_MATH_1_PI);
978  /* Size is power of two for future noise filtering w. fft */
979  winsize = IRPLIB_MIN(IRPLIB_MIN(nx, ny), irplib_roundup_power2
980  ((uint32_t)(3.0 * objradius + 0.5)));
981 
982  xposmax = cpl_apertures_get_maxpos_x(aperts, ifluxapert);
983  yposmax = cpl_apertures_get_maxpos_y(aperts, ifluxapert);
984  xposcen = cpl_apertures_get_centroid_x(aperts, ifluxapert);
985  yposcen = cpl_apertures_get_centroid_y(aperts, ifluxapert);
986  valmax = cpl_apertures_get_max(aperts, ifluxapert);
987 
988  cpl_apertures_delete(aperts);
989  cpl_image_delete(labels);
990 
991  cpl_msg_debug(cpl_func, "Object radius at S/R=%g: %g (window-size=%u)",
992  sigma, objradius, (unsigned)winsize);
993  cpl_msg_debug(cpl_func, "Object-peak @ (%d, %d) = %g", (int)xposmax,
994  (int)yposmax, valmax);
995 
996  gauss_parameters = cpl_array_new(7, CPL_TYPE_DOUBLE);
997  cpl_array_set_double(gauss_parameters, 0, median);
998 
999  code = cpl_fit_image_gaussian(self, NULL, xposcen, yposcen,
1000  winsize, winsize, gauss_parameters,
1001  NULL, NULL, NULL,
1002  NULL, NULL, NULL,
1003  NULL, NULL, NULL);
1004  if (!code) {
1005  const double M_x = cpl_array_get_double(gauss_parameters, 3, NULL);
1006  const double M_y = cpl_array_get_double(gauss_parameters, 4, NULL);
1007 
1008  valfit = irplib_gaussian_eval_2d(gauss_parameters, M_x, M_y);
1009 
1010  if (!cpl_errorstate_is_equal(prestate)) {
1011  code = cpl_error_get_code();
1012  } else {
1013  *pxpos = M_x;
1014  *pypos = M_y;
1015  *ppeak = valfit;
1016 
1017  cpl_msg_debug(cpl_func, "Gauss-fit @ (%g, %g) = %g",
1018  M_x, M_y, valfit);
1019  }
1020  }
1021  cpl_array_delete(gauss_parameters);
1022 
1023 #ifdef IRPLIB_STREHL_USE_CPL_IMAGE_FIT_GAUSSIAN
1024  if (code || valfit < valmax) {
1025  cpl_errorstate_set(prestate);
1026 
1027  code = cpl_image_fit_gaussian(self, xposcen, yposcen,
1028  (int)(2.0 * objradius),
1029  &norm,
1030  &xcen,
1031  &ycen,
1032  &sig_x,
1033  &sig_y,
1034  &fwhm_x,
1035  &fwhm_y);
1036 
1037  if (!code) {
1038  valfit = irplib_gaussian_2d(0.0, 0.0, norm, sig_x, sig_y);
1039 
1040  cpl_msg_debug(cpl_func, "Gauss-Fit @ (%g, %g) = %g. norm=%g, "
1041  "sigma=(%g, %g)", xcen, ycen, valfit, norm,
1042  sig_x, sig_y);
1043 
1044  if (valfit > valmax) {
1045  *pxpos = xcen;
1046  *pypos = ycen;
1047  *ppeak = valfit;
1048  }
1049  }
1050  }
1051 #endif
1052 
1053  if (code || valfit < valmax) {
1054  cpl_errorstate_set(prestate);
1055  *pxpos = xposcen;
1056  *pypos = yposcen;
1057  *ppeak = valmax;
1058  }
1059 
1060  return code ? cpl_error_set_where(cpl_func) : CPL_ERROR_NONE;
1061 }
1062 #endif