
/*******************************************************************************
*
* File sap_gcr.c
*
* Copyright (C) 2005 Martin Luescher
*
* This software is distributed under the terms of the GNU General Public
* License (GPL)
*
* SAP+GCR solver for the Wilson-Dirac equation (D_w+m0)*psi=eta
*
* The externally accessible functions is
*
*   double sap_gcr(int nmx,double res,int k,int l,int *status,int *ifail)
*     Obtains an approximate solution psi=psd[l] of the Wilson-Dirac equation
*     for a given source eta=psd[k], using at most nmx GCR iterations, with a
*     relative residue smaller than res. The global swd field and the fields
*     on the GCR_BLOCKS grid are updated automatically when needed
*      On exit status reports the number of iterations that were required, or
*     a negative value if the solver failed, while ifail is 0 or 1 depending
*     on whether the inversions of the SW-term (if any) were safe or not. The
*     return value is the norm of the residue of the solution
*
* Notes:
*
* Evidently the SAP+GCR solver is a global program that must be called on
* all processes simultaneously. It requires a workspace of 2*nkv+1 single-
* precision spinor fields and 1 double-precision spinor field. The workspace
* is reserved internally using the utilities in the wspace.c module (these
* must therefore also be used in the calling programs)
*
* To run this program it suffices to set the lattice and solver parameters
* through set_lat_parms() and set_gcr_parms() [parms.c]. The program then
* carries out all preparatory steps or terminates with an error message
* if an inconsistency is discovered
*
*******************************************************************************/

#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;

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;
   }
}


static void Mj(int j,spinor *pr,spinor *pz,spinor *paz)
{
   int n,isz,isaz;
   //double nn;
   isz=(pz-ps[0][0])/NSPIN;
   isaz=(paz-ps[0][0])/NSPIN;

   set_s2zero(VOLUME,pz);
   assign_s2s(VOLUME,pr,paz);

   for (n=0;n<ncy;n++) {
      msap(nmr,isaz,isz);
      //nn = norm_square(VOLUME,1,paz);
      //nn = sqrt(nn);
      if(!dds_myrank) {
	//printf("sap cycle %d n = %e\n", n, nn);
      }
   }

   Opz(pr,paz);
   //exit(0);
}


double sap_gcr(int nmx,double res,int k,int l,int *status,int *ifail)
{
   int iprms[3],nb;
   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");
   }
   
   MPI_Comm_rank(MPI_COMM_WORLD,&dds_myrank);

   lat=lat_parms();
   gcr=gcr_parms();

   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");

   nb=gcr.nb;
   nmr=gcr.nmr;
   ncy=gcr.ncy;
   nkv=gcr.nkv;

   ws=reserve_ws(2*nkv+1);
   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) {
     assign_ud2ubgr(GCR_BLOCKS);
     (*ifail)|=assign_swd2swbgr(GCR_BLOCKS,ODD_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");

      error_root(check_blk_flags(GCR_BLOCKS,QHAT,nb)!=0,1,"sap_gcr [sap_gcr.c]",
                 "Block fields are not in proper condition");
      

      rho=fgcr(VOLUME,1,Op_dble,Mj,ws,wsd,nkv,nmx,res,
               psd[k][0],psd[l][0],status);
   }
   
   release_wsd();
   release_ws();
   
   return rho;
}
