/*===========================================================================
  Copyright (C) 2001 European Southern Observatory (ESO)
 
  This program is free software; you can redistribute it and/or 
  modify it under the terms of the GNU General Public License as 
  published by the Free Software Foundation; either version 2 of 
  the License, or (at your option) any later version.
 
  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.
 
  You should have received a copy of the GNU General Public 
  License along with this program; if not, write to the Free 
  Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
  MA 02139, USA.
 
  Corresponding concerning ESO-MIDAS should be addressed as follows:
    Internet e-mail: midas@eso.org
    Postal address: European Southern Observatory
            Data Management Division 
            Karl-Schwarzschild-Strasse 2
            D 85748 Garching bei Muenchen 
            GERMANY
===========================================================================*/
#ifdef HAVE_CONFIG_H
#  include <config.h>
#endif


/* Code taken from MIDAS $MIDASHOME/$MIDVERS/stdred/echelle/libsrc/mrqmin.c */
#include <stdio.h>
#include <flames_gaussj.h>
#include <flames_mrqcof.h>
#include <flames_newmatrix.h>
#include <flames_covsrt.h>
#include <flames_uves.h>
#include <flames_mrqmin.h>


int mrqmin(float x[],
           float y[],
           float sig[],
           int ndata,
           float a[],
           int ma,
           int lista[],
           int mfit,
           float ** covar,
           float ** alpha,
           float * chisq,
           void (*funcs)(float,float *,float *,float *,int),
           double * alamda)
     /*
float x[],y[],sig[],a[],**covar,**alpha,*chisq;
double *alamda;
int ndata,ma,lista[],mfit;
void (*funcs)();
     */
/* This code implements Levenberg Marquardt method to fit data */
{
    int k,kk,j,ihit,err;
    static float *da,*atry,**oneda,*beta,ochisq;
    err = 0;

    if (*alamda < 0.0) {
        oneda=matrix(1,mfit,1,1);
        atry=vector(1,ma);
        da=vector(1,ma);
        beta=vector(1,ma);
        kk=mfit+1;
                printf("kk=%d\n",kk);
        for (j=1;j<=ma;j++) {
            ihit=0;
            for (k=1;k<=mfit;k++) {
              printf("lista=%d j=%d k=%d\n",lista[k],j,k);
                if (lista[k] == j) ihit++;
            }
            if (ihit == 0)
                lista[kk++]=j;
            else if (ihit > 1) nrerror("Bad LISTA permutation in MRQMIN-1");
                printf("kk=%d\n",kk);
        }
        if (kk != ma+1) nrerror("Bad LISTA permutation in MRQMIN-2");
        
        *alamda=0.001;
                printf("Run mrqcof\n");
        mrqcof(x,y,sig,ndata,a,ma,lista,mfit,alpha,beta,chisq,funcs);
                printf("Runed mrqcof\n");
        ochisq=(*chisq);
    }
        printf("exit\n");
    for (j=1;j<=mfit;j++) {
        for (k=1;k<=mfit;k++) covar[j][k]=alpha[j][k];
        covar[j][j]=alpha[j][j]*(1.0+(*alamda));
        oneda[j][1]=beta[j];
    }
    err = gaussj(covar,mfit,oneda,1);
    for (j=1;j<=mfit;j++)
        da[j]=oneda[j][1];
    if (*alamda == 0.0) {
       covsrt((double **)covar,ma,lista,mfit);
        free_vector(beta,1,ma);
        free_vector(da,1,ma);
        free_vector(atry,1,ma);
        free_matrix(oneda,1,mfit,1,1);
        return(err);
    }
    for (j=1;j<=ma;j++) atry[j]=a[j];
    for (j=1;j<=mfit;j++)
        atry[lista[j]] = a[lista[j]]+da[j];
    mrqcof(x,y,sig,ndata,atry,ma,lista,mfit,covar,da,chisq,funcs);
    if (*chisq < ochisq) {
        *alamda *= 0.1;
        ochisq=(*chisq);
        for (j=1;j<=mfit;j++) {
            for (k=1;k<=mfit;k++) alpha[j][k]=covar[j][k];
            beta[j]=da[j];
            a[lista[j]]=atry[lista[j]];
        }
    } else {
        *alamda *= 10.0;
        *chisq=ochisq;
    }
    return(err);
}



/* mrq_min() is the same as mrqmin() except for that x is assumed to be
   an array starting at 1 and having a step size of 1: 1,2,3,4,...,ndata.
   As x is only used in mrqcof or mrq_cof() respectively, the changes had
   only to be done in mrq_cof()!
 */
int mrq_min(float y[],
            float sig[],
            int ndata,
            float a[],
            int ma,
            int lista[],
            int mfit,
            float ** covar,
            float ** alpha,
            float * chisq,
            void (*funcs)(float,float *,float *,float *,int),
            float * alamda)
{
    int k,kk,j,ihit,err;
    static float *da,*atry,**oneda,*beta,ochisq;

    if (*alamda < 0.0) {
        oneda=matrix(1,mfit,1,1);
        atry=vector(1,ma);
        da=vector(1,ma);
        beta=vector(1,ma);
        kk=mfit+1;
        for (j=1;j<=ma;j++) {
            ihit=0;
            for (k=1;k<=mfit;k++)
                if (lista[k] == j) ihit++;
            if (ihit == 0)
                lista[kk++]=j;
            else if (ihit > 1) nrerror("Bad LISTA permutation in MRQMIN-1");
        }
        if (kk != ma+1) nrerror("Bad LISTA permutation in MRQMIN-2");
        *alamda=0.001;
        mrq_cof(y,sig,ndata,a,ma,lista,mfit,alpha,beta,chisq,funcs);
        ochisq=(*chisq);
    }
    for (j=1;j<=mfit;j++) {
        for (k=1;k<=mfit;k++) covar[j][k]=alpha[j][k];
        covar[j][j]=alpha[j][j]*(1.0+(*alamda));
        oneda[j][1]=beta[j];
    }
    err = gaussj(covar,mfit,oneda,1);
    for (j=1;j<=mfit;j++)
        da[j]=oneda[j][1];
    if (*alamda == 0.0) {
       covsrt((double **)covar,ma,lista,mfit);
        free_vector(beta,1,ma);
        free_vector(da,1,ma);
        free_vector(atry,1,ma);
        free_matrix(oneda,1,mfit,1,1);
        return(err);
    }
    for (j=1;j<=ma;j++) atry[j]=a[j];
    for (j=1;j<=mfit;j++)
        atry[lista[j]] = a[lista[j]]+da[j];
    mrq_cof(y,sig,ndata,atry,ma,lista,mfit,covar,da,chisq,funcs);
    if (*chisq < ochisq) {
        *alamda *= 0.1;
        ochisq=(*chisq);
        for (j=1;j<=mfit;j++) {
            for (k=1;k<=mfit;k++) alpha[j][k]=covar[j][k];
            beta[j]=da[j];
            a[lista[j]]=atry[lista[j]];
        }
    } else {
        *alamda *= 10.0;
        *chisq=ochisq;
    }
    return(err);
}
