
/*******************************************************************************
*
* File ssap_gcr.c
*
* Copyright (C) 2011 Andrea Nobile
*
*
*
*******************************************************************************/

#define SAP_GCR_C

#include <stdlib.h>
#include <stdio.h>
#include <math.h>
#include "mpi.h"
#include "su3.h"
#include "flags.h"
#include "start.h"
#include "block.h"
#include "linalg.h"
#include "linsolv.h"
#include "sw_term.h"
#include "dirac.h"
#include "sap_gcr.h"
#include "global.h"


static int nmr,ncy,nkv,iwd;
static spinor **ws;
static spinor_dble **wsd;

static int dds_myrank;
extern int gauge_updated;

double fgmres_dr(int vol,int icom,void (*Op)(spinor_dble *pk,spinor_dble *pl),
		 void (*Mj)(int j,spinor *pr,spinor *pz,spinor *paz),
		 spinor *ws[],spinor_dble *wsd[],int nkv,int nmx,double res,
		 spinor_dble *pk,spinor_dble *pl,int *status);


void set_ndfl(int ndfl);

static void Op_dble(spinor_dble *pk,spinor_dble *pl)
{
   int k,l;

   k=(pk-psd[0][0])/NSPIN;
   l=(pl-psd[0][0])/NSPIN;

   Qnohat_dble(k,l);
   mulg5_dble(VOLUME,pl);
}


static void Opz(spinor *pr,spinor *paz)
{
   spinor *rsm;

   rsm=pr+VOLUME;

   for (;pr<rsm;pr++)
   {
      _vector_sub((*paz).c1,(*pr).c1,(*paz).c1);
      _vector_sub((*paz).c2,(*pr).c2,(*paz).c2);
      _vector_sub((*paz).c3,(*pr).c3,(*paz).c3);
      _vector_sub((*paz).c4,(*pr).c4,(*paz).c4);
      paz+=1;
   }
}

void Mj(int j, spinor *pr,spinor *pz,spinor *paz)
{
  int n;
  
  
  
  set_s2zero(VOLUME,pz);
  assign_s2s(VOLUME,pr,paz);

  for (n=0;n<ncy;n++) {
    msap_gs_ptr(nmr,paz,pz);
  
  }
  
   Opz(pr,paz);
}




double ssap_fgmres_dr(int nmx,int ndfl, double res,int k,int l,int *status,int *ifail)
{
   int iprms[3];
   double dprms[1],rho;
   gcr_parms_t gcr;
   lat_parms_t lat;

   if (NPROC>1)
   {
      iprms[0]=nmx;
      iprms[1]=k;
      iprms[2]=l;

      dprms[0]=res;

      MPI_Bcast(iprms,3,MPI_INT,0,MPI_COMM_WORLD);
      MPI_Bcast(dprms,1,MPI_DOUBLE,0,MPI_COMM_WORLD);

      error((iprms[0]!=nmx)||(iprms[1]!=k)||(iprms[2]!=l)||(dprms[0]!=res),1,
            "sap_gcr [sap_gcr.c]","Parameters are not global");
   }

   lat=lat_parms();
   gcr=gcr_parms();
   
   MPI_Comm_rank(MPI_COMM_WORLD,&dds_myrank);
   
   error_root(lat.kappa==0.0,1,
              "sap_gcr [sap_gcr.c]","Lattice parameters are not set");
   error_root(gcr.nb==0,1,
              "sap_gcr [sap_gcr.c]","GCR parameters are not set");

   
   nmr=gcr.nmr;
   ncy=gcr.ncy;
   nkv=gcr.nkv;
  
  
   wsd=reserve_wsd(1);
   iwd=(wsd[0]-psd[0][0])/NSPIN;
   *ifail=0;

   error_root((k<0)||(k>=no_sd)||(k==iwd)||
              (l<0)||(l>=no_sd)||(l==iwd)||(k==l),1,
              "sap_gcr [sap_gcr.c]","Improper workspace or arguments k,l");
   if(gauge_updated) {
     //if (query_blk_flags(GCR_BLOCKS,UBLK_MATCH_UD,nb)!=1)
     assign_ud2ubgr(GCR_BLOCKS);
     
     //if ((query_flags(SWD_UP2DATE)!=1)||
     // (query_flags(SWD_E_INVERTED)!=0)||(query_flags(SWD_O_INVERTED)!=0))
     sw_term();
     
     //if (check_blk_flags(GCR_BLOCKS,QHAT,nb)!=0)
     (*ifail)|=assign_swd2swbgr(GCR_BLOCKS,ALL_PTS);
     gauge_updated = 0;
   }
      
   if (*ifail)
   {
      *status=0;
      rho=1.0;
   }
   else
   {
      error_root(check_flags(QNOHAT_DBLE)!=0,1,"sap_gcr [sap_gcr.c]",
                 "Global fields are not in proper condition");

      
      set_ndfl(ndfl);

      rho=fgmres_dr(VOLUME,1,Op_dble,Mj,ws,wsd,nkv,nmx,res,psd[k][0],psd[l][0],status);
               

   
   }
   
   release_wsd();
   

   return rho;
}
