https://github.com/entron/snake-dmrg
Raw File
Tip revision: 5581575de60596a13ea45e4ac96e981b761d95c0 authored by Cheng Guo on 18 March 2015, 18:47:37 UTC
Update README.md
Tip revision: 5581575
SuperChain_iDMRG.cpp
#include "SuperChain.h"

namespace snake
{
namespace physics
{
long int multnum;
}
}

void snake::physics::SuperChain::CalGroundState()
{
  //std::cout<<leftbase<<std::endl;
  //std::cout<<rightbase<<std::endl;
  //std::cout<<Hlr<<std::endl;
  //std::cout<<L->hamiltonian->H<<std::endl;
  //std::cout<<R->hamiltonian->H<<std::endl;
  
  midsite1=snake::physics::allfreesites[L->sitenum-1];
  midsite2=snake::physics::allfreesites[L->sitenum];
  double *eigval,**eigvec;
  int dim=calDim();
  int EigStatesNum=1;

  std::cout<<"SupL="<<sitenum<<"\t";
  std::cout<<"TargetGQNNum="; printvector(TargetGQN); std::cout<<"\t";
  std::cout<<"SupHamDim="<<dim<<"\t";

  mtimes=0;
  H2Dim=Hlr.size(0);

  eigval = new double[EigStatesNum];
  eigvec = new double*[dim];
  for (int i=0; i<dim; i++) eigvec[i] = new double[EigStatesNum];

  genindex();
  genmiddlemap(TargetGQN);
  dsaupd(dim,EigStatesNum,eigval,eigvec);

  //std::cout.width(20);
  std::cout.precision(15);
  std::cout<<"Eg="<<eigval[0]<<"\t";

  wf.resize(dim,1);
  for(int i=0;i<dim;i++) wf(i)=eigvec[i][0];

  delete [] eigval;
  for (int i=0; i<dim; i++)
    delete [] eigvec[i];
  delete [] eigvec;
  deletemiddlemap();
  delindex();
}


int snake::physics::SuperChain::calDim()
{
  int Dim=0;
  for(int i=0;i<leftbase.subnum;i++)
    for(int j=0;j<rightbase.subnum;j++)
    {
    	//std::cout<<leftbase.subgqn[i]+rightbase.subgqn[j]<<std::endl;
    	//printvector(TargetGQN);
    	if(leftbase.subgqn[i]+rightbase.subgqn[j]==TargetGQN)
    		Dim+=leftbase.dim[i]*rightbase.dim[j];
    }
  return Dim;
}

void snake::physics::SuperChain::av(int n,double *in,double *out)
{
  rightmult(in,out);
  leftmult(in,out);
  middlemult(Hlr,in,out);
  mtimes++;
}


void snake::physics::SuperChain::rightmult(double *in,double *out)
{
  double *instart,*outstart;
  instart=in;
  outstart=out;
  for(int j=0;j<leftbase.subnum;j++)
    for(int i=0;i<rightbase.subnum;i++)
      if(rightbase.subgqn[i]+leftbase.subgqn[j]==TargetGQN)
      {
        blas_mat_mat_mult(R->hamiltonian->H.submat[R->hamiltonian->H.pmat(i,i)].addr(),rightbase.dim[i],rightbase.dim[i],instart,rightbase.dim[i],leftbase.dim[j],outstart,rightbase.dim[i],leftbase.dim[j]);
        instart+=rightbase.dim[i]*leftbase.dim[j];
        outstart+=rightbase.dim[i]*leftbase.dim[j];//Can use instart instead
      }
}


void snake::physics::SuperChain::leftmult(double *in ,double *out)
{
  double *instart,*outstart;
  instart=in;
  outstart=out;
  for(int j=0;j<leftbase.subnum;j++)
    for(int i=0;i<rightbase.subnum;i++)
      if(rightbase.subgqn[i]+leftbase.subgqn[j]==TargetGQN)
      {
        blas_mat_mat_mult(instart,rightbase.dim[i],leftbase.dim[j],L->hamiltonian->H.submat[L->hamiltonian->H.pmat(j,j)].addr(),leftbase.dim[j],leftbase.dim[j],outstart,rightbase.dim[i],leftbase.dim[j],1.0,1.0);
        instart+=rightbase.dim[i]*leftbase.dim[j];
        outstart+=rightbase.dim[i]*leftbase.dim[j];
      }
}

/*
void snake::physics::SuperChain::middlemult(LaGenMatDouble &TO,double *in,double *out)
{
  for(int i=0;i<H2Dim;i++)
    for(int k=0;k<H2Dim;k++)
      if(TO(i,k)!=0)
        for(int j=0;j<mapdim[i];j++)
          out[map[i][j]]+=TO(i,k)*in[map[k][j]];
}
*/


void snake::physics::SuperChain::genindex()
{
  GQNBase b1=midsite1.base;
  GQNBase b2=midsite2.base;
  //std::cout<<b<<std::endl;
  index=new int*** [b1.subnum];
  for(int j=0;j<b1.subnum;j++)
  {
    index[j]=new int** [b1.dim[j]];
    for(int r=0;r<b1.dim[j];r++)
    {
      index[j][r]=new int* [b2.subnum];
      for(int k=0;k<b2.subnum;k++)
        index[j][r][k]=new int [b2.dim[k]];
    }
  }
  int p=0;
  for(int j=0;j<b1.subnum;j++)
    for(int r=0;r<b1.dim[j];r++)
      for(int k=0;k<b2.subnum;k++)
        for(int s=0;s<b2.dim[k];s++)
        {
          index[j][r][k][s]=p;
          p++;
        }
}


void snake::physics::SuperChain::delindex()
{
  GQNBase b1=midsite1.base;
  GQNBase b2=midsite2.base;
  for(int j=0;j<b1.subnum;j++)
  {
    for(int r=0;r<b1.dim[j];r++)
    {
      for(int k=0;k<b2.subnum;k++)
        delete [] index[j][r][k];
      delete [] index[j][r];
    }
    delete [] index[j];
  }
  delete [] index;
}


void snake::physics::SuperChain::genmiddlemap(std::vector<snake::math::GQN> &tgqn)
{
  int middleDim=midsite1.base.Dim*midsite2.base.Dim;
  int count[middleDim];
  mapdim=new int [middleDim];
  map=new int *[middleDim];
  for(int i=0;i<middleDim;i++)
    mapdim[i]=0;
  GQNBase leftsite=midsite1.base;
  GQNBase rightsite=midsite2.base;

  for(int m=0;m<leftbase.subnum;m++)
  {
    for(int i=0;i<oldleftbase.subnum;i++)
      for(int p=0;p<oldleftbase.dim[i];p++)
        for(int j=0;j<leftsite.subnum;j++)
          if(leftbase.subgqn[m]==oldleftbase.subgqn[i]+leftsite.subgqn[j])
            for(int r=0;r<leftsite.dim[j];r++)
              for(int k=0;k<rightsite.subnum;k++)
                for(int s=0;s<rightsite.dim[k];s++)
                  for(int l=0;l<oldrightbase.subnum;l++)
                    for(int q=0;q<oldrightbase.dim[l];q++)
                      if(rightsite.subgqn[k]+oldrightbase.subgqn[l]+leftbase.subgqn[m]==tgqn)
                        mapdim[index[j][r][k][s]]+=1;//Exam this by an example then you  will understand it.
  }

  for(int i=0;i<middleDim;i++)
  {
    map[i]=new int [mapdim[i]];
    count[i]=0;
  }

  for(int m=0,pointer=0;m<leftbase.subnum;m++)
  {
    for(int i=0;i<oldleftbase.subnum;i++)
      for(int p=0;p<oldleftbase.dim[i];p++)
        for(int j=0;j<leftsite.subnum;j++)
          if(leftbase.subgqn[m]==oldleftbase.subgqn[i]+leftsite.subgqn[j])
            for(int r=0;r<leftsite.dim[j];r++)
              for(int k=0;k<rightsite.subnum;k++)
                for(int s=0;s<rightsite.dim[k];s++)
                  for(int l=0;l<oldrightbase.subnum;l++)
                    for(int q=0;q<oldrightbase.dim[l];q++)
                      if(rightsite.subgqn[k]+oldrightbase.subgqn[l]+leftbase.subgqn[m]==tgqn)
                      {
                        map[index[j][r][k][s]][count[index[j][r][k][s]]]=pointer;
                        count[index[j][r][k][s]]++;
                        pointer+=1;
                      }
  }
}


void snake::physics::SuperChain::deletemiddlemap()
{
  int middleDim=midsite1.base.Dim*midsite2.base.Dim;
  for(int i=0;i<middleDim;i++)
    delete [] map[i];
  delete [] map;
  delete [] mapdim;
}


void snake::physics::SuperChain::dsaupd(int n,int nev,double *Evals,double **Evecs)
{
  int ido = 0;/* Initialization of the reverse communication
		  parameter. */

  char bmat[2] = "I";/* Specifies that the right hand side matrix
			 should be the identity matrix; this makes
			 the problem a standard eigenvalue problem.
			 Setting bmat = "G" would have us solve the
			 problem Av = lBv (this would involve using
			 some other programs from BLAS, however). */
  char which[3] = "SA";/* Ask for the nev eigenvalues of smallest
			   magnitude.  The possible options are
			   LM: largest magnitude
			   SM: smallest magnitude
			   LA: largest real component
			   SA: smallest real compoent
			   LI: largest imaginary component
			   SI: smallest imaginary component */
  double tol = 1e-9;/* Sets the tolerance; tol<=0 specifies
		       machine precision */
  double *resid;
  resid = new double[n];
  int ncv =24;/* The largest number of basis vectors that will
		      be used in the Implicitly Restarted Arnoldi
		      Process.  Work per major iteration is
		      proportional to N*NCV*NCV. */
  if (ncv>n) ncv = n;
  double *v;
  int ldv = n;
  v = new double[ldv*ncv];
  int *iparam;
  iparam = new int[11];/* An array used to pass information to the routines
			   about their functional modes. */
  iparam[0] = 1;// Specifies the shift strategy (1->exact)
  iparam[2] = 3*n;// Maximum number of iterations
  iparam[6] = 1;/* Sets the mode of dsaupd.
		      1 is exact shifting,
		      2 is user-supplied shifts,
		      3 is shift-invert mode,
		      4 is buckling mode,
		      5 is Cayley mode. */

  int *ipntr;
  ipntr = new int[11];/* Indicates the locations in the work array workd
			  where the input and output vectors in the
			  callback routine are located. */
  double *workd;
  workd = new double[3*n];
  double *workl;
  workl = new double[ncv*(ncv+8)];
  int lworkl = ncv*(ncv+8);/* Length of the workl array */
  int info = 0;/* Passes convergence information out of the iteration
		   routine. */
  int rvec = 1;  /* Specifies that eigenvectors should be calculated */
  int *select;
  select = new int[ncv];
  double *d;
  d = new double[2*ncv];/* This vector will return the eigenvalues from
			    the second routine, dseupd. */
  double sigma;
  int ierr;

   /* Here we enter the main loop where the calculations are
     performed.  The communication parameter ido tells us when
     the desired tolerance is reached, and at that point we exit
     and extract the solutions. */

  do {
    dsaupd_(&ido, bmat, &n, which, &nev, &tol, resid,
            &ncv, v, &ldv, iparam, ipntr, workd, workl,
            &lworkl, &info);

     /* From those results, the eigenvalues and vectors are
     extracted. */
    if ((ido==1)||(ido==-1)) av(n, workd+ipntr[0]-1, workd+ipntr[1]-1);
  } while ((ido==1)||(ido==-1));

  if (info<0) {
    std::cout << "Error with dsaupd, info = " << info << "\n";
    std::cout << "Check documentation in dsaupd\n\n";
  } else {
    dseupd_(&rvec, "All", select, d, v, &ldv, &sigma, bmat,
            &n, which, &nev, &tol, resid, &ncv, v, &ldv,
            iparam, ipntr, workd, workl, &lworkl, &ierr);

    if (ierr!=0) {
      std::cout << "Error with dseupd, info = " << ierr << "\n";
      std::cout << "Check the documentation of dseupd.\n\n";
    } else if (info==1) {
      std::cout << "Maximum number of iterations reached.\n\n";
    } else if (info==3) {
      std::cout << "No shifts could be applied during implicit\n";
      std::cout << "Arnoldi update, try increasing NCV.\n\n";
    }

     /* Before exiting, we copy the solution information over to
       the arrays of the calling program, then clean up the
       memory used by this routine.  For some reason, when I
       don't find the eigenvectors I need to reverse the order of
       the values. */
    int i, j;
    for (i=0; i<nev; i++) Evals[i] = d[i];
    for (i=0; i<nev; i++) for (j=0; j<n; j++) Evecs[j][i] = v[i*n+j];

    delete [] resid;
    delete [] v;
    delete [] iparam;
    delete [] ipntr;
    delete [] workd;
    delete [] workl;
    delete [] select;
    delete [] d;
  }
}
back to top