/*===========================================================================
  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
  ===========================================================================*/
/*-------------------------------------------------------------------------*/
/**
 * @defgroup flames_gaussj  Gauss-Jordan elimination for inverting matrices for matrices of type float 
 *
 */
/*-------------------------------------------------------------------------*/

/*---------------------------------------------------------------------------
  Includes
  --------------------------------------------------------------------------*/

#ifdef HAVE_CONFIG_H
#  include <config.h>
#endif

#include <stdio.h>
#include <math.h>
#include <string.h>

#include <flames_gaussj.h>
#include <flames_dgaussj.h>
#include <flames_midas_def.h>
#include <flames_def_drs_par.h>
#include <flames_uves.h>
#include <flames_newmatrix.h>
#include <uves_msg.h>

#define SWAP(a,b) {float temp=(a);(a)=(b);(b)=temp;}

//jmlarsen: this use of static memory might not work
static int  nold = -1;
static int  *indxc, *indxr, *ipiv;

static float 
fabs_f(float);

/* 
   Absolute value for float variables
*/  

static float 
fabs_f(float x)
{
  if (x<0) return(-x);
  return(x);
}
/**@{*/

/*---------------------------------------------------------------------------
  Implementation
  ---------------------------------------------------------------------------*/
/**
   @name  flames_gaussj()  
   @short  Gauss-Jordan elimination for inverting matrices for matrices of type float 
   @author G. Mulas  -  ITAL_FLAMES Consortium. Ported to CPL by A. Modigliani

   @param a 
   @param n 
   @param b 
   @param m

   @return success or failure code

   DRS Functions called:          
                                                                         
   Pseudocode:                                                             

   @note
   public C functions from Numerical Recipes
   modified for their use within the MIDAS environment

*/


int 
gaussj(
       float **a, 
       int n, 
       float **b, 
       int m)
{
  int i=0;
  int icol=0;//initialize to 1 to be sure that a[0] is never accessed
  int irow=0;//initialize to 1 to be sure that a[0] is never accessed
  int j=0;
  int k=0;
  int l=0;
  int ll=0;
  float big=0;
  float dum=0;
  float pivinv=0;
  /* float fabs_f();*/


  int actvals=0;
  char drs_verbosity[10];
  int mid_stat=0;

  memset(drs_verbosity, 0, 10);
  if ((mid_stat=SCKGETC(DRS_VERBOSITY, 1, 3, &actvals, drs_verbosity))
      != 0) {
    /* the keyword seems undefined, protest... */
    return(MAREMMA);
  }

  if (n > nold)
    {
      if (nold > -1)        /* not the very first time */
        {
	  if ( strcmp(drs_verbosity,"LOW") == 0 ){
	  } else {
	    printf("floatgauss: remapping memory, nold = %d, new n = %d\n",nold,n);
	  }
	  free_ivector(ipiv,1,nold);
	  free_ivector(indxr,1,nold);
	  free_ivector(indxc,1,nold);
        }
      indxc=ivector(1,n);
      indxr=ivector(1,n);
      ipiv=ivector(1,n);
      nold = n;
    }
  
  for (j=1;j<=n;j++) ipiv[j]=0;
  for (i=1;i<=n;i++) {
    big=0.0;
    for (j=1;j<=n;j++)
      if (ipiv[j] != 1)
	for (k=1;k<=n;k++) {
	  if (ipiv[k] == 0) {
	    if (fabs_f(a[j][k]) >= big) {
	      big=fabs_f(a[j][k]);
	      irow=j;
	      icol=k;
	    }
	  } else if (ipiv[k] > 1){
	    uves_msg_error("GAUSSJ: Singular Matrix-1");
	    free_ivector(ipiv,1,nold);
	    free_ivector(indxr,1,nold);
	    free_ivector(indxc,1,nold);
            nold = -1;
	    return(-1);
	  }
	}
    ++(ipiv[icol]);
    if (irow != icol) {
      for (l=1;l<=n;l++) SWAP(a[irow][l],a[icol][l])
	for (l=1;l<=m;l++) SWAP(b[irow][l],b[icol][l])
	  }
    indxr[i]=irow;
    indxc[i]=icol;
    if (a[icol][icol] == 0.0){
      uves_msg_error("GAUSSJ: Singular Matrix-2");
      free_ivector(ipiv,1,nold);
      free_ivector(indxr,1,nold);
      free_ivector(indxc,1,nold);
      nold = -1;
      return(-2);
    }
    pivinv=1.0/a[icol][icol];
    a[icol][icol]=1.0;
    for (l=1;l<=n;l++) a[icol][l] *= pivinv;
    for (l=1;l<=m;l++) b[icol][l] *= pivinv;
    for (ll=1;ll<=n;ll++)
      if (ll != icol) {
	dum=a[ll][icol];
	a[ll][icol]=0.0;
	for (l=1;l<=n;l++) a[ll][l] -= a[icol][l]*dum;
	for (l=1;l<=m;l++) b[ll][l] -= b[icol][l]*dum;
      }
  }
  for (l=n;l>=1;l--) {
    if (indxr[l] != indxc[l])
      for (k=1;k<=n;k++)
	SWAP(a[k][indxr[l]],a[k][indxc[l]]);
  }

  return(0);
}





int 
dgaussj(double **a, int n, double **b, int m)
{
  int i=0;
  int icol=1; //initialize to 1 to be sure that a[0] is never accessed
  int irow=1; //initialize to 1 to be sure that a[0] is never accessed
  int j=0;
  int k=0;
  int l=0;
  int ll=0;
  double big, dum, pivinv;
 
  double eps=1.e-30, epsn=-1.e-30;
  int  *ip, *iq;
  register int pivot, irr, icc;

  int actvals=0;
  char drs_verbosity[10];
  int mid_stat=0;

  memset(drs_verbosity, 0, 10);
  if ((mid_stat=SCKGETC(DRS_VERBOSITY, 1, 3, &actvals, drs_verbosity)) != 0) {
    /* the keyword seems undefined, protest... */
    return(MAREMMA);
  }



  if (n > nold) {
    if (nold > -1)  {           /* not the very first time */
       
      if ( strcmp(drs_verbosity,"LOW") == 0 ) {
      } else {
	printf("doublegauss: remapping memory, nold = %d, new n = %d\n",nold,n);
      }
      free_ivector(ipiv,1,nold);
      free_ivector(indxr,1,nold);
      free_ivector(indxc,1,nold);
    }
    indxc=ivector(1,n);
    indxr=ivector(1,n);
    ipiv=ivector(1,n);
    nold = n;
  }


  for (j=1;j<=n;j++) ipiv[j]=0;


  for (i=1;i<=n;i++) {
    big=0.0;
    for (j=1;j<=n;j++) {
      if (ipiv[j] != 1) {
        for (k=1;k<=n;k++) {
          pivot = ipiv[k];
	  if (pivot == 0) {
	    if (fabs(a[j][k]) >= big) {
	      big=fabs(a[j][k]);
	      irow=j;
	      icol=k;
 	    }
	  }
          else if (pivot > 1) {
	    uves_msg_error("GAUSSJ: Singular Matrix-1");
	    free_ivector(ipiv,1,nold);
	    free_ivector(indxr,1,nold);
            free_ivector(indxc,1,nold);
            nold = -1;
	    return(-1);
	  }
	}
      }
    }

    ++(ipiv[icol]);
    if (irow != icol) {
      for (l=1;l<=n;l++) SWAP(a[irow][l],a[icol][l]);
      for (l=1;l<=m;l++) SWAP(b[irow][l],b[icol][l]);
    }
    indxr[i]=irow;
    indxc[i]=icol;
    dum = a[icol][icol];

    a[icol][icol]=1.0;

    if ((dum < eps) && (dum > epsn))  {       /* better than == 0.0 */
      
      uves_msg_error("GAUSSJ: Singular Matrix-2");
      free_ivector(ipiv,1,nold);
      free_ivector(indxr,1,nold);
      free_ivector(indxc,1,nold);
      nold = -1;
      return(-2);
    }

    pivinv=1.0/dum;
    for (l=1;l<=n;l++) a[icol][l] *= pivinv;
    for (l=1;l<=m;l++) b[icol][l] *= pivinv;
    for (ll=1;ll<=n;ll++) {
      if (ll != icol) {

	dum=a[ll][icol];
	a[ll][icol]=0.0;
        for (l=1;l<=n;l++) a[ll][l] -= a[icol][l]*dum;
        for (l=1;l<=m;l++) b[ll][l] -= b[icol][l]*dum;

      }
    }

  }


  ip = &indxr[n]; iq = &indxc[n];
  for (l=n;l>=1;l--) {
    irr = *ip--;
    icc = *iq--; 
    if (irr != icc) {
      for (k=1;k<=n;k++) SWAP(a[k][irr],a[k][icc]);
    }
  }

  return(0);
}


#undef SWAP
/**@}*/
