public software.sextractor

[/] [branches/] [multi/] [src/] [psf.c] - Blame information for rev 267

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 233 bertin
/*
2
*                               psf.c
3 2 bertin
*
4 233 bertin
* Fit a PSF model to an image.
5 2 bertin
*
6 233 bertin
*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
7 2 bertin
*
8 233 bertin
*       This file part of:      SExtractor
9 2 bertin
*
10 248 bertin
*       Copyright:              (C) 1998-2011 Emmanuel Bertin -- IAP/CNRS/UPMC
11 2 bertin
*
12 233 bertin
*       License:                GNU General Public License
13
*
14
*       SExtractor is free software: you can redistribute it and/or modify
15
*       it under the terms of the GNU General Public License as published by
16
*       the Free Software Foundation, either version 3 of the License, or
17
*       (at your option) any later version.
18
*       SExtractor is distributed in the hope that it will be useful,
19
*       but WITHOUT ANY WARRANTY; without even the implied warranty of
20
*       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
21
*       GNU General Public License for more details.
22
*       You should have received a copy of the GNU General Public License
23
*       along with SExtractor. If not, see <http://www.gnu.org/licenses/>.
24
*
25 267 bertin
*       Last modified:          06/10/2011
26 233 bertin
*
27
*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*/
28 2 bertin
 
29
#ifdef HAVE_CONFIG_H
30
#include        "config.h"
31
#endif
32
 
33
#include        <math.h>
34
#include        <stdio.h>
35
#include        <stdlib.h>
36
#include        <string.h>
37
 
38
#include        "define.h"
39
#include        "globals.h"
40
#include        "prefs.h"
41
#include        "fits/fitscat.h"
42
#include        "check.h"
43 248 bertin
#include        "field.h"
44 2 bertin
#include        "filter.h"
45
#include        "image.h"
46 173 bertin
#include        "wcs/poly.h"
47 2 bertin
#include        "psf.h"
48
 
49
/*------------------------------- variables ---------------------------------*/
50
 
51
 
52
extern keystruct        objkey[];
53
extern objstruct        outobj;
54
 
55
/********************************* psf_init **********************************/
56
/*
57
Allocate memory and stuff for the PSF-fitting.
58
*/
59
void    psf_init(psfstruct *psf)
60
  {
61
  QMALLOC(thepsfit, psfitstruct, 1);
62 218 bertin
  QMALLOC(thepsfit->x, double, prefs.psf_npsfmax);
63
  QMALLOC(thepsfit->y, double, prefs.psf_npsfmax);
64 2 bertin
  QMALLOC(thepsfit->flux, float, prefs.psf_npsfmax);
65 218 bertin
  QMALLOC(thepsfit->fluxerr, float, prefs.psf_npsfmax);
66 5 bertin
  QMALLOC(ppsfit, psfitstruct, 1); /*?*/
67 218 bertin
  QMALLOC(ppsfit->x, double, prefs.psf_npsfmax);
68
  QMALLOC(ppsfit->y, double, prefs.psf_npsfmax);
69 5 bertin
  QMALLOC(ppsfit->flux, float, prefs.psf_npsfmax);
70 218 bertin
  QMALLOC(ppsfit->fluxerr, float, prefs.psf_npsfmax);
71 2 bertin
 
72
  return;
73
  }
74
 
75
 
76
/********************************* psf_end ***********************************/
77
/*
78
Free memory occupied by the PSF-fitting stuff.
79
*/
80 5 bertin
void    psf_end(psfstruct *psf, psfitstruct *psfit)
81 2 bertin
  {
82
   int  d, ndim;
83
 
84
  ndim = psf->poly->ndim;
85
  for (d=0; d<ndim; d++)
86
    free(psf->contextname[d]);
87
  free(psf->context);
88
  free(psf->contextname);
89
  free(psf->contextoffset);
90
  free(psf->contextscale);
91
  free(psf->contexttyp);
92
  poly_end(psf->poly);
93
  free(psf->maskcomp);
94
  free(psf->maskloc);
95
  free(psf->masksize);
96
  free(psf);
97
 
98 173 bertin
  if (psfit)
99
    {
100
    free(psfit->x);
101
    free(psfit->y);
102
    free(psfit->flux);
103 218 bertin
    free(psfit->fluxerr);
104 173 bertin
    free(psfit);
105
    }
106 2 bertin
 
107
  return;
108
  }
109
 
110
 
111
/********************************* psf_load *********************************/
112
/*
113
Read the PSF data from a FITS file.
114
*/
115
psfstruct       *psf_load(char *filename)
116
  {
117
   static obj2struct    saveobj2;
118
   psfstruct            *psf;
119
   catstruct            *cat;
120
   tabstruct            *tab;
121
   keystruct            *key;
122
   char                 *head, *ci,*co;
123
   int                  deg[POLY_MAXDIM], group[POLY_MAXDIM], ndim, ngroup,
124
                        i,k;
125
 
126
/* Open the cat (well it is not a "cat", but simply a FITS file */
127
  if (!(cat = read_cat(filename)))
128
    error(EXIT_FAILURE, "*Error*: PSF file not found: ", filename);
129
 
130
/* OK, we now allocate memory for the PSF structure itself */
131
  QCALLOC(psf, psfstruct, 1);
132
 
133
/* Store a short copy of the PSF filename */
134
  if ((ci=strrchr(filename, '/')))
135
    strcpy(psf->name, ci+1);
136
  else
137
    strcpy(psf->name, filename);
138
 
139
  if (!(tab = name_to_tab(cat, "PSF_DATA", 0)))
140
    error(EXIT_FAILURE, "*Error*: PSF_DATA table not found in catalog ",
141
        filename);
142
 
143
  head = tab->headbuf;
144
 
145
/*-- Dimension of the polynomial */
146
  if (fitsread(head, "POLNAXIS", &ndim, H_INT,T_LONG) == RETURN_OK
147
        && ndim)
148
    {
149
/*-- So we have a polynomial description of the PSF variations */
150
    if (ndim > POLY_MAXDIM)
151
        {
152
        sprintf(gstr, "*Error*: The POLNAXIS parameter in %s exceeds %d",
153
                psf->name, POLY_MAXDIM);
154
        error(EXIT_FAILURE, gstr, "");
155
        }
156
 
157
    QMALLOC(psf->contextname, char *, ndim);
158
    QMALLOC(psf->context, double *, ndim);
159
    QMALLOC(psf->contexttyp, t_type, ndim);
160
    QMALLOC(psf->contextoffset, double, ndim);
161
    QMALLOC(psf->contextscale, double, ndim);
162
 
163 267 bertin
/*-- We will have to use the flagobj2 struct, so we first save its content */
164
    saveobj2 = flagobj2;
165
/*-- flagobj2 is used as a FLAG array, so we initialize it to 0 */
166
    memset(&flagobj2, 0, sizeof(flagobj2));
167 2 bertin
    for (i=0; i<ndim; i++)
168
      {
169
/*---- Polynomial groups */
170
      sprintf(gstr, "POLGRP%1d", i+1);
171
      if (fitsread(head, gstr, &group[i], H_INT,T_LONG) != RETURN_OK)
172
        goto headerror;
173
 
174
/*---- Contexts */
175
      QMALLOC(psf->contextname[i], char, 80);
176
      sprintf(gstr, "POLNAME%1d", i+1);
177
      if (fitsread(head,gstr,psf->contextname[i],H_STRING,T_STRING)!=RETURN_OK)
178
        goto headerror;
179
      if (*psf->contextname[i]==(char)':')
180
/*------ It seems we're facing a FITS header parameter */
181
        psf->context[i] = NULL; /* This is to tell we'll have to load */
182
                                /* a FITS header context later on */
183
      else
184
/*------ The context element is a dynamic object parameter */
185
        {
186
        if ((k = findkey(psf->contextname[i], (char *)objkey,
187
                sizeof(keystruct)))==RETURN_ERROR)
188
          {
189
          sprintf(gstr, "*Error*: %s CONTEXT parameter in %s unknown",
190
                psf->contextname[i], psf->name);
191
          error(EXIT_FAILURE, gstr, "");
192
          }
193
        key = objkey+k;
194
        psf->context[i] = key->ptr;
195
        psf->contexttyp[i] = key->ttype;
196
/*------ Declare the parameter "active" to trigger computation by SExtractor */
197
        *((char *)key->ptr) = (char)'\1';
198
        }
199
/*---- Scaling of the context parameter */
200
      sprintf(gstr, "POLZERO%1d", i+1);
201
      if (fitsread(head, gstr, &psf->contextoffset[i], H_EXPO, T_DOUBLE)
202
                !=RETURN_OK)
203
        goto headerror;
204
      sprintf(gstr, "POLSCAL%1d", i+1);
205
      if (fitsread(head, gstr, &psf->contextscale[i], H_EXPO, T_DOUBLE)
206
                !=RETURN_OK)
207
        goto headerror;
208
      }
209
 
210
/*-- Number of groups */
211
    if (fitsread(head, "POLNGRP ", &ngroup, H_INT, T_LONG) != RETURN_OK)
212
      goto headerror;
213
 
214
    for (i=0; i<ngroup; i++)
215
      {
216
/*---- Polynomial degree for each group */
217
      sprintf(gstr, "POLDEG%1d", i+1);
218
      if (fitsread(head, gstr, &deg[i], H_INT,T_LONG) != RETURN_OK)
219
        goto headerror;
220
      }
221
 
222
    psf->poly = poly_init(group, ndim, deg, ngroup);
223
 
224 267 bertin
/*-- Restore previous flagobj2 content */
225
    flagobj2 = saveobj2;
226 2 bertin
    }
227
  else
228
    {
229
/*-- This is a simple, constant PSF */
230
    psf->poly = poly_init(group, 0, deg, 0);
231
    psf->context = NULL;
232
    }
233
 
234
/* Dimensionality of the PSF mask */
235
  if (fitsread(head, "PSFNAXIS", &psf->maskdim, H_INT, T_LONG) != RETURN_OK)
236
    goto headerror;
237
  if (psf->maskdim<2 || psf->maskdim>3)
238
    error(EXIT_FAILURE, "*Error*: wrong dimensionality for the PSF "
239
        "mask in ", filename);
240
  QMALLOC(psf->masksize, int, psf->maskdim);
241
  for (i=0; i<psf->maskdim; i++)
242
    psf->masksize[i] = 1;
243
  psf->masknpix = 1;
244
  for (i=0; i<psf->maskdim; i++)
245
    {
246
    sprintf(gstr, "PSFAXIS%1d", i+1);
247
    if (fitsread(head, gstr, &psf->masksize[i], H_INT,T_LONG) != RETURN_OK)
248
      goto headerror;
249
    psf->masknpix *= psf->masksize[i];
250
    }
251
 
252
/* PSF FWHM: defaulted to 3 pixels */
253
 if (fitsread(head, "PSF_FWHM", &psf->fwhm, H_FLOAT,T_DOUBLE) != RETURN_OK)
254
    psf->fwhm = 3.0;
255
 
256
/* PSF oversampling: defaulted to 1 */
257 221 bertin
  if (fitsread(head, "PSF_SAMP", &psf->pixstep,H_FLOAT,T_FLOAT) != RETURN_OK
258
        || psf->pixstep <= 0.0)
259 2 bertin
    psf->pixstep = 1.0;
260
 
261
/* Load the PSF mask data */
262
  key = read_key(tab, "PSF_MASK");
263
  psf->maskcomp = key->ptr;
264
 
265 206 bertin
  QMALLOC(psf->maskloc, float, psf->masksize[0]*psf->masksize[1]);
266 2 bertin
 
267
/* But don't touch my arrays!! */
268
  blank_keys(tab);
269
 
270
  free_cat(&cat, 1);
271
 
272
  return psf;
273
 
274
headerror:
275
  error(EXIT_FAILURE, "*Error*: Incorrect or obsolete PSF data in ", filename);
276
  return NULL;
277
  }
278
 
279
 
280
/***************************** psf_readcontext *******************************/
281
/*
282
Read the PSF context parameters in the FITS header.
283
*/
284
void    psf_readcontext(psfstruct *psf, picstruct *field)
285
  {
286
   static double        contextval[POLY_MAXDIM];
287
   int                  i, ndim;
288
 
289
  ndim = psf->poly->ndim;
290
  for (i=0; i<ndim; i++)
291
    if (!psf->context[i])
292
      {
293
      psf->context[i] = &contextval[i];
294
      psf->contexttyp[i] = T_DOUBLE;
295 173 bertin
      if (fitsread(field->tab->headbuf, psf->contextname[i]+1, &contextval[i],
296 2 bertin
                H_FLOAT,T_DOUBLE) == RETURN_ERROR)
297
        {
298
        sprintf(gstr, "*Error*: %s parameter not found in the header of ",
299
                psf->contextname[i]+1);
300
        error(EXIT_FAILURE, gstr, field->rfilename);
301
        }
302
      }
303
 
304
  return;
305
  }
306
 
307
 
308
/******************************** psf_fit ***********************************/
309 234 bertin
/*                   standard PSF fit for one component                     */
310 5 bertin
/****************************************************************************/
311
 
312 2 bertin
void    psf_fit(psfstruct *psf, picstruct *field, picstruct *wfield,
313 267 bertin
                obj2struct *obj2)
314 5 bertin
{
315
  checkstruct           *check;
316 248 bertin
  static double x2[PSF_NPSFMAX],y2[PSF_NPSFMAX],xy[PSF_NPSFMAX],
317 5 bertin
                        deltax[PSF_NPSFMAX],
318 218 bertin
                        deltay[PSF_NPSFMAX],
319
                        flux[PSF_NPSFMAX],fluxerr[PSF_NPSFMAX],
320 2 bertin
                        deltaxb[PSF_NPSFMAX],deltayb[PSF_NPSFMAX],
321 218 bertin
                        fluxb[PSF_NPSFMAX],fluxerrb[PSF_NPSFMAX],
322 5 bertin
                        sol[PSF_NTOT], covmat[PSF_NTOT*PSF_NTOT],
323 2 bertin
                        vmat[PSF_NTOT*PSF_NTOT], wmat[PSF_NTOT];
324 206 bertin
  float                 *data, *data2, *data3, *weight, *d, *w;
325
  double                *mat,
326
                        *m, *var,
327 5 bertin
                        dx,dy,
328
                        pix,pix2, wthresh,val,
329
                        backnoise2, gain, radmin2,radmax2,satlevel,chi2,
330 2 bertin
                        r2, valmax, psf_fwhm;
331 206 bertin
  float                 **psfmasks, **psfmaskx,**psfmasky,
332 218 bertin
                        *ps, *dh, *wh, pixstep;
333 217 bertin
  PIXTYPE               *datah, *weighth;
334 5 bertin
  int                   i,j,p, npsf,npsfmax, npix, nppix, ix,iy,niter,
335
                        width, height, pwidth,pheight, x,y,
336 2 bertin
                        xmax,ymax, wbad, gainflag, convflag, npsfflag,
337 18 bertin
                        ival,kill=0;
338 5 bertin
 
339 2 bertin
  dx = dy = 0.0;
340
  niter = 0;
341
  npsfmax = prefs.psf_npsfmax;
342
  pixstep = 1.0/psf->pixstep;
343 200 bertin
  gain = (field->gain >0.0? field->gain: 1e30);
344 2 bertin
  backnoise2 = field->backsig*field->backsig;
345 267 bertin
  satlevel = field->satur_level - obj2->bkg;
346 2 bertin
  wthresh = wfield?wfield->weight_thresh:BIG;
347
  gainflag = prefs.weightgain_flag;
348
  psf_fwhm = psf->fwhm*psf->pixstep;
349
 
350 5 bertin
 
351
  /* Initialize outputs */
352 2 bertin
  thepsfit->niter = 0;
353
  thepsfit->npsf = 0;
354 5 bertin
  for (j=0; j<npsfmax; j++)
355 2 bertin
    {
356 5 bertin
      thepsfit->x[j] = obj2->posx;
357
      thepsfit->y[j] = obj2->posy;
358
      thepsfit->flux[j] = 0.0;
359 218 bertin
      thepsfit->fluxerr[j] = 0.0;
360 2 bertin
    }
361
 
362 5 bertin
  /* Scale data area with object "size" */
363 267 bertin
  ix = (obj2->xmax+obj2->xmin+1)/2;
364
  iy = (obj2->ymax+obj2->ymin+1)/2;
365
  width = obj2->xmax-obj2->xmin+1+psf_fwhm;
366 2 bertin
  if (width < (ival=(int)(psf_fwhm*2)))
367
    width = ival;
368 267 bertin
  height = obj2->ymax-obj2->ymin+1+psf_fwhm;
369 2 bertin
  if (height < (ival=(int)(psf_fwhm*2)))
370
    height = ival;
371
  npix = width*height;
372
  radmin2 = PSF_MINSHIFT*PSF_MINSHIFT;
373
  radmax2 = npix/2.0;
374
 
375 5 bertin
  /* Scale total area with PSF FWHM */
376 2 bertin
  pwidth = (int)(psf->masksize[0]*psf->pixstep)+width;;
377
  pheight = (int)(psf->masksize[1]*psf->pixstep)+height;
378
  nppix = pwidth*pheight;
379
 
380
  QMALLOC(weighth, PIXTYPE, npix);
381 206 bertin
  QMALLOC(weight, float, npix);
382 2 bertin
  QMALLOC(datah, PIXTYPE, npix);
383 206 bertin
  QMALLOC(data, float, npix);
384
  QMALLOC(data2, float, npix);
385
  QMALLOC(data3, float, npix);
386 2 bertin
  QMALLOC(mat, double, npix*PSF_NTOT);
387 267 bertin
  if (prefs.check[CHECK_SUBPSFPROTOS] || prefs.check[CHECK_PSFPROTOS])
388 2 bertin
    {
389 5 bertin
      QMALLOC(checkmask, PIXTYPE, nppix);
390 2 bertin
    }
391
 
392 206 bertin
  QMALLOC(psfmasks, float *, npsfmax);
393
  QMALLOC(psfmaskx, float *, npsfmax);
394
  QMALLOC(psfmasky, float *, npsfmax);
395 2 bertin
  for (i=0; i<npsfmax; i++)
396
    {
397 206 bertin
      QMALLOC(psfmasks[i], float, npix);
398
      QMALLOC(psfmaskx[i], float, npix);
399
      QMALLOC(psfmasky[i], float, npix);
400 2 bertin
    }
401
 
402 5 bertin
  /* Compute weights */
403 2 bertin
  wbad = 0;
404
  if (wfield)
405
    {
406 249 bertin
    psf_copyobjpix(datah, weighth, width, height, ix,iy, obj2,
407 248 bertin
                !(field->flags&MEASURE_FIELD));
408
    for (wh=weighth, w=weight, dh=datah,p=npix; p--;)
409
      if ((pix=*(wh++)) < wthresh && pix>0
410
        && (pix2=*(dh++))>-BIG
411
        && pix2<satlevel)
412
        *(w++) = 1/sqrt(pix+(pix2>0.0?
413
                        (gainflag? pix2*pix/backnoise2:pix2)/gain
414
                        :0.0));
415 5 bertin
        else
416
          {
417 248 bertin
          *(w++) = 0.0;
418
          wbad++;
419 5 bertin
          }
420 2 bertin
    }
421
  else
422 248 bertin
    {
423 249 bertin
    psf_copyobjpix(datah, NULL, width, height, ix,iy, obj2,
424 248 bertin
                !(field->flags&MEASURE_FIELD));
425 2 bertin
    for (w=weight, dh=datah, p=npix; p--;)
426
      if ((pix=*(dh++))>-BIG && pix<satlevel)
427
        *(w++) = 1.0/sqrt(backnoise2+(pix>0.0?pix/gain:0.0));
428
      else
429
        {
430 5 bertin
          *(w++) = 0.0;
431
          wbad++;
432 2 bertin
        }
433 248 bertin
    }
434 2 bertin
 
435 5 bertin
  /* Special action if most of the weights are zero!! */
436 2 bertin
  if (wbad>=npix-3)
437
    return;
438
 
439 5 bertin
  /* Weight the data */
440 2 bertin
  dh = datah;
441 267 bertin
  val = obj2->dbkg;      /* Take into account a local background change */
442 2 bertin
  d = data;
443
  w = weight;
444
  for (p=npix; p--;)
445
    *(d++) = (*(dh++)-val)**(w++);
446
 
447 5 bertin
  /* Get the local PSF */
448 267 bertin
  psf_build(psf, obj2);
449 2 bertin
 
450
  npsfflag = 1;
451
  r2 = psf_fwhm*psf_fwhm/2.0;
452 218 bertin
  fluxb[0] = fluxerrb[0] = deltaxb[0] = deltayb[0] = 0.0;
453 5 bertin
 
454 2 bertin
  for (npsf=1; npsf<=npsfmax && npsfflag; npsf++)
455
    {
456 5 bertin
      kill=0;
457 2 bertin
/*-- First compute an optimum initial guess for the positions of components */
458 5 bertin
      if (npsf>1)
459
        {
460 2 bertin
/*---- Subtract previously fitted components */
461 5 bertin
          d = data2;
462
          dh = datah;
463
          for (p=npix; p--;)
464
            *(d++) = (double)*(dh++);
465
          for (j=0; j<npsf-1; j++)
466
            {
467
              d = data2;
468
              ps = psfmasks[j];
469
              for (p=npix; p--;)
470
                *(d++) -= flux[j]**(ps++);
471
            }
472
          convolve_image(field, data2, data3, width,height);
473 2 bertin
/*---- Ignore regions too close to stellar cores */
474 5 bertin
          for (j=0; j<npsf-1; j++)
475 2 bertin
            {
476 5 bertin
              d = data3;
477
              dy = -((double)(height/2)+deltay[j]);
478
              for (y=height; y--; dy += 1.0)
479
                {
480
                  dx = -((double)(width/2)+deltax[j]);
481
                  for (x=width; x--; dx+= 1.0, d++)
482
                    if (dx*dx+dy*dy<r2)
483
                      *d = -BIG;
484
                }
485 2 bertin
            }
486 5 bertin
/*---- Now find the brightest pixel (poor man's guess, to be refined later) */
487
          d = data3;
488
          valmax = -BIG;
489
          xmax = width/2;
490
          ymax = height/2;
491
          for (y=0; y<height; y++)
492
            for (x=0; x<width; x++)
493
              {
494
                if ((val = *(d++))>valmax)
495
                  {
496
                    valmax = val;
497
                    xmax = x;
498
                    ymax = y;
499
                  }
500
              }
501
          deltax[npsf-1] = (double)(xmax - width/2);
502
          deltay[npsf-1] = (double)(ymax - height/2);
503
        }
504
      else
505
        {
506 2 bertin
/*---- Only one component to fit: simply use the barycenter as a guess */
507 267 bertin
          deltax[npsf-1] = obj2->mx - ix;
508
          deltay[npsf-1] = obj2->my - iy;
509 2 bertin
        }
510
 
511 5 bertin
      niter = 0;
512
      convflag = 1;
513
      for (i=0; i<PSF_NITER && convflag; i++)
514 2 bertin
        {
515 5 bertin
          convflag = 0,niter++,m=mat;
516
          for (j=0; j<npsf; j++)
517 2 bertin
            {
518 5 bertin
/*------ Resample the PSFs here for the 1st iteration */
519
              vignet_resample(psf->maskloc, psf->masksize[0], psf->masksize[1],
520
                              psfmasks[j], width, height,
521
                              -deltax[j]*pixstep, -deltay[j]*pixstep,
522
                              pixstep);
523
              m=compute_gradient(weight,width,height,
524
                                 psfmasks[j],psfmaskx[j],psfmasky[j],m);
525 2 bertin
            }
526 5 bertin
 
527
 
528
          svdfit(mat, data, npix, npsf*PSF_NA, sol, vmat, wmat);
529
 
530
          compute_pos( &npsf, &convflag, &npsfflag,radmin2,radmax2,
531
                       r2, sol,flux, deltax, deltay,&dx,&dy);
532 2 bertin
        }
533 218 bertin
 
534 5 bertin
/*-- Compute variances and covariances */
535 218 bertin
      svdvar(vmat, wmat, npsf*PSF_NA, covmat);
536
      var = covmat;
537
      for (j=0; j<npsf; j++, var += (npsf*PSF_NA+1)*PSF_NA)
538
        {
539 5 bertin
/*---- First, the error on the flux estimate */
540 218 bertin
          fluxerr[j] = sqrt(*var)>0.0?  sqrt(*var):999999.0;
541 5 bertin
          //if (flux[j]<12*fluxerr && j>0)
542
          //  npsfmax--,flux[j]=0;
543 218 bertin
          if (flux[j]<12*fluxerr[j] && j>0)
544 5 bertin
                 {
545
                   flux[j]=0,kill++,npsfmax--;
546
                   //if(j==npsfmax-1)
547
                   //  kill++;             
548
                 }
549 2 bertin
        }
550 5 bertin
      if (npsfflag)
551
        {
552
/*--- If we reach this point we know the data are worth backuping */
553
          for (j=0; j<npsf; j++)
554
            {
555
              deltaxb[j] = deltax[j];
556
              deltayb[j] = deltay[j];
557
              fluxb[j] = flux[j];
558 218 bertin
              fluxerrb[j]=fluxerr[j];
559 5 bertin
            }
560
        }
561 2 bertin
    }
562 5 bertin
  npsf=npsf-1-kill;
563 2 bertin
 
564
/* Now keep only fitted stars that fall within the current detection area */
565
  i = 0;
566
  for (j=0; j<npsf; j++)
567 5 bertin
    {
568
      x = (int)(deltaxb[j]+0.4999)+width/2;
569
      y = (int)(deltayb[j]+0.4999)+height/2;
570
      if (x<0 || x>=width || y<0 || y>=height)
571
        continue;
572
      if (weight[y*width+x] < 1/BIG)
573
        continue;
574
      if (10*fluxb[j]<fluxb[0] )
575
        continue;
576
      if (fluxb[j]<=0 )
577
        continue;
578
 
579
      if (FLAG(obj2.poserrmx2_psf))
580 218 bertin
        compute_poserr(j,covmat,sol,obj2,x2,y2,xy, npsf);
581 5 bertin
 
582
      deltax[i] = deltaxb[j];
583
      deltay[i] = deltayb[j];
584 218 bertin
      flux[i] = fluxb[j];
585
      fluxerr[i++] = fluxerrb[j];
586 2 bertin
    }
587 218 bertin
 
588 2 bertin
  npsf = i;
589
 
590 5 bertin
  /* Compute chi2 if asked to
591 2 bertin
  if (FLAG(obj2.chi2_psf))
592
    {
593
      for (j=0; j<npsf; j++)
594 5 bertin
        {
595
          chi2 = 0.0;
596
          for (d=data,w=weight,p=0; p<npix; w++,p++)
597
            {
598
              pix = *(d++);
599
              pix -=  psfmasks[j][p]*flux[j]**w;
600
              chi2 += pix*pix;
601
              if (chi2>1E29) chi2=1E28;
602
            }
603 267 bertin
          obj2->chi2_psf = obj2->sigbkg>0.?
604
            chi2/((npix - 3*npsf)*obj2->sigbkg*obj2->sigbkg):999999;
605 5 bertin
 
606
        }
607
 
608
    }*/
609
 /* Compute relative chi2 if asked to */
610
    if (FLAG(obj2.chi2_psf))
611 2 bertin
    {
612 5 bertin
      for (j=0; j<npsf; j++)
613 2 bertin
        {
614 5 bertin
          chi2 = 0.0;
615
          for (d=data,w=weight,p=0; p<npix; w++,p++)
616
            {
617
              pix = *(d++)/flux[j];
618
              pix -=  psfmasks[j][p]**w;
619
              chi2 += pix*pix;
620
              if (chi2>1E29) chi2=1E28;
621
            }
622
          obj2->chi2_psf = flux[j]>0?
623 267 bertin
                chi2/((npix - 3*npsf)*obj2->sigbkg*obj2->sigbkg):999999;
624 2 bertin
 
625
        }
626 5 bertin
 
627 2 bertin
    }
628 5 bertin
  /* CHECK images */
629 2 bertin
  if (prefs.check[CHECK_SUBPSFPROTOS] || prefs.check[CHECK_PSFPROTOS])
630
    for (j=0; j<npsf; j++)
631
      {
632 5 bertin
        vignet_resample(psf->maskloc, psf->masksize[0], psf->masksize[1],
633 206 bertin
                        checkmask, pwidth, pheight,
634 5 bertin
                        -deltax[j]*pixstep, -deltay[j]*pixstep, pixstep);
635
        if ((check = prefs.check[CHECK_SUBPSFPROTOS]))
636
          addcheck(check, checkmask, pwidth,pheight, ix,iy,-flux[j]);
637
        if ((check = prefs.check[CHECK_PSFPROTOS]))
638
          addcheck(check, checkmask, pwidth,pheight, ix,iy,flux[j]);
639 2 bertin
      }
640
 
641
  thepsfit->niter = niter;
642
  thepsfit->npsf = npsf;
643
  for (j=0; j<npsf; j++)
644
    {
645 5 bertin
      thepsfit->x[j] = ix+deltax[j]+1.0;
646
      thepsfit->y[j] = iy+deltay[j]+1.0;
647
      thepsfit->flux[j] = flux[j];
648 218 bertin
      thepsfit->fluxerr[j] = fluxerr[j];
649 267 bertin
    }
650 5 bertin
 
651
  for (i=0; i<prefs.psf_npsfmax; i++)
652 2 bertin
    {
653 5 bertin
      QFREE(psfmasks[i]);
654
      QFREE(psfmaskx[i]);
655
      QFREE(psfmasky[i]);
656 2 bertin
    }
657
 
658
  QFREE(psfmasks);
659
  QFREE(psfmaskx);
660
  QFREE(psfmasky);
661
  QFREE(datah);
662
  QFREE(data);
663
  QFREE(data2);
664
  QFREE(data3);
665
  QFREE(weighth);
666
  QFREE(weight);
667
  QFREE(data);
668 5 bertin
  QFREE(mat);
669 2 bertin
 
670 267 bertin
  if (prefs.check[CHECK_SUBPSFPROTOS] || prefs.check[CHECK_PSFPROTOS])
671
    QFREE(checkmask);
672 2 bertin
 
673
  return;
674 5 bertin
}
675 2 bertin
 
676
 
677 248 bertin
/****************************** double_psf_fit ******************************/
678
/* double fit to make psf detection on one image and photometry on another  */
679
/****************************************************************************/
680 5 bertin
 
681
void    double_psf_fit(psfstruct *ppsf, picstruct *pfield, picstruct *pwfield,
682 267 bertin
                       obj2struct *obj2,
683 248 bertin
                        psfstruct *psf, picstruct *field, picstruct *wfield)
684 5 bertin
{
685
  static double      /* sum[PSF_NPSFMAX]*/ pdeltax[PSF_NPSFMAX],
686
    pdeltay[PSF_NPSFMAX],psol[PSF_NPSFMAX], pcovmat[PSF_NPSFMAX*PSF_NPSFMAX],
687 218 bertin
    pvmat[PSF_NPSFMAX*PSF_NPSFMAX], pwmat[PSF_NPSFMAX],pflux[PSF_NPSFMAX],
688
    pfluxerr[PSF_NPSFMAX];
689 5 bertin
 
690 206 bertin
    double *pmat,
691
     *pm, /* *pps,  *px, *py,*/
692 5 bertin
    dx,dy,pdx,pdy, /* x1,y1, mx,my,mflux, */
693
    val, ppix,ppix2, /* dflux, */
694
    gain, radmin2,radmax2,satlevel
695
    ,chi2,pwthresh,pbacknoise2, /* mr, */
696 18 bertin
    r2=0, psf_fwhm,ppsf_fwhm ;
697 206 bertin
  float         **ppsfmasks, **ppsfmaskx,**ppsfmasky, *pps;
698
  float         *pdata, *pdata2, *pdata3, *pweight, *pd, *pw,
699
                *pdh, *pwh, pixstep,ppixstep;
700 5 bertin
  PIXTYPE       *pdatah, *pweighth;
701
  int                   i,j,k,p, npsf, npix,ix,iy,
702
    width, height, /* hw,hh, */
703
    x,y, /* yb, */
704
    wbad, gainflag,
705
    ival,npsfmax;
706
  double *pvar;
707
 
708
  pdx = pdy =dx = dy = 0.0;
709
  ppixstep = 1.0/ppsf->pixstep;
710
  pixstep = 1.0/psf->pixstep;
711 200 bertin
  gain = (field->gain >0.0? field->gain: 1e30);
712 5 bertin
  npsfmax=prefs.psf_npsfmax;
713
  pbacknoise2 = pfield->backsig*pfield->backsig;
714 267 bertin
  satlevel = field->satur_level - obj2->bkg;
715 5 bertin
  gainflag = prefs.weightgain_flag;
716
  psf_fwhm = psf->fwhm*psf->pixstep;
717
  ppsf_fwhm = ppsf->fwhm*ppsf->pixstep;
718
  pwthresh = pwfield?pwfield->weight_thresh:BIG;
719
 
720
  /* Initialize outputs */
721
  ppsfit->niter = 0;
722
  ppsfit->npsf = 0;
723
  for (j=0; j<npsfmax; j++)
724
    {
725
      ppsfit->x[j] = 999999.0;
726
      ppsfit->y[j] = 999999.0;
727
      ppsfit->flux[j] = 0.0;
728 218 bertin
      ppsfit->fluxerr[j] = 0.0;
729
      pdeltax[j]= pdeltay[j]=psol[j]= pwmat[j]=pflux[j]=pfluxerr[j]=0.0;
730 5 bertin
 
731
    }
732
 
733 267 bertin
  ix = (obj2->xmax+obj2->xmin+1)/2;
734
  iy = (obj2->ymax+obj2->ymin+1)/2;
735
  width = obj2->xmax-obj2->xmin+1+psf_fwhm;
736 5 bertin
  if (width < (ival=(int)(psf_fwhm*2)))
737
    width = ival;
738 267 bertin
  height = obj2->ymax-obj2->ymin+1+psf_fwhm;
739 5 bertin
  if (height < (ival=(int)(psf_fwhm*2)))
740
    height = ival;
741
  npix = width*height;
742
  radmin2 = PSF_MINSHIFT*PSF_MINSHIFT;
743
  radmax2 = npix/2.0;
744 267 bertin
  psf_fit(psf, field, wfield, obj2);
745 5 bertin
  npsf=thepsfit->npsf;
746
 
747 206 bertin
  QMALLOC(ppsfmasks,float *,npsfmax);
748
  QMALLOC(ppsfmaskx,float *,npsfmax);
749
  QMALLOC(ppsfmasky,float *,npsfmax);
750 5 bertin
 
751
  for (i=0; i<npsfmax; i++)
752
    {
753 206 bertin
      QMALLOC(ppsfmasks[i],float,npix);
754
      QMALLOC(ppsfmaskx[i],float,npix);
755
      QMALLOC(ppsfmasky[i],float,npix);
756 5 bertin
    }
757
 
758
  QMALLOC(pweighth, PIXTYPE, npix);
759 206 bertin
  QMALLOC(pweight, float, npix);
760 5 bertin
  QMALLOC(pdatah, PIXTYPE, npix);
761 206 bertin
  QMALLOC(pdata, float, npix);
762
  QMALLOC(pdata2, float, npix);
763
  QMALLOC(pdata3, float, npix);
764 5 bertin
  QMALLOC(pmat, double, npix*npsfmax);
765
 
766
   for (j=0; j<npsf; j++)
767
    {
768
      pdeltax[j] =thepsfit->x[j]-ix-1 ;
769
      pdeltay[j] =thepsfit->y[j]-iy-1 ;
770
      ppsfit->flux[j] = 0;
771 218 bertin
      ppsfit->fluxerr[j] = 0;
772 5 bertin
    }
773
 
774
/*-------------------  Now the photometry fit ---------------------*/
775
   /* Compute photometry weights */
776
  wbad = 0;
777
  if (pwfield)
778
    {
779 249 bertin
    psf_copyobjpix(pdatah, pweighth, width, height, ix,iy, obj2, 0);
780 248 bertin
    for (pwh=pweighth, pw=pweight, pdh=pdatah,p=npix; p--;)
781
      {
782
      if ((ppix=*(pwh++)) < pwthresh && ppix>0
783
                && (ppix2=*(pdh++))>-BIG  && ppix2<satlevel)
784
        *(pw++) = 1/sqrt(ppix+(ppix2>0.0?
785 5 bertin
                        (gainflag? ppix2*ppix/pbacknoise2:ppix2)/gain : 0.0));
786
      else
787 248 bertin
        {
788
        *(pw++) = 0.0;
789
        wbad++;
790 5 bertin
        }
791 248 bertin
      }
792 5 bertin
    }
793
  else
794 248 bertin
    {
795 249 bertin
    psf_copyobjpix(pdatah, NULL, width, height, ix,iy, obj2, 0);
796 5 bertin
    for (pw=pweight, pdh=pdatah, p=npix; p--;)
797
      if ((ppix=*(pdh++))>-BIG && ppix<satlevel)
798 248 bertin
        *(pw++) = 1.0/sqrt(pbacknoise2+(ppix>0.0?ppix/gain:0.0));
799 5 bertin
      else
800
        {
801 248 bertin
        *(pw++) = 0.0;
802
        wbad++;
803 5 bertin
        }
804 248 bertin
    }
805
 
806 5 bertin
  /* Special action if most of the weights are zero!! */
807
  if (wbad>=npix-3)
808
    return;
809
 
810
  /* Weight the data */
811
  pdh = pdatah;
812
  pd = pdata;
813
  pw = pweight;
814 267 bertin
  val = obj2->dbkg;
815 5 bertin
  for (p=npix; p--;)
816
    *(pd++) = (*(pdh++)-val)**(pw++);
817
 
818
 
819
  /* Get the photmetry PSF */
820 267 bertin
   psf_build(ppsf, obj2);
821 5 bertin
  for (j=1; j<=npsf; j++)
822
    {
823
      if (j>1)
824
        {
825
          /*---- Subtract //previously fitted components in photometry image */
826
          pd = pdata2;
827
          pdh = pdatah;
828
          for (p=npix; p--;)
829
            *(pd++) = (double)*(pdh++);
830
          for (k=0; k<j-1; k++)
831
            {
832
              pd = pdata2;
833
              pps = ppsfmasks[k];
834
              for (p=npix; p--;)
835
                *(pd++) -= pflux[k]**(pps++);
836
            }
837
          convolve_image(pfield, pdata2, pdata3, width,height);
838
         /*---- Ignore regions too close to stellar cores */
839
          for (k=0; k<j-1; k++)
840
            {
841
              pd = pdata3;
842
              dy = -((double)(height/2)+pdeltay[k]);
843
              for (y=height; y--; dy += 1.0)
844
                {
845
                  dx = -((double)(width/2)+pdeltax[k]);
846
                  for (x=width; x--; dx+= 1.0, pd++)
847
                    if (dx*dx+dy*dy<r2) /*?*/
848
                      *pd = -BIG;
849
                }
850
            }
851
        }
852
 
853
      pm=pmat;
854
      for (k=0; k<j; k++)
855
            {
856
              /*------ Resample the PSFs here for the 1st iteration */
857
              vignet_resample(ppsf->maskloc,
858
                        ppsf->masksize[0], ppsf->masksize[1],
859
                        ppsfmasks[k], width, height,
860
                        -pdeltax[k]*ppixstep, -pdeltay[k]*ppixstep,
861
                        ppixstep);
862
              pm=compute_gradient_phot(pweight,width,height, ppsfmasks[k],pm);
863
            }
864
 
865
      svdfit(pmat, pdata, npix, j, psol, pvmat, pwmat);
866
      compute_pos_phot( &j, psol,pflux);
867
 
868
  for (k=0; k<j; k++)
869
        {
870
          svdvar(pvmat, pwmat, j, pcovmat);
871
          pvar = pcovmat;
872 218 bertin
          pfluxerr[k]= sqrt(*pvar)>0.0 && sqrt(*pvar)<99?
873 5 bertin
            sqrt(*pvar):99;
874
        }
875
    }
876
  /* Compute chi2 if asked to
877
  if (FLAG(obj2.chi2_psf))
878
    {
879
      for (j=0; j<npsf; j++)
880
        {
881
          chi2 = 0.0;
882
          for (pd=pdata,pw=pweight,p=0; p<npix; pw++,p++)
883
            {
884
              ppix = *(pd++);
885
              ppix -=  ppsfmasks[j][p]*pflux[j]**pw;
886
              chi2 += ppix*ppix;
887
              if (chi2>1E29) chi2=1E28;
888
            }
889 267 bertin
          obj2->chi2_psf = obj2->sigbkg>0.?
890
            chi2/((npix - 3*npsf)*obj2->sigbkg*obj2->sigbkg):999999;
891 5 bertin
 
892
        }
893
 
894
    }
895
 */
896
 /* Compute relative error if asked to */
897
  if (FLAG(obj2.chi2_psf))
898
  {
899
      for (j=0; j<npsf; j++)
900
        {
901
          chi2 = 0.0;
902
          for (pd=pdata,pw=pweight,p=0; p<npix; pw++,p++)
903
            {
904
              ppix = *(pd++)/pflux[j];
905
              ppix -=  ppsfmasks[j][p]**pw;
906
              chi2 += ppix*ppix;
907
              if (chi2>1E29) chi2=1E28;
908
            }
909
          obj2->chi2_psf = pflux[j]>0?
910 267 bertin
                chi2/((npix - 3*npsf)*obj2->sigbkg*obj2->sigbkg):999999;
911 5 bertin
 
912
        }
913
 
914
    }
915
  ppsfit->niter = thepsfit->niter;
916
  ppsfit->npsf = npsf;
917
 
918
  for (j=0; j<npsf; j++)
919
    {
920
      thepsfit->x[j] = ix+pdeltax[j]+1.0;
921
      thepsfit->y[j] = iy+pdeltay[j]+1.0;
922
      thepsfit->flux[j] = pflux[j];
923 218 bertin
      thepsfit->fluxerr[j] = pfluxerr[j];
924 5 bertin
      ppsfit->x[j] = ix+pdeltax[j]+1.0;
925
      ppsfit->y[j] = iy+pdeltay[j]+1.0;
926
      ppsfit->flux[j] = pflux[j];
927 218 bertin
      ppsfit->fluxerr[j] = pfluxerr[j];
928 5 bertin
    }
929
 
930
 
931
  for (i=0; i<npsfmax; i++)
932
    {
933
      QFREE(ppsfmasks[i]);
934
      QFREE(ppsfmaskx[i]);
935
      QFREE(ppsfmasky[i]);
936
    }
937
 
938
 
939
  QFREE(ppsfmasks);
940
  QFREE(ppsfmaskx);
941
  QFREE(ppsfmasky);
942
  QFREE(pdatah);
943
  QFREE(pdata);
944
  QFREE(pdata2);
945
  QFREE(pdata3);
946
  QFREE(pweighth);
947
  QFREE(pweight);
948
  QFREE(pdata);
949
  QFREE(pmat);
950
 
951 267 bertin
  if (prefs.check[CHECK_SUBPSFPROTOS] || prefs.check[CHECK_PSFPROTOS])
952 5 bertin
    {
953
      QFREE(checkmask);
954
    }
955
  return;
956 249 bertin
  }
957 5 bertin
 
958 248 bertin
 
959
/****** psf_copyobjpix ******************************************************
960
PROTO   int psf_copyobjpix(PIXTYPE *data, PIXTYPE *weight,
961
                        int wout, int hout, int ix, int iy,
962
                        obj2struct *obj2, int detect_flag);
963
PURPOSE Copy a piece of the input object image/weights to local arrays.
964
INPUT   Pointer to the output data array,
965
        pointer to the output weight array,
966
        output frame width,
967
        output frame height,
968
        integer x coordinate,
969
        integer y coordinate,
970
        pointer to the obj2 structure,
971
        detection field flag (non 0 only for pure detection images).
972
OUTPUT  RETURN_ERROR if the coordinates are outside object image,
973
        RETURN_OK otherwise.
974
NOTES   -.
975
AUTHOR  E. Bertin (IAP)
976 249 bertin
VERSION 23/06/2011
977 248 bertin
 ***/
978
int     psf_copyobjpix(PIXTYPE *data, PIXTYPE *weight,
979
                        int wout, int hout, int ix, int iy,
980 249 bertin
                        obj2struct *obj2, int detect_flag)
981 248 bertin
  {
982
   PIXTYPE      *datat,*weightt, *imagein,*weightin;
983 249 bertin
   int          i,y, win,hin, w2, xmin,xmax,ymin,ymax;
984
 
985 248 bertin
/* Set output to -BIG */
986 249 bertin
  datat = data;
987 248 bertin
  for (i=wout*hout; i--;)
988 249 bertin
    *(datat++) = -BIG;
989 248 bertin
  if (weight)
990
    memset(weight, 0, wout*hout*sizeof(PIXTYPE));
991
 
992
  ix -= obj2->immin[0];
993
  iy -= obj2->immin[1];
994
  win = obj2->imsize[0];
995
  hin = obj2->imsize[1];
996
 
997
/* Don't go further if out of frame!! */
998
  if (ix<0 || ix>=win || iy<0 || iy>=hin)
999
    return RETURN_ERROR;
1000
 
1001
/* Set the image boundaries */
1002
  w2 = wout;
1003
  ymin = iy-hout/2;
1004
  ymax = ymin + hout;
1005
  if (ymin<0)
1006
    {
1007
    data -= ymin*wout;
1008
    if (weight)
1009
      weight -= ymin*wout;
1010
    ymin = 0;
1011
    }
1012
  if (ymax>hin)
1013
    ymax = hin;
1014
 
1015
  xmin = ix-wout/2;
1016
  xmax = xmin + wout;
1017
  if (xmax>win)
1018
    {
1019
    w2 -= xmax-win;
1020
    xmax = win;
1021
    }
1022
  if (xmin<0)
1023
    {
1024
    data -= xmin;
1025
    if (weight)
1026
      weight -= xmin;
1027
    w2 += xmin;
1028
    xmin = 0;
1029
    }
1030
 
1031
/* Copy the right pixels to the destination */
1032 249 bertin
  imagein = detect_flag? obj2->dimage:obj2->image;
1033 248 bertin
  for (y=ymin; y<ymax; y++, data += wout)
1034
    memcpy(data, imagein + xmin+y*win, w2*sizeof(PIXTYPE));
1035
  if (weight)
1036
    {
1037 249 bertin
    weightin = detect_flag? obj2->dweight:obj2->weight;
1038 248 bertin
    for (y=ymin; y<ymax; y++, data += wout)
1039
      memcpy(weight, weightin + xmin+y*win, w2*sizeof(PIXTYPE));
1040
    }
1041
 
1042
 
1043
  return RETURN_OK;
1044
  }
1045
 
1046
 
1047
 
1048 2 bertin
/******************************* psf_build **********************************/
1049
/*
1050
Build the local PSF (function of "context").
1051
*/
1052 267 bertin
void    psf_build(psfstruct *psf, obj2struct *obj2)
1053 2 bertin
  {
1054
   static double        pos[POLY_MAXDIM];
1055 201 bertin
   double       *basis, fac;
1056
   float        *ppc, *pl;
1057 2 bertin
   int          i,n,p, ndim, npix;
1058
 
1059 221 bertin
  if (psf->build_flag)
1060
    return;
1061
 
1062 2 bertin
  npix = psf->masksize[0]*psf->masksize[1];
1063
 
1064
/* Reset the Local PSF mask */
1065 206 bertin
  memset(psf->maskloc, 0, npix*sizeof(float));
1066 2 bertin
 
1067
/* Grab the context vector */
1068
  ndim = psf->poly->ndim;
1069
  for (i=0; i<ndim; i++)
1070
    {
1071 267 bertin
    ttypeconv((char *)obj2 + ((void *)psf->context[i]-(void *)&flagobj2),
1072
                &pos[i], psf->contexttyp[i],T_DOUBLE);
1073 2 bertin
    pos[i] = (pos[i] - psf->contextoffset[i]) / psf->contextscale[i];
1074
    }
1075
  poly_func(psf->poly, pos);
1076
 
1077
  basis = psf->poly->basis;
1078
 
1079
  ppc = psf->maskcomp;
1080
/* Sum each component */
1081
  for (n = (psf->maskdim>2?psf->masksize[2]:1); n--;)
1082
    {
1083
    pl = psf->maskloc;
1084
    fac = *(basis++);
1085
    for (p=npix; p--;)
1086
      *(pl++) +=  fac**(ppc++);
1087
    }
1088
 
1089 221 bertin
  psf->build_flag = 1;
1090
 
1091 2 bertin
  return;
1092
  }
1093
 
1094
 
1095 221 bertin
/******************************** psf_fwhm **********************************/
1096
/*
1097
Return the local PSF FWHM.
1098
*/
1099 267 bertin
double  psf_fwhm(psfstruct *psf, obj2struct *obj2)
1100 221 bertin
  {
1101
   float        *pl,
1102
                val, max;
1103
   int          n,p, npix;
1104
 
1105
  if (!psf->build_flag)
1106 267 bertin
    psf_build(psf, obj2);
1107 221 bertin
 
1108
  npix = psf->masksize[0]*psf->masksize[1];
1109
  max = -BIG;
1110
  pl = psf->maskloc;
1111
  for (p=npix; p--;)
1112
    if ((val=*(pl++)) > max)
1113
      max = val;
1114
  pl = psf->maskloc;
1115
  max /= 2.0;
1116
  n = 0;
1117
  for (p=npix; p--;)
1118
    if (*(pl++) >= max)
1119
      n++;
1120
 
1121
  return 2.0*sqrt(n/PI)*psf->pixstep;
1122
  }
1123
 
1124
 
1125 5 bertin
/*****************************compute_gradient*********************************/
1126
 
1127 206 bertin
double *compute_gradient(float *weight,int width, int height,
1128
                         float *masks,float *maskx,float *masky
1129 5 bertin
                        ,double *m)
1130
{
1131
  int x,y;
1132 206 bertin
  float *w, *ps,*px,*py;
1133 5 bertin
 
1134
  /*------ copy of the (weighted) PSF, with outer ring set to zero */
1135
      ps = masks;
1136
      w = weight;
1137
      for (y=0; y<height; y++)
1138
        for (x=0; x<width; x++, ps++, w++)
1139
          *(m++) = y?(y>=(height-1)?0:(x?(x>=(width-1)?0:*ps**w):0)):0;
1140
      /*------ (weighted) PSF gradient in x (kernel for first moment in x) */
1141
      ps = masks;
1142
      px = maskx;
1143
      w = weight;
1144
      for (y=0; y<height; y++)
1145
        for (x=0; x<width; x++, ps++, w++)
1146
          *(m++) = ((*px++) = (x?(x>=(width-1)?0:*(ps+1)-*(ps-1)):0))**w/2;
1147
      /*------ (weighted) PSF gradient in y (kernel for first moment in y) */
1148
      ps = masks;
1149
      py = masky;
1150
      w = weight;
1151
      for (y=0; y<height; y++)
1152
        for (x=0; x<width; x++, ps++, w++)
1153
          *(m++) = (*(py++)=(y?(y>=(height-1)?0:*(ps+width)-*(ps-width)):0))
1154
            **w/2;
1155
  return m;
1156
}
1157
 
1158
/*****************************compute_gradient_phot*****************************
1159
****/
1160
 
1161 206 bertin
double *compute_gradient_phot(float  *pweight,int width, int height,
1162
                         float *pmasks,double *pm)
1163 5 bertin
 
1164
{
1165
  int x,y;
1166 206 bertin
  float  *pw, *pps;
1167 5 bertin
 
1168
  /*------ copy of the (weighted) PSF, with outer ring set to zero */
1169
      pps = pmasks;
1170
      pw = pweight;
1171
      for (y=0; y<height; y++)
1172
        for (x=0; x<width; x++, pps++, pw++)
1173
          *(pm++) = y?(y>=(height-1)?0:(x?(x>=(width-1)?0:*pps**pw):0)):0;
1174
 
1175
  return pm;
1176
}
1177
 
1178
/**************************compute_pos********************************/
1179
 
1180
void compute_pos(int *pnpsf,int *pconvflag,int *pnpsfflag,double radmin2,
1181
                         double radmax2,double r2,double *sol,double *flux
1182
                        ,double *deltax,double *deltay,double *pdx,double *pdy)
1183
{
1184
  int j,k,convflag,npsfflag,npsf;
1185
  double dx,dy;
1186
 
1187
  dx=*pdx;
1188
  dy=*pdy;
1189
  convflag=*pconvflag;
1190
  npsfflag=*pnpsfflag;
1191
  npsf=*pnpsf;
1192
  for (j=0; j<npsf; j++)
1193
    {
1194
      flux[j] = sol[j*PSF_NA];
1195
      /*------ Update the PSF shifts */
1196
      if (fabs(flux[j])>0.0)
1197
        {
1198
          dx = -sol[j*PSF_NA+1]/((npsf>1?2:1)*flux[j]);
1199
          dy = -sol[j*PSF_NA+2]/((npsf>1?2:1)*flux[j]);
1200
        }
1201
 
1202
      deltax[j] += dx;
1203
      deltay[j] += dy;
1204
      /*------ Continue until all PSFs have come to a complete stop */
1205
      if ((dx*dx+dy*dy) > radmin2)
1206
        convflag = 1;
1207
    }
1208
  for (j=0; j<npsf; j++)
1209
    {
1210
      /*------ Exit if too much decentering or negative flux */
1211
      for (k=j+1; k<npsf; k++)
1212
        {
1213
          dx = deltax[j]-deltax[k];
1214
          dy = deltay[j]-deltay[k];
1215
          if (dx*dx+dy*dy<r2/4.0)
1216
            {
1217
              flux[j] = -BIG;
1218
              break;
1219
            }
1220
        }
1221
      if (flux[j]<0.0
1222
          || (deltax[j]*deltax[j] + deltay[j]*deltay[j]) > radmax2)
1223
        {
1224
          npsfflag = 0;
1225
          convflag = 0;
1226
          npsf--;
1227
          break;
1228
        }
1229
    }
1230
  *pdx=dx;
1231
  *pdy=dy;
1232
  *pconvflag=convflag;
1233
  *pnpsfflag= npsfflag;
1234
  *pnpsf=npsf;
1235
  return;
1236
}
1237
 
1238
/**************************compute_pos_phot********************************/
1239
 
1240
void compute_pos_phot(int *pnpsf,double *sol,double *flux)
1241
{
1242
  int j,npsf;
1243
  npsf=*pnpsf;
1244
  for (j=0; j<npsf; j++)
1245
    {
1246
      flux[j] = sol[j];
1247
    }
1248
  *pnpsf=npsf;
1249
  return;
1250
}
1251
 
1252
 
1253
/************************************compute_poserr*****************************
1254
*********/
1255
 
1256
void compute_poserr( int j,double *var,double *sol,obj2struct *obj2,double *x2,
1257 218 bertin
                    double *y2,double *xy, int npsf)
1258 5 bertin
{
1259 218 bertin
  double vara,covab,varb, f2;
1260 5 bertin
 
1261
  /*------ Variances and covariance along x and y */
1262 218 bertin
  vara = *(var += (PSF_NA*npsf+1)*(j*PSF_NA+1));
1263 5 bertin
  covab = *(++var);
1264 218 bertin
  varb = *(var += PSF_NA*npsf);
1265
  f2 = sol[PSF_NA*j];
1266
  f2 *= f2;
1267
  obj2->poserrmx2_psf = vara/f2;
1268
  obj2->poserrmy2_psf = varb/f2;
1269
  obj2->poserrmxy_psf = covab/f2;
1270
 
1271 5 bertin
  /*------ If requested, translate variances to major and minor error axes... */
1272
  if (FLAG(obj2.poserra_psf))
1273
    {
1274
      double    pmx2,pmy2,temp,theta;
1275
 
1276
      if (fabs(temp=obj2->poserrmx2_psf-obj2->poserrmy2_psf) > 0.0)
1277
        theta = atan2(2.0 * obj2->poserrmxy_psf,temp) / 2.0;
1278
      else
1279
        theta = PI/4.0;
1280
 
1281
      temp = sqrt(0.25*temp*temp+obj2->poserrmxy_psf*obj2->poserrmxy_psf);
1282
      pmy2 = pmx2 = 0.5*(obj2->poserrmx2_psf+obj2->poserrmy2_psf);
1283
      pmx2+=temp;
1284
      pmy2-=temp;
1285 218 bertin
 
1286 5 bertin
      obj2->poserra_psf = (float)sqrt(pmx2);
1287
      obj2->poserrb_psf = (float)sqrt(pmy2);
1288
      obj2->poserrtheta_psf = theta*180.0/PI;
1289
    }
1290
 
1291
  /*------ ...Or ellipse parameters */
1292
  if (FLAG(obj2.poserr_cxx))
1293
    {
1294
      double    xm2,ym2, xym, temp;
1295
 
1296
      xm2 = obj2->poserrmx2_psf;
1297
      ym2 = obj2->poserrmy2_psf;
1298
      xym = obj2->poserrmxy_psf;
1299
      obj2->poserrcxx_psf = (float)(ym2/(temp=xm2*ym2-xym*xym));
1300
      obj2->poserrcyy_psf = (float)(xm2/temp);
1301
      obj2->poserrcxy_psf = (float)(-2*xym/temp);
1302
    }
1303
  return;
1304
}
1305
 
1306
 
1307 2 bertin
/******************************** svdfit ************************************/
1308
/*
1309
General least-square fit A.x = b, based on Singular Value Decomposition (SVD).
1310
Loosely adapted from Numerical Recipes in C, 2nd Ed. (p. 671).
1311
Note: the a and v matrices are transposed with respect to the N.R. convention.
1312
*/
1313 206 bertin
void svdfit(double *a, float *b, int m, int n, double *sol,
1314 2 bertin
        double *vmat, double *wmat)
1315
  {
1316
#define MAX(a,b) (maxarg1=(a),maxarg2=(b),(maxarg1) > (maxarg2) ?\
1317
        (maxarg1) : (maxarg2))
1318
#define PYTHAG(a,b)     ((at=fabs(a)) > (bt=fabs(b)) ? \
1319
                                  (ct=bt/at,at*sqrt(1.0+ct*ct)) \
1320
                                : (bt ? (ct=at/bt,bt*sqrt(1.0+ct*ct)): 0.0))
1321
#define SIGN(a,b) ((b) >= 0.0 ? fabs(a) : -fabs(a))
1322
#define TOL             1.0e-11
1323
 
1324
   int                  flag,i,its,j,jj,k,l,nm,mmi,nml;
1325
   double               c,f,h,s,x,y,z,
1326
                        anorm, g, scale,
1327
                        at,bt,ct,maxarg1,maxarg2,
1328
                        thresh, wmax,
1329
                        *w,*ap,*ap0,*ap1,*ap10,*rv1p,*vp,*vp0,*vp1,*vp10,
1330 206 bertin
                        *tmpp, *rv1,*tmp;
1331
   float                *bp;
1332 2 bertin
 
1333
  anorm = g = scale = 0.0;
1334
  if (m < n)
1335
    error(EXIT_FAILURE, "*Error*: Not enough rows for solving the system ",
1336
        "in svdfit()");
1337
 
1338
  QMALLOC(rv1, double, n);
1339
  QMALLOC(tmp, double, n);
1340
  l = nm = nml = 0;                      /* To avoid gcc -Wall warnings */
1341
  for (i=0;i<n;i++)
1342
    {
1343
    l = i+1;
1344
    nml = n-l;
1345
    rv1[i] = scale*g;
1346
    g = s = scale = 0.0;
1347
    if ((mmi = m - i) > 0)
1348
      {
1349
      ap = ap0 = a+i*(m+1);
1350
      for (k=mmi;k--;)
1351
        scale += fabs(*(ap++));
1352
      if (scale)
1353
        {
1354
        for (ap=ap0,k=mmi; k--; ap++)
1355
          {
1356
          *ap /= scale;
1357
          s += *ap**ap;
1358
          }
1359
        f = *ap0;
1360
        g = -SIGN(sqrt(s),f);
1361
        h = f*g-s;
1362
        *ap0 = f-g;
1363
        ap10 = a+l*m+i;
1364
        for (j=nml;j--; ap10+=m)
1365
          {
1366
          for (s=0.0,ap=ap0,ap1=ap10,k=mmi; k--;)
1367
            s += *(ap1++)**(ap++);
1368
          f = s/h;
1369
          for (ap=ap0,ap1=ap10,k=mmi; k--;)
1370
            *(ap1++) += f**(ap++);
1371
          }
1372
        for (ap=ap0,k=mmi; k--;)
1373
          *(ap++) *= scale;
1374
        }
1375
      }
1376
    wmat[i] = scale*g;
1377
    g = s = scale = 0.0;
1378
    if (i < m && i+1 != n)
1379
      {
1380
      ap = ap0 = a+i+m*l;
1381
      for (k=nml;k--; ap+=m)
1382
        scale += fabs(*ap);
1383
      if (scale)
1384
        {
1385
        for (ap=ap0,k=nml;k--; ap+=m)
1386
          {
1387
          *ap /= scale;
1388
          s += *ap**ap;
1389
          }
1390
        f=*ap0;
1391
        g = -SIGN(sqrt(s),f);
1392
        h=f*g-s;
1393
        *ap0=f-g;
1394
        rv1p = rv1+l;
1395
        for (ap=ap0,k=nml;k--; ap+=m)
1396
          *(rv1p++) = *ap/h;
1397
        ap10 = a+l+m*l;
1398
        for (j=m-l; j--; ap10++)
1399
          {
1400
          for (s=0.0,ap=ap0,ap1=ap10,k=nml; k--; ap+=m,ap1+=m)
1401
            s += *ap1**ap;
1402
          rv1p = rv1+l;
1403
          for (ap1=ap10,k=nml;k--; ap1+=m)
1404
            *ap1 += s**(rv1p++);
1405
          }
1406
        for (ap=ap0,k=nml;k--; ap+=m)
1407
          *ap *= scale;
1408
        }
1409
      }
1410
    anorm=MAX(anorm,(fabs(wmat[i])+fabs(rv1[i])));
1411
    }
1412
 
1413
  for (i=n-1;i>=0;i--)
1414
    {
1415
    if (i < n-1)
1416
      {
1417
      if (g)
1418
        {
1419
        ap0 = a+l*m+i;
1420
        vp0 = vmat+i*n+l;
1421
        vp10 = vmat+l*n+l;
1422
        g *= *ap0;
1423
        for (ap=ap0,vp=vp0,j=nml; j--; ap+=m)
1424
          *(vp++) = *ap/g;
1425
        for (j=nml; j--; vp10+=n)
1426
          {
1427
          for (s=0.0,ap=ap0,vp1=vp10,k=nml; k--; ap+=m)
1428
            s += *ap**(vp1++);
1429
          for (vp=vp0,vp1=vp10,k=nml; k--;)
1430
            *(vp1++) += s**(vp++);
1431
          }
1432
        }
1433
      vp = vmat+l*n+i;
1434
      vp1 = vmat+i*n+l;
1435
      for (j=nml; j--; vp+=n)
1436
        *vp = *(vp1++) = 0.0;
1437
      }
1438
    vmat[i*n+i]=1.0;
1439
    g=rv1[i];
1440
    l=i;
1441
    nml = n-l;
1442
    }
1443
 
1444
  for (i=(m<n?m:n); --i>=0;)
1445
    {
1446
    l=i+1;
1447
    nml = n-l;
1448
    mmi=m-i;
1449
    g=wmat[i];
1450
    ap0 = a+i*m+i;
1451
    ap10 = ap0 + m;
1452
    for (ap=ap10,j=nml;j--;ap+=m)
1453
      *ap=0.0;
1454
    if (g)
1455
      {
1456
      g=1.0/g;
1457
      for (j=nml;j--; ap10+=m)
1458
        {
1459
        for (s=0.0,ap=ap0,ap1=ap10,k=mmi; --k;)
1460
              s += *(++ap)**(++ap1);
1461
        f = (s/(*ap0))*g;
1462
        for (ap=ap0,ap1=ap10,k=mmi;k--;)
1463
          *(ap1++) += f**(ap++);
1464
        }
1465
      for (ap=ap0,j=mmi;j--;)
1466
        *(ap++) *= g;
1467
      }
1468
    else
1469
      for (ap=ap0,j=mmi;j--;)
1470
        *(ap++)=0.0;
1471
    ++(*ap0);
1472
    }
1473
 
1474
  for (k=n; --k>=0;)
1475
      {
1476
      for (its=0;its<100;its++)
1477
        {
1478
        flag=1;
1479
        for (l=k;l>=0;l--)
1480
          {
1481
          nm=l-1;
1482
          if (fabs(rv1[l])+anorm == anorm)
1483
            {
1484
            flag=0;
1485
            break;
1486
            }
1487
          if (fabs(wmat[nm])+anorm == anorm)
1488
            break;
1489
          }
1490
        if (flag)
1491
          {
1492
          c=0.0;
1493
          s=1.0;
1494
          ap0 = a+nm*m;
1495
          ap10 = a+l*m;
1496
          for (i=l; i<=k; i++,ap10+=m)
1497
            {
1498
            f=s*rv1[i];
1499
            if (fabs(f)+anorm == anorm)
1500
              break;
1501
            g=wmat[i];
1502
            h=PYTHAG(f,g);
1503
            wmat[i]=h;
1504
            h=1.0/h;
1505
            c=g*h;
1506
            s=(-f*h);
1507
            for (ap=ap0,ap1=ap10,j=m; j--;)
1508
              {
1509
              z = *ap1;
1510
              y = *ap;
1511
              *(ap++) = y*c+z*s;
1512
              *(ap1++) = z*c-y*s;
1513
              }
1514
            }
1515
          }
1516
        z=wmat[k];
1517
        if (l == k)
1518
          {
1519
          if (z < 0.0)
1520
            {
1521
            wmat[k] = -z;
1522
            vp = vmat+k*n;
1523
            for (j=n; j--; vp++)
1524
              *vp = (-*vp);
1525
            }
1526
          break;
1527
          }
1528
        if (its == 99)
1529
          error(EXIT_FAILURE, "*Error*: No convergence in 100 SVD iterations ",
1530
                "in svdfit()");
1531
        x=wmat[l];
1532
        nm=k-1;
1533
        y=wmat[nm];
1534
        g=rv1[nm];
1535
        h=rv1[k];
1536
        f=((y-z)*(y+z)+(g-h)*(g+h))/(2.0*h*y);
1537
        g=PYTHAG(f,1.0);
1538
        f=((x-z)*(x+z)+h*((y/(f+SIGN(g,f)))-h))/x;
1539
        c=s=1.0;
1540
        ap10 = a+l*m;
1541
        vp10 = vmat+l*n;
1542
        for (j=l;j<=nm;j++,ap10+=m,vp10+=n)
1543
          {
1544
          i=j+1;
1545
          g=rv1[i];
1546
          y=wmat[i];
1547
          h=s*g;
1548
          g=c*g;
1549
          z=PYTHAG(f,h);
1550
          rv1[j]=z;
1551
          c=f/z;
1552
          s=h/z;
1553
          f=x*c+g*s;
1554
          g=g*c-x*s;
1555
          h=y*s;
1556
          y=y*c;
1557
          for (vp=(vp1=vp10)+n,jj=n; jj--;)
1558
            {
1559
            z = *vp;
1560
            x = *vp1;
1561
            *(vp1++) = x*c+z*s;
1562
            *(vp++) = z*c-x*s;
1563
            }
1564
          z=PYTHAG(f,h);
1565
          wmat[j]=z;
1566
          if (z)
1567
            {
1568
            z=1.0/z;
1569
            c=f*z;
1570
            s=h*z;
1571
            }
1572
          f=c*g+s*y;
1573
          x=c*y-s*g;
1574
          for (ap=(ap1=ap10)+m,jj=m; jj--;)
1575
            {
1576
            z = *ap;
1577
            y = *ap1;
1578
            *(ap1++) = y*c+z*s;
1579
            *(ap++) = z*c-y*s;
1580
            }
1581
          }
1582
        rv1[l]=0.0;
1583
        rv1[k]=f;
1584
        wmat[k]=x;
1585
        }
1586
      }
1587
 
1588
  wmax=0.0;
1589
  w = wmat;
1590
  for (j=n;j--; w++)
1591
    if (*w > wmax)
1592
      wmax=*w;
1593
  thresh=TOL*wmax;
1594
  w = wmat;
1595
  for (j=n;j--; w++)
1596
    if (*w < thresh)
1597
      *w = 0.0;
1598
 
1599
  w = wmat;
1600
  ap = a;
1601
  tmpp = tmp;
1602
  for (j=n; j--; w++)
1603
    {
1604
    s=0.0;
1605
    if (*w)
1606
      {
1607
      bp = b;
1608
      for (i=m; i--;)
1609
        s += *(ap++)**(bp++);
1610
      s /= *w;
1611
      }
1612
    else
1613
      ap += m;
1614
    *(tmpp++) = s;
1615
    }
1616
 
1617
  vp0 = vmat;
1618
  for (j=0; j<n; j++,vp0++)
1619
    {
1620
    s=0.0;
1621
    tmpp = tmp;
1622
    for (vp=vp0,jj=n; jj--; vp+=n)
1623
      s += *vp**(tmpp++);
1624
    sol[j]=s;
1625
    }
1626
 
1627
/* Free temporary arrays */
1628
  free(tmp);
1629
  free(rv1);
1630
 
1631
  return;
1632
  }
1633
 
1634
#undef SIGN
1635
#undef MAX
1636
#undef PYTHAG
1637
#undef TOL
1638
 
1639
/******************************** svdvar ************************************/
1640
/*
1641
Computation of the covariance matrix from the SVD vmat and wmat matrices.A
1642
dapted from Numerical Recipes in C, 2nd Ed. (p. 679).
1643
*/
1644
void svdvar(double *v, double *w, int n, double *cov)
1645
  {
1646
   static double        wti[PSF_NTOT];
1647
   double               sum;
1648
   int                  i,j,k;
1649
 
1650
  for (i=0; i<n; i++)
1651
    wti[i] = w[i]? 1.0/(w[i]*w[i]) : 0.0;
1652
 
1653
  for (i=0; i<n; i++)
1654
    for (j=0; j<=i; j++)
1655
      {
1656
      for (sum=0.0,k=0; k<n; k++)
1657
        sum += v[k*n+i]*v[k*n+j]*wti[k];
1658
      cov[j*n+i] = cov[i*n+j] = sum;
1659
      }
1660
 
1661
  return;
1662
  }
1663