SINFONI Pipeline Reference Manual  2.5.2
sinfo_utl_illumcorr.c
1 /* $Id: sinfo_utl_illumcorr.c,v 1.18 2012-03-03 10:38:03 amodigli Exp $
2  *
3  * This file is part of the CPL (Common Pipeline Library)
4  * Copyright (C) 2002 European Southern Observatory
5  *
6  * This library is free software; you can redistribute it and/or
7  * modify it under the terms of the GNU Lesser General Public
8  * License as published by the Free Software Foundation; either
9  * version 2.1 of the License, or (at your option) any later version.
10  *
11  * This library 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 GNU
14  * Lesser General Public License for more details.
15  *
16  * You should have received a copy of the GNU Lesser General Public
17  * License along with this library; if not, write to the Free Software
18  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19  */
20 /*
21  * $Author: amodigli $
22  * $Date: 2012-03-03 10:38:03 $
23  * $Revision: 1.18 $
24  * $Name: not supported by cvs2svn $
25  */
26 
27 /****************************************************************
28  * Object Data reduction *
29  ****************************************************************/
30 
31 #ifdef HAVE_CONFIG_H
32 #include <config.h> /* allows the program compilation */
33 #endif
34 
35 /*-----------------------------------------------------------------------------
36  Includes
37 -----------------------------------------------------------------------------*/
38 
39 /* std */
40 #include <strings.h>
41 #include <string.h>
42 #include <stdio.h>
43 #include <math.h>
44 #include <libgen.h>
45 
46 
47 /* cpl */
48 #include <cpl.h>
49 
50 /* irplib */
51 #include <irplib_utils.h>
52 
53 /* sinfoni */
54 #include <sinfo_pro_types.h>
55 #include <sinfo_product_config.h>
56 #include <sinfo_prepare_stacked_frames_config.h>
57 #include <sinfo_objnod_config.h>
58 #include <sinfo_new_objnod.h>
59 #include <sinfo_new_prepare_stacked_frames.h>
60 #include <sinfo_pro_save.h>
61 #include <sinfo_raw_types.h>
62 #include <sinfo_functions.h>
63 #include <sinfo_tpl_utils.h>
64 #include <sinfo_tpl_dfs.h>
65 #include <sinfo_hidden.h>
66 #include <sinfo_globals.h>
67 #include <sinfo_rec_utils.h>
68 //Only for sinfo_propertylist_has
69 #include <sinfo_dfs.h>
70 
71 
72 /*-----------------------------------------------------------------------------
73  Function prototypes
74 -----------------------------------------------------------------------------*/
75 static int sinfo_utl_illumcorr_create(cpl_plugin *plugin);
76 static int sinfo_utl_illumcorr_exec(cpl_plugin *plugin);
77 static int sinfo_utl_illumcorr_destroy(cpl_plugin *plugin);
78 static int sinfo_utl_illumcorr(cpl_parameterlist *config, cpl_frameset *set);
79 
80 
81 #define SINFO_DOUBLE_SWAP(a,b) { register double t=(a);(a)=(b);(b)=t; }
82 
83 static cpl_error_code
84 sinfo_tools_sort_double(
85  double * pix_arr,
86  int n);
87 
88 static cpl_frame*
89 sinfo_get_dummy_object(cpl_frameset* obj_set);
90 
91 static void
92 sinfo_illumcorr_config_add (cpl_parameterlist *list);
93 
94 static int
95 create_illumcorr (const char* plugin_id,
96  cpl_parameterlist *cpl_cfg,
97  cpl_frameset* sof,
98  const char *name_i);
99 static int
100 sinfo_illumcorr_create_bins (cpl_imagelist *sky,
101  int llx, int lly, int urx, int ury,
102  int spec_bin,
103  double min_flux,
104  int ** start,
105  int ** end,
106  int z1, int z2);
107 
108 static int
109 sinfo_juha_function1d_natural_spline(double *, double *, int, double *,
110  double *, int);
111 
112 static int
113 sinfo_function1d_search_value(double *, int, double, int *) ;
114 
115 static cpl_vector *
116 sinfo_vector_filter_median_create(const cpl_vector * v, int hw);
117 
118 static cpl_vector *
119 sinfo_juha_vector_filter_median_create(const cpl_vector * v, int hw);
120 
121 static double
122 sinfo_image_get_median_window (const cpl_image *image,
123  int llx, int lly, int urx, int ury);
124 
125 
126 /*-----------------------------------------------------------------------------
127  Static variables
128 -----------------------------------------------------------------------------*/
129 
130 static char sinfo_utl_illumcorr_description1[] =
131  "This recipe calculates illumination correction based on sky emission.\n"
132  "The input files are sky (or object) frames tagged\n"
133  " SKY_NODDING (OBJECT_NODDING)\n"
134  "Master calibration frames:\n";
135 
136 
137 static char sinfo_utl_illumcorr_description2[] =
138  "A corresponding (DIT) dark frame (tag=MASTER_DARK)"
139  "A corresponding (band,preoptics) wavelength map image (tag=WAVE_MAP)\n"
140  "A corresponding (band,preoptics) master flat field (tag=MASTER_FLAT_LAMP)\n"
141  "A corresponding (band,preoptics) master bad pixel map (tag=MASTER_BP_MAP)\n"
142  "A corresponding (band,preoptics) slitlets position frame (tag=SLIT_POS)\n"
143  "A corresponding (band) distortion table (tag=DISTORTION)\n"
144  "A corresponding (band) slitlet distance table (tag=SLITLETS_DISTANCE)\n";
145 
146 
147 static char sinfo_utl_illumcorr_description3[] =
148  "The output is a cube resulting from the analysis of sky emission\n"
149  "\n";
150 
151 
152 static char sinfo_utl_illumcorr_description[1300];
153 
154 /*-----------------------------------------------------------------------------
155  Functions code
156 -----------------------------------------------------------------------------*/
157 
159 /*---------------------------------------------------------------------------*/
164 /*---------------------------------------------------------------------------*/
165 static int
166 sinfo_utl_illumcorr_create(cpl_plugin *plugin)
167 {
168 
169  /*
170  * We have to provide the option we accept to the application.
171  * We need to setup our parameter list and hook it into the recipe
172  * interface.
173  */
174  cpl_recipe *recipe = (cpl_recipe *)plugin;
175  recipe->parameters = cpl_parameterlist_new();
176  if(recipe->parameters == NULL) {
177  return 1;
178  }
179  cpl_error_reset();
180  irplib_reset();
181 
182  /*
183  * Fill the parameter list.
184  */
185  sinfo_product_config_add (recipe->parameters);
186  sinfo_prepare_stacked_frames_config_add(recipe->parameters);
187  sinfo_objnod_config_add(recipe->parameters);
188  sinfo_illumcorr_config_add (recipe->parameters);
189 
190  return 0;
191 
192 }
193 
194 /*---------------------------------------------------------------------------*/
200 /*---------------------------------------------------------------------------*/
201 static int
202 sinfo_utl_illumcorr_exec(cpl_plugin *plugin)
203 {
204 
205  cpl_recipe *recipe = (cpl_recipe *) plugin;
206  int code=0;
207  cpl_errorstate initial_errorstate = cpl_errorstate_get();
208 
209  if(recipe->parameters == NULL) {
210  return 1;
211  }
212  if(recipe->frames == NULL) {
213  return 1;
214  }
215  code=sinfo_utl_illumcorr(recipe->parameters, recipe->frames);
216 
217  if (!cpl_errorstate_is_equal(initial_errorstate)) {
218  /* Dump the error history since recipe execution start.
219  At this point the recipe cannot recover from the error */
220  cpl_errorstate_dump(initial_errorstate, CPL_FALSE, NULL);
221  }
222  return code;
223 
224 
225 }
226 
227 /*---------------------------------------------------------------------------*/
233 /*---------------------------------------------------------------------------*/
234 static int
235 sinfo_utl_illumcorr_destroy(cpl_plugin *plugin)
236 {
237  cpl_recipe *recipe = (cpl_recipe *) plugin;
238  /*
239  * We just destroy what was created during the plugin initializzation phase
240  * i.e. the parameter list. The frame set is managed by the application which
241  * called us, so that we must not touch it.
242  */
243 
244  cpl_parameterlist_delete(recipe->parameters);
245 
246  return 0;
247 
248 }
249 
250 /*---------------------------------------------------------------------------*/
258 /*---------------------------------------------------------------------------*/
259 int
260 cpl_plugin_get_info(cpl_pluginlist *list)
261 {
262 
263  cpl_recipe *recipe = cpl_calloc(1, sizeof *recipe);
264  cpl_plugin *plugin = &recipe->interface;
265 
266  strcpy(sinfo_utl_illumcorr_description,sinfo_utl_illumcorr_description1);
267  strcat(sinfo_utl_illumcorr_description,sinfo_utl_illumcorr_description2);
268  strcat(sinfo_utl_illumcorr_description,sinfo_utl_illumcorr_description3);
269 
270  cpl_plugin_init(plugin,
271  CPL_PLUGIN_API,
272  SINFONI_BINARY_VERSION,
273  CPL_PLUGIN_TYPE_RECIPE,
274  "sinfo_utl_illumcorr",
275  "Object data reduction",
276  sinfo_utl_illumcorr_description,
277  "Juha Reunanen",
278  "reunanen@strw.leidenuniv.nl",
279  sinfo_get_license(),
280  sinfo_utl_illumcorr_create,
281  sinfo_utl_illumcorr_exec,
282  sinfo_utl_illumcorr_destroy);
283 
284  cpl_pluginlist_append(list, plugin);
285 
286  return 0;
287 
288 }
289 
290 /*
291  * The actual recipe actually start here.
292  */
293 
294 static int
295 sinfo_utl_illumcorr(cpl_parameterlist *config, cpl_frameset *set)
296 {
297  char outname[FILE_NAME_SZ];
298 
299  int i=0;
300  int k=0;
301 
302  int ind=0;
303  int nsky=0;
304  int nobj=0;
305  int ncdb=0;
306  int nstk=0;
307 
308  cpl_frameset * obj_set=NULL;
309  cpl_frameset * sky_set=NULL;
310  cpl_frameset * cdb_set=NULL;
311  cpl_frameset * wrk_set=NULL;
312  cpl_frameset * stk_set=NULL;
313  cpl_frame * sky_frm=NULL;
314 
315  cpl_frame * dup_frm=NULL;
316  cpl_frame * cdb_frm=NULL;
317  cpl_frame * wrk_frm=NULL;
318  cpl_frameset * ref_set=NULL;
319 
320  cpl_frame * dark_frm=NULL;
321 
322  fake* fk;
323 
324 
325  cpl_image * ima1=NULL ;
326  cpl_image * ima2=NULL ;
327  cpl_image * resima=NULL ;
328  cpl_propertylist * plist=NULL ;
329  cpl_frame * product_frame=NULL;
330  const char *name_i=NULL;
331 
332  /* cpl_parameterlist_dump(config); */
333  sinfo_msg("Welcome to SINFONI Pipeline release %d.%d.%d",
334  SINFONI_MAJOR_VERSION,SINFONI_MINOR_VERSION,SINFONI_MICRO_VERSION);
335 
336  if(sinfo_dfs_set_groups(set)) {
337  sinfo_msg_error("Cannot identify RAW and CALIB frames") ;
338  return -1;
339  }
340 
341  dark_frm = cpl_frameset_find(set,PRO_MASTER_DARK);
342  if (dark_frm == NULL) {
343  sinfo_msg_error("Cannot find dark frame") ;
344  return (-1);
345  }
346 
347  ref_set=cpl_frameset_duplicate(set);
348 
349  obj_set=cpl_frameset_new();
350  sky_set=cpl_frameset_new();
351  cdb_set=cpl_frameset_new();
352  fk = sinfo_fake_new();
353 
354  sinfo_extract_obj_frames(set,obj_set);
355  sinfo_extract_sky_frames(set,sky_set);
356  sinfo_extract_mst_frames(set,cdb_set);
357 
358  nobj=cpl_frameset_get_size(obj_set);
359  nsky=cpl_frameset_get_size(sky_set);
360  ncdb=cpl_frameset_get_size(cdb_set);
361 
362  if ((nobj==0) && (nsky==0)) {
363  sinfo_msg_error("Empty input set");
364  cpl_frameset_delete(obj_set);
365  cpl_frameset_delete(sky_set);
366  cpl_frameset_delete(cdb_set);
367  cpl_frameset_delete(ref_set);
368  sinfo_fake_delete(&fk);
369  return (-1);
370  }
371 
372 
373  /*
374  * Create median collapsed sky frame either from real SKY frames,
375  * or from jittered OBJECT frames
376  */
377  if ( nsky != 0) {
378  if( (sky_frm = sinfo_get_dummy_object(sky_set)) == NULL) {
379  sinfo_msg_error("Problem to get dummy frame");
380  cpl_frameset_delete(obj_set);
381  cpl_frameset_delete(sky_set);
382  cpl_frameset_delete(cdb_set);
383  cpl_frameset_delete(ref_set);
384  sinfo_fake_delete(&fk);
385  return (-1);
386  }
387  }
388  else {
389  if( (sky_frm = sinfo_get_dummy_object(obj_set)) == NULL) {
390  sinfo_msg_error("Problem to get dummy frame");
391  cpl_frameset_delete(obj_set);
392  cpl_frameset_delete(sky_set);
393  cpl_frameset_delete(cdb_set);
394  cpl_frameset_delete(ref_set);
395  sinfo_fake_delete(&fk);
396  return (-1);
397  }
398  }
399 
400  /*
401  * Seems it's not possible to use draks as sky (due to INS.GRAT1.ENC)
402  * and stacking phase subtracts dark only in special circumstances...
403  */
404  ima1 = cpl_image_load(cpl_frame_get_filename(sky_frm),CPL_TYPE_FLOAT,0,0);
405  ima2 = cpl_image_load(cpl_frame_get_filename(dark_frm),CPL_TYPE_FLOAT,0,0);
406  resima = cpl_image_subtract_create(ima1, ima2);
407  plist=cpl_propertylist_load(cpl_frame_get_filename(sky_frm), 0);
408  cpl_image_delete(ima1);
409  cpl_image_delete(ima2);
410 
411  product_frame = cpl_frame_new();
412  cpl_frame_set_filename(product_frame, "out_fake_object2.fits") ;
413  cpl_frame_set_tag(product_frame, "OBJECT_NODDING") ;
414  cpl_frame_set_type(product_frame, CPL_FRAME_TYPE_IMAGE) ;
415  cpl_frame_set_group(product_frame, CPL_FRAME_GROUP_RAW) ;
416  //cpl_frame_set_level(product_frame, CPL_FR) ;
417  cpl_propertylist_erase_regexp(plist, "^ESO PRO CATG",0);
418 
419  cpl_image_save(resima, "out_fake_object2.fits", CPL_BPP_IEEE_FLOAT, plist,
420  CPL_IO_DEFAULT) ;
421  cpl_propertylist_delete(plist) ;
422  cpl_image_delete(resima) ;
423 
424 
425  /*
426  * Stack it - with some trickery...
427  */
428  wrk_set=cpl_frameset_new();
429 
430  dup_frm=cpl_frame_duplicate(product_frame);
431  cpl_frame_set_tag (dup_frm, "OBJECT_NODDING");
432  cpl_frame_set_group (dup_frm ,CPL_FRAME_GROUP_RAW);
433  cpl_frameset_insert(wrk_set,dup_frm);
434 
435  /* merge CDB frames to work set */
436  for(k=0;k<ncdb;k++) {
437  cdb_frm=cpl_frameset_get_frame(cdb_set,k);
438  dup_frm=cpl_frame_duplicate(cdb_frm);
439  cpl_frameset_insert(wrk_set,dup_frm);
440  }
441 
442 
443  /* defines a new name for the output stacked frame */
444  sprintf(outname,"%s%d%s","out_stack",i,".fits");
445  if(-1 == sinfo_new_stack_frames(config,wrk_set,
446  PRO_OBJECT_NODDING_STACKED,i,fk,cpl_func)) {
447 
448  cpl_frameset_delete(wrk_set);
449  //cpl_frameset_delete(tot_set);
450  cpl_frameset_delete(obj_set);
451  cpl_frameset_delete(sky_set);
452  cpl_frameset_delete(cdb_set);
453  cpl_frameset_delete(ref_set);
454  sinfo_fake_delete(&fk);
455  return -1;
456  }
457 
458  stk_set=cpl_frameset_new();
459  sinfo_contains_frames_kind(wrk_set,stk_set,PRO_STACKED);
460  nstk=cpl_frameset_get_size(stk_set);
461 
462  for(k=0;k<nstk;k++) {
463  wrk_frm=cpl_frameset_get_frame(stk_set,k);
464  dup_frm = cpl_frame_duplicate(wrk_frm);
465  cpl_frameset_insert(set,dup_frm);
466  }
467  cpl_frameset_delete(stk_set);
468  cpl_frameset_delete(wrk_set);
469 
470  sinfo_msg("------------------------------") ;
471  sinfo_msg("CREATING SKY CUBE");
472  sinfo_msg("------------------------------") ;
473 
474 
475  if ( -1 == (ind=sinfo_new_objnod(cpl_func,config, set, PRO_COADD_OBJ ) ) ) {
476  sinfo_msg_error("NODDING SCIENCE FRAMES no. %d\n", ind) ;
477  cpl_frameset_delete(obj_set);
478  cpl_frameset_delete(sky_set);
479  cpl_frameset_delete(cdb_set);
480  cpl_frameset_delete(ref_set);
481  sinfo_fake_delete(&fk);
482 
483  return (-1);
484  }
485  sinfo_msg("------------------------------") ;
486  sinfo_msg("CREATED SKY CUBE");
487  sinfo_msg("------------------------------") ;
488 
489 
490  stk_set=cpl_frameset_new();
491  sinfo_contains_frames_kind(set, stk_set, PRO_OBS_OBJ);
492  nstk=cpl_frameset_get_size(stk_set);
493 
494  wrk_frm=cpl_frameset_get_frame(stk_set,0);
495  name_i = cpl_frame_get_filename(wrk_frm);
496 
497 
498  //cpl_frameset_delete(wrk_set);
499  cpl_frameset_delete(obj_set);
500  cpl_frameset_delete(sky_set);
501  cpl_frameset_delete(cdb_set);
502  cpl_frameset_delete(ref_set);
503  sinfo_fake_delete(&fk);
504  cpl_frame_delete(sky_frm);
505  create_illumcorr (cpl_func, config, set, name_i);
506 
507  return (0);
508 
509 }
510 
511 
512 static cpl_frame*
513 sinfo_get_dummy_object(cpl_frameset* obj_set)
514 {
515 
516  cpl_imagelist* obj_list=NULL;
517  cpl_image* fake_object=NULL;
518  char filename[FILE_NAME_SZ];
519  cpl_frame* frame=NULL;
520  cpl_frame* object_frame=NULL;
521 
522  cpl_propertylist* plist=NULL;
523 
524  obj_list = cpl_imagelist_load_frameset(obj_set,CPL_TYPE_FLOAT,0,0);
525  fake_object = cpl_imagelist_collapse_median_create(obj_list);
526 
527  frame = cpl_frameset_get_frame(obj_set,0);
528  strcpy(filename,cpl_frame_get_filename(frame));
529 
530  if ((cpl_error_code)((plist = cpl_propertylist_load(filename, 0)) == NULL)) {
531  sinfo_msg_error("getting header from reference ima frame %s",filename);
532  cpl_propertylist_delete(plist) ;
533  return NULL ;
534  }
535 
536  if (sinfo_propertylist_has(plist, KEY_NAME_DPR_TYPE)) {
537  cpl_propertylist_set_string(plist, KEY_NAME_DPR_TYPE, "OBJECT");
538  } else {
539  cpl_propertylist_append_string(plist, KEY_NAME_DPR_TYPE,"OBJECT") ;
540  }
541 
542  if (cpl_image_save(fake_object, "out_fake_object.fits", CPL_BPP_IEEE_FLOAT,
543  plist,CPL_IO_DEFAULT)!=CPL_ERROR_NONE) {
544  sinfo_msg_error("Cannot save the product %s","out_fake_object.fits");
545  cpl_propertylist_delete(plist) ;
546  return NULL ;
547  }
548  cpl_propertylist_delete(plist);
549 
550  object_frame = cpl_frame_new() ;
551  cpl_frame_set_filename(object_frame, "out_fake_object.fits") ;
552  cpl_frame_set_tag(object_frame, "OBJECT") ;
553  cpl_frame_set_type(object_frame, CPL_FRAME_TYPE_IMAGE);
554  /*
555  cpl_frame_set_group(object_frame, CPL_FRAME_GROUP_PRODUCT);
556  */
557  cpl_frame_set_level(object_frame, CPL_FRAME_LEVEL_FINAL);
558  cpl_image_delete(fake_object);
559  cpl_imagelist_delete(obj_list);
560 
561  return object_frame;
562 }
563 
564 static void
565 sinfo_illumcorr_config_add (cpl_parameterlist *list)
566 {
567  cpl_parameter *p;
568 
569  if (!list) {
570  return;
571  }
572 
573  p = cpl_parameter_new_range("sinfoni.illumcorr.spec_bin",
574  CPL_TYPE_INT,
575  "Number of spectral planes to be combined ",
576  "sinfoni.illumcorr",
577  100, 1, 200);
578  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI,"illumcorr-spec_bin");
579  cpl_parameterlist_append(list, p);
580 
581  p = cpl_parameter_new_value("sinfoni.illumcorr.min_flux",
582  CPL_TYPE_DOUBLE,
583  "Minimum flux in each spectral bin ",
584  "sinfoni.illumcorr",
585  0.0);
586  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI,"illumcorr-min_flux");
587  cpl_parameterlist_append(list, p);
588 
589  p = cpl_parameter_new_value("sinfoni.illumcorr.center_bins",
590  CPL_TYPE_BOOL,
591  "Center the spectral bins at prominent "
592  "emission features ",
593  "sinfoni.illumcorr",
594  FALSE);
595  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI,"illumcorr-center_bins");
596  cpl_parameterlist_append(list, p);
597 
598  p = cpl_parameter_new_enum("sinfoni.illumcorr.order",
599  CPL_TYPE_INT,
600  "The order of the polynomial to be fitted "
601  "for each slitlet",
602  "sinfoni.illumcorr",
603  0,
604  2,0,1);
605  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI,"illumcorr-order");
606  cpl_parameterlist_append(list, p);
607 
608  p = cpl_parameter_new_value("sinfoni.illumcorr.sigma",
609  CPL_TYPE_DOUBLE,
610  "Reject n-sigma deviant pixels on each slitlet ",
611  "sinfoni.illumcorr",
612  3.0);
613  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI,"illumcorr-sigma");
614  cpl_parameterlist_append(list, p);
615 
616  p = cpl_parameter_new_value("sinfoni.illumcorr.iterations",
617  CPL_TYPE_INT,
618  "Number of sigma rejection iterations to run ",
619  "sinfoni.illumcorr",
620  3);
621  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI,"illumcorr-iter");
622  cpl_parameterlist_append(list, p);
623 
624  p = cpl_parameter_new_range("sinfoni.illumcorr.llx",
625  CPL_TYPE_INT,
626  "Reference region coordinates ",
627  "sinfoni.illumcorr",
628  8, 0, 63);
629  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI,"illumcorr-llx");
630  cpl_parameterlist_append(list, p);
631 
632  p = cpl_parameter_new_range("sinfoni.illumcorr.lly",
633  CPL_TYPE_INT,
634  "Reference region coordinates ",
635  "sinfoni.illumcorr",
636  33, 0, 63);
637  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI,"illumcorr-lly");
638  cpl_parameterlist_append(list, p);
639 
640  p = cpl_parameter_new_range("sinfoni.illumcorr.urx",
641  CPL_TYPE_INT,
642  "Reference region coordinates ",
643  "sinfoni.illumcorr",
644  60, 0, 63);
645  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI,"illumcorr-urx");
646  cpl_parameterlist_append(list, p);
647 
648  p = cpl_parameter_new_range("sinfoni.illumcorr.ury",
649  CPL_TYPE_INT,
650  "Reference region coordinates ",
651  "sinfoni.illumcorr",
652  36, 0, 63);
653  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI,"illumcorr-ury");
654  cpl_parameterlist_append(list, p);
655 
656  p = cpl_parameter_new_enum("sinfoni.illumcorr.smooth0",
657  CPL_TYPE_INT,
658  "Smooth zeroth order terms by fitting "
659  "with polynomial (1),"
660  "with median filter (2) or not (0) ",
661  "sinfoni.illumcorr",
662  0,
663  3, 0, 1, 2);
664  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI,"illumcorr-smooth0");
665  cpl_parameterlist_append(list, p);
666 
667  p = cpl_parameter_new_value("sinfoni.illumcorr.smooth0_order",
668  CPL_TYPE_INT,
669  "Order of the smoothing polynomial for 0th term",
670  "sinfoni.illumcorr",
671  2);
672  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI,"illumcorr-smooth_order0");
673  cpl_parameterlist_append(list, p);
674 
675  p = cpl_parameter_new_range("sinfoni.illumcorr.smooth0_size",
676  CPL_TYPE_INT,
677  "Size of the median filter for 0th "
678  "order smoothing ",
679  "sinfoni.illumcorr",
680  51,3, 301);
681  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI,"illumcorr-smooth0_size");
682  cpl_parameterlist_append(list, p);
683 
684  p = cpl_parameter_new_value("sinfoni.illumcorr.smooth1",
685  CPL_TYPE_BOOL,
686  "Smooth higher (>0) order polynomials ",
687  "sinfoni.illumcorr",
688  TRUE);
689  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI,"illumcorr-smooth");
690  cpl_parameterlist_append(list, p);
691 
692  p = cpl_parameter_new_value("sinfoni.illumcorr.smooth1_order",
693  CPL_TYPE_INT,
694  "Smoothing order for higher terms ",
695  "sinfoni.illumcorr",
696  2);
697  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI,"illumcorr-smooth_order");
698  cpl_parameterlist_append(list, p);
699 
700  p = cpl_parameter_new_value("sinfoni.illumcorr.illumcorr_sigma",
701  CPL_TYPE_DOUBLE,
702  "Reject all fits for which the rms is "
703  "illumcorr-sigma times bigger than the "
704  "median rms in each spectral bin" ,
705  "sinfoni.illumcorr",
706  5.0);
707  cpl_parameter_set_alias(p,CPL_PARAMETER_MODE_CLI,
708  "illumcorr-illumcorr_sigma");
709  cpl_parameterlist_append(list, p);
710 
711 }
712 
713 static int
714 create_illumcorr (const char* plugin_id,
715  cpl_parameterlist *cpl_cfg,
716  cpl_frameset* sof,
717  const char *name_i)
718 {
719  cpl_parameter *p=NULL;
720  double min_flux=0;
721  double sigma=0;
722  double il_sigma=0;
723  int spec_bin=0;
724  int _order=0;
725  cpl_imagelist *sky=NULL;
726  cpl_imagelist *binnedsky=NULL;
727  cpl_imagelist *result=NULL;
728  cpl_image *temp_image=NULL;
729  cpl_image *temp_image2=NULL;
730  int nplanes=0;
731  int i=0;
732  int j=0;
733  int k=0;
734  int kk=0;
735  int n=0;
736  int slitlet=0;
737  int bin=0;
738  double *median=NULL;
739  double *pos=NULL;
740  double temp=0;
741  double temp2=0;
742  double *inter_pos=NULL;
743  double *inter_val=NULL;
744  double *plane_pos=NULL;
745  double *plane_val=NULL;
746  int llx=0;
747  int lly=0;
748  int urx=0;
749  int ury=0;
750  int smooth_order=0;
751  int iter=0;
752  cpl_vector *row=NULL;
753  cpl_vector *model=NULL;
754  cpl_vector *xpos=NULL;
755  cpl_vector *tempvector=NULL;
756  cpl_vector *tempvector2=NULL;
757  double mse=0.0;
758  double stddev=0.0;
759  cpl_polynomial*poly=NULL;
760  cpl_polynomial *poly2=NULL;
761  double *temparray=NULL;
762  double *tempxarray=NULL;
763  double * tempsarray=NULL;
764  cpl_polynomial**coeffs=NULL;
765  float *data=NULL;
766  double *rms_values=NULL;
767  double rms_array[32];
768  int smooth=0;
769  int smooth0=0;
770  int smooth_order0=0;
771  int smooth_size0=0;
772  int center_bins = 0;
773 
774  int *bin_start=NULL;
775  int *bin_end=NULL;
776  int z1=0;
777  int z2=0;
778  int nbins=0;
779 
780  FILE *dumpfile=NULL;
781 
782  int order[32];
783  int ok[64];
784  int nbad=0;
785 
786 
787  /*
788  * Get parameters
789  */
790  p = cpl_parameterlist_find(cpl_cfg, "sinfoni.illumcorr.spec_bin");
791  spec_bin = cpl_parameter_get_int(p);
792  p = cpl_parameterlist_find(cpl_cfg, "sinfoni.illumcorr.min_flux");
793  min_flux = cpl_parameter_get_double(p);
794  p = cpl_parameterlist_find(cpl_cfg, "sinfoni.illumcorr.order");
795  _order = cpl_parameter_get_int(p);
796  p = cpl_parameterlist_find(cpl_cfg, "sinfoni.illumcorr.sigma");
797  sigma = cpl_parameter_get_double(p);
798  p = cpl_parameterlist_find(cpl_cfg, "sinfoni.illumcorr.llx");
799  llx = cpl_parameter_get_int(p);
800  p = cpl_parameterlist_find(cpl_cfg, "sinfoni.illumcorr.lly");
801  lly = cpl_parameter_get_int(p);
802  p = cpl_parameterlist_find(cpl_cfg, "sinfoni.illumcorr.urx");
803  urx = cpl_parameter_get_int(p);
804  p = cpl_parameterlist_find(cpl_cfg, "sinfoni.illumcorr.ury");
805  ury = cpl_parameter_get_int(p);
806  p = cpl_parameterlist_find(cpl_cfg, "sinfoni.illumcorr.illumcorr_sigma");
807  il_sigma = cpl_parameter_get_double(p);
808 
809  p = cpl_parameterlist_find(cpl_cfg, "sinfoni.illumcorr.smooth0");
810  smooth0 = cpl_parameter_get_int (p);
811  p = cpl_parameterlist_find(cpl_cfg, "sinfoni.illumcorr.smooth0_order");
812  smooth_order0 = cpl_parameter_get_int (p);
813  p = cpl_parameterlist_find(cpl_cfg, "sinfoni.illumcorr.smooth0_size");
814  smooth_size0 = cpl_parameter_get_int (p);
815 
816  p = cpl_parameterlist_find(cpl_cfg, "sinfoni.illumcorr.smooth1");
817  smooth = cpl_parameter_get_bool (p);
818  p = cpl_parameterlist_find(cpl_cfg, "sinfoni.illumcorr.smooth1_order");
819  smooth_order = cpl_parameter_get_int (p);
820 
821  p = cpl_parameterlist_find(cpl_cfg, "sinfoni.illumcorr.iterations");
822  iter = cpl_parameter_get_int (p);
823 
824  p = cpl_parameterlist_find(cpl_cfg, "sinfoni.illumcorr.center_bins");
825  center_bins = cpl_parameter_get_bool (p);
826 
827  /* cpl_msg_set_level(CPL_MSG_DEBUG); */
828 
829  /*
830  * Allocate resources
831  */
832  sky = cpl_imagelist_load(name_i, CPL_TYPE_FLOAT, 0);
833  nplanes = cpl_imagelist_get_size(sky);
834 
835  /* Determine the start and end points of data within the
836  * reference region */
837  z1 = 0;
838  z2=nplanes -1;
839  while (z1<nplanes
840  && isnan(cpl_image_get_mean_window(cpl_imagelist_get(sky, z1),
841  llx, lly, urx, ury)))
842  z1++;
843  while (z2>=0
844  && isnan(cpl_image_get_mean_window(cpl_imagelist_get(sky, z2),
845  llx, lly, urx, ury)))
846  z2--;
847  z1 += 2;
848  z2 -= 2;
849  if (z1>=nplanes || z2 <0 || z2<=z1) {
850  sinfo_msg_error ("Start z = %d, end z = %d", z1, z2);
851  cpl_imagelist_delete (sky);
852  return (-1);
853  }
854  sinfo_msg ("Start z = %d, end z = %d", z1, z2);
855 
856  binnedsky = cpl_imagelist_new ();
857  median = (double*) cpl_calloc(nplanes/spec_bin, sizeof(double));
858  pos = (double*) cpl_calloc(nplanes/spec_bin, sizeof(double));
859  temparray = (double*) cpl_calloc(64, sizeof(double));
860  tempxarray= (double*) cpl_calloc(64, sizeof(double));
861  tempsarray= (double*) cpl_calloc (nplanes/spec_bin, sizeof(double));
862  plane_pos = (double*) cpl_calloc (nplanes/spec_bin, sizeof(double));
863  plane_val = (double*) cpl_calloc (nplanes/spec_bin, sizeof(double));
864  coeffs = (cpl_polynomial**) cpl_calloc(32*(nplanes/spec_bin),
865  sizeof(cpl_polynomial*));
866  rms_values= (double*) cpl_calloc (32*(nplanes/spec_bin), sizeof (double));
867  inter_pos = (double*) cpl_calloc (nplanes, sizeof(double));
868  inter_val = (double*) cpl_calloc (nplanes, sizeof(double));
869 
870  model = cpl_vector_new(64);
871  xpos = cpl_vector_new(64);
872 
873  for (i=0; i<64; i++)
874  cpl_vector_set(xpos, i, (double)(i)-((double)urx-(double)llx)/2.0);
875  for (i=0; i<nplanes; i++)
876  inter_pos[i] = (double)i;
877 
878  /*
879  * This array could be given as input file for the recipe.
880  * Generally, 0th order fitting is sufficient (and of course
881  * more robust), but few slitlets might require 1st order.
882  */
883  for (i=0; i<32; i++)
884  order[i] = _order;
885 
886 
887  if (center_bins == 1) {
888  sinfo_msg("Using centering on emission features\n");
889  nbins = sinfo_illumcorr_create_bins (sky,llx, lly, urx, ury,
890  spec_bin, min_flux,
891  &bin_start, &bin_end,
892  z1, z2);
893  }
894  else {
895  sinfo_msg("Using simple spectral binning - "
896  "not centering on emission features\n");
897  nbins = (z2-z1)/spec_bin;
898  bin_start = (int*)cpl_calloc(nbins+1, sizeof(int));
899  bin_end = (int*)cpl_calloc(nbins+1, sizeof(int));
900  for (i = 0; i<nbins; i++) {
901  bin_start[i] = z1+i*spec_bin;
902  bin_end[i] = z1+(i+1)*spec_bin - 1;
903  }
904  if (bin_end[nbins-1]<z2-spec_bin/10) {
905  bin_start[nbins] = bin_end[nbins-1]+1;
906  bin_end[nbins] = z2;
907  nbins++;
908  }
909  }
910 
911  /*
912  * - bin the cube in spectral direction
913  * - calculate the median (=reference value) in region
914  * (llx,lly) - (urx,ury)
915  * - calculate the weighted position of the each spectral bin
916  */
917  sinfo_msg("Binning the cube and calculating statistics\n");
918  for (i=0; i<nbins; i++) {
919  temp_image = cpl_image_duplicate(cpl_imagelist_get(sky, bin_start[i]));
920  median[i] = sinfo_image_get_median_window (temp_image, llx, lly, urx, ury);
921  pos[i] = median[i] * (double)bin_start[i];
922  cpl_imagelist_set (binnedsky, temp_image, i);
923  for (j=bin_start[i]+1; j<bin_end[i]; j++) {
924  temp_image2 = cpl_imagelist_get (sky, j);
925  cpl_image_add (temp_image, temp_image2);
926  temp = sinfo_image_get_median_window (temp_image2, llx, lly, urx, ury);
927  median[i] = median[i] + temp;
928  pos[i] = pos[i] + temp*(double)j;
929  }
930  temp2 =(double)(bin_end[i]-bin_start[i]+1);
931  cpl_image_divide_scalar (temp_image, temp2);
932  pos[i] = pos[i]/median[i];
933  median[i] = median[i] / temp2;
934  sinfo_msg_debug("median image=%g at %g",median[i], pos[i]);
935  }
936 
937  sinfo_msg("Fitting slitlets between x=%d - x=%d\n", llx, urx);
938  sinfo_msg("Fitting order %d\n", _order);
939  for (k=0;k<nbins; k++) {
940  if (median[k]>min_flux) {
941  for (j=0; j<32; j++) {
942  row=cpl_vector_new_from_image_row(cpl_imagelist_get(binnedsky,k),2*j+1);
943  n = 0;
944  for (i=llx; i<=urx; i++) {
945  if (!isnan(cpl_vector_get(row, i))) {
946  ok[i] = 1;
947  temparray[n] = cpl_vector_get(row, i);
948  tempxarray[n] = cpl_vector_get(xpos, i);
949  n++;
950  }
951  else
952  ok[i] = 0;
953  }
954 
955  /* The ends of cube are always filled with NaNs => n==0*/
956  if (n>20) {
957  tempvector = cpl_vector_wrap (n, temparray);
958  tempvector2= cpl_vector_wrap (n, tempxarray);
959  poly = cpl_polynomial_fit_1d_create (tempvector2, tempvector,
960  order[j], &mse);
961 
962  if (poly == NULL)
963  sinfo_msg("Fitting failed (plane %d, row %d): %s",
964  k, j, (char* ) cpl_error_get_message());
965  else {
966  if (sigma>0 && iter>0) {
967  for (kk = 0; kk<iter; kk++) {
968  cpl_vector_fill_polynomial (model, poly, 0.0, 1.0);
969  cpl_vector_subtract (model, row);
970 
971  /* Calculate stdev NaN-correctly */
972  n = 0;
973  for (i=llx; i<=urx; i++)
974  if (ok[i] == 1)
975  temparray[n++] = cpl_vector_get(model, i);
976  stddev = cpl_vector_get_stdev(tempvector);
977 
978  for (i=llx; i<=urx; i++)
979  if (ok[i] == 1)
980  if (fabs(cpl_vector_get(model, i))>(stddev*sigma))
981  ok[i] = 0;
982 
983 
984  n = 0;
985  for (i=llx; i<=urx; i++) {
986  if (ok[i] == 1) {
987  temparray[n] = cpl_vector_get(row, i);
988  tempxarray[n] = cpl_vector_get(xpos, i);
989  n++;
990  }
991  }
992  cpl_polynomial_delete(poly);
993  if (n>20) {
994  cpl_vector_unwrap (tempvector);
995  cpl_vector_unwrap (tempvector2);
996  tempvector = cpl_vector_wrap (n, temparray);
997  tempvector2= cpl_vector_wrap (n, tempxarray);
998  stddev = cpl_vector_get_stdev(tempvector);
999 
1000  poly = cpl_polynomial_fit_1d_create (tempvector2,
1001  tempvector,
1002  order[j], &mse);
1003  if (poly == NULL)
1004  break;
1005  }
1006  else {
1007  poly = NULL;
1008  break;
1009  }
1010  /* printf ("%d %e ", n, stddev); */
1011  }
1012  }
1013 
1014  if (poly!=NULL) {
1015  coeffs[j*nbins+k] = poly;
1016  rms_values[j*nbins+k] = sqrt(mse);
1017  }
1018  else
1019  coeffs[j*nbins+k] = NULL;
1020  }
1021  cpl_vector_unwrap (tempvector);
1022  cpl_vector_unwrap (tempvector2);
1023  }
1024  cpl_vector_delete(row);
1025  }
1026  }
1027  }
1028 
1029  /*
1030  * These should (probably) be saved in a fits file...
1031  */
1032  sinfo_msg("Writing dat out_illum.dat\n");
1033  dumpfile = fopen ("out_illum.dat","w");
1034  fprintf (dumpfile, "# slitlet, pos, median, rms, coeff0, coeff1...\n");
1035  for (slitlet = 0; slitlet<32; slitlet++)
1036  for (bin=0; bin<nbins; bin++) {
1037  poly = coeffs[slitlet*nbins+bin];
1038  if (poly != NULL) {
1039  fprintf (dumpfile, "%d %f %f %f ",slitlet, pos[bin],
1040  median[bin],
1041  rms_values[slitlet*nbins+bin]);
1042  for (i=0; i<(cpl_polynomial_get_degree(poly)+1); i++) {
1043  temp = cpl_polynomial_get_coeff (poly, &i);
1044  fprintf (dumpfile, "%f ", temp);
1045  }
1046  fprintf (dumpfile, "\n");
1047  }
1048  }
1049  fclose (dumpfile);
1050 
1051  /*
1052  * Remove poor fits:
1053  * - calculate the median rms of all fits
1054  * - throw away the fits whose rms is il_sigma*median_rms
1055  */
1056  sinfo_msg("Removing poor fits - factor %f", il_sigma);
1057  n = 0;
1058  i = 0;
1059  nbad=0;
1060  sinfo_msg("max loop over bin =%d",nbins);
1061  for (bin=0; bin<nbins; bin++) {
1062  k = 0;
1063  for (slitlet=0; slitlet<32; slitlet++)
1064  if (coeffs[slitlet*nbins+bin] != NULL)
1065  rms_array[k++] = rms_values[slitlet*nbins+bin];
1066  if (k>0) {
1067  /* For some bizarre reason, cpl_tools_get_median_double returns
1068  * -1076245448.000000 (is that NaN?). On closer inspection,
1069  * it seems to have replaced one of the numbers in array with NaN...*/
1070  tempvector = cpl_vector_wrap (k, &rms_array[0]);
1071  temp = cpl_vector_get_median (tempvector);
1072  sinfo_msg("median temp=%g",temp);
1073  cpl_vector_unwrap (tempvector);
1074  for (slitlet=0; slitlet<32; slitlet++)
1075  if (coeffs[slitlet*nbins+bin] != NULL) {
1076  i++;
1077  if (rms_values[slitlet*nbins+bin]>(il_sigma*temp)) {
1078  cpl_polynomial_delete(coeffs[slitlet*nbins+bin]);
1079  coeffs[slitlet*nbins+bin] = NULL;
1080  n++;
1081  }
1082  } else {
1083  nbad++;
1084  }
1085 
1086  }
1087  }
1088  sinfo_msg("Removed %d poor fits out of %d. Bad coeffs=%d", n,i,nbad);
1089 
1090  if(smooth0 == 1) {
1091  sinfo_msg("Smoothing zeroth terms (order %d)", smooth_order0);
1092  /*
1093  * Since the new centering scheme will pro
1094  */
1095  for (slitlet = 0; slitlet<32; slitlet++) {
1096  k = 0;
1097  for (bin=0; bin<nbins; bin++) {
1098  if (coeffs[slitlet*nbins+bin] != NULL) {
1099  poly = coeffs[slitlet*nbins+bin];
1100  i = 0;
1101  temp = cpl_polynomial_get_coeff (poly, &i);
1102  plane_pos[k] = pos[bin];
1103  plane_val[k] = temp/median[bin];
1104  k++;
1105  }
1106  }
1107  if (k>0) {
1108  tempvector = cpl_vector_wrap (k, plane_pos);
1109  tempvector2= cpl_vector_wrap (k, plane_val);
1110  poly2 = cpl_polynomial_fit_1d_create (tempvector, tempvector2,
1111  smooth_order0, &mse);
1112  cpl_vector_unwrap (tempvector);
1113  cpl_vector_unwrap (tempvector2);
1114  for (bin=0; bin<nbins; bin++) {
1115  if (coeffs[slitlet*nbins+bin] != NULL) {
1116  poly = coeffs[slitlet*nbins+bin];
1117  i = 0;
1118  temp2 = cpl_polynomial_eval_1d (poly2, pos[bin], NULL);
1119  cpl_polynomial_set_coeff (poly, &i, temp2*median[bin]);
1120  }
1121  }
1122  cpl_polynomial_delete(poly2);
1123  }
1124  else
1125  sinfo_msg_warning ("Not enough data points in slitlet %d", slitlet);
1126  }
1127  }
1128  else if (smooth0 == 2) {
1129  sinfo_msg("Smoothing zeroth terms (median filter size %d)", smooth_size0);
1130  smooth_size0 = smooth_size0/2;
1131  if (smooth_size0 <= 0) smooth_size0 = 1;
1132  for (slitlet = 0; slitlet<32; slitlet++) {
1133  k = 0;
1134  for (bin=0; bin<nbins; bin++) {
1135  if (coeffs[slitlet*nbins+bin] != NULL) {
1136  poly = coeffs[slitlet*nbins+bin];
1137  i = 0;
1138  temp = cpl_polynomial_get_coeff (poly, &i);
1139  //plane_pos[k] = pos[bin];
1140  plane_val[k] = temp/median[bin];
1141  k++;
1142  }
1143  }
1144  if (k>0) {
1145  tempvector = cpl_vector_wrap (k, plane_val);
1146  tempvector2= sinfo_juha_vector_filter_median_create (tempvector,
1147  smooth_size0);
1148  cpl_vector_unwrap (tempvector);
1149  kk = 0;
1150  for (bin=0; bin<nbins; bin++) {
1151  if (coeffs[slitlet*nbins+bin] != NULL) {
1152  poly = coeffs[slitlet*nbins+bin];
1153  i = 0;
1154  cpl_polynomial_set_coeff(poly, &i, cpl_vector_get(tempvector2, kk++)
1155  *median[bin]);
1156  }
1157  }
1158  cpl_vector_delete (tempvector2);
1159  }
1160  }
1161  }
1162 
1163  if(smooth == 1) {
1164  sinfo_msg("Smoothing higher terms (with order %d)", smooth_order);
1165  for (slitlet = 0; slitlet<32; slitlet++) {
1166  if (order[slitlet]>0) {
1167  for (j=1; j<=order[slitlet]; j++) {
1168  k = 0;
1169  for (bin=0; bin<nbins; bin++) {
1170  if (coeffs[slitlet*nbins+bin] != NULL) {
1171  poly = coeffs[slitlet*nbins+bin];
1172  i = 0;
1173  /* temp = cpl_polynomial_get_coeff (poly, &i); */
1174  temp2 = cpl_polynomial_get_coeff (poly, &j);
1175  plane_pos[k] = pos[bin];
1176  plane_val[k] = temp2/median[bin];
1177  k++;
1178  }
1179  }
1180  if (k>0) {
1181  tempvector = cpl_vector_wrap (k, plane_pos);
1182  tempvector2= cpl_vector_wrap (k, plane_val);
1183  poly2 = cpl_polynomial_fit_1d_create (tempvector, tempvector2,
1184  smooth_order, &mse);
1185  cpl_vector_unwrap (tempvector);
1186  cpl_vector_unwrap (tempvector2);
1187  for (bin=0; bin<nbins; bin++) {
1188  if (coeffs[slitlet*nbins+bin] != NULL) {
1189  poly = coeffs[slitlet*nbins+bin];
1190  i = 0;
1191  /* temp = cpl_polynomial_get_coeff (poly, &i); */
1192  temp2 = cpl_polynomial_eval_1d (poly2, pos[bin], NULL);
1193  cpl_polynomial_set_coeff (poly, &j, temp2*median[bin]);
1194  }
1195  }
1196  cpl_polynomial_delete(poly2);
1197  }
1198  else
1199  sinfo_msg_warning ("Not enough data points in slitlet %d\n",
1200  slitlet);
1201  }
1202  }
1203  }
1204  }
1205 
1206  sinfo_msg("Creating cube for illumination correction\n");
1207  result = cpl_imagelist_new ();
1208  for (i=0; i<nplanes; i++) {
1209  temp_image = cpl_image_new (64, 64, CPL_TYPE_FLOAT);
1210  cpl_imagelist_set (result, temp_image, i);
1211  }
1212 
1213  sinfo_msg("nplanes=%d spec_bin=%d",nplanes,spec_bin);
1214  if ( nbins>5) {
1215  sinfo_msg("Interpolating\n");
1216  for (slitlet = 0; slitlet<32; slitlet++) {
1217  for (i=0; i<64; i++) {
1218  k = 0;
1219  for (bin=0; bin<nbins; bin++) {
1220  if (coeffs[slitlet*nbins+bin] != NULL) {
1221  plane_pos[k] = pos[bin];
1222  plane_val[k] = cpl_polynomial_eval_1d(coeffs[slitlet*nbins+bin],
1223  cpl_vector_get(xpos, i),NULL)/
1224  median[bin];
1225  k++;
1226  }
1227  }
1228 
1229  if (k>3) {
1230  sinfo_juha_function1d_natural_spline (plane_pos, plane_val, k,
1231  &inter_pos[(int)plane_pos[0]],
1232  &inter_val[(int)plane_pos[0]],
1233  (int)(plane_pos[k-1]-plane_pos[0]));
1234  for (j=0; j<=(int)plane_pos[0]; j++)
1235  inter_val[j] = inter_val[(int)plane_pos[0]+1];
1236  for (j=(int)plane_pos[k-1]-1; j<nplanes; j++)
1237  inter_val[j] = inter_val[(int)plane_pos[k-1]-2];
1238  for (k=0; k<nplanes; k++) {
1239  data = cpl_image_get_data_float(cpl_imagelist_get(result, k));
1240  data[i + (2*slitlet)*64] = inter_val[k];
1241  data[i + (2*slitlet+1)*64] = inter_val[k];
1242  /*sinfo_msg("inter_val=%g",inter_val[k]);*/
1243  }
1244  }
1245  else
1246  sinfo_msg_warning ("Too few points %d\n", slitlet);
1247  }
1248  }
1249  }
1250  else if (nbins==1) {
1251  sinfo_msg("Filling the illumination cube\n");
1252  for (slitlet = 0; slitlet<32; slitlet++) {
1253  for (i=0; i<64; i++) {
1254  if (coeffs[slitlet] != NULL) {
1255  temp = cpl_polynomial_eval_1d(coeffs[slitlet],
1256  cpl_vector_get(xpos, i),NULL)/median[0];
1257  for (k=0; k<nplanes; k++) {
1258  data = cpl_image_get_data_float(cpl_imagelist_get(result, k));
1259  data[i + (2*slitlet)*64] = temp;
1260  data[i + (2*slitlet+1)*64] = temp;
1261  sinfo_msg("temp=%g",temp);
1262  }
1263  }
1264  }
1265  }
1266  } else {
1267 
1268  }
1269 
1270 
1271  sinfo_msg("Writing ima out_illum.fits\n");
1272  /* pl = cpl_propertylist_load (name_i, 0); */
1273  /* if (sinfo_propertylist_has(pl, KEY_NAME_PRO_CATG)) */
1274  /* cpl_propertylist_set_string (pl, KEY_NAME_PRO_CATG, PRO_ILL_COR); */
1275  /* else */
1276  /* cpl_propertylist_append_string (pl, KEY_NAME_PRO_CATG, PRO_ILL_COR); */
1277 
1278  /* cpl_imagelist_save(result, "out_illum.fits", CPL_BPP_IEEE_FLOAT, pl, 0); */
1279 
1280  sinfo_pro_save_ims(result,sof,sof,"out_illum.fits",
1281  PRO_ILL_COR,NULL,plugin_id, cpl_cfg);
1282 
1283  /*
1284  * These should (probably) be saved in a fits file...
1285  */
1286  sinfo_msg("Writing dat out_illum2.dat\n");
1287  dumpfile = fopen ("out_illum2.dat","w");
1288  fprintf (dumpfile, "# slitlet, pos, median, rms, coeff0, coeff1...\n");
1289  for (slitlet = 0; slitlet<32; slitlet++)
1290  for (bin=0; bin<nbins; bin++) {
1291  poly = coeffs[slitlet*nbins+bin];
1292  if (poly != NULL) {
1293  fprintf (dumpfile, "%d %f %f %f ",slitlet, pos[bin],
1294  median[bin],
1295  rms_values[slitlet*nbins+bin]);
1296  for (i=0; i<(cpl_polynomial_get_degree(poly)+1); i++) {
1297  temp = cpl_polynomial_get_coeff (poly, &i);
1298  fprintf (dumpfile, "%f ", temp);
1299  }
1300  fprintf (dumpfile, "\n");
1301  }
1302  }
1303  fclose (dumpfile);
1304 
1305  /*
1306  * Clean up...
1307  */
1308  for (i = 0; i<32*nbins; i++)
1309  if (coeffs[i] != NULL)
1310  cpl_polynomial_delete(coeffs[i]);
1311  cpl_imagelist_delete (sky);
1312  cpl_imagelist_delete (binnedsky);
1313  cpl_imagelist_delete (result);
1314  cpl_free (pos);
1315  cpl_free (median);
1316  cpl_free (temparray);
1317  cpl_free (tempxarray);
1318  cpl_free (tempsarray);
1319  cpl_free (coeffs);
1320  cpl_free (inter_pos);
1321  cpl_free (inter_val);
1322  cpl_free (plane_pos);
1323  cpl_free (plane_val);
1324  cpl_free (rms_values);
1325  cpl_vector_delete (xpos);
1326  cpl_vector_delete (model);
1327 
1328  cpl_free (bin_start);
1329  cpl_free (bin_end);
1330 
1331  return (1);
1332 }
1333 
1334 /*
1335  * sinfo_illumcorr_create_bins:
1336  * - searches for the sky emission lines
1337  * - increases the size of the bin to include two or more emission
1338  * lines if they are too close to each other
1339  * - fills the space between emission lines with bins if
1340  * thermal background has enough flux
1341  * - copies the start and end points of bins to two arrays
1342  * (returned in **start and **end)
1343  *
1344  * Returns: the number bins created
1345  *
1346  * The arrays start and end must be deallocated with cpl_free()
1347  */
1348 static int
1349 sinfo_illumcorr_create_bins (cpl_imagelist *sky,
1350  int llx, int lly, int urx, int ury,
1351  int spec_bin,
1352  double min_flux,
1353  int ** start,
1354  int ** end,
1355  int z1, int z2)
1356 {
1357  int temp_i=0;
1358  double testarray3[15];
1359  double temp_double=0;
1360  int i=0, j=0, k=0,kk=0,nplanes=0;
1361 
1362  int norig = 0, nmerged = 0, ncont = 0, nline=0;
1363 
1364  int *pos=NULL;
1365  int *x1=NULL;
1366  int *x2=NULL;
1367  int *x1b=NULL;
1368  int *x2b=NULL;
1369  int *s1=NULL;
1370  int *s2=NULL;
1371  double *flux=NULL;
1372  double *spec=NULL;
1373  double *spec_cont=NULL;
1374  double *spec_line=NULL;
1375 
1376 
1377  cpl_image *temp_image=NULL;
1378 
1379  nplanes = cpl_imagelist_get_size(sky);
1380 
1381  spec = (double*) cpl_calloc(nplanes, sizeof(double));
1382  spec_line = (double*) cpl_calloc(nplanes, sizeof(double));
1383  spec_cont = (double*) cpl_calloc(nplanes, sizeof(double));
1384 
1385  /* there should be no way of actually needing this large arrays*/
1386  pos = (int*) cpl_calloc(nplanes, sizeof(int));
1387  flux = (double*) cpl_calloc(nplanes, sizeof(double));
1388  x1 = (int*) cpl_calloc(nplanes, sizeof(int));
1389  x2 = (int*) cpl_calloc(nplanes, sizeof(int));
1390  x1b = (int*) cpl_calloc(nplanes, sizeof(int));
1391  x2b = (int*) cpl_calloc(nplanes, sizeof(int));
1392 
1393  for (i=z1; i<=z2; i++) {
1394  temp_image = cpl_imagelist_get(sky, i);
1395  spec[i] = sinfo_image_get_median_window (temp_image, llx, lly, urx, ury);
1396  }
1397  for (i=z1+7; i<=z2-7; i++) {
1398  k = 0;
1399  for (j=-7; j<=7; j++)
1400  if (!isnan(spec[i+j]))
1401  testarray3[k++] = spec[i+j];
1402  if (k>0) {
1403  sinfo_tools_sort_double (&testarray3[0], k);
1404  spec_cont[i] = testarray3[1];
1405  }
1406  else
1407  spec_cont[i] = 0./0.;
1408  }
1409 
1410  sinfo_msg_debug("Calculating pure line flux at pos: "
1411  "original, continuum, line");
1412  for (i=z1; i<=z2; i++) {
1413  spec_line[i] = spec[i] - spec_cont[i];
1414  sinfo_msg_debug("Flux at %i = %g %g %g",
1415  i,spec[i],spec_cont[i], spec_line[i]);
1416  }
1417 
1418 
1419  /*
1420  * Search for peaks
1421  */
1422  sinfo_msg ("Searching for peaks");
1423  temp_double = -10000.0;
1424  i = z1+2;
1425  while (i<=z2-2) {
1426  if (!isnan (spec_line[i])) {
1427  if (temp_double<spec_line[i]) {
1428  temp_i = i;
1429  temp_double = spec_line[i];
1430  }
1431  else {
1432  /* Found a peak! */
1433  if (temp_i == i-1 && spec_line[temp_i]>min_flux) {
1434  k = 0;
1435  for (j=-spec_bin/2; j<=spec_bin/2; j++)
1436  if (j+i>=0 && i+j<nplanes && isnan(spec[i+j])) {
1437  k = 1;
1438  break;
1439  }
1440  if (k==0) {
1441  pos[norig] = temp_i; // - spec_bin/2;
1442  flux[norig] = temp_double;
1443  x1[norig] = temp_i;
1444  x2[norig] = temp_i;
1445  temp_double = -10000.0;
1446  while (spec_line[i]<spec_line[i-1])
1447  i++;
1448  i--;
1449  norig++;
1450  }
1451  }
1452  }
1453  }
1454  i++;
1455  }
1456 
1457  /*
1458  * Merge the features which are too close to each other
1459  */
1460  sinfo_msg ("Merging emission features too close to each other");
1461  i = 0;
1462  while (i<norig) {
1463  if (flux[i] > 0.0) {
1464  j = i+1;
1465  while (j<norig
1466  && (x1[j]-x2[i]) <=spec_bin
1467  && flux[j]>0.0) {
1468  flux[j] = -100.0;
1469  x2[i] = x1[j];
1470  j++;
1471  nmerged++;
1472  }
1473  }
1474  i++;
1475  }
1476 
1477  nline = norig - nmerged;
1478 
1479  j = 0;
1480  for (i=0; i<norig; i++)
1481  if (flux[i]>0.0) {
1482  x1b[j] = x1[i] - spec_bin/2;
1483  x2b[j] = x2[i] + spec_bin/2;
1484  j++;
1485  /* sinfo_msg ("Bin start: %i end %i", x1[i], x2[i]); */
1486  }
1487 
1488  x1b[j] = nplanes+1;
1489 
1490  /*
1491  * Check whether there is enough continuum (thermal background)
1492  * for binning
1493  */
1494  j=0;
1495  i=z1;
1496  while (i<=z2) {
1497  if (!isnan (spec[i])) {
1498  if (x1b[j]-i < spec_bin) {
1499  i = x2b[j]+1;
1500  j++;
1501  }
1502  else {
1503  kk = 0;
1504  for (k=0; k<spec_bin; k++)
1505  if (spec[i+k]>min_flux)
1506  kk++;
1507  if (kk==spec_bin) {
1508  x1[ncont] = i;
1509  x2[ncont] = i+spec_bin-1;
1510  ncont++;
1511  i = i+spec_bin;
1512  }
1513  else
1514  i++;
1515  }
1516  }
1517  else
1518  i++;
1519  }
1520 
1521  sinfo_msg ("Number of bins centered on emission features:");
1522  sinfo_msg (" %i - %i (merged) = %i", norig, nmerged, nline);
1523  sinfo_msg (" %i continuum bins", ncont);
1524 
1525  s1 = (int*)cpl_calloc(norig-nmerged+ncont, sizeof(int));
1526  s2 = (int*)cpl_calloc(norig-nmerged+ncont, sizeof(int));
1527 
1528 
1529  /*
1530  * Merge arrays sorted
1531  */
1532  i=0;
1533  j=0;
1534  k=0;
1535  while (k<norig-nmerged+ncont) {
1536  if (i<norig && j<ncont && x1b[i]<x1[j]) {
1537  s1[k] = x1b[i];
1538  s2[k] = x2b[i];
1539  k++;
1540  i++;
1541  }
1542  else if (i<norig && j<ncont && x1b[i]>x1[j]) {
1543  s1[k] = x1[j];
1544  s2[k] = x2[j];
1545  k++;
1546  j++;
1547  }
1548  else if (i == norig) {
1549  s1[k] = x1[j];
1550  s2[k] = x2[j];
1551  k++;
1552  j++;
1553  }
1554  else if (j == ncont) {
1555  s1[k] = x1b[i];
1556  s2[k] = x2b[i];
1557  k++;
1558  i++;
1559  }
1560  else {
1561  /* Should never happen */
1562  sinfo_msg_warning("Something went wrong when combining "
1563  "the bins %i and %i", i,j);
1564  break;
1565  }
1566  }
1567 
1568  for (i=0; i<nline+ncont; i++)
1569  sinfo_msg_debug ("Bin start: %i end %i", s1[i], s2[i]);
1570 
1571  *start = s1;
1572  *end = s2;
1573 
1574  cpl_free (pos);
1575  cpl_free (x1);
1576  cpl_free (x2);
1577  cpl_free (x1b);
1578  cpl_free (x2b);
1579  cpl_free (flux);
1580  cpl_free (spec);
1581  cpl_free (spec_line);
1582  cpl_free (spec_cont);
1583 
1584  return (nline+ncont);
1585 }
1586 
1587 
1588 /*-------------------------------------------------------------------------*/
1615 /*--------------------------------------------------------------------------*/
1616 
1617 static int
1618 sinfo_juha_function1d_natural_spline(
1619  double * x,
1620  double * y,
1621  int len,
1622  double * splX,
1623  double * splY,
1624  int splLen
1625 )
1626 {
1627  int end;
1628  int loc, found;
1629  register int i, j, n;
1630  double * h; /* vector of deltas in x */
1631  double * alpha;
1632  double * l,
1633  * mu,
1634  * z,
1635  * a,
1636  * b,
1637  * c,
1638  * d,
1639  v;
1640 
1641  end = len - 1;
1642 
1643  a = cpl_malloc(sizeof(double) * splLen * 9) ;
1644  b = a + len;
1645  c = b + len;
1646  d = c + len;
1647  h = d + len;
1648  l = h + len;
1649  z = l + len;
1650  mu = z + len;
1651  alpha = mu + len;
1652 
1653  for (i = 0; i < len; i++) {
1654  a[i] = (double)y[i];
1655  }
1656 
1657  /* Calculate vector of differences */
1658  for (i = 0; i < end; i++) {
1659  h[i] = (double)x[i + 1] - (double)x[i];
1660  if (h[i] < 0.0) {
1661  cpl_free(a) ;
1662  return -1;
1663  }
1664  }
1665 
1666  /* Calculate alpha vector */
1667  for (n = 0, i = 1; i < end; i++, n++) {
1668  /* n = i - 1 */
1669  alpha[i] = 3.0 * ((a[i+1] / h[i]) - (a[i] / h[n]) - (a[i] / h[i]) +
1670  (a[n] / h[n]));
1671  }
1672 
1673  /* Vectors to solve the tridiagonal matrix */
1674  l[0] = l[end] = 1.0;
1675  mu[0] = mu[end] = 0.0;
1676  z[0] = z[end] = 0.0;
1677  c[0] = c[end] = 0.0;
1678 
1679  /* Calculate the intermediate results */
1680  for (n = 0, i = 1; i < end; i++, n++) {
1681  /* n = i-1 */
1682  l[i] = 2 * (h[i] + h[n]) - h[n] * mu[n];
1683  mu[i] = h[i] / l[i];
1684  z[i] = (alpha[i] - h[n] * z[n]) / l[i];
1685  }
1686  for (n = end, j = end - 1; j >= 0; j--, n--) {
1687  /* n = j + 1 */
1688  c[j] = z[j] - mu[j] * c[n];
1689  b[j] = (a[n] - a[j]) / h[j] - h[j] * (c[n] + 2.0 * c[j]) / 3.0;
1690  d[j] = (c[n] - c[j]) / (3.0 * h[j]);
1691  }
1692 
1693  /* Now calculate the new values */
1694  for (j = 0; j < splLen; j++) {
1695  v = (double)splX[j];
1696  splY[j] = (float)0;
1697 
1698  /* Is it outside the interval? */
1699  if ((v < (double)x[0]) || (v > (double)x[end])) {
1700  continue;
1701  }
1702  /* Search for the interval containing v in the x vector */
1703  loc = sinfo_function1d_search_value(x, len, (double)v, &found);
1704  if (found) {
1705  splY[j] = y[loc];
1706  } else {
1707  loc--;
1708  v -= (double)x[loc];
1709  splY[j] = (float)( a[loc] + v * (b[loc] + v * (c[loc] + v * d[loc])));
1710  }
1711  }
1712  cpl_free(a) ;
1713  return 0;
1714 }
1715 
1716 /*-------------------------------------------------------------------------*/
1732 /*--------------------------------------------------------------------------*/
1733 
1734 static int
1735 sinfo_function1d_search_value(
1736  double * x,
1737  int len,
1738  double key,
1739  int * foundPtr
1740 )
1741 {
1742  int high,
1743  low,
1744  middle;
1745 
1746  low = 0;
1747  high = len - 1;
1748 
1749  while (high >= low) {
1750  middle = (high + low) / 2;
1751  if (key > x[middle]) {
1752  low = middle + 1;
1753  } else if (key < x[middle]) {
1754  high = middle - 1;
1755  } else {
1756  *foundPtr = 1;
1757  return (middle);
1758  }
1759  }
1760  *foundPtr = 0;
1761  return (low);
1762 }
1763 
1764 
1765 /*
1766 cpl_vector * sinfo_vector_filter_median_create(
1767  const cpl_vector * v,
1768  int hw)
1769 {
1770  cpl_vector * filtered;
1771  double * row;
1772  int i, j, k, size;
1773  double temp;
1774 
1775  size = cpl_vector_get_size(v);
1776  filtered = cpl_vector_new(size);
1777 
1778  row = cpl_malloc((2*hw+1) * sizeof(double));
1779  for (i=0; i<size; i++) {
1780  k = 0;
1781  for (j=-hw; j<=hw; j++)
1782  if ( (i+j) >= 0 && (i+j) < size) {
1783  temp = cpl_vector_get (v, i+j);
1784  row[k] = temp;
1785  k++;
1786  }
1787  cpl_tools_sort_double (row, k);
1788  if (k%2 == 1)
1789  temp = row[k/2];
1790  else
1791  temp = row[k/2-1];
1792  cpl_vector_set (filtered, i, temp);
1793  }
1794  cpl_free(row);
1795  return filtered;
1796 }
1797  */
1798 
1799 static cpl_vector *
1800 sinfo_juha_vector_filter_median_create(
1801  const cpl_vector * v,
1802  int hw)
1803 {
1804  cpl_vector * filtered=NULL;
1805  double * row=NULL;
1806  int i, j, k, size;
1807  double temp;
1808 
1809  size = cpl_vector_get_size(v);
1810  filtered = cpl_vector_new(size);
1811 
1812  row = cpl_malloc((2*hw+1) * sizeof(double));
1813  for (i=0; i<size; i++) {
1814  k = 0;
1815  for (j=-hw; j<=hw; j++)
1816  if ( (i+j) >= 0 && (i+j) < size) {
1817  temp = cpl_vector_get (v, i+j);
1818  row[k] = temp;
1819  k++;
1820  }
1821  sinfo_tools_sort_double (row, k);
1822 
1823  if (k%2 == 1)
1824  temp = row[k/2];
1825  else
1826  temp = row[k/2-1];
1827  cpl_vector_set (filtered, i, temp);
1828  }
1829  cpl_free(row);
1830  return filtered;
1831 }
1832 
1833 #define CPL_PIX_STACK_SIZE 50
1834 /*---------------------------------------------------------------------------*/
1845 /*---------------------------------------------------------------------------*/
1846 static cpl_error_code sinfo_tools_sort_double(
1847  double * pix_arr,
1848  int n)
1849 {
1850  int i, ir, j, k, l;
1851  int * i_stack ;
1852  int j_stack ;
1853  double a ;
1854 
1855  /* Check entries */
1856  cpl_ensure(pix_arr, CPL_ERROR_NULL_INPUT, CPL_ERROR_NULL_INPUT) ;
1857 
1858  ir = n ;
1859  l = 1 ;
1860  j_stack = 0 ;
1861  i_stack = malloc(CPL_PIX_STACK_SIZE * sizeof(double)) ;
1862  for (;;) {
1863  if (ir-l < 7) {
1864  for (j=l+1 ; j<=ir ; j++) {
1865  a = pix_arr[j-1];
1866  for (i=j-1 ; i>=1 ; i--) {
1867  if (pix_arr[i-1] <= a) break;
1868  pix_arr[i] = pix_arr[i-1];
1869  }
1870  pix_arr[i] = a;
1871  }
1872  if (j_stack == 0) break;
1873  ir = i_stack[j_stack-- -1];
1874  l = i_stack[j_stack-- -1];
1875  } else {
1876  k = (l+ir) >> 1;
1877  SINFO_DOUBLE_SWAP(pix_arr[k-1], pix_arr[l])
1878  if (pix_arr[l] > pix_arr[ir-1]) {
1879  SINFO_DOUBLE_SWAP(pix_arr[l], pix_arr[ir-1])
1880  }
1881  if (pix_arr[l-1] > pix_arr[ir-1]) {
1882  SINFO_DOUBLE_SWAP(pix_arr[l-1], pix_arr[ir-1])
1883  }
1884  if (pix_arr[l] > pix_arr[l-1]) {
1885  SINFO_DOUBLE_SWAP(pix_arr[l], pix_arr[l-1])
1886  }
1887  i = l+1;
1888  j = ir;
1889  a = pix_arr[l-1];
1890  for (;;) {
1891  do i++; while (pix_arr[i-1] < a);
1892  do j--; while (pix_arr[j-1] > a);
1893  if (j < i) break;
1894  SINFO_DOUBLE_SWAP(pix_arr[i-1], pix_arr[j-1]);
1895  }
1896  pix_arr[l-1] = pix_arr[j-1];
1897  pix_arr[j-1] = a;
1898  j_stack += 2;
1899  if (j_stack > CPL_PIX_STACK_SIZE) {
1900  /* Should never reach here */
1901  free(i_stack);
1902  return CPL_ERROR_ILLEGAL_INPUT ;
1903  }
1904  if (ir-i+1 >= j-l) {
1905  i_stack[j_stack-1] = ir;
1906  i_stack[j_stack-2] = i;
1907  ir = j-1;
1908  } else {
1909  i_stack[j_stack-1] = j-1;
1910  i_stack[j_stack-2] = l;
1911  l = i;
1912  }
1913  }
1914  }
1915  free(i_stack) ;
1916  return CPL_ERROR_NONE ;
1917 }
1918 
1919 static cpl_vector *
1920 sinfo_vector_filter_median_create(
1921  const cpl_vector * v,
1922  int hw)
1923 {
1924  cpl_vector * filtered;
1925  cpl_vector * row;
1926  int i, j, k, size;
1927  double temp;
1928 
1929  /* Create the filtered vector */
1930  size = cpl_vector_get_size(v);
1931  filtered = cpl_vector_new(size);
1932 
1933  /* median filter on all central items */
1934  row = cpl_vector_new((2*hw+1));
1935  for (i=0; i<size; i++) {
1936  k = 0;
1937  for (j=-hw; j<=hw; j++)
1938  if ( (i+j) >= 0 && (i+j) < size) {
1939  temp = cpl_vector_get (v, i+j);
1940  cpl_vector_set(row,k,temp);
1941  k++;
1942  }
1943  /* this returns ~2e8 when all the values are 1.0....*/
1944  /* temp = cpl_tools_get_median_double(row, k); */
1945  cpl_vector_sort(row, +1);
1946  if (k%2 == 1) {
1947  temp = cpl_vector_get(row,k/2);
1948  }
1949  else {
1950  temp = cpl_vector_get(row,k/2-1);
1951  }
1952 
1953  sinfo_msg("value = %g ", temp);
1954  cpl_vector_set (filtered, i, temp);
1955  }
1956  cpl_vector_delete(row);
1957  return filtered;
1958 }
1959 
1960 /*
1961  * A NaN safe version of cpl_image_get_median_window
1962  */
1963 static double
1964 sinfo_image_get_median_window (const cpl_image *image,
1965  int llx, int lly, int urx, int ury)
1966 {
1967  cpl_image *window;
1968  float *data;
1969  double *array, median;
1970  int size, i,j;
1971 
1972  window = cpl_image_extract (image, llx, lly, urx, ury);
1973  size = (urx-llx+1)*(ury-lly+1);
1974  data = cpl_image_get_data_float(window);
1975 
1976  array = (double*)cpl_calloc ( size, sizeof(double));
1977  j = 0;
1978  for (i=0; i<size; i++)
1979  if (!isnan(data[i]))
1980  array[j++] = data[i];
1981 
1982  if (j>0)
1983  sinfo_tools_sort_double (array, j);
1984 
1985  if (j == 0 || 2*j<size)
1986  median = 0./0.;
1987  else if (j%2 == 1)
1988  median = array[j/2];
1989  else
1990  median = array[j/2-1];
1991 
1992  cpl_image_delete (window);
1993  cpl_free (array);
1994 
1995  return (median);
1996 }