uves_physmod_cstacen.c

00001 /*                                                                              *
00002  *   This file is part of the ESO UVES Pipeline                                 *
00003  *   Copyright (C) 2004,2005 European Southern Observatory                      *
00004  *                                                                              *
00005  *   This library is free software; you can redistribute it and/or modify       *
00006  *   it under the terms of the GNU General Public License as published by       *
00007  *   the Free Software Foundation; either version 2 of the License, or          *
00008  *   (at your option) any later version.                                        *
00009  *                                                                              *
00010  *   This program is distributed in the hope that it will be useful,            *
00011  *   but WITHOUT ANY WARRANTY; without even the implied warranty of             *
00012  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *
00013  *   GNU General Public License for more details.                               *
00014  *                                                                              *
00015  *   You should have received a copy of the GNU General Public License          *
00016  *   along with this program; if not, write to the Free Software                *
00017  *   Foundation, 51 Franklin St, Fifth Floor, Boston, MA  02111-1307  USA       *
00018  *                                                                              */
00019 
00020 /*
00021  * $Author: amodigli $
00022  * $Date: 2010/09/24 09:32:07 $
00023  * $Revision: 1.11 $
00024  * $Name: uves-5_0_0 $
00025  * $Log: uves_physmod_cstacen.c,v $
00026  * Revision 1.11  2010/09/24 09:32:07  amodigli
00027  * put back QFITS dependency to fix problem spot by NRI on FIBER mode (with MIDAS calibs) data
00028  *
00029  * Revision 1.9  2007/06/06 08:17:33  amodigli
00030  * replace tab with 4 spaces
00031  *
00032  * Revision 1.8  2006/08/23 15:41:06  amodigli
00033  * removed warning from checks on line length
00034  *
00035  * Revision 1.7  2006/08/11 14:56:05  amodigli
00036  * removed Doxygen warnings
00037  *
00038  * Revision 1.6  2006/06/20 10:56:56  amodigli
00039  * cleaned output, added units
00040  *
00041  * Revision 1.5  2006/06/20 08:25:56  amodigli
00042  * fixed doxigen warnings
00043  *
00044  * Revision 1.4  2006/06/13 11:59:51  jmlarsen
00045  * Fixed doc. bug
00046  *
00047  * Revision 1.3  2006/06/08 11:01:50  amodigli
00048  * fixed some warnings
00049  *
00050  * Revision 1.2  2006/06/01 14:43:17  jmlarsen
00051  * Added missing documentation
00052  *
00053  * Revision 1.1  2006/02/03 07:46:30  jmlarsen
00054  * Moved recipe implementations to ./uves directory
00055  *
00056  * Revision 1.13  2006/01/20 10:05:49  jmlarsen
00057  * Inserted missing doxygen end tag
00058  *
00059  * Revision 1.12  2006/01/13 09:54:42  amodigli
00060  * Fixed some bugs: improved agreement with MIDAS version
00061  *
00062  * Revision 1.11  2006/01/09 14:05:42  amodigli
00063  * Fixed doxigen warnings
00064  *
00065  * Revision 1.10  2006/01/05 14:29:59  jmlarsen
00066  * Removed newline characters from output strings
00067  *
00068  * Revision 1.9  2005/12/20 08:11:44  jmlarsen
00069  * Added CVS  entry
00070  *
00071  */
00072 
00073 #ifdef HAVE_CONFIG_H
00074 #  include <config.h>
00075 #endif
00076 
00077 /*---------------------------------------------------------------------------*/
00084 /*---------------------------------------------------------------------------*/
00085 
00086 /* code derived by MIDAS cstacen.c */
00087 /*-----------------------------------------------------------------------------
00088                                 Includes
00089  ----------------------------------------------------------------------------*/
00090 /* definition of the used functions in this module */
00091 
00092 #include "uves_physmod_cstacen.h"
00093 #include <cpl.h>
00094 #include <math.h>
00095 /*-----------------------------------------------------------------------------
00096                                 Defines
00097  ----------------------------------------------------------------------------*/
00098 /* Define _POSIX_SOURCE to indicate that this is a POSIX program */
00099 /* replaced osmmget by cpl_calloc */
00100 /* replaced osmmfree by cpl_free */
00101 #define  _POSIX_SOURCE 1
00102 
00103 /* define some macros and constants */
00104 
00105 #ifndef  PI
00106 #define  PI             3.14159265358979325e0
00107 #endif
00108 /*
00109 #ifndef true
00110 #define true            1
00111 #define false           0
00112 #endif
00113 */
00114 
00115 /* Constants used by the moment centering */
00116 
00117 #define MINVAL      1.0e-37
00118 #define MMXITER     8
00119 #define SMALL           1.0e-20
00120 
00121 
00122 /* Constants used by the gaussian centering */
00123 
00124 #define MAXPAR        4
00125 #define IGNORE        2
00126 #define NOCONV        -1
00127 #define OUTSIDE        -2
00128 #define GMXITER     50
00129 #define GCHIMAX        5.0e+16
00130 #define GCHIFND        0.005
00131 
00132 
00133 #define MYMIN(a,b)   ((a) > (b) ? (b) : (a))
00134 #define MYMAX(a,b)   ((b) > (a) ? (b) : (a))
00135 
00138 /*-----------------------------------------------------------------------------
00139                             Functions prototypes
00140  ----------------------------------------------------------------------------*/
00141 
00142 /*-----------------------------------------------------------------------------
00143                             Static variables
00144  ----------------------------------------------------------------------------*/
00145 /*-----------------------------------------------------------------------------
00146                             Functions code
00147  ----------------------------------------------------------------------------*/
00148 
00149 /*---------------------------------------------------------------------------*/
00188 /*---------------------------------------------------------------------------*/
00189 
00190 int 
00191 uves_physmod_stacen(float* p_img, int dimx, int dimy, char meth, int* image, 
00192                   float* xout, float* yout, float* xerr, float* yerr,
00193                   float* xsig, float* ysig, float* xyval, int* stat )
00194 
00195 {
00196 int   npix[2], imap[4];
00197 float xypos[2], xyerr[2], xysig[2];
00198 
00199 npix[0]  = dimx;
00200 npix[1]  = dimy;
00201 
00202 imap[0] = image[0] - 1;
00203 imap[1] = image[1] - 1;
00204 imap[2] = image[2] - 1;
00205 imap[3] = image[3] - 1;
00206 
00207 /*
00208  uves_msg("Input=: npix[0]=%d npix[1]=%d",npix[0],npix[1]);
00209  uves_msg("Input=: imap[0]=%d imap[1]=%d imap[2]=%d imap[3]=%d",imap[0],imap[1],imap[2],imap[3]);
00210 */
00211 
00212 *stat = uves_physmod_cstacen(meth, p_img, npix, imap, xypos, xyerr, xysig, xyval );
00213 
00214 *xout = xypos[0] + 1;
00215 *yout = xypos[1] + 1;
00216 
00217 
00218 *xerr = xyerr[0];
00219 *yerr = xyerr[1];
00220 *xsig = xysig[0];
00221 *ysig = xysig[1];
00222 /*
00223  uves_msg("xout=%f,yout=%f,xerr=%f,yerr=%f,xsig=%f,ysig=%f",
00224          *xout,*yout,*xerr,*yerr,*xsig,*ysig);
00225      */
00226 
00227  return 0;
00228 } 
00229 /*---------------------------------------------------------------------------*/
00235 static int CGN_NINT(float a){   
00236   int res=0;
00237 
00238  res = (a) > 0 ? floor(a+0.5) : -floor(a-0.5);
00239  return res;
00240 }
00241 
00242 /*---------------------------------------------------------------------------*/
00269 /*---------------------------------------------------------------------------*/
00270 
00271 
00272 static int Ckapsig( float *val, int nval, int iter, float akap, 
00273                           float *cons, float *rms, int *npts )
00274 
00275 {
00276 
00277 register int ii=0;
00278 register int it=0;
00279 register int nr=0;
00280 
00281 int   nr_old=0;
00282 
00283 float clip=0;
00284 float dels=0;
00285 float delv=0;
00286 float mean=0;
00287 float msq=0;
00288 float sum=0;
00289 float *vsq=NULL;
00290 
00291 if ( nval < 2 ) return (-1);
00292 
00293 
00294 /* initialize mean value */
00295 
00296 mean = 0.0;
00297 for (ii=0; ii<nval; ii++) mean += val[ii];
00298 mean /= (float) (nval);
00299 msq = mean * mean;
00300 
00301 
00302 /* initialize RMS */
00303 
00304 vsq = (float *) cpl_calloc( nval, sizeof( float ));
00305 
00306 dels = 0.0;
00307 for (ii=0; ii<nval; ii++)
00308     {
00309     vsq[ii] = val[ii] * val[ii];
00310     delv = MYMAX( 0.0, vsq[ii] + msq - (2.0 * mean * val[ii]));
00311     dels += delv;
00312     }
00313 
00314 *rms = (float) sqrt( MYMAX( MINVAL, dels / (nval-1)));
00315 clip = akap * (*rms);
00316 
00317 
00318 /* iterate */
00319 
00320 nr_old = 0;
00321 for (it=0; it<iter; it++)
00322    {
00323    nr = 0;
00324    sum  = 0.0;
00325    dels = 0.0;
00326 
00327    for ( ii = 0; ii < nval; ii++ )
00328       {
00329       if ( fabs( val[ii] - mean ) < (double) clip )     
00330          {
00331          nr++;
00332          delv = MYMAX( 0.0, vsq[ii] + msq - 2.0 * mean * val[ii]);
00333          dels += delv;
00334          sum  += val[ii];
00335          }
00336       }
00337 
00338    if ( nr <= 2 || nr == nr_old ) goto end_of_it;
00339 
00340 
00341    /* define new rms and mean value */
00342 
00343    nr_old = nr;
00344    *rms = (float) sqrt( MYMAX( MINVAL, dels / (nr-1)));
00345    clip = akap * *rms;
00346    mean = sum / nr_old;
00347    msq  = mean * mean;
00348    }
00349 
00350 end_of_it:
00351 *cons = mean;                /* exit */
00352 *npts = nr;
00353 
00354 cpl_free(vsq);
00355 return (0);
00356 }
00357 
00358 
00359 /*---------------------------------------------------------------------------*/
00374 /*---------------------------------------------------------------------------*/
00375 
00376 static int MATINV( double (*matrix)[MAXPAR], int nfree )
00377 {
00378 
00379 register int ii=0;
00380 register int jj=0;
00381 register int kk=0;
00382 
00383 int    evin=0;
00384 int    row=0;
00385 int    per[MAXPAR];
00386 double even=0.;
00387 double mjk=0.;
00388 double rowmax=0.;
00389 double hv[MAXPAR];
00390 
00391 
00392 for ( ii = 0; ii < nfree; ii++ ) per[ii] = ii;     /* set permutation array */
00393 
00394 for ( jj = 0; jj < nfree; jj++ )                   /* in j-th column, ... */
00395    {
00396    rowmax = fabs( matrix[jj][jj] );             /* determine row with ... */
00397    row = jj;                                    /* largest element. */
00398    for ( ii = jj + 1; ii < nfree; ii++ )
00399       {
00400       if ( fabs( matrix[ii][jj] ) > rowmax )
00401          {
00402          rowmax = fabs( matrix[ii][jj] );
00403          row = ii;
00404          }
00405       }
00406 
00407    if (fabs(matrix[row][jj]) < SMALL)             /* determinant is zero! */
00408       return (1);
00409 
00410    if ( row > jj )                           /* if largest element not ...*/
00411       {
00412       for ( kk = 0; kk < nfree; kk++ )     /* on diagonal, then ... */
00413          {
00414          even = matrix[jj][kk];            /* permutate rows. */
00415          matrix[jj][kk] = matrix[row][kk];
00416          matrix[row][kk] = even;
00417          }
00418       evin = per[jj];                      /* keep track of permutation */
00419       per[jj] = per[row];
00420       per[row] = evin;
00421       }
00422 
00423    even = 1.0 / matrix[jj][jj];              /* modify column */
00424    for (ii=0; ii<nfree; ii++) 
00425       matrix[ii][jj] *= even;
00426    matrix[jj][jj] = even;
00427    for (kk=0; kk<jj; kk++)
00428       { 
00429       mjk = matrix[jj][kk];
00430       for ( ii = 0; ii < jj; ii++ ) 
00431          matrix[ii][kk] -= matrix[ii][jj] * mjk;
00432       for ( ii = jj + 1; ii < nfree; ii++ )
00433          matrix[ii][kk] -= matrix[ii][jj] * mjk;
00434       matrix[jj][kk] = -even * mjk;
00435       }
00436 
00437    for ( kk = jj + 1; kk < nfree; kk++ )
00438       {
00439       mjk = matrix[jj][kk];
00440       for ( ii = 0; ii < jj; ii++ )
00441          matrix[ii][kk] -= matrix[ii][jj] * mjk;
00442       for ( ii = jj + 1; ii < nfree; ii++ )
00443          matrix[ii][kk] -= matrix[ii][jj] * mjk;
00444       matrix[jj][kk] = -even * mjk;
00445       }
00446    }
00447 
00448 for ( ii = 0; ii < nfree; ii++ )                /* finally, repermute the ...*/
00449    { 
00450    for ( kk = 0; kk < nfree; kk++ )          /* columns. */
00451       {
00452       hv[per[kk]] = matrix[ii][kk];
00453       }
00454    for ( kk = 0; kk < nfree; kk++)
00455       {
00456       matrix[ii][kk] = hv[kk];
00457       }
00458    }
00459 
00460 return 0;
00461 }
00462 
00463 /*---------------------------------------------------------------------------*/
00474 /*---------------------------------------------------------------------------*/
00475 
00476 static double ERFCC( double xx )
00477 
00478 {
00479 
00480 double t=0.;
00481 double z=0.;
00482 double ans=0.;
00483 double zz=0.;
00484 double zozo=0.;
00485 
00486 
00487 z = fabs( xx );
00488 t = 1.0 / (1.0 + (0.5 * z));
00489 
00490 /*
00491 ans = t * exp( -z * z - 1.26551223 + t * ( 1.00002368 + t *
00492                       ( 0.37409196 + t * ( 0.09678418 + t * 
00493                       (-0.18628806 + t * ( 0.27886807 + t *
00494                       (-1.13520398 + t * ( 1.48851587 + t *
00495                       (-0.82215223 + t * 0.17087277 )))))))));
00496 
00497 
00498 the original code above didn't work on Red Hat Linux 5.2
00499 with CENTER/GAUSS where the main program is Fortran code
00500 neither on Alpha nor on Intel PC (using f2c) ... 
00501 
00502 however it works on SUSE Linux 6.xx on Intel (using g77)
00503 
00504 therefore this work around which seemed to solve the problem, KB 000522  */
00505 
00506 zz =  -z * z - 1.26551223 + t * ( 1.00002368 + t *
00507                       ( 0.37409196 + t * ( 0.09678418 + t *
00508                       (-0.18628806 + t * ( 0.27886807 + t *
00509                       (-1.13520398 + t * ( 1.48851587 + t *
00510                       (-0.82215223 + t * 0.17087277 ))))))));
00511 
00512 
00513 if (zz < -500.0)
00514    zozo = 0.0;
00515 else
00516    zozo = exp(zz);
00517 
00518 ans = t * zozo;
00519 
00520 
00521 return  (xx >= 0.0 ? ans : 2.0 - ans);
00522 }
00523 
00524 /*---------------------------------------------------------------------------*/
00534 /*---------------------------------------------------------------------------*/
00535 
00536 static double GAUSFU( double xx, double *gpar )
00537 {
00538 
00539 double rc=0.;
00540 double dd=0.;
00541 
00542 static int    init = TRUE;
00543 static double sqrt_2;
00544 static double rc1;
00545 
00546 
00547 if ( init )
00548    {
00549    sqrt_2  = sqrt( 2.0 );
00550    rc1 = sqrt(PI)/sqrt_2;
00551    init = FALSE;
00552    }
00553 
00554 rc = 1.0 / (sqrt_2 * gpar[2]);
00555 dd = xx - gpar[1];
00556 dd = ERFCC(rc * (dd - 0.5)) - ERFCC(rc * (dd + 0.5));
00557 return ( gpar[3] + rc1 * gpar[0] * gpar[2] * dd );
00558 }
00559 
00560 /*---------------------------------------------------------------------------*/
00572 /*---------------------------------------------------------------------------*/
00573 
00574 static void GAUSDE( double xdat, double *gpar, double *deriv )
00575 {
00576 double temp=0.;
00577 double tempp=0.;
00578 double x1=0.;
00579 double x2=0.;
00580 double zz=0.;
00581 double zx=0.;
00582 double dv1=0.; 
00583 double dv2=0.;
00584 static double sqrt_2;
00585 
00586 register int jj=0;
00587 static int    init = TRUE;
00588 
00589 
00590 if ( init )
00591    {
00592    sqrt_2  = sqrt( 2.0 );
00593    init = FALSE;
00594    }
00595 
00596 temp = sqrt_2 * gpar[2];
00597 tempp = xdat - gpar[1];
00598 x1 = (tempp - 0.5) / temp;
00599 x2 = (tempp + 0.5) / temp;
00600 zz = tempp / gpar[2] ;
00601 
00602 if ( ((zz * zz) - 50.0) < 0.0 )
00603    { 
00604    deriv[0] = (GAUSFU( xdat, gpar ) - gpar[3]) / gpar[0];
00605 
00606    zx = (-x1) * x1;
00607    if ( zx < -200.0)        /*  zx  always < 0 */
00608       dv1 = 0.0;        /*  e**(-200)  is = 0.0 ... */
00609    else
00610       dv1 = exp(zx);
00611    zx = (-x2) * x2;
00612    if ( zx < -200.0)
00613       dv2 = dv1;
00614    else
00615       dv2 = dv1 - exp(zx);
00616    deriv[1] = gpar[0] * dv2;
00617 
00618    /*    for (x1 * x1) > 400  we got floating point exceptions on DEC Alpha 
00619    deriv[1] = gpar[0] * (exp( -x1 * x1 ) - exp( -x2 * x2 ));
00620    */
00621 
00622    deriv[2] = deriv[1] * zz;
00623    }
00624 else
00625    for (jj=0; jj<3; jj++) deriv[jj] = 0.0;
00626      
00627 deriv[3] = 1.0;
00628 }
00629 
00630 /*---------------------------------------------------------------------------*/
00646 /*---------------------------------------------------------------------------*/
00647 
00648 static float FCHIS(double *data,int ndim,int nfree,int mode,double *dfit) {
00649 
00650 register int ii=0;
00651 
00652 double diff=0.;
00653 double weight=0.;
00654 double chisq=0.;
00655 
00656 
00657 if ( nfree > 0 )
00658    {
00659    chisq = 0.0;
00660 
00661    for (ii=0; ii<ndim; ii++)
00662       {
00663       if ( mode < 0 )
00664          {
00665          if ( *data < 0 )
00666             weight = -1. / *data;
00667          else if ( *data == 0 )
00668             weight = 1.0;
00669          else
00670             weight = 1. / *data;
00671          }
00672       else
00673          weight = 1.0;
00674 
00675       diff = (*data) - (*dfit);
00676       data++;  dfit++;
00677       chisq += weight * diff * diff;
00678       }
00679    return (chisq / nfree);
00680    }
00681 
00682 else
00683    return 0.0;
00684 }
00685 
00686 /*---------------------------------------------------------------------------*/
00714 static int LSQFIT( double *xdat, double *data, int ndim,
00715                          double *gpar, float *lamda, double *dfit, 
00716                          double *chisqr, double *sigma )
00717 
00718 {
00719 
00720 register int icnt=0;
00721 register int ii=0;
00722 register int jj=0;
00723 register int kk=0;
00724 
00725 int    nfree=0;
00726 
00727 double chisq1=0;
00728 double b[MAXPAR], beta[MAXPAR], deriv[MAXPAR], 
00729                array[MAXPAR][MAXPAR], alpha[MAXPAR][MAXPAR];
00730                                                                                
00731 
00732 nfree = ndim - MAXPAR;
00733 *sigma = 0.0;
00734 if ( nfree < 1 || fabs( (double) *gpar ) < SMALL ) return (1);
00735 
00736 
00737 /* evaluate ALPHA and BETA matrices */
00738 
00739 for (ii=0; ii<MAXPAR; ii++)
00740    {
00741    beta[ii] = 0.0;
00742    for (jj=0; jj<=ii; jj++) alpha[ii][jj] = 0.0;
00743    }
00744 
00745 for (ii=0; ii<ndim; ii++)
00746     {
00747     GAUSDE( xdat[ii], gpar, deriv );          /* here we divide by gpar[1] */
00748 
00749     for (jj=0; jj<MAXPAR; jj++)
00750        {
00751        beta[jj] += (data[ii] - GAUSFU( xdat[ii], gpar )) * deriv[jj];
00752        for (kk=0; kk<=jj; kk++) 
00753           alpha[jj][kk] += deriv[jj] * deriv[kk];
00754        }
00755     }
00756 
00757 for (ii=0; ii<MAXPAR; ii++)
00758    {
00759    for (jj=0; jj<=ii; jj++) 
00760       alpha[jj][ii] = alpha[ii][jj];
00761    }
00762 
00763 
00764 /* invert matrix */
00765 
00766 if ( *lamda < SMALL)
00767    {
00768    if (MATINV(alpha,MAXPAR) == 1) return (2);    /* determinant -> 0.0 */
00769 
00770    *sigma = MYMAX( 0.0, alpha[1][1] );
00771    }
00772 
00773 else                                /* evaluate chi square at starting point */
00774    {
00775    for (ii=0; ii<ndim; ii++)
00776       dfit[ii] = GAUSFU( xdat[ii], gpar );
00777 
00778    chisq1 = FCHIS( data, ndim, nfree, 0, dfit );
00779 
00780    icnt = 0;            /* invert matrix */
00781 loop:
00782    for ( jj = 0; jj < MAXPAR; jj++ )
00783       {
00784       for ( kk = 0; kk < MAXPAR; kk++ )
00785          {
00786          if (fabs( alpha[jj][jj] ) < 1.e-15 || fabs( alpha[kk][kk] ) < 1.e-15) 
00787             return 2;
00788          array[jj][kk] = alpha[jj][kk] / 
00789                                       sqrt( alpha[jj][jj] * alpha[kk][kk] ) ;
00790          }
00791       array[jj][jj] = 1.0 + *lamda;
00792       }
00793 
00794    (void) MATINV( array, MAXPAR );
00795 
00796    for ( jj = 0; jj < MAXPAR; jj++ )
00797       {
00798       b[jj] = gpar[jj] ;
00799       for ( kk = 0; kk < MAXPAR ; kk++ )
00800          {
00801          b[jj] += beta[kk] * array[jj][kk] / 
00802                                         sqrt( alpha[jj][jj] * alpha[kk][kk] );
00803          }
00804       }
00805 
00806 /* if chi square increased, increase LAMDA and try again */
00807 
00808    for (ii=0; ii<ndim; ii++)
00809       dfit[ii] = GAUSFU( xdat[ii], b );
00810    
00811    *chisqr = FCHIS( data, ndim, nfree, 0, dfit );
00812 
00813    if ( chisq1 - *chisqr < 0.0 )
00814       {
00815       if (++icnt < 60)
00816          {
00817          *lamda *= 10;
00818          goto loop;
00819          }
00820       else
00821          return (2);
00822       }
00823 
00824    for (jj=0; jj<MAXPAR; jj++) gpar[jj] = b[jj];
00825    *lamda /= 10.0;
00826    }
00827 
00828 return 0;
00829 }
00830 
00831 
00832 /*---------------------------------------------------------------------------*/
00852 static void Crhox( float *p_img, int *npix, int *image, 
00853                          int *lnew, double *krx )
00854 
00855 {
00856 register int nxdim=0;
00857 register int ix=0;
00858 register int iy=0;
00859 
00860 int nrx=0;
00861 int nry=0;
00862  
00863 double sum=0;
00864 
00865 
00866 
00867 
00868 /*  original FORTRAN code:
00869 
00870       IXA = IMAP(1)        IMAP(1-4) => image[0-3]
00871       IXE = IMAP(2)
00872       IYA = IMAP(3)
00873       JYA = IYA + JY - 1    JY => lnew[0]
00874       JYE = IYA + LY - 1    LY => lnew[1]
00875       M = 1
00876 
00877          DO 200 J=IXA,IXE
00878             ISUM = 0.D0
00879             DO 100 K=JYA,JYE
00880                ISUM = ISUM + AIMG(J,K)
00881 100         CONTINUE
00882             KRX(M) = ISUM
00883             M = M + 1
00884 200      CONTINUE
00885 */
00886 
00887 
00888 nrx = image[1] - image[0] + 1;
00889 nry = lnew[1] - lnew[0] + 1;
00890 nxdim = *npix;
00891 p_img += nxdim * (image[2] + lnew[0]);
00892 
00893 for (ix=0; ix<nrx; ix++)
00894    {
00895    sum = 0.0;
00896    for (iy=0; iy<nry*nxdim; iy+=nxdim) sum += p_img[iy];
00897    p_img++;
00898    *krx++ = sum;
00899    }
00900 }
00901 
00902 
00903 
00904 /*---------------------------------------------------------------------------*/
00924 static void Crhoy( float *p_img, int *npix, int *image, 
00925                          int *lnew, double *kry )
00926 
00927 {
00928 register int nxdim=0;
00929 register int ix=0;
00930 register int iy=0;
00931 
00932 int nrx=0;
00933 int nry=0;
00934 
00935 double sum=0;
00936 
00937 
00938 
00939 /*  original FORTRAN code:
00940 
00941       IXA = IMAP(1)        IMAP(1-4) => image[0-3]
00942       IYA = IMAP(3)
00943       IYE = IMAP(4)
00944       JXA = IXA + JX - 1    JX => lnew[0]
00945       JXE = IXA + LX - 1    LX => lnew[1]
00946 
00947          M = 1
00948          DO 200 J=IYA,IYE
00949             ISUM = 0.D0
00950             DO 100 K=JXA,JXE
00951                ISUM = ISUM + AIMG(K,J)
00952 100         CONTINUE
00953             KRY(M) = ISUM
00954             M = M + 1
00955 200      CONTINUE
00956 
00957 */
00958 
00959 nrx = lnew[1] - lnew[0] + 1;
00960 nry = image[3] - image[2] + 1;
00961 nxdim = *npix;
00962 p_img += (nxdim * image[2]) + (image[0] + lnew[0]);
00963 
00964 for (iy=0; iy<nry; iy++)
00965    {
00966    sum = 0.0;
00967    for (ix=0; ix<nrx; ix++) sum += p_img[ix];
00968    p_img += nxdim;
00969    *kry++ = sum;
00970    }
00971 }
00972 
00973 /*---------------------------------------------------------------------------*/
00997 static int Cserch( double *marg, int ndim, int ign, 
00998                          int *lmin, int *lmax, float *s_cent, float *s_width )
00999 
01000 {
01001 
01002 register int ii=0;
01003 
01004 int ql=0;
01005 int ibgn=0;
01006 int icrowd=0;
01007 int iend=0;
01008 int imax=0;
01009 int imin=0;
01010 int indx=0;
01011 
01012 double dxk=0.;
01013 double diff=0.;
01014 double drmn=0.;
01015 double drmx=0.;
01016 double sum=0.;
01017 double  *work=NULL;
01018 
01019 
01020 ibgn = ign;
01021 iend = ndim - ign -1;            /* ojo */
01022 
01023 /* create workspace to store the derivative of the marginal data */
01024 
01025 work = (double *) cpl_calloc( ndim , sizeof( double ));
01026 
01027 
01028 /* find maximum and minimum derivative of MARG */
01029 
01030 imin = imax = 0;
01031 drmn = drmx = 0.0;
01032 for (ii = ibgn; ii < iend; ii++ )
01033     {
01034     diff = marg[ii+1] - marg[ii-1];
01035     work[ii] = marg[ii+2] - marg[ii-2] + (2 * diff);
01036     if ( work[ii] >= drmx )     
01037        {
01038        drmx = work[ii];
01039        imax = ii;
01040        }
01041     if (
01042        work[ii] <= drmn )     
01043        { drmn = work[ii];
01044        imin = ii;
01045        }
01046     }
01047 
01048 
01049 /* crowded ? */
01050 
01051 icrowd = 0;
01052 if (imin <= imax ) /* bright source to the left, compute right a new minima */
01053    {
01054    if ( ndim - imax > imin )     
01055       {
01056       icrowd = -1;
01057       drmn = drmx;
01058       for ( ii = imax+1; ii < iend; ii++ )
01059          {
01060          if ( work[ii] < drmn )
01061             {
01062             drmn = work[ii];
01063             imin = ii;
01064             }
01065          }
01066       }
01067    else           /* bright source to the right, compute left a new maxima */
01068       {
01069       icrowd = 1;
01070       drmx = drmn;
01071       for ( ii = ibgn; ii < imin; ii++ )
01072          {
01073          if ( work[ii] >= drmx )
01074             { 
01075             drmx = work[ii];
01076             imax = ii;
01077             }
01078          }
01079       }
01080    }
01081 
01082 
01083 /* compute estimates of image centre and width */
01084 
01085 *s_cent  = ((float)(imax + imin)) * 0.5;
01086 *s_width = imin - imax;
01087 
01088 sum = 0.0;
01089 for ( ii = imax; ii <= imin; ii++ ) sum += work[ii];
01090 
01091 diff = drmx - drmn;
01092 if ( fabs(diff) > SMALL)
01093    {
01094    dxk = sum * *s_width / ( (*s_width+1.0)*diff );
01095    *s_cent += dxk;
01096    }
01097 *s_width /= 2;
01098 indx = CGN_NINT(*s_cent);
01099 if (indx < 0)
01100    {
01101    *s_cent = 0.0;
01102    indx = 0;
01103    }
01104 else if (indx >= ndim)
01105    {
01106    *s_cent = (float)(ndim-1);
01107    indx = ndim-1;
01108    }
01109 
01110 
01111 /* find low- (left-) side local minimum */
01112 
01113 ql = indx - 2;
01114 *lmin = 0;
01115 if (ql < 2) goto next_step;
01116 
01117 low_loop:
01118 ql --;
01119 if (ql <= 0 ) goto next_step;
01120 if (ql == 1) goto lo5;
01121 if (ql == 2) goto lo4;
01122 if (ql == 3) goto lo3;
01123 
01124 if (marg[ql] > marg[ql-4]) goto low_loop;
01125 lo3:
01126 if (marg[ql] > marg[ql-3]) goto low_loop;
01127 lo4:
01128 if (marg[ql] > marg[ql-2]) goto low_loop;
01129 lo5:
01130 if (marg[ql] > marg[ql-1]) goto low_loop;
01131 
01132 *lmin = ql + 1;
01133 
01134 
01135 /* find high- (right-) side local minimum */
01136 
01137 next_step:
01138 ql = indx + 2;
01139 *lmax = ndim - 1;
01140 ii = ndim - ql;
01141 if (ii < 3) goto end_of_it;
01142 
01143 hi_loop:
01144 ql ++ ;
01145 ii = ndim - ql;
01146 if (ii == 1 ) goto end_of_it;
01147 if (ii == 2) goto hi5;
01148 if (ii == 3) goto hi4;
01149 if (ii == 4) goto hi3;
01150 
01151 if (marg[ql] > marg[ql+4]) goto hi_loop;
01152 hi3:
01153 if (marg[ql] > marg[ql+3]) goto hi_loop;
01154 hi4:
01155 if (marg[ql] > marg[ql+2]) goto hi_loop;
01156 hi5:
01157 if (marg[ql] > marg[ql+1]) goto hi_loop;
01158 *lmax = ql - 1;
01159 
01160 end_of_it:
01161 (void) cpl_free( (char *) work );
01162 return (icrowd);
01163 
01164 }
01165 
01166 /*---------------------------------------------------------------------------*/
01204 /*---------------------------------------------------------------------------*/
01205 
01206 /* ------------------------------------------*/
01207 /* here starts the code of the main function */
01208 /* ------------------------------------------*/
01209 
01210 
01211 int uves_physmod_cstacen(char meth, float* p_img, int* npix, int* image, 
01212             float* xypos, float* xyerr, float* xysig, float* xyval )
01213 
01214 {
01215 
01216 register int it=0;
01217 register int ix=0;
01218 register int iy=0;
01219 
01220 int bgnr=0;
01221 int indx=0;
01222 int indy=0;
01223 int istat=0;
01224 int nrx=0;
01225 int nry=0;
01226 int nval=0;
01227 int ifram[4];
01228 
01229 float bgval=0.;
01230 float clip=0.;
01231 float rms=0.;
01232 float xmom=0.;
01233 float ymom=0.;
01234 float source=0.;
01235 float sumi=0.;
01236 float xold=0.;
01237 float yold=0.;
01238 
01239 float *p_bgn=NULL;
01240 float *p_edge=NULL;
01241 
01242 
01243 istat = 0;                        /* initialize */
01244 p_bgn = p_img;
01245 for (ix=0; ix<4; ix++)
01246    ifram[ix] = image[ix] + 1;            /* 1 ---> ndim  */
01247 nrx = ifram[1] - ifram[0] + 1;
01248 nry = ifram[3] - ifram[2] + 1;
01249       
01250 xypos[0] = (ifram[0] + ifram[1]) * 0.5;             /* init to center pixel */
01251 xypos[1] = (ifram[2] + ifram[3]) * 0.5;
01252 xyerr[0] = xyerr[1] = 0.0;
01253 xysig[0] = xysig[1] = 0.0;
01254 *xyval = 0.0;
01255 
01256 /* MOMENT centering */
01257 
01258 if ( meth != 'G' && meth != 'g' )
01259    {
01260    int kk, istr, iend;
01261 
01262    xold = yold = -1.0;        /* find bgval and rms from edge pixels */
01263 
01264    p_img += (ifram[0] - 1) + (npix[0] * (ifram[2] - 1));
01265 
01266    /* collect edge pixels */
01267 
01268    if (nry > 1)
01269       {
01270       nval = (2 * nrx) + (2 * (nry-2));
01271       p_edge = (float *) cpl_calloc( nval , sizeof( float ));
01272 
01273       for (ix=0; ix<nrx;ix++)
01274          *p_edge++ = p_img[ix];
01275 
01276       p_img += *npix;
01277       for (iy=0; iy<(nry-2); iy++)
01278          {
01279          *p_edge++ = p_img[0];
01280          *p_edge++ = p_img[nrx - 1];
01281          p_img += npix[0];
01282          }
01283       for (ix=0; ix<nrx; ix++) *p_edge++ = p_img[ix];
01284       }
01285    else
01286       {
01287       nval = nrx;
01288       p_edge = (float *) cpl_calloc( nval , sizeof( float ));
01289 
01290       for (ix=0; ix<nrx;ix++)
01291          *p_edge++ = p_img[ix];
01292       }
01293 
01294    p_img = p_bgn;
01295 
01296    p_edge -= nval;
01297    (void) Ckapsig( p_edge, nval, 5, 2.0, &bgval, &rms, &bgnr );
01298    (void) cpl_free( (char *) p_edge );
01299 
01300 
01301    /* calculate moment for pixel values > 3 * RMS above BGVAL */
01302 
01303    clip = 3.0 * rms;
01304 
01305    for (it=0; it<MMXITER; it++)                      /* iteration loop */
01306       {
01307       sumi = xmom = ymom = 0.0;
01308       p_img += ifram[0] - 1 + (npix[0] * (ifram[2] - 1));
01309       for (iy=0; iy<nry; iy++)
01310          {
01311          for (ix=0; ix<nrx; ix++) 
01312             {
01313             if ( (source = p_img[ix] - bgval) > clip )
01314                {
01315                sumi += source;
01316                xmom += source * (ifram[0] + ix);
01317                ymom += source * (ifram[2] + iy);
01318                }
01319             }
01320          p_img += npix[0];
01321          }
01322       p_img = p_bgn;            /* reset to start of array */
01323 
01324       if ((nrx < 3) || (nry < 3))
01325          {
01326          xysig[0] = nrx;
01327          xysig[1] = nry;
01328          istat = 1;
01329          if ( sumi > 0.0 )
01330             {
01331             xypos[0] = xmom / sumi;
01332             xypos[1] = ymom / sumi;
01333             }
01334          else
01335             {
01336             istat = 2;
01337             xypos[0] = (ifram[0] + ifram[1]) * 0.5;
01338             xypos[1] = (ifram[2] + ifram[3]) * 0.5;
01339             }
01340          indx = CGN_NINT(xypos[0]-1);
01341          indy = CGN_NINT(xypos[1]-1);
01342          *xyval = p_img[indx + ((*npix) * indy)];
01343          goto end_of_iter;        /* EXIT iteration loop */
01344          }
01345 
01346       if (sumi > 0.0)                  /* only positive sources */
01347          {
01348          xypos[0] = xmom / sumi;
01349          xypos[1] = ymom / sumi;
01350          xysig[0] = nrx;
01351          xysig[1] = nry;
01352 
01353          if ( xold == xypos[0] && yold == xypos[1] )
01354             {
01355             int    nr = 0;
01356             double xdif, ydif, xrms, yrms;
01357 
01358             xrms = yrms = sumi = 0.0;
01359             p_img += ifram[0] - 1 + (npix[0] * (ifram[2] - 1));
01360             for (iy=0; iy<nry; iy++ )
01361                {
01362                for (ix=0; ix<nrx; ix++) 
01363                   {
01364                   if ( (source = p_img[ix] - bgval) > clip )
01365                      {
01366                      xdif = (ifram[0] + ix) - xypos[0];
01367                      ydif = (ifram[2] + iy) - xypos[1];
01368                      xrms += fabs( source * xdif *xdif );
01369                      yrms += fabs( source * ydif *ydif );
01370                      sumi += source;
01371                      nr++;
01372                      }
01373                   }
01374                p_img += npix[0];
01375                }
01376             p_img = p_bgn;
01377 
01378             indx = CGN_NINT(xypos[0]-1) + (npix[0] * CGN_NINT(xypos[1]-1));
01379             *xyval = p_img[indx];
01380             xysig[0] = (float) sqrt(xrms /(sumi+ *xyval - bgval));
01381             xysig[1] = (float) sqrt(yrms /(sumi+ *xyval - bgval));
01382             xyerr[0] = (float) (xysig[0] / sqrt( (double) (nr - 1)));
01383             xyerr[1] = (float) (xysig[1] / sqrt( (double) (nr - 1)));
01384             goto end_of_iter;            /* succesful return */
01385             }
01386 
01387 
01388          xold = xypos[0];
01389          yold = xypos[1]; 
01390          }
01391       else
01392          {
01393          istat = 2;
01394          xypos[0] = (ifram[0] + ifram[1]) * 0.5;
01395          xypos[1] = (ifram[2] + ifram[3]) * 0.5;
01396          indx = CGN_NINT(xypos[0]-1);
01397          indy = CGN_NINT(xypos[1]-1);
01398          *xyval = p_img[indx + ((*npix) * indy)];
01399          goto end_of_iter;              /* EXIT iteration loop */
01400          }
01401 
01402 
01403       /* crowded or weak source conditions */
01404 
01405       indx = CGN_NINT(xypos[0]-1) + (npix[0] * CGN_NINT(xypos[1]-1));
01406       if ( (*xyval = p_img[indx] - bgval) <= clip )
01407          {
01408          xysig[0] = xysig[1] = 0.0;
01409          istat = 1;
01410          goto end_of_iter;              /* EXIT iteration loop */
01411          }
01412 
01413 
01414       /* find extent of source i.e. delete spikes, etc.  */
01415 
01416       ix = CGN_NINT( xypos[0] );        /* ix, iy = 1,2,...   */
01417       iy = CGN_NINT( xypos[1] );
01418       kk = npix[0] * (iy - 1);
01419       istr = ifram[0];
01420       source = p_img[ix-1 + kk] - bgval;
01421       while ( source > clip && ix >= istr )
01422          {
01423          ifram[0] = ix;
01424          source = p_img[ix-1 + kk] - bgval;
01425          ix --;
01426          }
01427 
01428       ix = CGN_NINT( xypos[0] );
01429       iend = ifram[1];
01430       source = p_img[ix-1 + kk] - bgval;
01431       while ( source > clip && ix <= iend )
01432          {
01433          ifram[1] = ix;
01434          source = p_img[ix-1 + kk] -bgval;
01435          ix ++;
01436          } 
01437 
01438       ix = CGN_NINT( xypos[0] );
01439       istr = ifram[2];
01440       source = p_img[ix-1 + kk] - bgval;
01441       while ( source > clip && iy >= istr )
01442          {
01443          ifram[2] = iy;
01444          source = p_img[ix-1 + (*npix *(iy-1))] -bgval;
01445          iy --;
01446          }
01447 
01448       iy = CGN_NINT( xypos[1] );
01449       iend = ifram[3];
01450       source = p_img[ix-1 + kk] - bgval;
01451       while ( source > clip && iy <= iend )
01452          {
01453          ifram[3] = iy;
01454          source = p_img[ix-1 + (*npix *(iy-1))] -bgval;
01455          iy++;
01456          }
01457       nrx = ifram[1] - ifram[0] + 1;
01458       nry = ifram[3] - ifram[2] + 1;
01459       }
01460 
01461    istat = 3;                /* iteration failed */
01462 
01463 end_of_iter:
01464    xypos[0] --;
01465    xypos[1] --;
01466    }
01467 
01468 
01469 /* GAUSSIAN centering */
01470 
01471 else
01472    {
01473    register int ii;
01474    int    found, ierr, xlim[2], ylim[2], lnew[2];
01475    float  lamda, xcent, ycent, xwidth, ywidth;
01476    double chisqr, oldchi, sigma, *krx, *kry, *gfit, *xpos, *yfit, 
01477           gpar[MAXPAR];
01478 
01479 
01480    /* construct two marginal distibutions (in pixel coordinates!) */
01481 
01482    lnew[0] = (nry / 4);        /* in C notation, from 0 ...  */
01483    lnew[1] = nry - (nry / 4) - 1;
01484 
01485 
01486 /* Take care of 1-dim case */
01487 
01488    if (nry == 1)     
01489       {
01490       krx = (double *) cpl_calloc(nrx , sizeof(double));
01491       Crhox(p_img,npix,image,lnew,krx); 
01492       ierr = Cserch(krx,nrx,IGNORE,xlim,xlim+1,&xcent,&xwidth);
01493 
01494       /* store the data of the fit */
01495 
01496       nval = xlim[1] - xlim[0] + 1;
01497       xpos = (double *) cpl_calloc( nval , sizeof( double ));
01498       yfit = (double *) cpl_calloc( nval , sizeof( double ));
01499       gfit = (double *) cpl_calloc( nval , sizeof( double ));
01500       for (ii=0; ii<nval; ii++)
01501          {
01502          xpos[ii] = xlim[0] + ii;
01503          yfit[ii] = krx[xlim[0] + ii];
01504           }
01505 
01506       /* set parameters for LSQFIT (old FITINTE) */
01507 
01508       lamda = 0.001;
01509       chisqr = GCHIMAX;
01510       gpar[0] = krx[CGN_NINT(xcent)];
01511       gpar[1] = xcent;
01512       gpar[2] = xwidth;
01513       gpar[3] = (krx[xlim[0]] + krx[xlim[1]]) / 2;
01514       (void) cpl_free( (char *) krx );
01515 
01516       it = 0;
01517       found = FALSE;
01518       while ( ! found && it++ < GMXITER )
01519          {
01520          oldchi = chisqr;
01521          ierr = LSQFIT(xpos,yfit,nval,gpar,&lamda,gfit,&chisqr,&sigma);
01522          if ( ierr != 0 ) 
01523             {
01524             found = NOCONV;
01525             istat = 3;
01526             }
01527          else if ( (oldchi - chisqr)/ chisqr < GCHIFND ) 
01528             found = TRUE;
01529          }
01530 
01531       /* Is the source still in the image and has it a resonable shape? */
01532 
01533       lamda = 0.0;
01534       ierr = LSQFIT(xpos,yfit,nval,gpar,&lamda,gfit,&chisqr,&sigma);
01535       if ( ierr != 0 )
01536          {
01537          found = NOCONV;
01538          istat = 3;
01539          }
01540       else
01541          {
01542          sumi = (float)(gpar[1] + image[0]);
01543          indx = CGN_NINT(sumi);
01544          if ( indx < 0 || indx >= *npix )
01545             {
01546             found = OUTSIDE;
01547             istat = 2;
01548             }
01549          }
01550       (void) cpl_free( (char *) xpos );
01551       (void) cpl_free( (char *) yfit );
01552       (void) cpl_free( (char *) gfit );
01553 
01554       if ( found == TRUE )
01555          {
01556          xypos[0] = sumi;
01557          xypos[1] = 0;
01558          xysig[0] = (float) gpar[2];
01559          xyerr[0] = (float) sqrt( sigma * chisqr );
01560          indx = CGN_NINT( xypos[0]);
01561          *xyval = p_img[indx];
01562          }
01563       }
01564 
01565 
01566 /* Take care of 2-dim case */
01567 
01568    else
01569       {
01570       krx = (double *) cpl_calloc( nrx , sizeof( double ));
01571       kry = (double *) cpl_calloc( nry , sizeof( double ));
01572 
01573       /* Compute and search X-marginal & Y-marginal */
01574 
01575       Crhox( p_img, npix, image, lnew, krx ); 
01576       ierr = Cserch( krx, nrx, IGNORE, xlim, xlim+1, &xcent, &xwidth );
01577       lnew[0] = MYMAX( xlim[0], CGN_NINT(xcent - (2 * xwidth)));
01578       lnew[1] = MYMIN( xlim[1], CGN_NINT(xcent + (2 * xwidth)));
01579 
01580       Crhoy( p_img, npix, image, lnew, kry ); 
01581       ierr = Cserch( kry, nry, IGNORE, ylim, ylim+1, &ycent, &ywidth );
01582       lnew[0] = MYMAX( ylim[0], CGN_NINT(ycent - (2 * ywidth)));
01583       lnew[1] = MYMIN( ylim[1], CGN_NINT(ycent + (2 * ywidth)));
01584 
01585       Crhox( p_img, npix, image, lnew, krx ); 
01586       ierr = Cserch( krx, nrx, IGNORE, xlim, xlim+1, &xcent, &xwidth );
01587       lnew[0] = MYMAX( xlim[0], CGN_NINT(xcent - (2 * xwidth)));
01588       lnew[1] = MYMIN( xlim[1], CGN_NINT(xcent + (2 * xwidth)));
01589 
01590       Crhoy( p_img, npix, image, lnew, kry ); 
01591       ierr = Cserch( kry, nry, IGNORE, ylim, ylim+1, &ycent, &ywidth );
01592 
01593       /* fit a gaussian to the source along the X-axis */
01594 
01595       nval = xlim[1] - xlim[0] + 1;
01596       xpos = (double *) cpl_calloc( nval , sizeof( double ));
01597       yfit = (double *) cpl_calloc( nval , sizeof( double ));
01598       gfit = (double *) cpl_calloc( nval , sizeof( double ));
01599       for (ii=0; ii<nval; ii++)
01600          {
01601          xpos[ii] = xlim[0] + ii;
01602          yfit[ii] = krx[xlim[0] + ii];
01603         }
01604 
01605       /* set parameters for LSQFIT */
01606 
01607       lamda = 0.001;
01608       chisqr = GCHIMAX;
01609       gpar[0] = krx[CGN_NINT( xcent )];
01610       gpar[1] = xcent;
01611       gpar[2] = xwidth;
01612       gpar[3] = (krx[xlim[0]] + krx[xlim[1]]) / 2;
01613       (void) cpl_free( ( char *) krx );
01614 
01615       it = 0;
01616       found = FALSE;
01617       while ( ! found && it++ < GMXITER )
01618          { 
01619          oldchi = chisqr;
01620          ierr = LSQFIT(xpos,yfit,nval,gpar,&lamda,gfit,&chisqr,&sigma);
01621          if ( ierr != 0 || gpar[2] <= 0.0 ) 
01622             {
01623             found = NOCONV;
01624             istat = 3;
01625             }
01626          else if ( (oldchi - chisqr)/ chisqr < GCHIFND ) 
01627             found = TRUE;
01628          }
01629 
01630       /* Is the source still in the image and has it a resonable shape? */
01631 
01632       lamda = 0.0;
01633       ierr = LSQFIT(xpos,yfit,nval,gpar,&lamda,gfit,&chisqr,&sigma);
01634       if ( ierr != 0 )
01635          {
01636          found = NOCONV;
01637          istat = 3;
01638          }
01639       else
01640          {
01641          sumi = (float)(gpar[1] + image[0]);
01642          indx = CGN_NINT(sumi);
01643          if ( indx < 0 || indx >= *npix ) 
01644             {
01645             found = OUTSIDE; 
01646             istat = 2;
01647             }
01648          }
01649 
01650       (void) cpl_free( (char *) xpos );
01651       (void) cpl_free( (char *) yfit );
01652       (void) cpl_free( (char *) gfit );
01653 
01654       if ( found == TRUE )
01655          {
01656          xypos[0] = sumi;
01657          xysig[0] = (float) gpar[2];
01658          xyerr[0] = (float) sqrt( sigma * chisqr );
01659 
01660          /* x-dir o.k. - now fit a gaussian to the source along the Y-axis */
01661 
01662          nval = ylim[1] - ylim[0] + 1;
01663          xpos = (double *) cpl_calloc( nval , sizeof( double ));
01664          yfit = (double *) cpl_calloc( nval , sizeof( double ));
01665          gfit = (double *) cpl_calloc( nval , sizeof( double ));
01666 
01667          for (ii=0; ii<nval; ii++)
01668             {
01669             xpos[ii] = ylim[0] + ii;
01670             yfit[ii] = kry[ylim[0] + ii]; 
01671             }
01672 
01673          /* set parameters for LSQFIT */
01674 
01675          lamda = 0.001;
01676          chisqr = GCHIMAX;
01677          gpar[0] = kry[CGN_NINT( ycent )];     
01678          gpar[1] = ycent;
01679          gpar[2] = ywidth;
01680          gpar[3] = (kry[ylim[0]] + kry[ylim[1]]) / 2;
01681 
01682          it = 0;
01683          found = FALSE;
01684          while ( ! found && it++ < GMXITER )
01685             {
01686             oldchi = chisqr;
01687             ierr = LSQFIT(xpos,yfit,nval,gpar,&lamda,gfit,&chisqr,&sigma );
01688             if ( ierr != 0 || gpar[2] <= 0.0 ) 
01689                {
01690                found = NOCONV;
01691                istat = 3;
01692                }
01693             else if ( (oldchi - chisqr)/ chisqr < GCHIFND ) 
01694                found = TRUE;
01695             }
01696 
01697          /* Is the source still in the image and has it a resonable shape? */
01698 
01699          lamda = 0.0;
01700          ierr = LSQFIT(xpos,yfit,nval,gpar,&lamda,gfit,&chisqr,&sigma);
01701          if ( ierr != 0 ) 
01702             {
01703             found = NOCONV;
01704             istat = 3;
01705             }
01706          else
01707             {
01708             indx = CGN_NINT(xypos[0]);
01709             sumi = (float) (gpar[1] + image[2]);
01710             indy = CGN_NINT(sumi);
01711             if ( indy < 0 || indy >= npix[1] ) 
01712                {
01713                found = OUTSIDE; 
01714                istat = 2;
01715                }
01716             else
01717                indx += (*npix) * indy;
01718             }
01719          (void) cpl_free( (char *) xpos );
01720          (void) cpl_free( (char *) yfit );
01721          (void) cpl_free( (char *) gfit );
01722 
01723          if ( found == TRUE )
01724             {
01725             xypos[1] = sumi;
01726             xysig[1] = (float) gpar[2];
01727             xyerr[1] = (float) sqrt( sigma * chisqr );
01728             *xyval = p_img[indx];
01729             }
01730          }
01731       (void) cpl_free( ( char *) kry );
01732       }
01733    }
01734 
01735 return istat;
01736 }

Generated on 9 Mar 2012 for UVES Pipeline Reference Manual by  doxygen 1.6.1