GIRAFFE Pipeline Reference Manual

gimath_lm.c
1 /* $Id$
2  *
3  * This file is part of the GIRAFFE Pipeline
4  * Copyright (C) 2002-2006 European Southern Observatory
5  *
6  * This program is free software; you can redistribute it and/or modify
7  * it under the terms of the GNU General Public License as published by
8  * the Free Software Foundation; either version 2 of the License, or
9  * (at your option) any later version.
10  *
11  * This program is distributed in the hope that it will be useful,
12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14  * GNU General Public License for more details.
15  *
16  * You should have received a copy of the GNU General Public License
17  * along with this program; if not, write to the Free Software
18  * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
19  */
20 
21 /*
22  * $Author$
23  * $Date$
24  * $Revision$
25  * $Name$
26  */
27 
28 #ifdef HAVE_CONFIG_H
29 # include <config.h>
30 #endif
31 
32 #include <stdlib.h>
33 #include <stdio.h>
34 #include <math.h>
35 
36 #include <cxmemory.h>
37 #include <cxmessages.h>
38 
39 #include "gimacros.h"
40 #include "gimath.h"
41 #include "gimath_lm.h"
42 #include "gimessages.h"
43 
58 #define SWAP(a,b) {swap=(a);(a)=(b);(b)=swap;}
59 
60 
68 lmrq_model lmrq_models[] = {
69  {LMRQ_GAUSSUM, mrqgaussum, 4, 1, "gaussum", LINE_MODEL},
70  {LMRQ_XOPTMOD, mrqxoptmod, 7, 3, "xoptmod", XOPT_MODEL},
71  {LMRQ_XOPTMODGS, mrqxoptmodGS, 7, 3, "xoptmodGS", XOPT_MODEL},
72  {LMRQ_XOPTMOD2, mrqxoptmod2, 10, 3, "xoptmod2", XOPT_MODEL},
73  {LMRQ_PSFCOS, mrqpsfcos, 5, 1, "psfcos", LINE_MODEL},
74  {LMRQ_PSFEXP, mrqpsfexp, 5, 1, "psfexp", LINE_MODEL},
75  {LMRQ_YOPTMOD, mrqyoptmod, 7, 3, "yoptmod", YOPT_MODEL},
76  {LMRQ_YOPTMOD2, mrqyoptmod2, 10, 3, "yoptmod2", YOPT_MODEL},
77  {LMRQ_LOCYWARP, mrqlocywarp, 5, 4, "locywarp", LOCY_MODEL},
78  {LMRQ_PSFEXP2, mrqpsfexp2, 5, 1, "psfexp2", LINE_MODEL},
79  {LMRQ_TEST, mrqtest, 2, 1, "test", LINE_MODEL}
80 };
81 
82 cxint nr_lmrq_models = CX_N_ELEMENTS(lmrq_models);
83 
84 
101 static void
102 covariance_sort(cpl_matrix *covar, cxint ma, cxint ia[], cxint mfit)
103 {
104 
105  register cxint i, j, k;
106  register cxdouble swap;
107 
108  cxdouble *pd_covar = NULL;
109  cxint nr_covar;
110 
111  pd_covar = cpl_matrix_get_data(covar);
112  nr_covar = cpl_matrix_get_nrow(covar);
113 
114  for (i = mfit; i < ma; i++)
115  for (j = 0; j <= i; j++)
116  pd_covar[i * nr_covar + j] = pd_covar[j * nr_covar + i] = 0.0;
117 
118  k = mfit - 1;
119  for (j = (ma-1); j >= 0; j--) {
120  if (ia[j]) {
121  for (i = 0; i < ma; i++)
122  SWAP(pd_covar[i * nr_covar + k],pd_covar[i * nr_covar + j])
123 
124  for (i = 0;i < ma; i++)
125  SWAP(pd_covar[k * nr_covar + i],pd_covar[j * nr_covar + i])
126 
127  k--;
128  }
129  }
130 
131 } /* end covariance_sort() */
132 
133 #undef SWAP
134 
161 static double
162 mrqdydaweight(cxdouble x, cxdouble x0, cxdouble dx)
163 {
164  register cxdouble w;
165 
166  w = exp(-pow(fabs(x-x0),DW_DEGREE)/pow(dx,DW_DEGREE/DW_LOG001));
167 
168  if (isnan(w))
169  w = 1;
170 
171  return w;
172 }
173 
200 cxint
201 mrqnlfit(
202  cpl_matrix *x,
203  cpl_matrix *y,
204  cpl_matrix *sig,
205  cxint ndata,
206  cpl_matrix *a,
207  cxdouble r[],
208  cxint ia[],
209  cxint ma,
210  cpl_matrix *alpha,
211  cxdouble *chisq,
212  lmrq_params fit_params,
213  fitted_func funcs
214 ) {
215 
216  cxint itst,
217  n,
218  res;
219 
220  cxdouble alamda,
221  ochisq;
222 
223  cpl_matrix *beta = NULL;
224 
225  /*************************************************************************
226  PROCESSING
227  *************************************************************************/
228 
229  beta = cpl_matrix_new(ma,ma);
230 
231  alamda = -1.0;
232 
233  res = mymrqmin(x, y, sig, ndata, a, r, ia, ma, alpha, beta, chisq,
234  funcs, &alamda);
235 
236  if (res != 0) {
237  cpl_matrix_delete(beta); beta = NULL;
238  return res;
239  }
240 
241  itst=0;
242 
243  for (n = 1; n <= fit_params.imax; n++) {
244 
245  ochisq = *chisq;
246 
247  res = mymrqmin(x, y, sig, ndata, a, r, ia, ma, alpha, beta, chisq,
248  funcs, &alamda);
249 
250  if (res!=0) {
251  cpl_matrix_delete(beta); beta = NULL;
252  return res;
253  }
254 
255  if (*chisq > ochisq)
256  itst=0;
257  else if (fabs(ochisq-*chisq) < fit_params.dchsq)
258  itst++;
259 
260  if (itst > fit_params.tmax)
261  break;
262  }
263 
264  /* get covariance matrix */
265  alamda=0.0;
266 
267  res = mymrqmin(x, y, sig, ndata, a, r, ia, ma, alpha, beta, chisq,
268  funcs, &alamda);
269 
270  if (res != 0) {
271  cpl_matrix_delete(beta); beta = NULL;
272  return res;
273  }
274 
275  cpl_matrix_delete(beta); beta = NULL;
276 
277  return n;
278 
279 } /* end mrqnlfit() */
280 
337 cxint
338 mymrqmin(
339  cpl_matrix *x,
340  cpl_matrix *y,
341  cpl_matrix *sig,
342  cxint ndata,
343  cpl_matrix *a,
344  cxdouble r[],
345  cxint ia[],
346  cxint ma,
347  cpl_matrix *covar,
348  cpl_matrix *alpha,
349  cxdouble *chisq,
350  fitted_func funcs,
351  cxdouble *alamda
352 ) {
353 
354  register cxint gj, j, k, l, m;
355 
356  static cxdouble *pd_a, *pd_covar, *pd_alpha;
357  static cxint nr_covar, nr_alpha, nr_moneda, mfit;
358 
359  static cpl_matrix *matry, *mbeta, *mda, *moneda;
360  static cxdouble *atry, *beta, *da, *oneda, ochisq;
361 
362  /*************************************************************************
363  PROCESSING
364  *************************************************************************/
365 
366  pd_a = cpl_matrix_get_data(a);
367  pd_covar = cpl_matrix_get_data(covar);
368  pd_alpha = cpl_matrix_get_data(alpha);
369  nr_covar = cpl_matrix_get_nrow(covar);
370  nr_alpha = cpl_matrix_get_nrow(alpha);
371 
372  if (*alamda<0.0) {
373 
374  matry = cpl_matrix_new(ma,1);
375  atry = cpl_matrix_get_data(matry);
376 
377  mbeta = cpl_matrix_new(ma,1);
378  beta = cpl_matrix_get_data(mbeta);
379 
380  mda = cpl_matrix_new(ma,1);
381  da = cpl_matrix_get_data(mda);
382 
383  for (mfit = 0, j = 0; j < ma; j++)
384  if (ia[j])
385  mfit++;
386 
387  moneda = cpl_matrix_new(1,mfit);
388  oneda = cpl_matrix_get_data(moneda);
389 
390  *alamda = 0.001;
391 
392  gj = mymrqcof(x, y, sig, ndata, a, r, ia, ma, alpha, mbeta,
393  chisq, funcs);
394 
395  if (gj != 0) {
396  cpl_matrix_delete(moneda); moneda = NULL; oneda = NULL;
397  cpl_matrix_delete(mda); mda = NULL; da = NULL;
398  cpl_matrix_delete(mbeta); mbeta = NULL; beta = NULL;
399  cpl_matrix_delete(matry); matry = NULL; atry = NULL;
400  return gj;
401  }
402 
403  ochisq = (*chisq);
404 
405  for (j = 0; j < ma; j++)
406  atry[j] = pd_a[j];
407 
408  }
409 
410  nr_moneda = cpl_matrix_get_nrow(moneda);
411 
412  for (j = -1, l = 0; l < ma; l++) {
413  if (ia[l]) {
414  for (j++, k = -1, m = 0; m < ma; m++) {
415  if (ia[m]) {
416  k++;
417  pd_covar[j * nr_covar + k] = pd_alpha[j * nr_alpha + k];
418  }
419  }
420 
421  pd_covar[j * nr_covar + j] =
422  pd_alpha[j * nr_alpha + j] * (1.0 + (*alamda));
423 
424  oneda[j * nr_moneda + 0] = beta[j];
425  }
426  }
427 
428  gj = giraffe_gauss_jordan(covar, mfit, moneda, 1);
429 
430  if (gj != 0) {
431  cpl_matrix_delete(moneda); moneda = NULL; oneda = NULL;
432  cpl_matrix_delete(mda); mda = NULL; da = NULL;
433  cpl_matrix_delete(mbeta); mbeta = NULL; beta = NULL;
434  cpl_matrix_delete(matry); matry = NULL; atry = NULL;
435  return gj;
436  }
437 
438  for (j = 0; j < mfit; j++)
439  da[j] = oneda[j * nr_moneda + 0];
440 
441  if (*alamda == 0.0) {
442  covariance_sort(covar, ma, ia, mfit);
443  cpl_matrix_delete(moneda); moneda = NULL; oneda = NULL;
444  cpl_matrix_delete(mda); mda = NULL; da = NULL;
445  cpl_matrix_delete(mbeta); mbeta = NULL; beta = NULL;
446  cpl_matrix_delete(matry); matry = NULL; atry = NULL;
447  return 0;
448  }
449 
450  for (j = -1, l = 0; l < ma; l++)
451  if (ia[l])
452  atry[l] = pd_a[l] + da[++j];
453 
454  gj = mymrqcof(x, y, sig, ndata, matry, r, ia, ma, covar, mda,
455  chisq, funcs);
456 
457  if (gj != 0) {
458  cpl_matrix_delete(moneda); moneda = NULL; oneda = NULL;
459  cpl_matrix_delete(mda); mda = NULL; da = NULL;
460  cpl_matrix_delete(mbeta); mbeta = NULL; beta = NULL;
461  cpl_matrix_delete(matry); matry = NULL; atry = NULL;
462  return gj;
463  }
464 
465  if (*chisq < ochisq) {
466 
467  *alamda *= 0.1;
468  ochisq = *chisq;
469 
470  for (j = -1, l = 0; l < ma; l++) {
471  if (ia[l]) {
472  for (j++, k = -1, m = 0; m < ma; m++) {
473  if (ia[m]) {
474  k++;
475  pd_alpha[j * nr_alpha + k] =
476  pd_covar[j * nr_covar + k];
477  }
478  }
479 
480  beta[j] = da[j];
481  pd_a[l] = atry[l];
482  }
483  }
484 
485  } else {
486  *alamda *= 10.0;
487  *chisq = ochisq;
488  }
489 
490  return 0;
491 
492 } /* end mymrqmin() */
493 
521 cxint
522 mymrqcof(
523  cpl_matrix *x,
524  cpl_matrix *y,
525  cpl_matrix *sig,
526  cxint ndata,
527  cpl_matrix *a,
528  cxdouble r[],
529  cxint ia[],
530  cxint ma,
531  cpl_matrix *alpha,
532  cpl_matrix *beta,
533  cxdouble *chisq,
534  fitted_func funcs
535 ) {
536 
537  register cxint i, j, k, l, m, mfit = 0;
538 
539  cxdouble ymod, wt, sig2i, dy, *dyda;
540 
541  cxdouble *pd_x = NULL,
542  *pd_y = NULL,
543  *pd_sig = NULL,
544  *pd_a = NULL,
545  *pd_alpha = NULL,
546  *pd_beta = NULL;
547 
548  cxint nr_alpha, nc_x;
549 
550  /************************************************************************
551  PROCESSING
552  ************************************************************************/
553 
554  pd_x = cpl_matrix_get_data(x);
555  nc_x = cpl_matrix_get_ncol(x);
556  pd_y = cpl_matrix_get_data(y);
557  pd_sig = cpl_matrix_get_data(sig);
558  pd_a = cpl_matrix_get_data(a);
559  pd_alpha = cpl_matrix_get_data(alpha);
560  nr_alpha = cpl_matrix_get_nrow(alpha);
561  pd_beta = cpl_matrix_get_data(beta);
562 
563  for (j = 0; j < ma; j++) {
564  if (ia[j])
565  mfit++;
566  }
567 
568  for (j = 0; j < mfit; j++) {
569  for (k = 0; k <= j; k++)
570  pd_alpha[j * nr_alpha + k] = 0.0;
571 
572  pd_beta[j] = 0.0;
573  }
574 
575  *chisq = 0.0;
576 
577  dyda = (cxdouble *) cx_calloc(ma, sizeof(cxdouble));
578 
579  for (i = 0; i < ndata; i++) {
580 
581  (*funcs)(&(pd_x[i*nc_x]), pd_a, r, &ymod, dyda, ma);
582 
583  if (pd_sig[i]==0.0) {
584  continue;
585  }
586 
587  sig2i = 1.0 / (pd_sig[i] * pd_sig[i]);
588 
589  dy = pd_y[i] - ymod;
590 
591  for (j = -1, l = 0; l < ma; l++) {
592 
593  if (ia[l]) {
594  wt = dyda[l] * sig2i;
595  for (j++, k = -1, m = 0; m <= l; m++) {
596  if (ia[m]) {
597  ++k;
598  pd_alpha[j * nr_alpha + k] += (wt * dyda[m]);
599  }
600  }
601 
602  pd_beta[j] += (dy * wt);
603 
604  }
605  }
606 
607  *chisq += (dy * dy * sig2i);
608 
609  }
610 
611  for (j = 1; j < mfit; j++)
612  for (k = 0; k < j; k++)
613  pd_alpha[k * nr_alpha + j] = pd_alpha[j * nr_alpha + k];
614 
615 
616  cx_free(dyda);
617 
618  return 0;
619 
620 } /* end mymrqcof() */
621 
638 cxdouble
639 r_squared(cxdouble resSS, cpl_matrix *y, cxint n)
640 {
641  register cxint i;
642  register cxdouble Sy, Syy, SS;
643  cxdouble res, *pd_y = NULL;
644 
645  pd_y = cpl_matrix_get_data(y);
646 
647  if (n < 1)
648  return 0.0;
649 
650  for (i=0, Sy=0.0, Syy=0.0; i<n; i++) {
651  Sy += pd_y[i];
652  Syy += pd_y[i]*pd_y[i];
653  }
654 
655  SS = Syy - Sy*Sy/n;
656  res = resSS/SS;
657 
658  if (isnan(res))
659  return 0.0;
660 
661  if (res > 0.0)
662  res = sqrt(res);
663 
664  return res;
665 
666 } /* end r_squared() */
667 
699 void
700 mrqgaussum(cxdouble x[], cxdouble a[], cxdouble r[], cxdouble *y,
701  cxdouble dyda[], cxint na)
702 {
703 
704  register cxint i, j;
705  register cxdouble fac,ex,amplitude,center,backg,width,xred;
706 
707  (void) r; /* Not used. */
708  *y = 0.0;
709 
710  for (j = 0, i = 0; i < na; i += 4, j += 4) {
711  amplitude = a[i];
712  center = a[i + 1];
713  backg = a[i + 2];
714  width = a[i + 3];
715  xred = (x[0] - center) / width;
716  ex = exp(-xred * xred / 2.);
717  fac = amplitude * xred * ex;
718  *y += (amplitude * ex + backg);
719 
720  /* Check if derivatives expected */
721  if (dyda == NULL) continue;
722 
723  /* derivatives for each parameters */
724  dyda[j] = ex; /* d(y)/d(amplitude) */
725  dyda[j + 1] = fac / width; /* d(y)/d(center) */
726  dyda[j + 2] = 1.; /* d(y)/d(backg) */
727  dyda[j + 3] = (fac * xred) / width; /* d(y)/d(width) */
728  }
729 
730 } /* end mrqgaussum() */
731 
783 void
784 mrqxoptmod(cxdouble x[], cxdouble a[], cxdouble r[], cxdouble *y,
785  cxdouble dyda[], cxint na)
786 {
787 
788  const cxchar *fctid = "mrqxoptmod";
789 
790  register cxdouble xccd, d, X;
791  register cxdouble lambda,xfibre,yfibre,pixsize,nx;
792  /* Optical model parameters */
793  register cxdouble fcoll,cfact;
794  /* Grating parameters */
795  register cxdouble gtheta,gorder,gspace;
796  register cxdouble yfibre2,tmp,tmp2,d2,X2,gspace2,sqtmp,costheta,sintheta;
797 
798  /* check for number of parameters */
799  if (na != 7) {
800  cpl_error_set(fctid, CPL_ERROR_ILLEGAL_INPUT);
801  return;
802  }
803 
804  *y = 0.0;
805  if (dyda != NULL) {
806  dyda[0] = dyda[1] = dyda[2] = dyda[3] =
807  dyda[4] = dyda[5] = dyda[6] = 0.0;
808  }
809 
810  lambda = x[LMI_WLEN]; /* wavelength [mm] */
811  xfibre = x[LMI_XFIB]; /* Y fibre [mm] */
812  yfibre = x[LMI_YFIB]; /* Y fibre [mm] */
813 
814  nx = a[LMP_NX]; /* CCD size in X [pixels] */
815  pixsize = a[LMP_PXSIZ]; /* CCD pixel size [mm] */
816  fcoll = a[LMP_FCOLL]; /* collimator focal length [mm] */
817  cfact = a[LMP_CFACT]; /* camera magnification factor */
818  gtheta = a[LMP_THETA]; /* grating angle [radian] */
819  gorder = a[LMP_ORDER]; /* grating diffraction order */
820  gspace = a[LMP_SPACE]; /* grating groove spacing [mm] */
821 
822  yfibre2 = yfibre * yfibre;
823  gspace2 = gspace * gspace;
824  costheta = cos(gtheta);
825  sintheta = sin(gtheta);
826  d2 = xfibre * xfibre + yfibre2 + (fcoll * fcoll);
827  d = sqrt(d2);
828  X = (-lambda*gorder/gspace) + (xfibre*costheta/d) + (fcoll*sintheta/d);
829  X2 = X * X;
830  sqtmp = sqrt(1.0 - yfibre2/d2 - X2);
831  tmp = -sintheta*X + costheta*sqtmp;
832  tmp2 = tmp * tmp;
833  xccd = (cfact * fcoll * (X*costheta + sintheta*sqtmp))/tmp;
834 
835  /* takes care of model direction */
836  if (nx < 0.0)
837  *y = (xccd / pixsize - 0.5*nx);
838  else
839  *y = (-xccd / pixsize + 0.5*nx);
840 
841  /* Check if derivatives expected */
842  if (dyda == NULL)
843  return;
844 
845  /* derivatives for each parameters */
846  dyda[LMP_NX] = 0.5; /* d(y)/d(nx) */
847  dyda[LMP_PXSIZ] = 0.0; /* d(y)/d(pixsize) */
848 
849  dyda[LMP_FCOLL] = cfact*(costheta*X+sintheta*sqtmp)/tmp +
850  cfact*fcoll*(costheta*(-X*fcoll/d2+sintheta/d -
851  gorder*lambda*fcoll/(d2*gspace)) +
852  0.5*sintheta*(-2.0*X*(-X*fcoll/d2+sintheta/d -
853  gorder*lambda*fcoll/(d2*gspace))+2.0*yfibre2*fcoll/(d2*d2))/sqtmp)/tmp -
854  cfact*fcoll*(costheta*X+sintheta*sqtmp)*(-sintheta*(-X*fcoll/d2 +
855  sintheta/d-gorder*lambda*fcoll/(d2*gspace)) +
856  0.5*costheta*(-2.0*X*(-X*fcoll/d2+sintheta/d -
857  gorder*lambda*fcoll/(d2*gspace))+2.0*yfibre2*fcoll/(d2*d2))/sqtmp)/tmp2;
858  dyda[LMP_FCOLL] /= pixsize; /* d(y)/d(fcoll) */
859 
860  dyda[LMP_CFACT] = (xccd/cfact)/pixsize; /* d(y)/d(cfact) */
861 
862  dyda[LMP_THETA] = cfact*fcoll*((-xfibre*sintheta/d+fcoll*costheta/d)*costheta -
863  sintheta*X-sintheta*X*(-xfibre*sintheta/d+fcoll*costheta/d)/sqtmp +
864  costheta*sqtmp)/tmp -
865  cfact*fcoll*(costheta*X+sintheta*sqtmp)*(-(-xfibre*sintheta/d +
866  fcoll*costheta/d)*sintheta-costheta*X -
867  costheta*X*(-xfibre*sintheta/d+fcoll*costheta/d)/sqtmp -
868  sintheta*sqtmp)/tmp2;
869  dyda[LMP_THETA] /= pixsize; /* d(y)/d(gtheta) */
870 
871  dyda[LMP_ORDER] = 0.0; /* d(y)/d(gorder) */
872  dyda[LMP_SPACE] = cfact*fcoll*(lambda*gorder*costheta/gspace2-sintheta*X*lambda*gorder/(sqtmp*gspace2))/tmp -
873  cfact*fcoll*(X*costheta+sintheta*sqtmp) *
874  (-lambda*gorder*sintheta/gspace2-costheta*X*lambda*gorder/(sqtmp*gspace2))/tmp2;
875  dyda[LMP_SPACE] /= pixsize; /* d(y)/d(gspace) */
876 
877  if (nx > 0.0) {
878  dyda[LMP_NX] = -dyda[LMP_NX];
879  dyda[LMP_PXSIZ] = -dyda[LMP_PXSIZ];
880  dyda[LMP_FCOLL] = -dyda[LMP_FCOLL];
881  dyda[LMP_CFACT] = -dyda[LMP_CFACT];
882  dyda[LMP_THETA] = -dyda[LMP_THETA];
883  dyda[LMP_ORDER] = -dyda[LMP_ORDER];
884  dyda[LMP_SPACE] = -dyda[LMP_SPACE];
885  }
886 
887  if (r != NULL) {
888  register cxint k;
889 
890  k = LMP_FCOLL << 1;
891  if (r[k+1] > 0) {
892  dyda[LMP_FCOLL] *= mrqdydaweight(a[LMP_FCOLL],r[k],r[k+1]);
893  }
894  k = LMP_CFACT << 1;
895  if (r[k+1] > 0) {
896  dyda[LMP_CFACT] *= mrqdydaweight(a[LMP_CFACT],r[k],r[k+1]);
897  }
898  k = LMP_THETA << 1;
899  if (r[k+1] > 0) {
900  dyda[LMP_THETA] *= mrqdydaweight(a[LMP_THETA],r[k],r[k+1]);
901  }
902  k = LMP_SPACE << 1;
903  if (r[k+1] > 0) {
904  dyda[LMP_SPACE] *= mrqdydaweight(a[LMP_SPACE],r[k],r[k+1]);
905  }
906  }
907 
908 } /* end mrqxoptmod() */
909 
971 void
972 mrqxoptmod2(cxdouble x[], cxdouble a[], cxdouble r[], cxdouble *y,
973  cxdouble dyda[], cxint na)
974 {
975 
976  const cxchar *fctid = "mrqxoptmod2";
977 
978  register cxdouble lambda,xfibre,yfibre,pixsize,nx;
979  /* Optical model parameters */
980  register cxdouble fcoll,cfact;
981  /* Grating parameters */
982  register cxdouble gtheta,gorder,gspace;
983  /* Slit position parameters */
984  cxdouble slitdx,slitdy,slitphi;
985 
986  register cxdouble t1,t10,t104,t107,t11,t113,t119,t12,t120,t121,t124,t136,
987  t137,t138,t14,t143,t148,t16,t161,t162,t166,t168,t17,t173,
988  t18,t19,t191,t195,t196,t2,t20,t201,t21,t210,t23,t24,t26,
989  t27,t28,t3,t30,t32,t33,t34,t35,t36,t37,t38,t39,t4,t40,t44,
990  t49,t52,t58,t60,t61,t62,t64,t68,t75,t76,t78,t80,t9,t91,t93;
991 
992  /* check for number of parameters */
993  if (na != 10) {
994  cpl_error_set(fctid, CPL_ERROR_ILLEGAL_INPUT);
995  return;
996  }
997 
998  *y = 0.0;
999  if (dyda != NULL) {
1000  dyda[0] = dyda[1] = dyda[2] = dyda[3] =
1001  dyda[4] = dyda[5] = dyda[6] =
1002  dyda[7] = dyda[8] = dyda[9] = 0.0;
1003  }
1004 
1005  lambda = x[LMI_WLEN]; /* wavelength [mm] */
1006  xfibre = x[LMI_XFIB]; /* Y fibre [mm] */
1007  yfibre = x[LMI_YFIB]; /* Y fibre [mm] */
1008 
1009  nx = a[LMP_NX]; /* CCD size in X [pixels] */
1010  pixsize = a[LMP_PXSIZ]; /* CCD pixel size [mm] */
1011  fcoll = a[LMP_FCOLL]; /* collimator focal length [mm] */
1012  cfact = a[LMP_CFACT]; /* camera magnification factor */
1013  gtheta = a[LMP_THETA]; /* grating angle [radian] */
1014  gorder = a[LMP_ORDER]; /* grating diffraction order */
1015  gspace = a[LMP_SPACE]; /* grating groove spacing [mm] */
1016  slitdx = a[LMP_SOFFX]; /* slit position x offset [mm] */
1017  slitdy = a[LMP_SOFFY]; /* slit position y offset [mm] */
1018  slitphi = a[LMP_SPHI]; /* slit position angle [radian] */
1019 
1020  t1 = cfact*fcoll;
1021  t2 = cos(gtheta);
1022  t3 = lambda*gorder;
1023  t4 = 1.0/gspace;
1024  t9 = xfibre*(1.0+slitphi*yfibre)+slitdx;
1025  t10 = t9*t2;
1026  t11 = t9*t9;
1027  t12 = slitphi*slitphi;
1028  t14 = sqrt(1.0-t12);
1029  t16 = yfibre*t14+slitdy;
1030  t17 = t16*t16;
1031  t18 = fcoll*fcoll;
1032  t19 = t11+t17+t18;
1033  t20 = sqrt(t19);
1034  t21 = 1.0/t20;
1035  t23 = sin(gtheta);
1036  t24 = fcoll*t23;
1037  t26 = -t3*t4+t10*t21+t24*t21;
1038  t27 = t2*t26;
1039  t28 = 1.0/t19;
1040  t30 = t26*t26;
1041  t32 = sqrt(1.0-t17*t28-t30);
1042  t33 = t23*t32;
1043  t34 = t27+t33;
1044  t35 = t23*t26;
1045  t36 = t2*t32;
1046  t37 = -t35+t36;
1047  t38 = 1.0/t37;
1048  t39 = t34*t38;
1049  t40 = 1.0/pixsize;
1050  t44 = pixsize*pixsize;
1051  t49 = t38*t40;
1052  t52 = 1.0/t20/t19;
1053  t58 = -t10*t52*fcoll+t23*t21-t18*t23*t52;
1054  t60 = 1.0/t32;
1055  t61 = t23*t60;
1056  t62 = t19*t19;
1057  t64 = t17/t62;
1058  t68 = 2.0*t64*fcoll-2.0*t26*t58;
1059  t75 = t1*t34;
1060  t76 = t37*t37;
1061  t78 = 1.0/t76*t40;
1062  t80 = t2*t60;
1063  t91 = -t9*t23*t21+fcoll*t2*t21;
1064  t93 = t26*t91;
1065  t104 = t2*lambda;
1066  t107 = t26*lambda*t4;
1067  t113 = t23*lambda;
1068  t119 = gspace*gspace;
1069  t120 = 1.0/t119;
1070  t121 = gorder*t120;
1071  t124 = t3*t120;
1072  t136 = t2*t21;
1073  t137 = 2.0*t9;
1074  t138 = t52*t137;
1075  t143 = t136-t10*t138/2.0-t24*t138/2.0;
1076  t148 = t64*t137-2.0*t26*t143;
1077  t161 = 2.0*t16;
1078  t162 = t52*t161;
1079  t166 = -t10*t162/2.0-t24*t162/2.0;
1080  t168 = t16*t28;
1081  t173 = -2.0*t168+t64*t161-2.0*t26*t166;
1082  t191 = 1.0/t14;
1083  t195 = 2.0*t9*xfibre*yfibre-2.0*t16*yfibre*t191*slitphi;
1084  t196 = t52*t195;
1085  t201 = xfibre*yfibre*t136-t10*t196/2.0-t24*t196/2.0;
1086  t210 = 2.0*t168*yfibre*t191*slitphi+t64*t195-2.0*t26*t201;
1087 
1088  /* takes care of model direction */
1089  if (nx < 0.0)
1090  *y = t1*t39*t40-0.5*nx;
1091  else
1092  *y = -t1*t39*t40+0.5*nx;
1093 
1094  /* Check if derivatives expected */
1095  if (dyda == NULL)
1096  return;
1097 
1098  /* derivatives for each parameters */
1099  dyda[LMP_NX] = 0.5; /* d(y)/d(nx) */
1100  dyda[LMP_PXSIZ] = -t1*t39/t44; /* d(y)/d(pixsize) */
1101  dyda[LMP_FCOLL] = /* d(y)/d(fcoll) */
1102  cfact*t34*t49+t1*(t2*t58+t61*t68/2.0)*t38*t40 -
1103  t75*t78*(-t23*t58+t80*t68/2.0);
1104  dyda[LMP_CFACT] = /* d(y)/d(cfact) */
1105  fcoll*t34*t49;
1106  dyda[LMP_THETA] = /* d(y)/d(gtheta) */
1107  t1*(-t35+t2*t91+t36-t61*t93)*t38*t40 -
1108  t75*t78*(-t27-t23*t91-t33-t80*t93);
1109  dyda[LMP_ORDER] = /* d(y)/d(gorder) */
1110  t1*(-t104*t4+t61*t107)*t38*t40-t75*t78*(t113*t4+t80*t107);
1111  dyda[LMP_SPACE] = /* d(y)/d(gspace) */
1112  t1*(t104*t121-t61*t26*t124)*t38*t40 -
1113  t75*t78*(-t113*t121-t80*t26*t124);
1114  dyda[LMP_SOFFX] = /* d(y)/d(slitdx) */
1115  t1*(t2*t143+t61*t148/2.0)*t38*t40 -
1116  t75*t78*(-t23*t143+t80*t148/2.0);
1117  dyda[LMP_SOFFY] = /* d(y)/d(slitdy) */
1118  t1*(t2*t166+t61*t173/2.0)*t38*t40 -
1119  t75*t78*(-t23*t166+t80*t173/2.0);
1120  dyda[LMP_SPHI] = /* d(y)/d(slitphi) */
1121  t1*(t2*t201+t61*t210/2.0)*t38*t40 -
1122  t75*t78*(-t23*t201+t80*t210/2.0);
1123 
1124  if (nx > 0.0) {
1125  dyda[LMP_NX] = -dyda[LMP_NX];
1126  dyda[LMP_PXSIZ] = -dyda[LMP_PXSIZ];
1127  dyda[LMP_FCOLL] = -dyda[LMP_FCOLL];
1128  dyda[LMP_CFACT] = -dyda[LMP_CFACT];
1129  dyda[LMP_THETA] = -dyda[LMP_THETA];
1130  dyda[LMP_ORDER] = -dyda[LMP_ORDER];
1131  dyda[LMP_SPACE] = -dyda[LMP_SPACE];
1132  dyda[LMP_SOFFX] = -dyda[LMP_SOFFX];
1133  dyda[LMP_SOFFY] = -dyda[LMP_SOFFY];
1134  dyda[LMP_SPHI] = -dyda[LMP_SPHI];
1135  }
1136 
1137  if (r != NULL) {
1138  register cxint k;
1139 
1140  k = LMP_PXSIZ << 1;
1141  if (r[k+1] > 0) {
1142  dyda[LMP_PXSIZ] *= mrqdydaweight(a[LMP_PXSIZ],r[k],r[k+1]);
1143  }
1144  k = LMP_FCOLL << 1;
1145  if (r[k+1] > 0) {
1146  dyda[LMP_FCOLL] *= mrqdydaweight(a[LMP_FCOLL],r[k],r[k+1]);
1147  }
1148  k = LMP_CFACT << 1;
1149  if (r[k+1] > 0) {
1150  dyda[LMP_CFACT] *= mrqdydaweight(a[LMP_CFACT],r[k],r[k+1]);
1151  }
1152  k = LMP_THETA << 1;
1153  if (r[k+1] > 0) {
1154  dyda[LMP_THETA] *= mrqdydaweight(a[LMP_THETA],r[k],r[k+1]);
1155  }
1156  k = LMP_ORDER << 1;
1157  if (r[k+1] > 0) {
1158  dyda[LMP_ORDER] *= mrqdydaweight(a[LMP_ORDER],r[k],r[k+1]);
1159  }
1160  k = LMP_SPACE << 1;
1161  if (r[k+1] > 0) {
1162  dyda[LMP_SPACE] *= mrqdydaweight(a[LMP_SPACE],r[k],r[k+1]);
1163  }
1164  k = LMP_SOFFX << 1;
1165  if (r[k+1] > 0) {
1166  dyda[LMP_SOFFX] *= mrqdydaweight(a[LMP_SOFFX],r[k],r[k+1]);
1167  }
1168  k = LMP_SOFFY << 1;
1169  if (r[k+1] > 0) {
1170  dyda[LMP_SOFFY] *= mrqdydaweight(a[LMP_SOFFY],r[k],r[k+1]);
1171  }
1172  k = LMP_SPHI << 1;
1173  if (r[k+1] > 0) {
1174  dyda[LMP_SPHI] *= mrqdydaweight(a[LMP_SPHI],r[k],r[k+1]);
1175  }
1176  }
1177 
1178 } /* end mrqxoptmod2() */
1179 
1244 void
1245 mrqyoptmod(cxdouble x[], cxdouble a[], cxdouble r[], cxdouble *y,
1246  cxdouble dyda[], cxint na)
1247 {
1248 
1249  const cxchar *fctid = "mrqyoptmod";
1250 
1251  register cxdouble lambda,xfibre,yfibre,pixsize,ny;
1252  /* Optical model parameters */
1253  register cxdouble fcoll,cfact;
1254  /* Grating parameters */
1255  register cxdouble gtheta,gorder,gspace;
1256 
1257  cxdouble t10,t12,t13,t15,t18,t2,t22,t24,t26,t27,t28,t29,t3,t30,t33,
1258  t4,t41,t45,t47,t5,t53,t56,t57,t6,t7,t76,t8,t9,t93,t94;
1259 
1260  (void) r; /* Not used. */
1261 
1262  /* check for number of parameters */
1263  if (na != 7) {
1264  cpl_error_set(fctid, CPL_ERROR_ILLEGAL_INPUT);
1265  return;
1266  }
1267 
1268  *y = 0.0;
1269  if (dyda != NULL) {
1270  dyda[LMP_NX] = dyda[LMP_PXSIZ] = dyda[LMP_FCOLL] = dyda[LMP_CFACT] =
1271  dyda[LMP_THETA] = dyda[LMP_ORDER] = dyda[LMP_SPACE] = 0.0;
1272  }
1273 
1274  lambda = x[LMI_WLEN];
1275  xfibre = x[LMI_XFIB];
1276  yfibre = x[LMI_YFIB];
1277 
1278  ny = a[LMP_NY];
1279  pixsize = a[LMP_PXSIZ];
1280  fcoll = a[LMP_FCOLL];
1281  cfact = a[LMP_CFACT];
1282  gtheta = a[LMP_THETA];
1283  gorder = a[LMP_ORDER];
1284  gspace = a[LMP_SPACE];
1285 
1286  t2 = cfact*fcoll*yfibre;
1287  t3 = xfibre*xfibre;
1288  t4 = yfibre*yfibre;
1289  t5 = fcoll*fcoll;
1290  t6 = t3+t4+t5;
1291  t7 = sqrt(t6);
1292  t8 = 1.0/t7;
1293  t9 = lambda*gorder;
1294  t10 = 1.0/gspace;
1295  t12 = cos(gtheta);
1296  t13 = xfibre*t12;
1297  t15 = sin(gtheta);
1298  t18 = -t9*t10+t13*t8+fcoll*t15*t8;
1299  t22 = t18*t18;
1300  t24 = sqrt(1.0-t4/t6-t22);
1301  t26 = -t18*t15+t12*t24;
1302  t27 = 1.0/t26;
1303  t28 = t8*t27;
1304  t29 = 1.0/pixsize;
1305  t30 = t28*t29;
1306  t33 = pixsize*pixsize;
1307  t41 = 1.0/t7/t6;
1308  t45 = t26*t26;
1309  t47 = t8/t45;
1310  t53 = -t13*t41*fcoll+t15*t8-t5*t15*t41;
1311  t56 = t12/t24;
1312  t57 = t6*t6;
1313  t76 = -xfibre*t15*t8+fcoll*t12*t8;
1314  t93 = gspace*gspace;
1315  t94 = 1.0/t93;
1316 
1317  *y = -t2*t30+0.5*ny;
1318 
1319  /* Check if derivatives expected */
1320  if (dyda == NULL) return;
1321 
1322  /* derivatives for each parameters */
1323  dyda[LMP_NY] = 0.5; /* d(y)/d(ny) */
1324 
1325  dyda[LMP_PXSIZ] = t2*t28/t33;
1326  dyda[LMP_FCOLL] = -cfact*yfibre*t30+cfact*t5*yfibre*t41*t27*t29+t2*t47*t29*
1327  (-t53*t15+t56*(2.0*t4/t57*fcoll-2.0*t18*t53)/2.0);
1328  dyda[LMP_CFACT] = -fcoll*yfibre*t30;
1329  dyda[LMP_THETA] = t2*t47*t29*(-t76*t15-t18*t12-t15*t24-t56*t18*t76);
1330  dyda[LMP_ORDER] = t2*t47*t29*(lambda*t10*t15+t56*t18*lambda*t10);
1331  dyda[LMP_SPACE] = t2*t47*t29*(-t9*t94*t15-t56*t18*t9*t94);
1332 
1333 } /* end mrqyoptmod() */
1334 
1407 void
1408 mrqyoptmod2(cxdouble x[], cxdouble a[], cxdouble r[], cxdouble *y,
1409  cxdouble dyda[], cxint na)
1410 {
1411 
1412  const cxchar *fctid = "mrqyoptmod2";
1413 
1414  register cxdouble lambda,xfibre,yfibre,pixsize,ny;
1415  /* Optical model parameters */
1416  register cxdouble fcoll,cfact;
1417  /* Grating parameters */
1418  register cxdouble gtheta,gorder,gspace;
1419  /* Slit position parameters */
1420  cxdouble slitdx,slitdy,slitphi;
1421 
1422  double t1,t102,t103,t11,t112,t117,t118,t12,t123,t13,t136,t14,t141,t145,
1423  t147,t15,t159,t16,t160,t17,t172,t179,t18,t184,t19,t2,t21,t22,t24,
1424  t25,t27,t29,t31,t33,t35,t36,t37,t38,t39,t4,t42,t50,t51,t54,t56,t6,
1425  t62,t65,t66,t68,t7,t85;
1426 
1427  (void) r; /* Not used. */
1428 
1429  /* check for number of parameters */
1430  if (na != 10) {
1431  cpl_error_set(fctid, CPL_ERROR_ILLEGAL_INPUT);
1432  return;
1433  }
1434 
1435  *y = 0.0;
1436  if (dyda != NULL) {
1437  dyda[LMP_NY] = dyda[LMP_PXSIZ] = dyda[LMP_FCOLL] = dyda[LMP_CFACT] =
1438  dyda[LMP_THETA] = dyda[LMP_ORDER] = dyda[LMP_SPACE] =
1439  dyda[LMP_SOFFX] = dyda[LMP_SOFFY] = dyda[LMP_SPHI] = 0.0;
1440  }
1441 
1442  lambda = x[LMI_WLEN];
1443  xfibre = x[LMI_XFIB];
1444  yfibre = x[LMI_YFIB];
1445 
1446  ny = a[LMP_NY];
1447  pixsize = a[LMP_PXSIZ];
1448  fcoll = a[LMP_FCOLL];
1449  cfact = a[LMP_CFACT];
1450  gtheta = a[LMP_THETA];
1451  gorder = a[LMP_ORDER];
1452  gspace = a[LMP_SPACE];
1453  slitdx = a[LMP_SOFFX];
1454  slitdy = a[LMP_SOFFY];
1455  slitphi = a[LMP_SPHI];
1456 
1457  t1 = cfact*fcoll;
1458  t2 = slitphi*slitphi;
1459  t4 = sqrt(1.0-t2);
1460  t6 = yfibre*t4+slitdy;
1461  t7 = t1*t6;
1462  t11 = xfibre*(1.0+slitphi*yfibre)+slitdx;
1463  t12 = t11*t11;
1464  t13 = t6*t6;
1465  t14 = fcoll*fcoll;
1466  t15 = t12+t13+t14;
1467  t16 = sqrt(t15);
1468  t17 = 1/t16;
1469  t18 = lambda*gorder;
1470  t19 = 1/gspace;
1471  t21 = cos(gtheta);
1472  t22 = t11*t21;
1473  t24 = sin(gtheta);
1474  t25 = fcoll*t24;
1475  t27 = -t18*t19+t22*t17+t25*t17;
1476  t29 = 1/t15;
1477  t31 = t27*t27;
1478  t33 = sqrt(1.0-t13*t29-t31);
1479  t35 = -t27*t24+t21*t33;
1480  t36 = 1/t35;
1481  t37 = t17*t36;
1482  t38 = 1/pixsize;
1483  t39 = t37*t38;
1484  t42 = pixsize*pixsize;
1485  t50 = 1/t16/t15;
1486  t51 = t50*t36;
1487  t54 = t35*t35;
1488  t56 = t17/t54;
1489  t62 = -t22*t50*fcoll+t24*t17-t14*t24*t50;
1490  t65 = t21/t33;
1491  t66 = t15*t15;
1492  t68 = t13/t66;
1493  t85 = -t11*t24*t17+fcoll*t21*t17;
1494  t102 = gspace*gspace;
1495  t103 = 1/t102;
1496  t112 = 2.0*t11;
1497  t117 = t21*t17;
1498  t118 = t50*t112;
1499  t123 = t117-t22*t118/2.0-t25*t118/2.0;
1500  t136 = 2.0*t6;
1501  t141 = t50*t136;
1502  t145 = -t22*t141/2.0-t25*t141/2.0;
1503  t147 = t6*t29;
1504  t159 = 1/t4;
1505  t160 = yfibre*t159;
1506  t172 = 2.0*t11*xfibre*yfibre-2.0*t6*yfibre*t159*slitphi;
1507  t179 = t50*t172;
1508  t184 = xfibre*yfibre*t117-t22*t179/2.0-t25*t179/2.0;
1509 
1510  *y = -t7*t39+0.5*ny;
1511 
1512  /* Check if derivatives expected */
1513  if (dyda == NULL) return;
1514 
1515  /* derivatives for each parameters */
1516  dyda[LMP_NY] = 0.5; /* d(y)/d(ny) */
1517  dyda[LMP_PXSIZ] = t7*t37/t42; /* d(y)/d(pixsize) */
1518  dyda[LMP_FCOLL] = /* d(y)/d(fcoll) */
1519  -cfact*t6*t39+cfact*t14*t6*t51*t38+
1520  t7*t56*t38*(-t62*t24+t65*(2.0*t68*fcoll-2.0*t27*t62)/2.0);
1521  dyda[LMP_CFACT] = /* d(y)/d(cfact) */
1522  -fcoll*t6*t39;
1523  dyda[LMP_THETA] = /* d(y)/d(gtheta) */
1524  t7*t56*t38*(-t85*t24-t27*t21-t24*t33-t65*t27*t85);
1525  dyda[LMP_ORDER] = /* d(y)/d(gorder) */
1526  t7*t56*t38*(lambda*t19*t24+t65*t27*lambda*t19);
1527  dyda[LMP_SPACE] = /* d(y)/d(gspace) */
1528  t7*t56*t38*(-t18*t103*t24-t65*t27*t18*t103);
1529  dyda[LMP_SOFFX] = /* d(y)/d(slitdx) */
1530  t7*t51*t38*t112/2.0+t7*t56*t38*(-t123*t24+t65*
1531  (t68*t112-2.0*t27*t123)/2.0);
1532  dyda[LMP_SOFFY] = /* d(y)/d(slitdy) */
1533  -t1*t39+t7*t51*t38*t136/2.0+t7*t56*t38*(-t145*t24+t65*
1534  (-2.0*t147+t68*t136-2.0*t27*t145)/2.0);
1535  dyda[LMP_SPHI] = /* d(y)/d(slitphi) */
1536  t1*t160*slitphi*t17*t36*t38+t7*t51*t38*t172/2.0+
1537  t7*t56*t38*(-t184*t24+t65*(2.0*t147*t160*slitphi+t68*t172-
1538  2.0*t27*t184)/2.0);
1539 
1540 } /* end mrqyoptmod2() */
1541 
1567 void
1568 mrqpsfcos(cxdouble x[], cxdouble a[], cxdouble r[], cxdouble *y,
1569  cxdouble dyda[], cxint na)
1570 {
1571 
1572  const cxchar *fctid = "mrqpsfcos";
1573 
1574  cxdouble t1,t10,t13,t14,t15,t16,t2,t26,t3,t4,t5,t6,t7,t8,t9;
1575 
1576  cxdouble amplitude = a[LMP_AMPL];
1577  cxdouble center = a[LMP_CENT];
1578  cxdouble background = a[LMP_BACK];
1579  cxdouble width1 = a[LMP_WID1];
1580  cxdouble width2 = a[LMP_WID2];
1581 
1582  (void) r; /* Not used. */
1583 
1584  /* check for number of parameters */
1585  if (na != 5) {
1586  cpl_error_set(fctid, CPL_ERROR_ILLEGAL_INPUT);
1587  return;
1588  }
1589 
1590  *y = 0.0;
1591  if (dyda != NULL) {
1592  dyda[LMP_AMPL] = dyda[LMP_CENT] = dyda[LMP_BACK] = dyda[LMP_WID1] =
1593  dyda[LMP_WID2] = 0.0;
1594  }
1595 
1596  t1 = x[0]-center;
1597  t2 = fabs(t1);
1598  t3 = 1.0/width2;
1599  t4 = t2*t3;
1600  t5 = pow(t4,width1);
1601  t6 = CX_PI*t5;
1602  t7 = cos(t6);
1603  t8 = 1.0+t7;
1604  t9 = t8*t8;
1605  t10 = t9*t8;
1606  t13 = amplitude*t9;
1607  t14 = sin(t6);
1608  t15 = t13*t14;
1609  t16 = log(t4);
1610  t26 = (t1>0.0)? 1.0:-1.0;
1611 
1612  if (t2 > width2) {
1613  *y = background;
1614 
1615  /* Check if derivatives expected */
1616  if (dyda == NULL) return;
1617 
1618  dyda[LMP_AMPL] = dyda[LMP_CENT] = dyda[LMP_BACK] = dyda[LMP_WID1] = 0.0;
1619  dyda[LMP_WID2] = 1.0;
1620  } else {
1621  *y = amplitude*t10/8.0+background; /* Function value */
1622 
1623  /* Check if derivatives expected */
1624  if (dyda == NULL)
1625  return;
1626 
1627  dyda[LMP_AMPL] = t10/8.0; /* d(y)/d(amplitude) */
1628  /* d(y)/d(center) */
1629  dyda[LMP_CENT] = 3.0/8.0*t13*t14*CX_PI*t5*width1*t26/t2;
1630  dyda[LMP_BACK] = 1.0; /* d(y)/d(background) */
1631  dyda[LMP_WID1] = -3.0/8.0*t15*t6*t16; /* d(y)/d(width1) */
1632  dyda[LMP_WID2] = 3.0/8.0*t15*t6*width1*t3; /* d(y)/d(width2) */
1633  }
1634 
1635  return;
1636 
1637 } /* end mrqpsfcos() */
1638 
1664 void
1665 mrqpsfexp(cxdouble x[], cxdouble a[], cxdouble r[], cxdouble *y,
1666  cxdouble dyda[], cxint na)
1667 {
1668 
1669  const cxchar *fctid = "mrqpsfexp";
1670 
1671  cxdouble t1,t2,t3,t4,t6,t8,t10,t15,t18;
1672 
1673  cxdouble amplitude = a[LMP_AMPL];
1674  cxdouble center = a[LMP_CENT];
1675  cxdouble background = a[LMP_BACK];
1676  cxdouble width1 = a[LMP_WID1];
1677  cxdouble width2 = a[LMP_WID2];
1678 
1679  /* check for number of parameters */
1680  if (na != 5) {
1681  cpl_error_set(fctid, CPL_ERROR_ILLEGAL_INPUT);
1682  return;
1683  }
1684 
1685  *y = 0.0;
1686  if (dyda != NULL) {
1687  dyda[LMP_AMPL] = dyda[LMP_CENT] = dyda[LMP_BACK] = dyda[LMP_WID1] =
1688  dyda[LMP_WID2] = 0.0;
1689  }
1690 
1691  t1 = x[0]-center;
1692 
1693  if (t1 > 0.0) {
1694  t2 = t1;
1695  t10 = 1.0;
1696  } else {
1697  t2 = -t1;
1698  t10 = -1.0;
1699  }
1700 
1701  t3 = pow(t2,width2);
1702  t4 = 1.0/width1;
1703  t6 = exp(-t3*t4);
1704  t8 = amplitude*t3;
1705  t15 = width1*width1;
1706  t18 = log(t2);
1707 
1708  *y = amplitude*t6+background;
1709 
1710  /* Check if derivatives expected */
1711  if (dyda == NULL)
1712  return;
1713 
1714  dyda[LMP_AMPL] = t6; /* d(y)/d(amplitude) */
1715  dyda[LMP_CENT] = t8*width2*t10/t2*t4*t6; /* d(y)/d(center) */
1716 
1717  if (isnan(dyda[LMP_CENT]))
1718  dyda[LMP_CENT] = 0.;
1719 
1720  dyda[LMP_BACK] = 1.0; /* d(y)/d(background) */
1721  dyda[LMP_WID1] = t8/t15*t6; /* d(y)/d(width1) */
1722  dyda[LMP_WID2] = -t8*t18*t4*t6; /* d(y)/d(width2) */
1723 
1724  if (isnan(dyda[LMP_WID2]))
1725  dyda[LMP_WID2] = 0.;
1726 
1727  if (r != NULL) {
1728  register cxint k;
1729 
1730  k = LMP_AMPL << 1;
1731  if (r[k+1] > 0) {
1732  dyda[LMP_AMPL] *= mrqdydaweight(a[LMP_AMPL],r[k],r[k+1]);
1733  }
1734  k = LMP_CENT << 1;
1735  if (r[k+1] > 0) {
1736  dyda[LMP_CENT] *= mrqdydaweight(a[LMP_CENT],r[k],r[k+1]);
1737  }
1738  k = LMP_WID1 << 1;
1739  if (r[k+1] > 0) {
1740  dyda[LMP_WID1] *= mrqdydaweight(a[LMP_WID1],r[k],r[k+1]);
1741  }
1742  k = LMP_WID2 << 1;
1743  if (r[k+1] > 0) {
1744  dyda[LMP_WID2] *= mrqdydaweight(a[LMP_WID2],r[k],r[k+1]);
1745  }
1746  }
1747 
1748  return;
1749 
1750 } /* end mrqpsfexp() */
1751 
1777 void
1778 mrqpsfexp2(cxdouble x[], cxdouble a[], cxdouble r[], cxdouble *y,
1779  cxdouble dyda[], cxint na)
1780 {
1781 
1782  const cxchar *fctid = "mrqpsfexp2";
1783 
1784  cxdouble t1,t2,t3,t4,t5,t6,t8,t10,t16;
1785 
1786  cxdouble amplitude = a[LMP_AMPL];
1787  cxdouble center = a[LMP_CENT];
1788  cxdouble background = a[LMP_BACK];
1789  cxdouble width1 = a[LMP_WID1];
1790  cxdouble width2 = a[LMP_WID2];
1791 
1792  /* check for number of parameters */
1793  if (na != 5) {
1794  cpl_error_set(fctid, CPL_ERROR_ILLEGAL_INPUT);
1795  return;
1796  }
1797 
1798  *y = 0.0;
1799  if (dyda != NULL) {
1800  dyda[LMP_AMPL] = dyda[LMP_CENT] = dyda[LMP_BACK] = dyda[LMP_WID1] =
1801  dyda[LMP_WID2] = 0.0;
1802  }
1803 
1804  t1 = x[0]-center;
1805 
1806  if (t1 > 0.0) {
1807  t2 = t1;
1808  t10 = 1.0;
1809  } else {
1810  t2 = -t1;
1811  t10 = -1.0;
1812  }
1813 
1814  t3 = 1.0/width1;
1815  t4 = t2*t3;
1816  t5 = pow(t4,width2);
1817  t6 = exp(-t5);
1818  t8 = amplitude*t5;
1819  t16 = log(t4);
1820 
1821  *y = amplitude*t6+background;
1822 
1823  /* Check if derivatives expected */
1824  if (dyda == NULL)
1825  return;
1826 
1827  dyda[LMP_AMPL] = t6; /* d(y)/d(amplitude) */
1828  dyda[LMP_CENT] = t8*width2*t10/t2*t6; /* d(y)/d(center) */
1829 
1830  if (isnan(dyda[LMP_CENT]))
1831  dyda[LMP_CENT] = 0.0;
1832 
1833  dyda[LMP_BACK] = 1.0; /* d(y)/d(background) */
1834  dyda[LMP_WID1] = t8*width2*t3*t6; /* d(y)/d(width1) */
1835  dyda[LMP_WID2] = -t8*t16*t6; /* d(y)/d(width2) */
1836 
1837  if (isnan(dyda[LMP_WID2]))
1838  dyda[LMP_WID2] = 0.0;
1839 
1840  if (r != NULL) {
1841  register cxint k;
1842 
1843  k = LMP_AMPL << 1;
1844  if (r[k+1] > 0) {
1845  dyda[LMP_AMPL] *= mrqdydaweight(a[LMP_AMPL],r[k],r[k+1]);
1846  }
1847  k = LMP_CENT << 1;
1848  if (r[k+1] > 0) {
1849  dyda[LMP_CENT] *= mrqdydaweight(a[LMP_CENT],r[k],r[k+1]);
1850  }
1851  k = LMP_WID1 << 1;
1852  if (r[k+1] > 0) {
1853  dyda[LMP_WID1] *= mrqdydaweight(a[LMP_WID1],r[k],r[k+1]);
1854  }
1855  k = LMP_WID2 << 1;
1856  if (r[k+1] > 0) {
1857  dyda[LMP_WID2] *= mrqdydaweight(a[LMP_WID2],r[k],r[k+1]);
1858  }
1859  }
1860 
1861  return;
1862 
1863 } /* end mrqpsfexp2() */
1864 
1885 void
1886 mrqlocywarp(cxdouble x[], cxdouble a[], cxdouble r[], cxdouble *y,
1887  cxdouble dyda[], cxint na)
1888 {
1889 
1890  const cxchar *fctid = "mrqlocywarp";
1891 
1892  cxdouble xccd, nx, startx;
1893  register cxint i,ncoef;
1894  cxdouble Tx, Ty, cx, Ky, tt, xx;
1895  cpl_matrix *mBase = NULL, *mX = NULL;
1896  register cxdouble fxx = 0.0, f1xx = 0.0, f2xx = 0.0, z1;
1897  cxdouble *pd_x = NULL, *pd_mbase = NULL;
1898 
1899  /* check for number of parameters */
1900  if (na != 5) {
1901  cpl_error_set(fctid, CPL_ERROR_ILLEGAL_INPUT);
1902  return;
1903  }
1904 
1905  *y = 0.0;
1906  if (dyda != NULL) {
1907  dyda[LMP_TX] = dyda[LMP_TY] = dyda[LMP_CX] = dyda[LMP_KY] =
1908  dyda[LMP_TT] = 0.0;
1909  }
1910 
1911  xccd = x[LMI_XCCD]; /* pixel abcissa */
1912  nx = x[LMI_NX]; /* number of pixels in dispersion dir. */
1913  startx = x[LMI_STRX]; /* 1st pixel position */
1914  ncoef = (cxint) x[LMI_NCOF]; /* number of chebyshev coef */
1915 
1916  Tx = a[LMP_TX]; /* Translation X */
1917  Ty = a[LMP_TY]; /* Translation Y */
1918  cx = a[LMP_CX]; /* Scaling X: cx = 1/Kx */
1919  Ky = a[LMP_KY]; /* Scaling Y */
1920  tt = a[LMP_TT]; /* Rotation theta: tt = tan(theta) */
1921 
1922  xx = cx*(xccd-Tx);
1923 
1924  mX = cpl_matrix_new(1,1);
1925  pd_x = cpl_matrix_get_data(mX);
1926  pd_x[0] = xx;
1927 
1928  mBase = giraffe_chebyshev_base1d(startx, nx, ncoef, mX);
1929 
1930  pd_mbase = cpl_matrix_get_data(mBase);
1931 
1932  for (i = 0; i < ncoef; i++)
1933  fxx += pd_mbase[i] * x[i+4];
1934 
1935  if (ncoef > 1) {
1936  for (i = 0; i < (ncoef - 1); i++)
1937  f1xx += pd_mbase[i] * (i+1)*x[i+5];
1938  }
1939 
1940  if (ncoef > 2) {
1941  for (i = 0; i < (ncoef - 2); i++)
1942  f2xx += pd_mbase[i] * (i+2)*x[i+6];
1943  }
1944 
1945  if (mX!=NULL) { cpl_matrix_delete(mX); mX = NULL; pd_x = NULL; }
1946  if (mBase!=NULL) { cpl_matrix_delete(mBase); mBase = NULL; pd_mbase = NULL; }
1947 
1948  z1 = 1.0 - tt*tt + tt*f1xx;
1949  *y = Ky*(fxx-tt*xx)/z1 + Ty;
1950 
1951  /* Check if derivatives expected */
1952  if (dyda == NULL)
1953  return;
1954 
1955  dyda[LMP_TX] = /* d(y)/d(Tx) */
1956  (cx*Ky/z1)*((tt-f1xx) + tt*f2xx*(fxx-tt*xx)/z1);
1957 
1958  dyda[LMP_TY] = 1.0; /* d(y)/d(Ty) */
1959 
1960  dyda[LMP_CX] = /* d(y)/d(cx) */
1961  (Ky*(xccd-Tx)/z1)*((f1xx-tt) - tt*f2xx*(fxx-tt*xx)/z1);
1962 
1963  dyda[LMP_KY] = (fxx-tt*xx)/z1; /* d(y)/d(Ky) */
1964  dyda[LMP_TT] = /* d(y)/d(tt) */
1965  (Ky/(z1*z1))*(-xx*(1.+tt*tt)+2.*tt*fxx-fxx*f1xx);
1966 
1967  if (r != NULL) {
1968  register cxint k;
1969 
1970  k = LMP_TX << 1;
1971  if (r[k+1] > 0) {
1972  dyda[LMP_TX] *= mrqdydaweight(a[LMP_TX],r[k],r[k+1]);
1973  }
1974  k = LMP_CX << 1;
1975  if (r[k+1] > 0) {
1976  dyda[LMP_CX] *= mrqdydaweight(a[LMP_CX],r[k],r[k+1]);
1977  }
1978  k = LMP_KY << 1;
1979  if (r[k+1] > 0) {
1980  dyda[LMP_KY] *= mrqdydaweight(a[LMP_KY],r[k],r[k+1]);
1981  }
1982  k = LMP_TT << 1;
1983  if (r[k+1] > 0) {
1984  dyda[LMP_TT] *= mrqdydaweight(a[LMP_TT],r[k],r[k+1]);
1985  }
1986  }
1987 
1988  return;
1989 
1990 } /* end mrqlocywarp() */
1991 
2012 void
2013 mrqxoptmodGS(cxdouble x[], cxdouble a[], cxdouble r[], cxdouble *y,
2014  cxdouble dyda[], cxint na)
2015 {
2016 
2017  const cxchar *fctid = "mrqxoptmodGS";
2018 
2019  register cxdouble lambda,xfibre,yfibre,pixsize,nx;
2020  /* Optical model parameters */
2021  register cxdouble fcoll,cfact;
2022  /* Grating parameters */
2023  register cxdouble gtheta,gorder,gspace;
2024 
2025  register cxdouble t1,t10,t109,t11,t110,t114,t12,t14,t17,t18,t2,t21,t23,t24;
2026  register cxdouble t25,t26,t27,t28,t29,t3,t30,t31,t35,t40,t43,t49,t5,t51,t52;
2027  register cxdouble t53,t59,t6,t66,t67,t69,t7,t71,t8,t82,t84,t9,t95,t98;
2028 
2029  /* check for number of parameters */
2030  if (na != 7) {
2031  cpl_error_set(fctid, CPL_ERROR_ILLEGAL_INPUT);
2032  return;
2033  }
2034 
2035  *y = 0.0;
2036  if (dyda != NULL) {
2037  dyda[LMP_NX] = dyda[LMP_PXSIZ] = dyda[LMP_FCOLL] = dyda[LMP_CFACT] =
2038  dyda[LMP_THETA] = dyda[LMP_ORDER] = dyda[LMP_SPACE] = 0.0;
2039  }
2040 
2041  lambda = x[LMI_WLEN]; /* wavelength [mm] */
2042  xfibre = x[LMI_XFIB]; /* Y fibre [mm] */
2043  yfibre = x[LMI_YFIB]; /* Y fibre [mm] */
2044 
2045  nx = a[LMP_NX]; /* CCD size in X [pixels] */
2046  pixsize = a[LMP_PXSIZ]; /* CCD pixel size [mm] */
2047  fcoll = a[LMP_FCOLL]; /* collimator focal length [mm] */
2048  cfact = a[LMP_CFACT]; /* camera magnification factor */
2049  gtheta = a[LMP_THETA]; /* grating angle [radian] */
2050  gorder = a[LMP_ORDER]; /* grating diffraction order */
2051  gspace = a[LMP_SPACE]; /* grating groove spacing [mm] */
2052 
2053  t1 = cfact*fcoll;
2054  t2 = lambda*gorder;
2055  t3 = 1.0/gspace;
2056  t5 = cos(gtheta);
2057  t6 = xfibre*t5;
2058  t7 = xfibre*xfibre;
2059  t8 = yfibre*yfibre;
2060  t9 = fcoll*fcoll;
2061  t10 = t7+t8+t9;
2062  t11 = sqrt(t10);
2063  t12 = 1.0/t11;
2064  t14 = sin(gtheta);
2065  t17 = -t2*t3+t12*t6+fcoll*t14*t12;
2066  t18 = t17*t5;
2067  t21 = t17*t17;
2068  t23 = sqrt(1.0-t8/t10-t21);
2069  t24 = t14*t23;
2070  t25 = t18+t24;
2071  t26 = t17*t14;
2072  t27 = t5*t23;
2073  t28 = -t26+t27;
2074  t29 = 1.0/t28;
2075  t30 = t25*t29;
2076  t31 = 1.0/pixsize;
2077  t35 = pixsize*pixsize;
2078  t40 = t29*t31;
2079  t43 = 1.0/t11/t10;
2080  t49 = -t6*t43*fcoll+t14*t12-t9*t14*t43;
2081  t51 = 1.0/t23;
2082  t52 = t14*t51;
2083  t53 = t10*t10;
2084  t59 = 2.0*t8/t53*fcoll-2.0*t17*t49;
2085  t66 = t1*t25;
2086  t67 = t28*t28;
2087  t69 = 1.0/t67*t31;
2088  t71 = t5*t51;
2089  t82 = -xfibre*t14*t12+fcoll*t5*t12;
2090  t84 = t17*t82;
2091  t95 = lambda*t3;
2092  t98 = t17*lambda*t3;
2093  t109 = gspace*gspace;
2094  t110 = 1.0/t109;
2095  t114 = t2*t110;
2096 
2097  /* takes care of model direction */
2098  if (nx < 0.0)
2099  *y = t1*t30*t31-0.5*nx;
2100  else
2101  *y = -t1*t30*t31+0.5*nx;
2102 
2103  /* Check if derivatives expected */
2104  if (dyda == NULL)
2105  return;
2106 
2107  /* derivatives for each parameters */
2108  dyda[LMP_NX] = 0.5; /* d(y)/d(nx) */
2109  dyda[LMP_PXSIZ] = -t1*t30/t35; /* d(y)/d(pixsize) */
2110  dyda[LMP_FCOLL] = /* d(y)/d(fcoll) */
2111  cfact*t25*t40+t1*(t49*t5+t52*t59/2.0)*t29*t31-
2112  t66*t69*(-t49*t14+t71*t59/2.0);
2113  dyda[LMP_CFACT] = /* d(y)/d(cfact) */
2114  fcoll*t25*t40;
2115  dyda[LMP_THETA] = /* d(y)/d(gtheta) */
2116  t1*(t82*t5-t26+t27-t52*t84)*t29*t31-
2117  t66*t69*(-t82*t14-t18-t24-t71*t84);
2118  dyda[LMP_ORDER] = /* d(y)/d(gorder) */
2119  t1*(-t95*t5+t52*t98)*t29*t31-t66*t69*(t95*t14+t71*t98);
2120  dyda[LMP_SPACE] = /* d(y)/d(gspace) */
2121  t1*(t2*t110*t5-t52*t17*t114)*t29*t31-
2122  t66*t69*(-t2*t110*t14-t71*t17*t114);
2123 
2124  if (nx > 0.0) {
2125  dyda[LMP_NX] = -dyda[LMP_NX];
2126  dyda[LMP_PXSIZ] = -dyda[LMP_PXSIZ];
2127  dyda[LMP_FCOLL] = -dyda[LMP_FCOLL];
2128  dyda[LMP_CFACT] = -dyda[LMP_CFACT];
2129  dyda[LMP_THETA] = -dyda[LMP_THETA];
2130  dyda[LMP_ORDER] = -dyda[LMP_ORDER];
2131  dyda[LMP_SPACE] = -dyda[LMP_SPACE];
2132  }
2133 
2134  if (r != NULL) {
2135  register cxint k;
2136 
2137  k = LMP_PXSIZ << 1;
2138  if (r[k+1] > 0) {
2139  dyda[LMP_PXSIZ] *= mrqdydaweight(a[LMP_PXSIZ],r[k],r[k+1]);
2140  }
2141  k = LMP_FCOLL << 1;
2142  if (r[k+1] > 0) {
2143  dyda[LMP_FCOLL] *= mrqdydaweight(a[LMP_FCOLL],r[k],r[k+1]);
2144  }
2145  k = LMP_CFACT << 1;
2146  if (r[k+1] > 0) {
2147  dyda[LMP_CFACT] *= mrqdydaweight(a[LMP_CFACT],r[k],r[k+1]);
2148  }
2149  k = LMP_THETA << 1;
2150  if (r[k+1] > 0) {
2151  dyda[LMP_THETA] *= mrqdydaweight(a[LMP_THETA],r[k],r[k+1]);
2152  }
2153  k = LMP_ORDER << 1;
2154  if (r[k+1] > 0) {
2155  dyda[LMP_ORDER] *= mrqdydaweight(a[LMP_ORDER],r[k],r[k+1]);
2156  }
2157  k = LMP_SPACE << 1;
2158  if (r[k+1] > 0) {
2159  dyda[LMP_SPACE] *= mrqdydaweight(a[LMP_SPACE],r[k],r[k+1]);
2160  }
2161  }
2162 
2163 } /* end mrqxoptmodGS() */
2164 
2188 void
2189 mrqtest(cxdouble x[], cxdouble a[], cxdouble r[], cxdouble *y,
2190  cxdouble dyda[], cxint na)
2191 {
2192 
2193  const cxchar *fctid = "mrqtest";
2194 
2195  cxdouble a1 = a[0];
2196  cxdouble b1 = a[1];
2197 
2198  (void) r; /* Not used. */
2199 
2200  /* check for number of parameters */
2201  if (na != 2) {
2202  cpl_error_set(fctid, CPL_ERROR_ILLEGAL_INPUT);
2203  return;
2204  }
2205 
2206  *y = 0.0;
2207  *y = a1 * x[0] + b1;
2208 
2209  /* Check if derivatives expected */
2210  if (dyda == NULL)
2211  return;
2212 
2213  dyda[0] = 0.0;
2214  dyda[1] = 0.0;
2215 
2216  return;
2217 
2218 } /* end mrqtest() */
2219 
struct definition to handle model functions
Definition: gimath_lm.h:146

This file is part of the GIRAFFE Pipeline Reference Manual 2.14.
Documentation copyright © 2002-2006 European Southern Observatory.
Generated on Wed Mar 11 2015 13:19:41 by doxygen 1.8.9.1 written by Dimitri van Heesch, © 1997-2004