89 #include "uves_physmod_cstacen.h"
98 #define _POSIX_SOURCE 1
103 #define PI 3.14159265358979325e0
114 #define MINVAL 1.0e-37
116 #define SMALL 1.0e-20
126 #define GCHIMAX 5.0e+16
127 #define GCHIFND 0.005
130 #define MYMIN(a,b) ((a) > (b) ? (b) : (a))
131 #define MYMAX(a,b) ((b) > (a) ? (b) : (a))
189 float* xout,
float* yout,
float* xerr,
float* yerr,
190 float* xsig,
float* ysig,
float* xyval,
int* stat )
193 int npix[2], imap[4];
194 float xypos[2], xyerr[2], xysig[2];
199 imap[0] = image[0] - 1;
200 imap[1] = image[1] - 1;
201 imap[2] = image[2] - 1;
202 imap[3] = image[3] - 1;
211 *xout = xypos[0] + 1;
212 *yout = xypos[1] + 1;
235 res = (a) > 0 ? floor(a+0.5) : -floor(a-0.5);
269 static int Ckapsig(
float *val,
int nval,
int iter,
float akap,
270 float *cons,
float *rms,
int *npts )
288 if ( nval < 2 )
return (-1);
294 for (ii=0; ii<nval; ii++) mean += val[ii];
295 mean /= (float) (nval);
301 vsq = (
float *) cpl_calloc( nval,
sizeof(
float ));
304 for (ii=0; ii<nval; ii++)
306 vsq[ii] = val[ii] * val[ii];
307 delv = MYMAX( 0.0, vsq[ii] + msq - (2.0 * mean * val[ii]));
311 *rms = (float) sqrt( MYMAX( MINVAL, dels / (nval-1)));
312 clip = akap * (*rms);
318 for (it=0; it<iter; it++)
324 for ( ii = 0; ii < nval; ii++ )
326 if ( fabs( val[ii] - mean ) < (double) clip )
329 delv = MYMAX( 0.0, vsq[ii] + msq - 2.0 * mean * val[ii]);
335 if ( nr <= 2 || nr == nr_old )
goto end_of_it;
341 *rms = (float) sqrt( MYMAX( MINVAL, dels / (nr-1)));
373 static int MATINV(
double (*matrix)[MAXPAR],
int nfree )
389 for ( ii = 0; ii < nfree; ii++ ) per[ii] = ii;
391 for ( jj = 0; jj < nfree; jj++ )
393 rowmax = fabs( matrix[jj][jj] );
395 for ( ii = jj + 1; ii < nfree; ii++ )
397 if ( fabs( matrix[ii][jj] ) > rowmax )
399 rowmax = fabs( matrix[ii][jj] );
404 if (fabs(matrix[row][jj]) < SMALL)
409 for ( kk = 0; kk < nfree; kk++ )
411 even = matrix[jj][kk];
412 matrix[jj][kk] = matrix[row][kk];
413 matrix[row][kk] = even;
420 even = 1.0 / matrix[jj][jj];
421 for (ii=0; ii<nfree; ii++)
422 matrix[ii][jj] *= even;
423 matrix[jj][jj] = even;
424 for (kk=0; kk<jj; kk++)
426 mjk = matrix[jj][kk];
427 for ( ii = 0; ii < jj; ii++ )
428 matrix[ii][kk] -= matrix[ii][jj] * mjk;
429 for ( ii = jj + 1; ii < nfree; ii++ )
430 matrix[ii][kk] -= matrix[ii][jj] * mjk;
431 matrix[jj][kk] = -even * mjk;
434 for ( kk = jj + 1; kk < nfree; kk++ )
436 mjk = matrix[jj][kk];
437 for ( ii = 0; ii < jj; ii++ )
438 matrix[ii][kk] -= matrix[ii][jj] * mjk;
439 for ( ii = jj + 1; ii < nfree; ii++ )
440 matrix[ii][kk] -= matrix[ii][jj] * mjk;
441 matrix[jj][kk] = -even * mjk;
445 for ( ii = 0; ii < nfree; ii++ )
447 for ( kk = 0; kk < nfree; kk++ )
449 hv[per[kk]] = matrix[ii][kk];
451 for ( kk = 0; kk < nfree; kk++)
453 matrix[ii][kk] = hv[kk];
485 t = 1.0 / (1.0 + (0.5 * z));
503 zz = -z * z - 1.26551223 + t * ( 1.00002368 + t *
504 ( 0.37409196 + t * ( 0.09678418 + t *
505 (-0.18628806 + t * ( 0.27886807 + t *
506 (-1.13520398 + t * ( 1.48851587 + t *
507 (-0.82215223 + t * 0.17087277 ))))))));
518 return (xx >= 0.0 ? ans : 2.0 - ans);
533 static double GAUSFU(
double xx,
double *gpar )
539 static int init = TRUE;
540 static double sqrt_2;
546 sqrt_2 = sqrt( 2.0 );
547 rc1 = sqrt(PI)/sqrt_2;
551 rc = 1.0 / (sqrt_2 * gpar[2]);
553 dd =
ERFCC(rc * (dd - 0.5)) -
ERFCC(rc * (dd + 0.5));
554 return ( gpar[3] + rc1 * gpar[0] * gpar[2] * dd );
571 static void GAUSDE(
double xdat,
double *gpar,
double *deriv )
581 static double sqrt_2;
584 static int init = TRUE;
589 sqrt_2 = sqrt( 2.0 );
593 temp = sqrt_2 * gpar[2];
594 tempp = xdat - gpar[1];
595 x1 = (tempp - 0.5) / temp;
596 x2 = (tempp + 0.5) / temp;
597 zz = tempp / gpar[2] ;
599 if ( ((zz * zz) - 50.0) < 0.0 )
601 deriv[0] = (
GAUSFU( xdat, gpar ) - gpar[3]) / gpar[0];
613 deriv[1] = gpar[0] * dv2;
619 deriv[2] = deriv[1] * zz;
622 for (jj=0; jj<3; jj++) deriv[jj] = 0.0;
645 static float FCHIS(
double *data,
int ndim,
int nfree,
int mode,
double *dfit) {
658 for (ii=0; ii<ndim; ii++)
663 weight = -1. / *data;
664 else if ( *data == 0 )
672 diff = (*data) - (*dfit);
674 chisq += weight * diff * diff;
676 return (chisq / nfree);
711 static int LSQFIT(
double *xdat,
double *data,
int ndim,
712 double *gpar,
float *lamda,
double *dfit,
713 double *chisqr,
double *sigma )
725 double b[MAXPAR], beta[MAXPAR], deriv[MAXPAR],
726 array[MAXPAR][MAXPAR], alpha[MAXPAR][MAXPAR];
729 nfree = ndim - MAXPAR;
731 if ( nfree < 1 || fabs( (
double) *gpar ) < SMALL )
return (1);
736 for (ii=0; ii<MAXPAR; ii++)
739 for (jj=0; jj<=ii; jj++) alpha[ii][jj] = 0.0;
742 for (ii=0; ii<ndim; ii++)
744 GAUSDE( xdat[ii], gpar, deriv );
746 for (jj=0; jj<MAXPAR; jj++)
748 beta[jj] += (data[ii] -
GAUSFU( xdat[ii], gpar )) * deriv[jj];
749 for (kk=0; kk<=jj; kk++)
750 alpha[jj][kk] += deriv[jj] * deriv[kk];
754 for (ii=0; ii<MAXPAR; ii++)
756 for (jj=0; jj<=ii; jj++)
757 alpha[jj][ii] = alpha[ii][jj];
765 if (
MATINV(alpha,MAXPAR) == 1)
return (2);
767 *sigma = MYMAX( 0.0, alpha[1][1] );
772 for (ii=0; ii<ndim; ii++)
773 dfit[ii] =
GAUSFU( xdat[ii], gpar );
775 chisq1 =
FCHIS( data, ndim, nfree, 0, dfit );
779 for ( jj = 0; jj < MAXPAR; jj++ )
781 for ( kk = 0; kk < MAXPAR; kk++ )
783 if (fabs( alpha[jj][jj] ) < 1.e-15 || fabs( alpha[kk][kk] ) < 1.e-15)
785 array[jj][kk] = alpha[jj][kk] /
786 sqrt( alpha[jj][jj] * alpha[kk][kk] ) ;
788 array[jj][jj] = 1.0 + *lamda;
791 (void)
MATINV( array, MAXPAR );
793 for ( jj = 0; jj < MAXPAR; jj++ )
796 for ( kk = 0; kk < MAXPAR ; kk++ )
798 b[jj] += beta[kk] * array[jj][kk] /
799 sqrt( alpha[jj][jj] * alpha[kk][kk] );
805 for (ii=0; ii<ndim; ii++)
806 dfit[ii] =
GAUSFU( xdat[ii], b );
808 *chisqr =
FCHIS( data, ndim, nfree, 0, dfit );
810 if ( chisq1 - *chisqr < 0.0 )
821 for (jj=0; jj<MAXPAR; jj++) gpar[jj] = b[jj];
849 static void Crhox(
float *p_img,
int *npix,
int *image,
850 int *lnew,
double *krx )
853 register int nxdim=0;
885 nrx = image[1] - image[0] + 1;
886 nry = lnew[1] - lnew[0] + 1;
888 p_img += nxdim * (image[2] + lnew[0]);
890 for (ix=0; ix<nrx; ix++)
893 for (iy=0; iy<nry*nxdim; iy+=nxdim) sum += p_img[iy];
921 static void Crhoy(
float *p_img,
int *npix,
int *image,
922 int *lnew,
double *kry )
925 register int nxdim=0;
956 nrx = lnew[1] - lnew[0] + 1;
957 nry = image[3] - image[2] + 1;
959 p_img += (nxdim * image[2]) + (image[0] + lnew[0]);
961 for (iy=0; iy<nry; iy++)
964 for (ix=0; ix<nrx; ix++) sum += p_img[ix];
994 static int Cserch(
double *marg,
int ndim,
int ign,
995 int *lmin,
int *lmax,
float *s_cent,
float *s_width )
1018 iend = ndim - ign -1;
1022 work = (
double *) cpl_calloc( ndim ,
sizeof(
double ));
1029 for (ii = ibgn; ii < iend; ii++ )
1031 diff = marg[ii+1] - marg[ii-1];
1032 work[ii] = marg[ii+2] - marg[ii-2] + (2 * diff);
1033 if ( work[ii] >= drmx )
1051 if ( ndim - imax > imin )
1055 for ( ii = imax+1; ii < iend; ii++ )
1057 if ( work[ii] < drmn )
1068 for ( ii = ibgn; ii < imin; ii++ )
1070 if ( work[ii] >= drmx )
1082 *s_cent = ((float)(imax + imin)) * 0.5;
1083 *s_width = imin - imax;
1086 for ( ii = imax; ii <= imin; ii++ ) sum += work[ii];
1089 if ( fabs(diff) > SMALL)
1091 dxk = sum * *s_width / ( (*s_width+1.0)*diff );
1101 else if (indx >= ndim)
1103 *s_cent = (float)(ndim-1);
1112 if (ql < 2)
goto next_step;
1116 if (ql <= 0 )
goto next_step;
1117 if (ql == 1)
goto lo5;
1118 if (ql == 2)
goto lo4;
1119 if (ql == 3)
goto lo3;
1121 if (marg[ql] > marg[ql-4])
goto low_loop;
1123 if (marg[ql] > marg[ql-3])
goto low_loop;
1125 if (marg[ql] > marg[ql-2])
goto low_loop;
1127 if (marg[ql] > marg[ql-1])
goto low_loop;
1138 if (ii < 3)
goto end_of_it;
1143 if (ii == 1 )
goto end_of_it;
1144 if (ii == 2)
goto hi5;
1145 if (ii == 3)
goto hi4;
1146 if (ii == 4)
goto hi3;
1148 if (marg[ql] > marg[ql+4])
goto hi_loop;
1150 if (marg[ql] > marg[ql+3])
goto hi_loop;
1152 if (marg[ql] > marg[ql+2])
goto hi_loop;
1154 if (marg[ql] > marg[ql+1])
goto hi_loop;
1158 (void) cpl_free( (
char *) work );
1209 float* xypos,
float* xyerr,
float* xysig,
float* xyval )
1242 for (ix=0; ix<4; ix++)
1243 ifram[ix] = image[ix] + 1;
1244 nrx = ifram[1] - ifram[0] + 1;
1245 nry = ifram[3] - ifram[2] + 1;
1247 xypos[0] = (ifram[0] + ifram[1]) * 0.5;
1248 xypos[1] = (ifram[2] + ifram[3]) * 0.5;
1249 xyerr[0] = xyerr[1] = 0.0;
1250 xysig[0] = xysig[1] = 0.0;
1255 if ( meth !=
'G' && meth !=
'g' )
1261 p_img += (ifram[0] - 1) + (npix[0] * (ifram[2] - 1));
1267 nval = (2 * nrx) + (2 * (nry-2));
1268 p_edge = (
float *) cpl_calloc( nval ,
sizeof(
float ));
1270 for (ix=0; ix<nrx;ix++)
1271 *p_edge++ = p_img[ix];
1274 for (iy=0; iy<(nry-2); iy++)
1276 *p_edge++ = p_img[0];
1277 *p_edge++ = p_img[nrx - 1];
1280 for (ix=0; ix<nrx; ix++) *p_edge++ = p_img[ix];
1285 p_edge = (
float *) cpl_calloc( nval ,
sizeof(
float ));
1287 for (ix=0; ix<nrx;ix++)
1288 *p_edge++ = p_img[ix];
1294 (void)
Ckapsig( p_edge, nval, 5, 2.0, &bgval, &rms, &bgnr );
1295 (void) cpl_free( (
char *) p_edge );
1302 for (it=0; it<MMXITER; it++)
1304 sumi = xmom = ymom = 0.0;
1305 p_img += ifram[0] - 1 + (npix[0] * (ifram[2] - 1));
1306 for (iy=0; iy<nry; iy++)
1308 for (ix=0; ix<nrx; ix++)
1310 if ( (source = p_img[ix] - bgval) > clip )
1313 xmom += source * (ifram[0] + ix);
1314 ymom += source * (ifram[2] + iy);
1321 if ((nrx < 3) || (nry < 3))
1328 xypos[0] = xmom / sumi;
1329 xypos[1] = ymom / sumi;
1334 xypos[0] = (ifram[0] + ifram[1]) * 0.5;
1335 xypos[1] = (ifram[2] + ifram[3]) * 0.5;
1339 *xyval = p_img[indx + ((*npix) * indy)];
1345 xypos[0] = xmom / sumi;
1346 xypos[1] = ymom / sumi;
1350 if ( xold == xypos[0] && yold == xypos[1] )
1353 double xdif, ydif, xrms, yrms;
1355 xrms = yrms = sumi = 0.0;
1356 p_img += ifram[0] - 1 + (npix[0] * (ifram[2] - 1));
1357 for (iy=0; iy<nry; iy++ )
1359 for (ix=0; ix<nrx; ix++)
1361 if ( (source = p_img[ix] - bgval) > clip )
1363 xdif = (ifram[0] + ix) - xypos[0];
1364 ydif = (ifram[2] + iy) - xypos[1];
1365 xrms += fabs( source * xdif *xdif );
1366 yrms += fabs( source * ydif *ydif );
1376 *xyval = p_img[indx];
1377 xysig[0] = (float) sqrt(xrms /(sumi+ *xyval - bgval));
1378 xysig[1] = (float) sqrt(yrms /(sumi+ *xyval - bgval));
1379 xyerr[0] = (float) (xysig[0] / sqrt( (
double) (nr - 1)));
1380 xyerr[1] = (float) (xysig[1] / sqrt( (
double) (nr - 1)));
1391 xypos[0] = (ifram[0] + ifram[1]) * 0.5;
1392 xypos[1] = (ifram[2] + ifram[3]) * 0.5;
1395 *xyval = p_img[indx + ((*npix) * indy)];
1403 if ( (*xyval = p_img[indx] - bgval) <= clip )
1405 xysig[0] = xysig[1] = 0.0;
1415 kk = npix[0] * (iy - 1);
1417 source = p_img[ix-1 + kk] - bgval;
1418 while ( source > clip && ix >= istr )
1421 source = p_img[ix-1 + kk] - bgval;
1427 source = p_img[ix-1 + kk] - bgval;
1428 while ( source > clip && ix <= iend )
1431 source = p_img[ix-1 + kk] -bgval;
1437 source = p_img[ix-1 + kk] - bgval;
1438 while ( source > clip && iy >= istr )
1441 source = p_img[ix-1 + (*npix *(iy-1))] -bgval;
1447 source = p_img[ix-1 + kk] - bgval;
1448 while ( source > clip && iy <= iend )
1451 source = p_img[ix-1 + (*npix *(iy-1))] -bgval;
1454 nrx = ifram[1] - ifram[0] + 1;
1455 nry = ifram[3] - ifram[2] + 1;
1471 int found, ierr, xlim[2], ylim[2], lnew[2];
1472 float lamda, xcent, ycent, xwidth, ywidth;
1473 double chisqr, oldchi, sigma, *krx, *kry, *gfit, *xpos, *yfit,
1479 lnew[0] = (nry / 4);
1480 lnew[1] = nry - (nry / 4) - 1;
1487 krx = (
double *) cpl_calloc(nrx ,
sizeof(
double));
1488 Crhox(p_img,npix,image,lnew,krx);
1489 ierr =
Cserch(krx,nrx,IGNORE,xlim,xlim+1,&xcent,&xwidth);
1493 nval = xlim[1] - xlim[0] + 1;
1494 xpos = (
double *) cpl_calloc( nval ,
sizeof(
double ));
1495 yfit = (
double *) cpl_calloc( nval ,
sizeof(
double ));
1496 gfit = (
double *) cpl_calloc( nval ,
sizeof(
double ));
1497 for (ii=0; ii<nval; ii++)
1499 xpos[ii] = xlim[0] + ii;
1500 yfit[ii] = krx[xlim[0] + ii];
1510 gpar[3] = (krx[xlim[0]] + krx[xlim[1]]) / 2;
1511 (void) cpl_free( (
char *) krx );
1515 while ( ! found && it++ < GMXITER )
1518 ierr =
LSQFIT(xpos,yfit,nval,gpar,&lamda,gfit,&chisqr,&sigma);
1524 else if ( (oldchi - chisqr)/ chisqr < GCHIFND )
1531 ierr =
LSQFIT(xpos,yfit,nval,gpar,&lamda,gfit,&chisqr,&sigma);
1539 sumi = (float)(gpar[1] + image[0]);
1541 if ( indx < 0 || indx >= *npix )
1547 (void) cpl_free( (
char *) xpos );
1548 (void) cpl_free( (
char *) yfit );
1549 (void) cpl_free( (
char *) gfit );
1551 if ( found == TRUE )
1555 xysig[0] = (float) gpar[2];
1556 xyerr[0] = (float) sqrt( sigma * chisqr );
1558 *xyval = p_img[indx];
1567 krx = (
double *) cpl_calloc( nrx ,
sizeof(
double ));
1568 kry = (
double *) cpl_calloc( nry ,
sizeof(
double ));
1572 Crhox( p_img, npix, image, lnew, krx );
1573 ierr =
Cserch( krx, nrx, IGNORE, xlim, xlim+1, &xcent, &xwidth );
1574 lnew[0] = MYMAX( xlim[0],
CGN_NINT(xcent - (2 * xwidth)));
1575 lnew[1] = MYMIN( xlim[1],
CGN_NINT(xcent + (2 * xwidth)));
1577 Crhoy( p_img, npix, image, lnew, kry );
1578 ierr =
Cserch( kry, nry, IGNORE, ylim, ylim+1, &ycent, &ywidth );
1579 lnew[0] = MYMAX( ylim[0],
CGN_NINT(ycent - (2 * ywidth)));
1580 lnew[1] = MYMIN( ylim[1],
CGN_NINT(ycent + (2 * ywidth)));
1582 Crhox( p_img, npix, image, lnew, krx );
1583 ierr =
Cserch( krx, nrx, IGNORE, xlim, xlim+1, &xcent, &xwidth );
1584 lnew[0] = MYMAX( xlim[0],
CGN_NINT(xcent - (2 * xwidth)));
1585 lnew[1] = MYMIN( xlim[1],
CGN_NINT(xcent + (2 * xwidth)));
1587 Crhoy( p_img, npix, image, lnew, kry );
1588 ierr =
Cserch( kry, nry, IGNORE, ylim, ylim+1, &ycent, &ywidth );
1592 nval = xlim[1] - xlim[0] + 1;
1593 xpos = (
double *) cpl_calloc( nval ,
sizeof(
double ));
1594 yfit = (
double *) cpl_calloc( nval ,
sizeof(
double ));
1595 gfit = (
double *) cpl_calloc( nval ,
sizeof(
double ));
1596 for (ii=0; ii<nval; ii++)
1598 xpos[ii] = xlim[0] + ii;
1599 yfit[ii] = krx[xlim[0] + ii];
1609 gpar[3] = (krx[xlim[0]] + krx[xlim[1]]) / 2;
1610 (void) cpl_free( (
char *) krx );
1614 while ( ! found && it++ < GMXITER )
1617 ierr =
LSQFIT(xpos,yfit,nval,gpar,&lamda,gfit,&chisqr,&sigma);
1618 if ( ierr != 0 || gpar[2] <= 0.0 )
1623 else if ( (oldchi - chisqr)/ chisqr < GCHIFND )
1630 ierr =
LSQFIT(xpos,yfit,nval,gpar,&lamda,gfit,&chisqr,&sigma);
1638 sumi = (float)(gpar[1] + image[0]);
1640 if ( indx < 0 || indx >= *npix )
1647 (void) cpl_free( (
char *) xpos );
1648 (void) cpl_free( (
char *) yfit );
1649 (void) cpl_free( (
char *) gfit );
1651 if ( found == TRUE )
1654 xysig[0] = (float) gpar[2];
1655 xyerr[0] = (float) sqrt( sigma * chisqr );
1659 nval = ylim[1] - ylim[0] + 1;
1660 xpos = (
double *) cpl_calloc( nval ,
sizeof(
double ));
1661 yfit = (
double *) cpl_calloc( nval ,
sizeof(
double ));
1662 gfit = (
double *) cpl_calloc( nval ,
sizeof(
double ));
1664 for (ii=0; ii<nval; ii++)
1666 xpos[ii] = ylim[0] + ii;
1667 yfit[ii] = kry[ylim[0] + ii];
1677 gpar[3] = (kry[ylim[0]] + kry[ylim[1]]) / 2;
1681 while ( ! found && it++ < GMXITER )
1684 ierr =
LSQFIT(xpos,yfit,nval,gpar,&lamda,gfit,&chisqr,&sigma );
1685 if ( ierr != 0 || gpar[2] <= 0.0 )
1690 else if ( (oldchi - chisqr)/ chisqr < GCHIFND )
1697 ierr =
LSQFIT(xpos,yfit,nval,gpar,&lamda,gfit,&chisqr,&sigma);
1706 sumi = (float) (gpar[1] + image[2]);
1708 if ( indy < 0 || indy >= npix[1] )
1714 indx += (*npix) * indy;
1716 (void) cpl_free( (
char *) xpos );
1717 (void) cpl_free( (
char *) yfit );
1718 (void) cpl_free( (
char *) gfit );
1720 if ( found == TRUE )
1723 xysig[1] = (float) gpar[2];
1724 xyerr[1] = (float) sqrt( sigma * chisqr );
1725 *xyval = p_img[indx];
1728 (void) cpl_free( (
char *) kry );