DETMON Pipeline Reference Manual  1.2.5
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 static cpl_error_code update_bad_pixel_map(cpl_image* im);
89 
90 #ifndef IRPLIB_NO_FIT_GAUSSIAN
91 #ifdef IRPLIB_STREHL_USE_CPL_IMAGE_FIT_GAUSSIAN
92 static double irplib_gaussian_2d(double, double, double, double, double);
93 #endif
94 
95 #if defined CPL_VERSION_CODE && CPL_VERSION_CODE >= CPL_VERSION(6, 9, 1)
96 #define irplib_gaussian_eval_2d cpl_gaussian_eval_2d
97 #else
98 static double irplib_gaussian_eval_2d(const cpl_array *, double, double);
99 #endif
100 
101 static uint32_t irplib_roundup_power2(uint32_t v) CPL_ATTR_CONST;
102 
103 static
104 cpl_error_code irplib_gaussian_maxpos(const cpl_image *,
105  double,
106  double *,
107  double *,
108  double *);
109 #endif
110 
111 /*-----------------------------------------------------------------------------
112  Functions code
113  -----------------------------------------------------------------------------*/
121 cpl_error_code update_bad_pixel_map(cpl_image* im)
122 {
123  int szx = cpl_image_get_size_x(im);
124  int szy = cpl_image_get_size_y(im);
125  int x = 0;
126  cpl_mask* bpm = cpl_image_get_bpm(im);
127 
128  for (x = 1; x <=szx; x++)
129  {
130  int y = 0;
131  for(y = 1; y <= szy; y++)
132  {
133  int isnull = 0;
134  double value = cpl_image_get(im, x, y, &isnull);
135  if (isnan(value))
136  {
137  cpl_mask_set(bpm, x, y, CPL_BINARY_1);
138  }
139  }
140  }
141  return cpl_error_get_code();
142 }
173 cpl_error_code irplib_strehl_mark_bad_and_compute(cpl_image * im,
174  double m1,
175  double m2,
176  double lam,
177  double dlam,
178  double pscale,
179  int size,
180  double xpos,
181  double ypos,
182  double r1,
183  double r2,
184  double r3,
185  int noise_box_sz,
186  int noise_nsamples,
187  double * strehl,
188  double * strehl_err,
189  double * star_bg,
190  double * star_peak,
191  double * star_flux,
192  double * psf_peak,
193  double * psf_flux,
194  double * bg_noise)
195 {
196  cpl_ensure_code(!update_bad_pixel_map(im), cpl_error_get_code());
197  return irplib_strehl_compute(im, m1, m2, lam, dlam, pscale, size, xpos, ypos,
198  r1,
199  r2,
200  r3,
201  noise_box_sz,
202  noise_nsamples,
203  strehl,
204  strehl_err,
205  star_bg,
206  star_peak,
207  star_flux,
208  psf_peak,
209  psf_flux,
210  bg_noise);
211 }
212 
213 /*----------------------------------------------------------------------------*/
244 /*----------------------------------------------------------------------------*/
245 cpl_error_code irplib_strehl_compute(const cpl_image * im,
246  double m1,
247  double m2,
248  double lam,
249  double dlam,
250  double pscale,
251  int size,
252  double xpos,
253  double ypos,
254  double r1,
255  double r2,
256  double r3,
257  int noise_box_sz,
258  int noise_nsamples,
259  double * strehl,
260  double * strehl_err,
261  double * star_bg,
262  double * star_peak,
263  double * star_flux,
264  double * psf_peak,
265  double * psf_flux,
266  double * bg_noise)
267 {
268  cpl_image * psf;
269  double star_radius, max_radius;
270 
271  /* FIXME: Arbitrary choice of image border */
272  const double window_size = (double)(IRPLIB_STREHL_RAD_CENTRAL);
273 
274  /* Determined empirically by C. Lidman for Strehl error computation */
275  const double strehl_error_coefficient = CPL_MATH_PI * 0.007 / 0.0271;
276  double ring[4];
277  /* cpl_flux_get_noise_ring() must succeed with this many tries */
278  int ring_tries = 3;
279 #ifndef IRPLIB_NO_FIT_GAUSSIAN
280  double xposfit, yposfit, peak;
281  cpl_error_code code;
282 #endif
283  cpl_errorstate prestate = cpl_errorstate_get();
284 
285  /* Check compile-time constant */
286  cpl_ensure_code(window_size > 0.0, CPL_ERROR_ILLEGAL_INPUT);
287 
288  /* Test inputs */
289  cpl_ensure_code(im != NULL, CPL_ERROR_NULL_INPUT);
290  cpl_ensure_code(strehl != NULL, CPL_ERROR_NULL_INPUT);
291  cpl_ensure_code(strehl_err != NULL, CPL_ERROR_NULL_INPUT);
292  cpl_ensure_code(star_bg != NULL, CPL_ERROR_NULL_INPUT);
293  cpl_ensure_code(star_peak != NULL, CPL_ERROR_NULL_INPUT);
294  cpl_ensure_code(star_flux != NULL, CPL_ERROR_NULL_INPUT);
295  cpl_ensure_code(psf_peak != NULL, CPL_ERROR_NULL_INPUT);
296  cpl_ensure_code(psf_flux != NULL, CPL_ERROR_NULL_INPUT);
297 
298  cpl_ensure_code(pscale > 0.0, CPL_ERROR_ILLEGAL_INPUT);
299 
300  cpl_ensure_code(r1 > 0.0, CPL_ERROR_ILLEGAL_INPUT);
301  cpl_ensure_code(r2 > 0.0, CPL_ERROR_ILLEGAL_INPUT);
302  cpl_ensure_code(r3 > r2, CPL_ERROR_ILLEGAL_INPUT);
303 
304  /* Computing a Strehl ratio is a story between an ideal PSF */
305  /* and a candidate image supposed to approximate this ideal PSF. */
306 
307  /* Generate first appropriate PSF to find max peak */
308  psf = irplib_strehl_generate_psf(m1, m2, lam, dlam, pscale, size);
309  if (psf == NULL) {
310  return cpl_error_set_where(cpl_func);
311  }
312 
313  /* Compute flux in PSF and find max peak */
314  *psf_peak = cpl_image_get_max(psf);
315  cpl_image_delete(psf);
316 
317  assert( *psf_peak > 0.0); /* The ideal PSF has a positive maximum */
318  *psf_flux = 1.0; /* The psf flux, cpl_image_get_flux(psf), is always 1 */
319 
320 #ifndef IRPLIB_NO_FIT_GAUSSIAN
321  code = irplib_gaussian_maxpos(im, IRPLIB_STREHL_DETECT_LEVEL,
322  &xposfit, &yposfit, &peak);
323  if (code) {
324  cpl_errorstate_set(prestate);
325  } else {
326  xpos = xposfit;
327  ypos = yposfit;
328  }
329 #endif
330 
331  /* Measure the background in the candidate image */
332  *star_bg = irplib_strehl_ring_background(im, xpos, ypos,
333  r2/pscale, r3/pscale,
334  IRPLIB_BG_METHOD_AVER_REJ);
335  if (!cpl_errorstate_is_equal(prestate)) {
336  return cpl_error_set_where(cpl_func);
337  }
338 
339  /* Compute star_radius in pixels */
340  star_radius = r1/pscale;
341 
342  /* Measure the flux on the candidate image */
343  *star_flux = irplib_strehl_disk_flux(im, xpos, ypos, star_radius, *star_bg);
344 
345  if (*star_flux <= 0.0) {
346  return cpl_error_set_message(cpl_func, CPL_ERROR_ILLEGAL_OUTPUT,
347  "Non-positive star flux=%g (Star "
348  "background=%g)", *star_flux, *star_bg);
349  }
350 
351  /* Find the peak value on the central part of the candidate image */
352  max_radius = window_size < star_radius ? window_size : star_radius;
353  cpl_ensure_code(!irplib_strehl_disk_max(im, xpos, ypos, max_radius,
354  star_peak), cpl_error_get_code());
355  *star_peak -= *star_bg;
356 
357  if (*star_flux <= 0.0) {
358  return cpl_error_set_message(cpl_func, CPL_ERROR_ILLEGAL_OUTPUT,
359  "Non-positive star peak=%g (Star "
360  "background=%g, Star flux=%g)",
361  *star_flux, *star_bg, *star_flux);
362  }
363 
364  /* Compute Strehl */
365  /* (StarPeak / StarFlux) / (PsfPeak / PsfFlux) */
366  *strehl = (*star_peak * *psf_flux ) / ( *star_flux * *psf_peak);
367 
368 #ifndef IRPLIB_NO_FIT_GAUSSIAN
369  if (code == CPL_ERROR_NONE && peak > *star_peak && *star_peak > 0.0 &&
370  *strehl * peak / *star_peak <= 1.0) {
371  cpl_msg_debug(cpl_func, "Increasing Strehl from %g: %g (%g)",
372  *strehl, *strehl * peak / *star_peak,
373  peak / *star_peak);
374  *strehl *= peak / *star_peak;
375  *star_peak = peak;
376  }
377 #endif
378 
379  /* Compute Strehl error */
380  /* computation could fail if the image contains pixels with NaN value*/
381  ring[0] = xpos;
382  ring[1] = ypos;
383  ring[2] = r2/pscale;
384  ring[3] = r3/pscale;
385 
386  while (cpl_flux_get_noise_ring(im, ring, noise_box_sz, noise_nsamples,
387  bg_noise, NULL) && --ring_tries > 0);
388  if (ring_tries > 0) {
389  cpl_errorstate_set(prestate); /* Recover, if an error happened */
390  } else {
391  return cpl_error_set_where(cpl_func);
392  }
393 
394  *strehl_err = strehl_error_coefficient * (*bg_noise) * pscale *
395  star_radius * star_radius / *star_flux;
396 
397  if (*strehl > 1.0) {
398  cpl_msg_warning(cpl_func, "Extreme Strehl-ratio=%g (strehl-error=%g, "
399  "star_peak=%g, star_flux=%g, psf_peak=%g, psf_flux=%g)",
400  *strehl, *strehl_err, *star_peak, *star_flux, *psf_peak,
401  *psf_flux);
402  }
403 
404  /* This check should not be able to fail, but just to be sure */
405  return *strehl_err >= 0.0
406  ? CPL_ERROR_NONE
407  : cpl_error_set_message(cpl_func, CPL_ERROR_ILLEGAL_OUTPUT,
408  "Negative strehl-error=%g (Strehl-ratio=%g, "
409  "star_peak=%g, star_flux=%g, psf_peak=%g, "
410  "psf_flux=%g", *strehl_err, *strehl,
411  *star_peak, *star_flux, *psf_peak, *psf_flux);
412 }
413 
414 /*----------------------------------------------------------------------------*/
430 /*----------------------------------------------------------------------------*/
431 double irplib_strehl_disk_flux(const cpl_image * im,
432  double xpos,
433  double ypos,
434  double rad,
435  double bg)
436 {
437  const int nx = cpl_image_get_size_x(im);
438  const int ny = cpl_image_get_size_y(im);
439  /* Round down */
440  const int lx = (int)(xpos - rad);
441  const int ly = (int)(ypos - rad);
442  /* Round up */
443  const int ux = (int)(xpos + rad) + 1;
444  const int uy = (int)(ypos + rad) + 1;
445 
446  const double sqr = rad * rad;
447  double flux = 0.0;
448  int i, j;
449 
450 
451  /* Check entries */
452  cpl_ensure(im != NULL, CPL_ERROR_NULL_INPUT, 0.0);
453  cpl_ensure(rad > 0.0, CPL_ERROR_ILLEGAL_INPUT, 0.0);
454 
455  for (j = IRPLIB_MAX(ly, 0); j < IRPLIB_MIN(uy, ny-1); j++) {
456  const double yj = (double)j - ypos;
457  for (i = IRPLIB_MAX(lx, 0); i < IRPLIB_MIN(ux, nx-1); i++) {
458  const double xi = (double)i - xpos;
459  const double dist = yj * yj + xi * xi;
460  if (dist <= sqr) {
461  int isbad;
462  const double value = cpl_image_get(im, i+1, j+1, &isbad);
463 
464  if (!isbad && irplib_isnan(value) == 0) {
465 
466  flux += value - bg;
467 
468  }
469  }
470  }
471  }
472 
473  return flux;
474 }
475 
476 /*----------------------------------------------------------------------------*/
490 /*----------------------------------------------------------------------------*/
491 double irplib_strehl_ring_background(const cpl_image * im,
492  double xpos,
493  double ypos,
494  double rad_int,
495  double rad_ext,
496  irplib_strehl_bg_method mode)
497 {
498  const int nx = cpl_image_get_size_x(im);
499  const int ny = cpl_image_get_size_y(im);
500  /* Round down */
501  const int lx = (int)(xpos - rad_ext);
502  const int ly = (int)(ypos - rad_ext);
503  /* Round up */
504  const int ux = (int)(xpos + rad_ext) + 1;
505  const int uy = (int)(ypos + rad_ext) + 1;
506  int mpix, npix;
507  const double sqr_int = rad_int * rad_int;
508  const double sqr_ext = rad_ext * rad_ext;
509  cpl_vector * pix_arr;
510  double flux = 0.0;
511  int i, j;
512 
513  /* Check entries */
514  cpl_ensure(im != NULL, CPL_ERROR_NULL_INPUT, 0.0);
515  cpl_ensure(rad_int > 0.0, CPL_ERROR_ILLEGAL_INPUT, 0.0);
516  cpl_ensure(rad_ext > rad_int, CPL_ERROR_ILLEGAL_INPUT, 0.0);
517 
518  cpl_ensure(mode == IRPLIB_BG_METHOD_AVER_REJ ||
519  mode == IRPLIB_BG_METHOD_MEDIAN,
520  CPL_ERROR_UNSUPPORTED_MODE, 0.0);
521 
522  mpix = (int)((2.0 * rad_ext + 1.0) * (2.0 * rad_ext + 1.0));
523 
524  /* Allocate pixel array to hold values in the ring */
525  pix_arr = cpl_vector_new(mpix);
526 
527  /* Count number of pixels in the ring */
528  /* Retrieve all pixels which belong to the ring */
529  npix = 0;
530  for (j = IRPLIB_MAX(ly, 0); j < IRPLIB_MIN(uy, ny-1); j++) {
531  const double yj = (double)j - ypos;
532  for (i = IRPLIB_MAX(lx, 0); i < IRPLIB_MIN(ux, nx-1); i++) {
533  const double xi = (double)i - xpos;
534  const double dist = yj * yj + xi * xi;
535  if (sqr_int <= dist && dist <= sqr_ext) {
536  int isbad;
537  const double value = cpl_image_get(im, i+1, j+1, &isbad);
538 
539  if (!isbad && irplib_isnan(value) == 0) {
540  cpl_vector_set(pix_arr, npix, value);
541  npix++;
542  }
543  }
544  }
545  }
546 
547  assert(npix <= mpix);
548 
549  if (npix < IRPLIB_DISK_BG_MIN_PIX_NB) {
550  cpl_vector_delete(pix_arr);
551  (void)cpl_error_set_message(cpl_func, CPL_ERROR_DATA_NOT_FOUND, "Need "
552  "at least %d (not %d <= %d) samples to "
553  "compute noise", IRPLIB_DISK_BG_MIN_PIX_NB,
554  npix, mpix);
555  return 0.0;
556  }
557 
558  /* Should not be able to fail now */
559 
560  /* Resize pixel array to actual number of values within the ring */
561  pix_arr = cpl_vector_wrap(npix, (double*)cpl_vector_unwrap(pix_arr));
562 
563  if (mode == IRPLIB_BG_METHOD_AVER_REJ) {
564  const int low_ind = (int)((double)npix * IRPLIB_DISK_BG_REJ_LOW);
565  const int high_ind = (int)((double)npix
566  * (1.0 - IRPLIB_DISK_BG_REJ_HIGH));
567 
568  /* Sort the array */
569  cpl_vector_sort(pix_arr, CPL_SORT_ASCENDING);
570 
571  for (i=low_ind; i<high_ind; i++) {
572  flux += cpl_vector_get(pix_arr, i);
573  }
574  if (high_ind - low_ind > 1) flux /= (double)(high_ind - low_ind);
575  } else /* if (mode == IRPLIB_BG_METHOD_MEDIAN) */ {
576  flux = cpl_vector_get_median(pix_arr);
577  }
578 
579  cpl_vector_delete(pix_arr);
580 
581  return flux;
582 }
583 
584 /*----------------------------------------------------------------------------*/
604 /*----------------------------------------------------------------------------*/
605 cpl_image * irplib_strehl_generate_psf(double m1,
606  double m2,
607  double lam,
608  double dlam,
609  double pscale,
610  int size)
611 {
612  cpl_image * otf_image = irplib_strehl_generate_otf(m1, m2, lam, dlam,
613  size, pscale);
614 
615  if (otf_image == NULL ||
616 
617  /* Transform back to real space
618  - Normalization is unnecessary, due to the subsequent normalisation.
619  - An OTF is point symmetric about its center, i.e. it is even,
620  i.e. the real space image is real.
621  - Because of this a forward FFT works as well.
622  - If the PSF ever needs to have its images halves swapped add
623  CPL_FFT_SWAP_HALVES to the FFT call.
624  */
625 
626  cpl_image_fft(otf_image, NULL, CPL_FFT_UNNORMALIZED) ||
627 
628  /* Compute absolute values of PSF */
629  cpl_image_abs(otf_image) ||
630 
631  /* Normalize PSF to get flux=1 */
632  cpl_image_normalise(otf_image, CPL_NORM_FLUX)) {
633 
634  (void)cpl_error_set_where(cpl_func);
635  cpl_image_delete(otf_image);
636  otf_image = NULL;
637  }
638 
639  return otf_image;
640 }
641 
644 /*----------------------------------------------------------------------------*/
660 /*----------------------------------------------------------------------------*/
661 static cpl_image * irplib_strehl_generate_otf(double m1,
662  double m2,
663  double lam,
664  double dlam,
665  int size,
666  double pscale)
667 {
668  double * otf_data;
669  /* Obscuration ratio, m1 / m2 */
670  const double obs_ratio = m1 != 0.0 ? m2 / m1 : 0.0;
671  /* pixel scale converted from Arsecond to radian */
672  const double rpscale = pscale * CPL_MATH_2PI / (double)(360 * 60 * 60);
673  /* Cut-off frequency in pixels per central wavelength (in m) */
674  const double f_max = m1 * rpscale * (double)size;
675 
676  /* Pixel corresponding to the zero frequency */
677  const int pix0 = size / 2;
678  int i, j;
679 
680 
681  cpl_ensure(m2 > 0.0, CPL_ERROR_ILLEGAL_INPUT, NULL);
682  cpl_ensure(m1 > m2, CPL_ERROR_ILLEGAL_INPUT, NULL);
683  cpl_ensure(dlam > 0.0, CPL_ERROR_ILLEGAL_INPUT, NULL);
684  cpl_ensure(pscale > 0.0, CPL_ERROR_ILLEGAL_INPUT, NULL);
685  cpl_ensure(size > 0, CPL_ERROR_ILLEGAL_INPUT, NULL);
686  /* Due the the FFT, size is actually required to be a power of two */
687  cpl_ensure(size % 2 == 0, CPL_ERROR_ILLEGAL_INPUT, NULL);
688 
689  /* Ensure positive lambda */
690  cpl_ensure(2.0 * lam > dlam, CPL_ERROR_ILLEGAL_INPUT, NULL);
691 
692  /* Convert wavelengths from micron to meter */
693  lam /= 1.0e6;
694  dlam /= 1.0e6;
695 
696  /* Allocate the output pixel buffer */
697  otf_data = (double*)cpl_malloc(size * size * sizeof(*otf_data));
698 
699  /* Convolution with the detector pixels */
700  /* The OTF is point symmetric so the whole image can be computed from the
701  values of a single octant. */
702  /* The image could be created with calloc() and j limited by
703  f_max / (mlam - mdlam * 0.5) but this is not faster */
704  for (j = 0; j <= pix0; j++) {
705  double sinc_y_9 = 0.0; /* Avoid uninit warning */
706  for (i = 0; i <= j; i++) {
707  if (i == 0 && j == 0) {
708  otf_data[size * pix0 + pix0] = 1.0;
709  } else {
710  const double x = (double)i;
711  const double y = (double)j;
712  const double sqdist = x * x + y * y;
713  double f_lambda, sinc_xy_9 = 0.0; /* Zero if OTF is zero */
714  double otfxy = 0.0;
715  int k;
716 
717  assert( j > 0 );
718 
719  /* 9 iterations on the wavelength */
720  /* Unrolling the loop is not faster (due to the break?) */
721  for (k = 4; k >= -4; k--) {
722  /* Compute intermediate cut-off frequency */
723  const double lambda = lam - dlam * (double)k / 8.0;
724 
725  /* A decreasing k ensures that we either enter on the first
726  iteration or not at all */
727  if (sqdist * lambda * lambda >= f_max * f_max) break;
728 
729  if (k == 4) {
730  f_lambda = sqrt(sqdist) / f_max;
731  if (i == 0) {
732  /* Sinc(x = 0) == 1 */
733  sinc_xy_9 = sinc_y_9 =
734  PSF_sinc_norm(y / (double)size) / 9.0;
735  } else {
736  sinc_xy_9 = sinc_y_9 *
737  PSF_sinc_norm(x / (double)size);
738  }
739  }
740 
741  otfxy += PSF_TelOTF(f_lambda * lambda, obs_ratio);
742  }
743  otfxy *= sinc_xy_9;
744 
745  /* When i == j the same value is written to the same
746  position twice. That's probably faster than a guard */
747  otf_data[size * (pix0 - j) + pix0 - i] = otfxy;
748  otf_data[size * (pix0 - i) + pix0 - j] = otfxy;
749  if (i < pix0) {
750  otf_data[size * (pix0 - j) + pix0 + i] = otfxy;
751  otf_data[size * (pix0 + i) + pix0 - j] = otfxy;
752  if (j < pix0) {
753  otf_data[size * (pix0 + j) + pix0 - i] = otfxy;
754  otf_data[size * (pix0 - i) + pix0 + j] = otfxy;
755  otf_data[size * (pix0 + j) + pix0 + i] = otfxy;
756  otf_data[size * (pix0 + i) + pix0 + j] = otfxy;
757  }
758  }
759  }
760  }
761  }
762 
763  return cpl_image_wrap_double(size, size, otf_data);
764 }
765 
766 /*----------------------------------------------------------------------------*
767  * H1 function
768  *----------------------------------------------------------------------------*/
769 static double PSF_H1(
770  double f,
771  double u,
772  double v)
773 {
774  const double e = fabs(1.0-v) > 0.0 ? -1.0 : 1.0; /* e = 1.0 iff v = 1.0 */
775 
776  return((v*v/CPL_MATH_PI)*acos((f/v)*(1.0+e*(1.0-u*u)/(4.0*f*f))));
777 }
778 
779 /*----------------------------------------------------------------------------*
780  * H2 function
781  *----------------------------------------------------------------------------*/
782 static double PSF_H2(double f,
783  double u)
784 {
785  const double tmp1 = (2.0 * f) / (1.0 + u);
786  const double tmp2 = (1.0 - u) / (2.0 * f);
787 
788  return -1.0 * (f/CPL_MATH_PI) * (1.0+u)
789  * sqrt((1.0-tmp1*tmp1)*(1.0-tmp2*tmp2));
790 }
791 
792 /*----------------------------------------------------------------------------*
793  * G function
794  *----------------------------------------------------------------------------*/
795 static double PSF_G(double f,
796  double u)
797 {
798  if (f <= (1.0-u)/2.0) return(u*u);
799  if (f >= (1.0+u)/2.0) return(0.0);
800  else return(PSF_H1(f,u,1.0) + PSF_H1(f,u,u) + PSF_H2(f,u));
801 }
802 
803 /*----------------------------------------------------------------------------*/
811 /*----------------------------------------------------------------------------*/
812 static double PSF_sinc_norm(double x)
813 {
814  return sin(x * CPL_MATH_PI) / (x * CPL_MATH_PI);
815 }
816 
817 /*----------------------------------------------------------------------------*
818  * Telescope OTF function
819  *----------------------------------------------------------------------------*/
820 static double PSF_TelOTF(double f,
821  double u)
822 {
823  return((PSF_G(f,1.0)+u*u*PSF_G(f/u,1.0)-2.0*PSF_G(f,u))/(1.0-u*u));
824 }
825 
826 /*----------------------------------------------------------------------------*/
837 /*----------------------------------------------------------------------------*/
838 cpl_error_code irplib_strehl_disk_max(const cpl_image * self,
839  double xpos,
840  double ypos,
841  double radius,
842  double * ppeak)
843 {
844 
845  const int nx = cpl_image_get_size_x(self);
846  const int ny = cpl_image_get_size_y(self);
847  /* Round down */
848  const int lx = (int)(xpos - radius);
849  const int ly = (int)(ypos - radius);
850  /* Round up */
851  const int ux = (int)(xpos + radius) + 1;
852  const int uy = (int)(ypos + radius) + 1;
853 
854  const double sqr = radius * radius;
855  cpl_boolean first = CPL_TRUE;
856  int i, j;
857 
858 
859  /* Check entries */
860  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
861  cpl_ensure_code(ppeak != NULL, CPL_ERROR_NULL_INPUT);
862  cpl_ensure_code(radius > 0.0, CPL_ERROR_ILLEGAL_INPUT);
863 
864 
865  for (j = IRPLIB_MAX(ly, 0); j < IRPLIB_MIN(uy, ny-1); j++) {
866  const double yj = (double)j - ypos;
867  for (i = IRPLIB_MAX(lx, 0); i < IRPLIB_MIN(ux, nx-1); i++) {
868  const double xi = (double)i - xpos;
869  const double dist = yj * yj + xi * xi;
870  if (dist <= sqr) {
871  int isbad;
872  const double value = cpl_image_get(self, i+1, j+1, &isbad);
873 
874  if (!isbad && irplib_isnan(value) == 0 &&
875  (first || value > *ppeak)) {
876  first = CPL_FALSE;
877  *ppeak = value;
878  }
879  }
880  }
881  }
882 
883  return first
884  ? cpl_error_set(cpl_func, CPL_ERROR_DATA_NOT_FOUND)
885  : CPL_ERROR_NONE;
886 }
887 
888 #ifndef IRPLIB_NO_FIT_GAUSSIAN
889 #ifdef IRPLIB_STREHL_USE_CPL_IMAGE_FIT_GAUSSIAN
890 /*----------------------------------------------------------------------------*/
906 /*----------------------------------------------------------------------------*/
907 static double irplib_gaussian_2d(double x,
908  double y,
909  double norm,
910  double sig_x,
911  double sig_y)
912 {
913 
914  /* Copied from CPL */
915  return norm / (sig_x * sig_y * CPL_MATH_2PI *
916  exp(x * x / (2.0 * sig_x * sig_x) +
917  y * y / (2.0 * sig_y * sig_y)));
918 }
919 #endif
920 
921 #if defined CPL_VERSION_CODE && CPL_VERSION_CODE >= CPL_VERSION(6, 9, 1)
922 #else
923 /*----------------------------------------------------------------------------*/
942 /*----------------------------------------------------------------------------*/
943 static
944 double irplib_gaussian_eval_2d(const cpl_array * self, double x, double y)
945 {
946  cpl_errorstate prestate = cpl_errorstate_get();
947  const double B = cpl_array_get_double(self, 0, NULL);
948  const double A = cpl_array_get_double(self, 1, NULL);
949  const double R = cpl_array_get_double(self, 2, NULL);
950  const double M_x = cpl_array_get_double(self, 3, NULL);
951  const double M_y = cpl_array_get_double(self, 4, NULL);
952  const double S_x = cpl_array_get_double(self, 5, NULL);
953  const double S_y = cpl_array_get_double(self, 6, NULL);
954 
955  double value = 0.0;
956 
957  if (!cpl_errorstate_is_equal(prestate)) {
958  (void)cpl_error_set_where(cpl_func);
959  } else if (cpl_array_get_size(self) != 7) {
960  (void)cpl_error_set(cpl_func, CPL_ERROR_ILLEGAL_INPUT);
961  } else if (fabs(R) < 1.0 && S_x != 0.0 && S_y != 0.0) {
962  const double x_n = (x - M_x) / S_x;
963  const double y_n = (y - M_y) / S_y;
964 
965  value = B + A / (CPL_MATH_2PI * S_x * S_y * sqrt(1 - R * R)) *
966  exp(-0.5 / (1 - R * R) * ( x_n * x_n + y_n * y_n
967  - 2.0 * R * x_n * y_n));
968  } else if (fabs(R) > 1.0) {
969  (void)cpl_error_set_message(cpl_func, CPL_ERROR_ILLEGAL_OUTPUT,
970  "fabs(R=%g) > 1", R);
971  } else {
972  (void)cpl_error_set_message(cpl_func, CPL_ERROR_DIVISION_BY_ZERO,
973  "R=%g. Sigma=(%g, %g)", R, S_x, S_y);
974  }
975 
976  return value;
977 }
978 #endif
979 
980 /*----------------------------------------------------------------------------*/
987 /*----------------------------------------------------------------------------*/
988 static uint32_t irplib_roundup_power2(uint32_t v)
989 {
990  v |= v >> 1;
991  v |= v >> 2;
992  v |= v >> 4;
993  v |= v >> 8;
994  v |= v >> 16;
995 
996  return v + 1;
997 }
998 
999 
1000 /*----------------------------------------------------------------------------*/
1011 /*----------------------------------------------------------------------------*/
1012 static
1013 cpl_error_code irplib_gaussian_maxpos(const cpl_image * self,
1014  double sigma,
1015  double * pxpos,
1016  double * pypos,
1017  double * ppeak)
1018 {
1019 
1020  const cpl_size nx = cpl_image_get_size_x(self);
1021  const cpl_size ny = cpl_image_get_size_y(self);
1022  int iretry = 3; /* Number retries with decreasing sigma */
1023  int ifluxapert;
1024  double med_dist;
1025  const double median = cpl_image_get_median_dev(self, &med_dist);
1026  cpl_mask * selection;
1027  cpl_size nlabels = 0;
1028  cpl_image * labels = NULL;
1029  cpl_apertures * aperts;
1030  cpl_size npixobj;
1031  double objradius;
1032  cpl_size winsize;
1033  cpl_size xposmax, yposmax;
1034  double xposcen, yposcen;
1035  double valmax, valfit = -1.0;
1036 #ifdef IRPLIB_STREHL_USE_CPL_IMAGE_FIT_GAUSSIAN
1037  double norm, xcen, ycen, sig_x, sig_y, fwhm_x, fwhm_y;
1038 #endif
1039  cpl_array * gauss_parameters = NULL;
1040  cpl_errorstate prestate = cpl_errorstate_get();
1041  cpl_error_code code;
1042 
1043 
1044  cpl_ensure_code( sigma > 0.0, CPL_ERROR_ILLEGAL_INPUT);
1045 
1046  selection = cpl_mask_new(nx, ny);
1047 
1048  for (; iretry > 0 && nlabels == 0; iretry--, sigma *= 0.5) {
1049 
1050  /* Compute the threshold */
1051  const double threshold = median + sigma * med_dist;
1052 
1053 
1054  /* Select the pixel above the threshold */
1055  code = cpl_mask_threshold_image(selection, self, threshold, DBL_MAX,
1056  CPL_BINARY_1);
1057 
1058  if (code) break;
1059 
1060  /* Labelise the thresholded selection */
1061  cpl_image_delete(labels);
1062  labels = cpl_image_labelise_mask_create(selection, &nlabels);
1063  }
1064  sigma *= 2.0; /* FIXME: unelegant */
1065 
1066  cpl_mask_delete(selection);
1067 
1068  if (code) {
1069  cpl_image_delete(labels);
1070  return cpl_error_set_where(cpl_func);
1071  } else if (nlabels == 0) {
1072  cpl_image_delete(labels);
1073  return cpl_error_set(cpl_func, CPL_ERROR_DATA_NOT_FOUND);
1074  }
1075 
1076  aperts = cpl_apertures_new_from_image(self, labels);
1077 
1078  /* Find the aperture with the greatest flux */
1079  code = irplib_apertures_find_max_flux(aperts, &ifluxapert, 1);
1080 
1081  npixobj = cpl_apertures_get_npix(aperts, ifluxapert);
1082  objradius = sqrt((double)npixobj * CPL_MATH_1_PI);
1083  /* Size is power of two for future noise filtering w. fft */
1084  winsize = IRPLIB_MIN(IRPLIB_MIN(nx, ny), irplib_roundup_power2
1085  ((uint32_t)(3.0 * objradius + 0.5)));
1086 
1087  xposmax = cpl_apertures_get_maxpos_x(aperts, ifluxapert);
1088  yposmax = cpl_apertures_get_maxpos_y(aperts, ifluxapert);
1089  xposcen = cpl_apertures_get_centroid_x(aperts, ifluxapert);
1090  yposcen = cpl_apertures_get_centroid_y(aperts, ifluxapert);
1091  valmax = cpl_apertures_get_max(aperts, ifluxapert);
1092 
1093  cpl_apertures_delete(aperts);
1094  cpl_image_delete(labels);
1095 
1096  cpl_msg_debug(cpl_func, "Object radius at S/R=%g: %g (window-size=%u)",
1097  sigma, objradius, (unsigned)winsize);
1098  cpl_msg_debug(cpl_func, "Object-peak @ (%d, %d) = %g", (int)xposmax,
1099  (int)yposmax, valmax);
1100 
1101  gauss_parameters = cpl_array_new(7, CPL_TYPE_DOUBLE);
1102  cpl_array_set_double(gauss_parameters, 0, median);
1103 
1104  code = cpl_fit_image_gaussian(self, NULL, xposcen, yposcen,
1105  winsize, winsize, gauss_parameters,
1106  NULL, NULL, NULL,
1107  NULL, NULL, NULL,
1108  NULL, NULL, NULL);
1109  if (!code) {
1110  const double M_x = cpl_array_get_double(gauss_parameters, 3, NULL);
1111  const double M_y = cpl_array_get_double(gauss_parameters, 4, NULL);
1112 
1113  valfit = irplib_gaussian_eval_2d(gauss_parameters, M_x, M_y);
1114 
1115  if (!cpl_errorstate_is_equal(prestate)) {
1116  code = cpl_error_get_code();
1117  } else {
1118  *pxpos = M_x;
1119  *pypos = M_y;
1120  *ppeak = valfit;
1121 
1122  cpl_msg_debug(cpl_func, "Gauss-fit @ (%g, %g) = %g",
1123  M_x, M_y, valfit);
1124  }
1125  }
1126  cpl_array_delete(gauss_parameters);
1127 
1128 #ifdef IRPLIB_STREHL_USE_CPL_IMAGE_FIT_GAUSSIAN
1129  if (code || valfit < valmax) {
1130  cpl_errorstate_set(prestate);
1131 
1132  code = cpl_image_fit_gaussian(self, xposcen, yposcen,
1133  (int)(2.0 * objradius),
1134  &norm,
1135  &xcen,
1136  &ycen,
1137  &sig_x,
1138  &sig_y,
1139  &fwhm_x,
1140  &fwhm_y);
1141 
1142  if (!code) {
1143  valfit = irplib_gaussian_2d(0.0, 0.0, norm, sig_x, sig_y);
1144 
1145  cpl_msg_debug(cpl_func, "Gauss-Fit @ (%g, %g) = %g. norm=%g, "
1146  "sigma=(%g, %g)", xcen, ycen, valfit, norm,
1147  sig_x, sig_y);
1148 
1149  if (valfit > valmax) {
1150  *pxpos = xcen;
1151  *pypos = ycen;
1152  *ppeak = valfit;
1153  }
1154  }
1155  }
1156 #endif
1157 
1158  if (code || valfit < valmax) {
1159  cpl_errorstate_set(prestate);
1160  *pxpos = xposcen;
1161  *pypos = yposcen;
1162  *ppeak = valmax;
1163  }
1164 
1165  return code ? cpl_error_set_where(cpl_func) : CPL_ERROR_NONE;
1166 }
1167 #endif