/**********************************************************************
  Band_DFT_Col.c:

     Band_DFT_Col.c is a subroutine to perform band calculations
     based on a collinear DFT

  Log of Band_DFT_Col.c:

     22/Nov/2001  Released by T.Ozaki

***********************************************************************/

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>
#include <time.h>
#include "openmx_common.h"
#include "lapack_prototypes.h"
#include "mpi.h"
#include <omp.h>

#define  measure_time  0


/*---------- added by TOYODA 17/FEB/2010 */
#include "exx_debug.h"
/*---------- until here */

#ifndef scalapack

double Band_DFT_Col_ScaLAPACK(
                    int SCF_iter,
                    int knum_i, int knum_j, int knum_k,
		    int SpinP_switch,
		    double *****nh,
		    double *****ImNL,
		    double ****CntOLP,
		    double *****CDM,
		    double *****EDM,
		    double Eele0[2], double Eele1[2], 
		    int *MP,
		    int *order_GA,
		    double *ko,
		    double *koS,
		    double ***EIGEN,
		    double *H1,
		    double *S1,
		    double *CDM1,
		    double *EDM1,
		    dcomplex **H,
		    dcomplex *Ss,
		    dcomplex *Cs,
                    dcomplex *Hs,
		    int ***k_op,
		    int *T_k_op,
		    int **T_k_ID,
		    double *T_KGrids1,
		    double *T_KGrids2,
		    double *T_KGrids3,
                    int myworld1,
		    int *NPROCS_ID1,
		    int *Comm_World1,
		    int *NPROCS_WD1,
		    int *Comm_World_StartID1,
		    MPI_Comm *MPI_CommWD1,
                    int myworld2,
		    int *NPROCS_ID2,
		    int *NPROCS_WD2,
		    int *Comm_World2,
		    int *Comm_World_StartID2,
		    MPI_Comm *MPI_CommWD2,
		    EXX_t *exx,
		    dcomplex ****exx_CDM,
		    double *Uexx)
{
  return 0.0;
}

#endif

#ifdef scalapack


double Band_DFT_Col_ScaLAPACK(
                    int SCF_iter,
                    int knum_i, int knum_j, int knum_k,
		    int SpinP_switch,
		    double *****nh,
		    double *****ImNL,
		    double ****CntOLP,
		    double *****CDM,
		    double *****EDM,
		    double Eele0[2], double Eele1[2], 
		    int *MP,
		    int *order_GA,
		    double *ko,
		    double *koS,
		    double ***EIGEN,
		    double *H1,
		    double *S1,
		    double *CDM1,
		    double *EDM1,
		    dcomplex **H,
		    dcomplex *Ss,
		    dcomplex *Cs,
                    dcomplex *Hs,
		    int ***k_op,
		    int *T_k_op,
		    int **T_k_ID,
		    double *T_KGrids1,
		    double *T_KGrids2,
		    double *T_KGrids3,
                    int myworld1,
		    int *NPROCS_ID1,
		    int *Comm_World1,
		    int *NPROCS_WD1,
		    int *Comm_World_StartID1,
		    MPI_Comm *MPI_CommWD1,
                    int myworld2,
		    int *NPROCS_ID2,
		    int *NPROCS_WD2,
		    int *Comm_World2,
		    int *Comm_World_StartID2,
		    MPI_Comm *MPI_CommWD2,
		    EXX_t *exx,
		    dcomplex ****exx_CDM,
		    double *Uexx)
{
  static int firsttime=1;
  int i,j,k,l,m,n,wan,MaxN,i0,ks;
  int i1,i1s,j1,ia,jb,lmax,po,po1,spin,s1,e1;
  int num2,RnB,l1,l2,l3,loop_num,ns,ne;
  int ct_AN,h_AN,wanA,tnoA,wanB,tnoB;
  int MA_AN,GA_AN,Anum,num_kloop0;
  int T_knum,S_knum,E_knum,kloop,kloop0;
  double av_num,lumos;
  double time0;
  int LB_AN,GB_AN,Bnum;
  double k1,k2,k3,Fkw;
  double sum,sumi,sum_weights;
  double Num_State;
  double My_Num_State;
  double FermiF;
  double tmp,eig,kw,EV_cut0;
  double x,Dnum,Dnum2,AcP,ChemP_MAX,ChemP_MIN;
  double *VecFkw;
  double *VecFkwE;
  int *is1,*ie1;
  int *is2,*ie2;
  MPI_Status *stat_send;
  MPI_Request *request_send;
  MPI_Request *request_recv;
  int *My_NZeros;
  int *SP_NZeros;
  int *SP_Atoms;
  MPI_Comm *MPI_CommWD_CDM1; 
  int *MPI_CDM1_flag;  

  int all_knum; 
  dcomplex Ctmp1,Ctmp2;
  int ii,ij,ik;
  int BM,BN,BK;
  double u2,v2,uv,vu;
  double d1,d2;
  double My_Eele1[2]; 
  double TZ,dum,sumE,kRn,si,co;
  double Resum,ResumE,Redum,Redum2;
  double Imsum,ImsumE,Imdum,Imdum2;
  double TStime,TEtime,SiloopTime,EiloopTime;
  double Stime,Etime,Stime0,Etime0;
  double FermiEps=1.0e-14;
  double x_cut=30.0;
  double My_Eele0[2];

  char file_EV[YOUSO10];
  FILE *fp_EV;
#ifdef xt3
  char buf[fp_bsize];          /* setvbuf */
#endif
  int AN,Rn,size_H1;
  int parallel_mode;
  int numprocs0,myid0;
  int ID,ID0,ID1;
  int numprocs1,myid1;
  int numprocs2,myid2;
  int Num_Comm_World1;
  int Num_Comm_World2;

  int tag=999,IDS,IDR;
  MPI_Status stat;
  MPI_Request request;

  double time1,time2,time3;
  double time4,time5,time6;
  double time7,time8,time9;
  double time10,time11,time12;
  double time81,time82,time83;
  double time84,time85;
  double time51;

  dcomplex *BLAS_H;
  dcomplex *BLAS_C;

  /* for OpenMP */
  int OMPID,Nthrds,Nprocs;

  /*---------- added by TOYODA 16/FEB/2010 */
  const int *exx_ep_atom1;
  const int *exx_ep_atom2;
  const int *exx_ep_cell;
  int iRn_x, iRn_y, iRn_z, iRn;
  int ncd, nshell_ep, iep, nep;
  /*---------- until here */

  FILE* file;
  char* BUF[1000];

  MPI_Comm mpi_comm_rows, mpi_comm_cols;
  int mpi_comm_rows_int,mpi_comm_cols_int;
  int info,ig,jg,il,jl,prow,pcol,brow,bcol;
  int ZERO=0, ONE=1;
  double alpha = 1.0; double beta = 0.0;
  int LOCr, LOCc, node, irow, icol;
  MPI_Status *stat_send2;
  double mC_spin_i1,C_spin_i1;

  /* for time */
  dtime(&TStime);

  time1 = 0.0;
  time2 = 0.0;
  time3 = 0.0;
  time4 = 0.0;
  time5 = 0.0;
  time6 = 0.0;
  time7 = 0.0;
  time8 = 0.0;
  time9 = 0.0;
  time10 = 0.0;
  time11 = 0.0;
  time12 = 0.0;
  time81 = 0.0;
  time82 = 0.0;
  time83 = 0.0;
  time84 = 0.0;
  time85 = 0.0;
  time51 = 0.0;

  /*---------- added by TOYODA 16/FEB/2010 */
  if (g_exx_switch) {
    nep          = EXX_Number_of_EP(exx);
    nshell_ep    = EXX_Number_of_EP_Shells(exx);
    exx_ep_atom1 = EXX_Array_EP_Atom1(exx);
    exx_ep_atom2 = EXX_Array_EP_Atom2(exx);
    exx_ep_cell  = EXX_Array_EP_Cell(exx);
    ncd = 2*nshell_ep + 1;
    Uexx[0] = 0.0;
    Uexx[1] = 0.0;
  }
  /*---------- until here */

  /* MPI */
  MPI_Comm_size(mpi_comm_level1,&numprocs0);
  MPI_Comm_rank(mpi_comm_level1,&myid0);
  MPI_Barrier(mpi_comm_level1);

  Num_Comm_World1 = SpinP_switch + 1; 

  /*********************************************** 
       for pallalel calculations in myworld1
  ***********************************************/

  MPI_Comm_size(MPI_CommWD1[myworld1],&numprocs1);
  MPI_Comm_rank(MPI_CommWD1[myworld1],&myid1);

  MPI_Comm_size(MPI_CommWD1[myworld1],&numprocs2);
  MPI_Comm_rank(MPI_CommWD1[myworld1],&myid2);

  /****************************************************
   find the number of basis functions, n
  ****************************************************/

  n = 0;
  for (i=1; i<=atomnum; i++){
    wanA  = WhatSpecies[i];
    n += Spe_Total_CNO[wanA];
  }

  /****************************************************
   find TZ
  ****************************************************/

  TZ = 0.0;
  for (i=1; i<=atomnum; i++){
    wan = WhatSpecies[i];
    TZ += Spe_Core_Charge[wan];
  }

  /***********************************************
     find the number of states to be solved 
  ***********************************************/

  lumos = (double)n*0.300;
  if (lumos<60.0) lumos = 400.0;
  MaxN = (TZ-system_charge)/2 + (int)lumos;
  if (n<MaxN) MaxN = n;

  /***********************************************
     allocation of arrays
  ***********************************************/

  VecFkw  = (double*)malloc(sizeof(double)*(n+2));
  VecFkwE = (double*)malloc(sizeof(double)*(n+2));

  /*
  BLAS_H = (dcomplex*)malloc(sizeof(dcomplex)*n*n);
  BLAS_C = (dcomplex*)malloc(sizeof(dcomplex)*n*n);
  */

  stat_send2 = malloc(sizeof(MPI_Status)*numprocs2);

  My_NZeros = (int*)malloc(sizeof(int)*numprocs0);
  SP_NZeros = (int*)malloc(sizeof(int)*numprocs0);
  SP_Atoms = (int*)malloc(sizeof(int)*numprocs0);

  MPI_CommWD_CDM1 = (MPI_Comm*)malloc(sizeof(MPI_Comm)*numprocs0);
  MPI_CDM1_flag = (int*)malloc(sizeof(int)*numprocs0);
  for (i=0; i<numprocs0; i++) MPI_CDM1_flag[i] = 0;

  if (firsttime) {
  PrintMemory("Band_DFT: ko", sizeof(double)*(n+1),NULL);
  PrintMemory("Band_DFT: koS",sizeof(double)*(n+1),NULL);
  PrintMemory("Band_DFT: H",  sizeof(dcomplex)*(n+1)*(n+1),NULL);
  PrintMemory("Band_DFT: S",  sizeof(dcomplex)*(n+1)*(n+1),NULL);
  PrintMemory("Band_DFT: C",  sizeof(dcomplex)*(n+1)*(n+1),NULL);
  }

  /***********************************************
              k-points by regular mesh 
  ***********************************************/

  if (way_of_kpoint==1){

    /**************************************************************
     k_op[i][j][k]: weight of DOS 
                 =0   no calc.
                 =1   G-point
                 =2   which has k<->-k point
        Now , only the relation, E(k)=E(-k), is used. 

    Future release: k_op will be used for symmetry operation 
    *************************************************************/

    for (i=0;i<=knum_i-1;i++) {
      for (j=0;j<=knum_j-1;j++) {
	for (k=0;k<=knum_k-1;k++) {
	  k_op[i][j][k]=-999;
	}
      }
    }

    for (i=0;i<=knum_i-1;i++) {
      for (j=0;j<=knum_j-1;j++) {
	for (k=0;k<=knum_k-1;k++) {
	  if ( k_op[i][j][k]==-999 ) {
	    k_inversion(i,j,k,knum_i,knum_j,knum_k,&ii,&ij,&ik);
	    if ( i==ii && j==ij && k==ik ) {
	      k_op[i][j][k]    = 1;
	    }

	    else {
	      k_op[i][j][k]    = 2;
	      k_op[ii][ij][ik] = 0;
	    }
	  }
	} /* k */
      } /* j */
    } /* i */

    /***********************************
       one-dimentionalize for MPI
    ************************************/

    T_knum = 0;
    for (i=0; i<=(knum_i-1); i++){
      for (j=0; j<=(knum_j-1); j++){
	for (k=0; k<=(knum_k-1); k++){
	  if (0<k_op[i][j][k]){
	    T_knum++;
	  }
	}
      }
    }

    /* set T_KGrids1,2,3 and T_k_op */

    T_knum = 0;
    for (i=0; i<knum_i; i++){

      if (knum_i==1)  k1 = 0.0;
      else            k1 = -0.5 + (2.0*(double)i+1.0)/(2.0*(double)knum_i) + Shift_K_Point;

      for (j=0; j<knum_j; j++){

	if (knum_j==1)  k2 = 0.0;
	else            k2 = -0.5 + (2.0*(double)j+1.0)/(2.0*(double)knum_j) - Shift_K_Point;

	for (k=0; k<knum_k; k++){

	  if (knum_k==1)  k3 = 0.0;
	  else            k3 = -0.5 + (2.0*(double)k+1.0)/(2.0*(double)knum_k) + 2.0*Shift_K_Point;

	  if (0<k_op[i][j][k]){

	    T_KGrids1[T_knum] = k1;
	    T_KGrids2[T_knum] = k2;
	    T_KGrids3[T_knum] = k3;
	    T_k_op[T_knum]    = k_op[i][j][k];

	    T_knum++;
	  }
	}
      }
    }

    if (myid0==Host_ID && 0<level_stdout){

      printf(" KGrids1: ");fflush(stdout);
      for (i=0;i<=knum_i-1;i++){
	if (knum_i==1)  k1 = 0.0;
	else            k1 = -0.5 + (2.0*(double)i+1.0)/(2.0*(double)knum_i) + Shift_K_Point;
	printf("%9.5f ",k1);fflush(stdout);
      }
      printf("\n");fflush(stdout);

      printf(" KGrids2: ");fflush(stdout);

      for (i=0;i<=knum_j-1;i++){
	if (knum_j==1)  k2 = 0.0;
	else            k2 = -0.5 + (2.0*(double)i+1.0)/(2.0*(double)knum_j) - Shift_K_Point;
	printf("%9.5f ",k2);fflush(stdout);
      }
      printf("\n");fflush(stdout);

      printf(" KGrids3: ");fflush(stdout);
      for (i=0;i<=knum_k-1;i++){
	if (knum_k==1)  k3 = 0.0;
	else            k3 = -0.5 + (2.0*(double)i+1.0)/(2.0*(double)knum_k) + 2.0*Shift_K_Point;
	printf("%9.5f ",k3);fflush(stdout);
      }
      printf("\n");fflush(stdout);
    }

  }

  /***********************************************
                Monkhorst-Pack k-points 
  ***********************************************/

  else if (way_of_kpoint==2){

    T_knum = num_non_eq_kpt; 
   
    for (k=0; k<num_non_eq_kpt; k++){
      T_KGrids1[k] = NE_KGrids1[k];
      T_KGrids2[k] = NE_KGrids2[k];
      T_KGrids3[k] = NE_KGrids3[k];
      T_k_op[k]    = NE_T_k_op[k];
    }
  }

  /***********************************************
            calculate the sum of weights
  ***********************************************/

  sum_weights = 0.0;
  for (k=0; k<T_knum; k++){
    sum_weights += (double)T_k_op[k];
  }

  /***********************************************
           allocate k-points into processors 
  ***********************************************/

  if (numprocs1<T_knum){

    /* set parallel_mode */
    parallel_mode = 0;

    /* allocation of kloop to ID */     

    for (ID=0; ID<numprocs1; ID++){
      tmp = (double)T_knum/(double)numprocs1;
      S_knum = (int)((double)ID*(tmp+1.0e-12)); 
      E_knum = (int)((double)(ID+1)*(tmp+1.0e-12)) - 1;
      if (ID==(numprocs1-1)) E_knum = T_knum - 1;
      if (E_knum<0)          E_knum = 0;

      for (k=S_knum; k<=E_knum; k++){
        /* ID in the first level world */
        T_k_ID[myworld1][k] = ID;
      }
    }

    /* find own informations */

    tmp = (double)T_knum/(double)numprocs1; 
    S_knum = (int)((double)myid1*(tmp+1.0e-12)); 
    E_knum = (int)((double)(myid1+1)*(tmp+1.0e-12)) - 1;
    if (myid1==(numprocs1-1)) E_knum = T_knum - 1;
    if (E_knum<0)             E_knum = 0;

    num_kloop0 = E_knum - S_knum + 1;

    MPI_Comm_size(MPI_CommWD2[myworld2],&numprocs2);
    MPI_Comm_rank(MPI_CommWD2[myworld2],&myid2);
  }

  else {

    /* set parallel_mode */
    parallel_mode = 1;
    num_kloop0 = 1;

    Num_Comm_World2 = T_knum;
    MPI_Comm_size(MPI_CommWD2[myworld2],&numprocs2);
    MPI_Comm_rank(MPI_CommWD2[myworld2],&myid2);

    S_knum = myworld2;

    /* allocate k-points into processors */
    
    for (k=0; k<T_knum; k++){
      /* ID in the first level world */
      T_k_ID[myworld1][k] = Comm_World_StartID2[k];
    }
  }


  /****************************************************
   find all_knum
   if (all_knum==1), all the calculation will be made 
   by the first diagonalization loop, and the second 
   diagonalization will be skipped. 
  ****************************************************/

  MPI_Allreduce(&num_kloop0, &all_knum, 1, MPI_INT, MPI_PROD, mpi_comm_level1);

  if (SpinP_switch==1 && numprocs0==1 && all_knum==1){
    all_knum = 0;
  }

  /****************************************************
    if (parallel_mode==1 && all_knum==1)
     make is1, ie1, is2, ie2
  ****************************************************/

  if (all_knum==1){

    /* allocation */ 

    stat_send = malloc(sizeof(MPI_Status)*numprocs2);
    request_send = malloc(sizeof(MPI_Request)*numprocs2);
    request_recv = malloc(sizeof(MPI_Request)*numprocs2);

    is1 = (int*)malloc(sizeof(int)*numprocs2);
    ie1 = (int*)malloc(sizeof(int)*numprocs2);

    is2 = (int*)malloc(sizeof(int)*numprocs2);
    ie2 = (int*)malloc(sizeof(int)*numprocs2);

    /* make is1 and ie1 */ 

    if ( numprocs2<=n ){

      av_num = (double)n/(double)numprocs2;

      for (ID=0; ID<numprocs2; ID++){
	is1[ID] = (int)(av_num*(double)ID) + 1; 
	ie1[ID] = (int)(av_num*(double)(ID+1)); 
      }

      is1[0] = 1;
      ie1[numprocs2-1] = n; 

    }

    else{

      for (ID=0; ID<n; ID++){
	is1[ID] = ID + 1; 
	ie1[ID] = ID + 1;
      }
      for (ID=n; ID<numprocs2; ID++){
	is1[ID] =  1;
	ie1[ID] = -2;
      }
    }

    /* make is2 and ie2 */ 

    if ( numprocs2<=MaxN ){

      av_num = (double)MaxN/(double)numprocs2;

      for (ID=0; ID<numprocs2; ID++){
	is2[ID] = (int)(av_num*(double)ID) + 1; 
	ie2[ID] = (int)(av_num*(double)(ID+1)); 
      }

      is2[0] = 1;
      ie2[numprocs2-1] = MaxN; 
    }

    else{
      for (ID=0; ID<MaxN; ID++){
	is2[ID] = ID + 1; 
	ie2[ID] = ID + 1;
      }
      for (ID=MaxN; ID<numprocs2; ID++){
	is2[ID] =  1;
	ie2[ID] = -2;
      }
    }

    /**********************************************
       for MPI communication of CDM1 and EDM1        
    **********************************************/

    {
    MPI_Group new_group,old_group; 
    int *new_ranks; 

    new_ranks = (int*)malloc(sizeof(int)*T_knum);

    /* ID: zeroth world */

    for (ID=Comm_World_StartID1[myworld1]; ID<(numprocs0+Comm_World_StartID1[myworld1]); ID++){

      /* ID0: zeroth world */

      ID0 = ID % numprocs0;

      /* ID1: first world */

      ID1 = (ID-Comm_World_StartID1[myworld1]) % numprocs1;
         
      for (i=0; i<T_knum; i++){
        if (Comm_World_StartID2[i]<=ID1){
          ks = i;
        }
      }

      new_ranks[0] = ID1;
      if (myid1==ID1) MPI_CDM1_flag[ID0] = 1;

      for (i=(ks+1); i<(T_knum+ks); i++){
        i0 = i % T_knum;
        /* id in the first world */
        ID1 = Comm_World_StartID2[i0] + (ID0 % NPROCS_WD2[i0]);
        new_ranks[i-ks] = ID1;
        if (myid1==ID1) MPI_CDM1_flag[ID0] = 1;
      }

      MPI_Comm_group(MPI_CommWD1[myworld1], &old_group);

      /* define a new group */
      MPI_Group_incl(old_group,T_knum,new_ranks,&new_group);
      MPI_Comm_create(MPI_CommWD1[myworld1], new_group, &MPI_CommWD_CDM1[ID0]);
      MPI_Group_free(&new_group);
    }

    free(new_ranks); /* never forget cleaning! */
    }

  } /* if (all_knum==1) */

  /****************************************************
     communicate T_k_ID
  ****************************************************/

  if (numprocs0==1 && SpinP_switch==1){
    for (k=0; k<T_knum; k++){
      T_k_ID[1][k] = T_k_ID[0][k];
    }
  }
  else{
    for (spin=0; spin<=SpinP_switch; spin++){
      ID = Comm_World_StartID1[spin];
      MPI_Bcast(&T_k_ID[spin][0], T_knum, MPI_INT, ID, mpi_comm_level1);
    }
  }

  /****************************************************
     store in each processor all the matrix elements
        for overlap and Hamiltonian matrices
  ****************************************************/

  dtime(&Stime);

  /* spin=myworld1 */

  spin = myworld1;

  /* set S1 */

  if (SCF_iter==1 || all_knum!=1){
    size_H1 = Get_OneD_HS_Col(1, CntOLP,   S1, MP, order_GA, My_NZeros, SP_NZeros, SP_Atoms);
  }

diagonalize1:

  /* set H1 */

  if (SpinP_switch==0){ 
    size_H1 = Get_OneD_HS_Col(1, nh[0], H1,   MP, order_GA, My_NZeros, SP_NZeros, SP_Atoms);
  }
  else if (1<numprocs0){
    size_H1 = Get_OneD_HS_Col(1, nh[0], H1,   MP, order_GA, My_NZeros, SP_NZeros, SP_Atoms);
    size_H1 = Get_OneD_HS_Col(1, nh[1], CDM1, MP, order_GA, My_NZeros, SP_NZeros, SP_Atoms);

    if (myworld1){
      for (i=0; i<size_H1; i++){
        H1[i] = CDM1[i];
      }
    }
  }
  else{
    size_H1 = Get_OneD_HS_Col(1, nh[spin], H1, MP, order_GA, My_NZeros, SP_NZeros, SP_Atoms);
  }

  dtime(&Etime);
  time1 += Etime - Stime;

  /****************************************************
                      start kloop
  ****************************************************/

  dtime(&SiloopTime);

  for (kloop0=0; kloop0<num_kloop0; kloop0++){

    kloop = S_knum + kloop0;

    k1 = T_KGrids1[kloop];
    k2 = T_KGrids2[kloop];
    k3 = T_KGrids3[kloop];

    /* make S and H */

    /*
    if (SCF_iter==1 || all_knum!=1){

      for (i1=0; i1<n*n; i1++) BLAS_S[i1] = Complex(0.0,0.0);

      for (i1=1; i1<=n; i1++){
	for (j1=1; j1<=n; j1++){
	  S[i1][j1] = Complex(0.0,0.0);
	} 
      } 
    }
    */

    for (i1=1; i1<=n; i1++){
      for (j1=1; j1<=n; j1++){
	H[i1][j1] = Complex(0.0,0.0);
      } 
    } 

    if (SCF_iter==1 || all_knum!=1){
      k = 0;
      for (AN=1; AN<=atomnum; AN++){
	GA_AN = order_GA[AN];
	wanA = WhatSpecies[GA_AN];
	tnoA = Spe_Total_CNO[wanA];
	Anum = MP[GA_AN];

	for (LB_AN=0; LB_AN<=FNAN[GA_AN]; LB_AN++){
	  GB_AN = natn[GA_AN][LB_AN];
	  Rn = ncn[GA_AN][LB_AN];
	  wanB = WhatSpecies[GB_AN];
	  tnoB = Spe_Total_CNO[wanB];
	  Bnum = MP[GB_AN];

	  l1 = atv_ijk[Rn][1];
	  l2 = atv_ijk[Rn][2];
	  l3 = atv_ijk[Rn][3];
	  kRn = k1*(double)l1 + k2*(double)l2 + k3*(double)l3;

	  si = sin(2.0*PI*kRn);
	  co = cos(2.0*PI*kRn);

	  for (i=0; i<tnoA; i++){

	    for (j=0; j<tnoB; j++){

	      H[Anum+i][Bnum+j].r += S1[k]*co;
	      H[Anum+i][Bnum+j].i += S1[k]*si;

	      k++;

	    }
	  }
	}
      }

      for(i=0;i<na_rows;i++){
	for(j=0;j<na_cols;j++){
	  ig = np_rows*nblk*((i)/nblk) + (i)%nblk + ((np_rows+my_prow)%np_rows)*nblk + 1;
	  jg = np_cols*nblk*((j)/nblk) + (j)%nblk + ((np_cols+my_pcol)%np_cols)*nblk + 1;
	  Cs[j*na_rows+i].r = H[ig][jg].r;
	  Cs[j*na_rows+i].i = H[ig][jg].i;
	}
      }
      
    }


    for (i1=1; i1<=n; i1++){
      for (j1=1; j1<=n; j1++){
	H[i1][j1] = Complex(0.0,0.0);
      } 
    } 

    k = 0;
    for (AN=1; AN<=atomnum; AN++){
      GA_AN = order_GA[AN];
      wanA = WhatSpecies[GA_AN];
      tnoA = Spe_Total_CNO[wanA];
      Anum = MP[GA_AN];

      for (LB_AN=0; LB_AN<=FNAN[GA_AN]; LB_AN++){
	GB_AN = natn[GA_AN][LB_AN];
	Rn = ncn[GA_AN][LB_AN];
	wanB = WhatSpecies[GB_AN];
	tnoB = Spe_Total_CNO[wanB];
	Bnum = MP[GB_AN];

	l1 = atv_ijk[Rn][1];
	l2 = atv_ijk[Rn][2];
	l3 = atv_ijk[Rn][3];
	kRn = k1*(double)l1 + k2*(double)l2 + k3*(double)l3;

	si = sin(2.0*PI*kRn);
	co = cos(2.0*PI*kRn);

	for (i=0; i<tnoA; i++){

	  for (j=0; j<tnoB; j++){

	    H[Anum+i][Bnum+j].r += H1[k]*co;
	    H[Anum+i][Bnum+j].i += H1[k]*si;

	    k++;

	  }

	}
      }
    }
    
    /*---------- added by TOYODA 15/FEB/2010 */
    if (5==XC_switch) {  

#if 0
      if (1<SCF_iter) { EXX_Debug_Check_DM(exx, exx_CDM, CDM); }
#endif

      EXX_Fock_Band(H, exx, exx_CDM, MP, k1, k2, k3, spin);
    }
    /*---------- until here */

    for(i=0;i<na_rows;i++){
      for(j=0;j<na_cols;j++){
	ig = np_rows*nblk*((i)/nblk) + (i)%nblk + ((np_rows+my_prow)%np_rows)*nblk + 1;
	jg = np_cols*nblk*((j)/nblk) + (j)%nblk + ((np_cols+my_pcol)%np_cols)*nblk + 1;
	Hs[j*na_rows+i].r = H[ig][jg].r;
	Hs[j*na_rows+i].i = H[ig][jg].i;
      }
    }


    /* diagonalize S */

    dtime(&Stime);

    if (parallel_mode==0 || (SCF_iter==1 || all_knum!=1)){
      MPI_Comm_split(MPI_CommWD2[myworld2],my_pcol,my_prow,&mpi_comm_rows);
      MPI_Comm_split(MPI_CommWD2[myworld2],my_prow,my_pcol,&mpi_comm_cols);

      mpi_comm_rows_int = MPI_Comm_c2f(mpi_comm_rows);
      mpi_comm_cols_int = MPI_Comm_c2f(mpi_comm_cols);

      F77_NAME(solve_evp_complex,SOLVE_EVP_COMPLEX)(&n, &n, Cs, &na_rows, &ko[1], Ss, &na_rows, &nblk, &mpi_comm_rows_int, &mpi_comm_cols_int);

      MPI_Comm_free(&mpi_comm_rows);
      MPI_Comm_free(&mpi_comm_cols);
    }

    dtime(&Etime);
    time2 += Etime - Stime;

    if (SCF_iter==1 || all_knum!=1){

      if (3<=level_stdout){
	printf(" myid0=%2d spin=%2d kloop %2d  k1 k2 k3 %10.6f %10.6f %10.6f\n",
	       myid0,spin,kloop,T_KGrids1[kloop],T_KGrids2[kloop],T_KGrids3[kloop]);
	for (i1=1; i1<=n; i1++){
	  printf("  Eigenvalues of OLP  %2d  %15.12f\n",i1,ko[i1]);
	}
      }

      /* minus eigenvalues to 1.0e-14 */

      for (l=1; l<=n; l++){
	if (ko[l]<0.0) ko[l] = 1.0e-14;
	koS[l] = ko[l];
      }

      /* calculate S*1/sqrt(ko) */

      for (l=1; l<=n; l++) ko[l] = 1.0/sqrt(ko[l]);

      /* S * 1.0/sqrt(ko[l]) */

      for(i=0;i<na_rows;i++){
	for(j=0;j<na_cols;j++){
	  jg = np_cols*nblk*((j)/nblk) + (j)%nblk + ((np_cols+my_pcol)%np_cols)*nblk + 1;
	  Ss[j*na_rows+i].r = Ss[j*na_rows+i].r*ko[jg];
	  Ss[j*na_rows+i].i = Ss[j*na_rows+i].i*ko[jg];
	}
      }

    }


    /****************************************************
     1.0/sqrt(ko[l]) * U^t * H * U * 1.0/sqrt(ko[l])
    ****************************************************/

    dtime(&Stime);

    /* pzgemm */

    /* H * U * 1.0/sqrt(ko[l]) */

    for(i=0;i<na_rows_max*na_cols_max;i++){
      Cs[i].r = 0.0;
      Cs[i].i = 0.0;
    }
    Cblacs_barrier(ictxt2,"A");

    F77_NAME(pzgemm,PZGEMM)("N","N",&n,&n,&n,&alpha,Hs,&ONE,&ONE,descH,Ss,&ONE,&ONE,descS,&beta,Cs,&ONE,&ONE,descC);

    /* 1.0/sqrt(ko[l]) * U^+ H * U * 1.0/sqrt(ko[l]) */

    for(i=0;i<na_rows*na_cols;i++){
      Hs[i].r = 0.0;
      Hs[i].i = 0.0;
    }
    Cblacs_barrier(ictxt2,"C");

    F77_NAME(pzgemm,PZGEMM)("C","N",&n,&n,&n,&alpha,Ss,&ONE,&ONE,descS,Cs,&ONE,&ONE,descC,&beta,Hs,&ONE,&ONE,descH);


    /* penalty for ill-conditioning states */

    EV_cut0 = Threshold_OLP_Eigen;

    for (i1=1; i1<=n; i1++){

      ig = i1;
      jg = i1;
              
      brow = (ig-1)/nblk;
      bcol = (jg-1)/nblk;
    
      prow = brow%np_rows;
      pcol = bcol%np_cols;

      if(my_prow==prow && my_pcol==pcol){
	il = (brow/np_rows+1)*nblk+1;
	jl = (bcol/np_cols+1)*nblk+1;
	if(((my_prow+np_rows)%np_rows) >= (brow%np_rows)){
	  if(my_prow==prow){
	    il = il+(ig-1)%nblk;
	  }
	  il = il-nblk;
	}
	if(((my_pcol+np_cols)%np_cols) >= (bcol%np_cols)){
	  if(my_pcol==pcol){
	    jl = jl+(jg-1)%nblk;
	  }
	  jl = jl-nblk;
	}
	if(koS[i1]<EV_cut0){
	  Hs[(jl-1)*na_rows+il-1].r += pow((koS[i1]/EV_cut0),-2.0) - 1.0;
	}
	mC_spin_i1 = Hs[(jl-1)*na_rows+il-1].r;
      }
      else{
	mC_spin_i1 = 0.0;
      }

      MPI_Allreduce(&mC_spin_i1, &C_spin_i1, 1, MPI_DOUBLE, MPI_SUM, MPI_CommWD2[myworld2]);
 
      /* cutoff the interaction between the ill-conditioned state */

      if (1.0e+3<C_spin_i1){
	for (j1=1; j1<=n; j1++){

	  ig = i1;
	  jg = j1;
              
	  brow = (ig-1)/nblk;
	  bcol = (jg-1)/nblk;

	  prow = brow%np_rows;
	  pcol = bcol%np_cols;

	  if(my_prow==prow && my_pcol==pcol){
	    il = (brow/np_rows+1)*nblk+1;
	    jl = (bcol/np_cols+1)*nblk+1;
	    if(((my_prow+np_rows)%np_rows) >= (brow%np_rows)){
	      if(my_prow==prow){
		il = il+(ig-1)%nblk;
	      }
	      il = il-nblk;
	    }
	    if(((my_pcol+np_cols)%np_cols) >= (bcol%np_cols)){
	      if(my_pcol==pcol){
		jl = jl+(jg-1)%nblk;
	      }
	      jl = jl-nblk;
	    }
	    Hs[(jl-1)*na_rows+il-1] = Complex(0.0,0.0);
	  }

	  ig = j1;
	  jg = i1;
              
	  brow = (ig-1)/nblk;
	  bcol = (jg-1)/nblk;

	  prow = brow%np_rows;
	  pcol = bcol%np_cols;

	  if(my_prow==prow && my_pcol==pcol){
	    il = (brow/np_rows+1)*nblk+1;
	    jl = (bcol/np_cols+1)*nblk+1;
	    if(((my_prow+np_rows)%np_rows) >= (brow%np_rows)){
	      if(my_prow==prow){
		il = il+(ig-1)%nblk;
	      }
	      il = il-nblk;
	    }
	    if(((my_pcol+np_cols)%np_cols) >= (bcol%np_cols)){
	      if(my_pcol==pcol){
		jl = jl+(jg-1)%nblk;
	      }
	      jl = jl-nblk;
	    }
	    Hs[(jl-1)*na_rows+il-1] = Complex(0.0,0.0);
	  }
	}

	ig = i1;
	jg = i1;
              
	brow = (ig-1)/nblk;
	bcol = (jg-1)/nblk;

	prow = brow%np_rows;
	pcol = bcol%np_cols;

	if(my_prow==prow && my_pcol==pcol){
	  il = (brow/np_rows+1)*nblk+1;
	  jl = (bcol/np_cols+1)*nblk+1;
	  if(((my_prow+np_rows)%np_rows) >= (brow%np_rows)){
	    if(my_prow==prow){
	      il = il+(ig-1)%nblk;
	    }
	    il = il-nblk;
	  }
	  if(((my_pcol+np_cols)%np_cols) >= (bcol%np_cols)){
	    if(my_pcol==pcol){
	      jl = jl+(jg-1)%nblk;
	    }
	    jl = jl-nblk;
	  }
	  Hs[(jl-1)*na_rows+il-1].r = 1.0e+4;
	}
      }
      
    }



    dtime(&Etime);
    time3 += Etime - Stime;

    /* diagonalize H' */

    dtime(&Stime);

    MPI_Comm_split(MPI_CommWD2[myworld2],my_pcol,my_prow,&mpi_comm_rows);
    MPI_Comm_split(MPI_CommWD2[myworld2],my_prow,my_pcol,&mpi_comm_cols);

    mpi_comm_rows_int = MPI_Comm_c2f(mpi_comm_rows);
    mpi_comm_cols_int = MPI_Comm_c2f(mpi_comm_cols);
	
    F77_NAME(solve_evp_complex,SOLVE_EVP_COMPLEX)(&n, &MaxN, Hs, &na_rows, &ko[1], Cs, &na_rows, &nblk, &mpi_comm_rows_int, &mpi_comm_cols_int);

    MPI_Comm_free(&mpi_comm_rows);
    MPI_Comm_free(&mpi_comm_cols);


    dtime(&Etime);
    time4 += Etime - Stime;

    for (l=1; l<=MaxN; l++){
      EIGEN[spin][kloop][l] = ko[l];
    }

    if (3<=level_stdout && 0<=kloop){
      printf(" myid0=%2d spin=%2d kloop %i, k1 k2 k3 %10.6f %10.6f %10.6f\n",
	     myid0,spin,kloop,T_KGrids1[kloop],T_KGrids2[kloop],T_KGrids3[kloop]);
      for (i1=1; i1<=n; i1++){
	if (SpinP_switch==0)
	  printf("  Eigenvalues of Kohn-Sham %2d %15.12f %15.12f\n",
		 i1,EIGEN[0][kloop][i1],EIGEN[0][kloop][i1]);
	else 
	  printf("  Eigenvalues of Kohn-Sham %2d %15.12f %15.12f\n",
		 i1,EIGEN[0][kloop][i1],EIGEN[1][kloop][i1]);
      }
    }

    /* calculation of wave functions */

    dtime(&Stime);

    if (all_knum==1){

      for(i=0;i<na_rows*na_cols;i++){
	Hs[i].r = 0.0;
	Hs[i].i = 0.0;
      }

      F77_NAME(pzgemm,PZGEMM)("N","N",&n,&n,&n,&alpha,Ss,&ONE,&ONE,descS,Cs,&ONE,&ONE,descC,&beta,Hs,&ONE,&ONE,descH);
      Cblacs_barrier(ictxt2,"A");

      if(myid2==0){

	for(node=0;node<numprocs2;node++){
     
	  if(node==0){

	    for(i=0;i<na_rows;i++){
	      for(j=0;j<na_cols;j++){
		ig = np_rows*nblk*((i)/nblk) + (i)%nblk + ((np_rows+my_prow)%np_rows)*nblk + 1;
		jg = np_cols*nblk*((j)/nblk) + (j)%nblk + ((np_cols+my_pcol)%np_cols)*nblk + 1;
		H[ig][jg].r = Hs[j*na_rows+i].r;
		H[ig][jg].i = Hs[j*na_rows+i].i;
	      }
	    }
	  }

	  else{
         
	    MPI_Recv(&irow, 1, MPI_INT, node, 10, MPI_CommWD2[myworld2], stat_send2);
	    MPI_Recv(&icol, 1, MPI_INT, node, 20, MPI_CommWD2[myworld2], stat_send2);
	    MPI_Recv(&LOCr, 1, MPI_INT, node, 40, MPI_CommWD2[myworld2], stat_send2);
	    MPI_Recv(&LOCc, 1, MPI_INT, node, 50, MPI_CommWD2[myworld2], stat_send2);
	    
	    MPI_Recv(Cs, LOCr*LOCc*2, MPI_DOUBLE, node, 30, MPI_CommWD2[myworld2], stat_send2);

	    for(i=0;i<LOCr;i++){
	      for(j=0;j<LOCc;j++){
		ig = np_rows*nblk*((i)/nblk) + (i)%nblk + ((np_rows+irow)%np_rows)*nblk + 1;
		jg = np_cols*nblk*((j)/nblk) + (j)%nblk + ((np_cols+icol)%np_cols)*nblk + 1;
		H[ig][jg].r = Cs[j*LOCr+i].r;
		H[ig][jg].i = Cs[j*LOCr+i].i;
	      }
	    }
	  }
	}
      }
      else{
	MPI_Send(&my_prow, 1, MPI_INT, 0, 10, MPI_CommWD2[myworld2]);
	MPI_Send(&my_pcol, 1, MPI_INT, 0, 20, MPI_CommWD2[myworld2]);
	MPI_Send(&na_rows, 1, MPI_INT, 0, 40, MPI_CommWD2[myworld2]);
	MPI_Send(&na_cols, 1, MPI_INT, 0, 50, MPI_CommWD2[myworld2]);
	MPI_Send(Hs, na_rows*na_cols*2, MPI_DOUBLE, 0, 30, MPI_CommWD2[myworld2]);
      } 

      /*
	! Broadcast the eigenvectors to all proceses 
      */

      for(i=1;i<=n;i++){
	MPI_Bcast(H[i],(n+1)*2,MPI_DOUBLE,0,MPI_CommWD2[myworld2]);
      }

      dtime(&Etime0);
      time51 += Etime0 - Stime0;

    } /* if (all_knum==1) */

    dtime(&Etime);
    time5 += Etime - Stime;

  } /* kloop0 */

  dtime(&EiloopTime);

  if (SpinP_switch==1 && numprocs0==1 && spin==0){
    spin++;  
    goto diagonalize1; 
  }

  /****************************************************
     MPI:

     EIGEN
  ****************************************************/

  MPI_Barrier(mpi_comm_level1);
  dtime(&Stime);

  for (spin=0; spin<=SpinP_switch; spin++){
    for (kloop=0; kloop<T_knum; kloop++){

      /* get ID in the zeroth world */
      ID = Comm_World_StartID1[spin] + T_k_ID[spin][kloop];
      MPI_Bcast(&EIGEN[spin][kloop][0], MaxN+1, MPI_DOUBLE, ID, mpi_comm_level1);
    } 
  }

  dtime(&Etime);
  time6 += Etime - Stime;

  /**************************************
         find chemical potential
  **************************************/

  dtime(&Stime);
  
  po = 0;
  loop_num = 0;
  ChemP_MAX = 10.0;  
  ChemP_MIN =-10.0;

  do {

    loop_num++;

    ChemP = 0.50*(ChemP_MAX + ChemP_MIN);
    Num_State = 0.0;

    for (kloop=0; kloop<T_knum; kloop++){
      for (spin=0; spin<=SpinP_switch; spin++){
	for (l=1; l<=MaxN; l++){

	  x = (EIGEN[spin][kloop][l] - ChemP)*Beta;

	  if (x<=-x_cut)      FermiF = 1.0;
	  else if (x>=x_cut)  FermiF = 0.0;
	  else                FermiF = 1.0/(1.0 + exp(x));

	  Num_State += FermiF*(double)T_k_op[kloop];

	} 
      }  
    } 

    if (SpinP_switch==0) 
      Num_State = 2.0*Num_State/sum_weights;
    else 
      Num_State = Num_State/sum_weights;
 
    Dnum = TZ - Num_State - system_charge;

    if (0.0<=Dnum) ChemP_MIN = ChemP;
    else           ChemP_MAX = ChemP;
    if (fabs(Dnum)<10e-14) po = 1;
  }
  while (po==0 && loop_num<2000);

  /****************************************************
           band energy in a finite temperature
  ****************************************************/

  Eele0[0] = 0.0;
  Eele0[1] = 0.0;

  for (kloop=0; kloop<T_knum; kloop++){
    for (spin=0; spin<=SpinP_switch; spin++){
      for (l=1; l<=MaxN; l++){

	x = (EIGEN[spin][kloop][l] - ChemP)*Beta;

	if (x<=-x_cut)      FermiF = 1.0;
	else if (x_cut<=x)  FermiF = 0.0;
	else                FermiF = 1.0/(1.0 + exp(x));

	Eele0[spin] += FermiF*EIGEN[spin][kloop][l]*(double)T_k_op[kloop];

      }
    }
  } 

  if (SpinP_switch==0){
    Eele0[0] = Eele0[0]/sum_weights;
    Eele0[1] = Eele0[0];
  }
  else {
    Eele0[0] = Eele0[0]/sum_weights;
    Eele0[1] = Eele0[1]/sum_weights;
  }

  Uele = Eele0[0] + Eele0[1];

  if (2<=level_stdout){
    printf("myid0=%2d ChemP=%lf, Eele0[0]=%lf, Eele0[1]=%lf\n",myid0,ChemP,Eele0[0],Eele0[1]);
  }

  dtime(&Etime);
  time7 += Etime - Stime;

  /*---------- added by TOYODA 16/FEB/2010 */
  if (g_exx_switch) {
    EXX_Energy_Band(Uexx, exx, exx_CDM, MP);
    if (0==SpinP_switch){
      Uexx[1] = Uexx[0];
      EXX_Log_Print("EXX: U= %20.12f\n", Uexx[0]);
    } else {
      EXX_Log_Print("EXX: U= %20.12f %20.2f\n", Uexx[0], Uexx[1]);
    }
  }  
  /*---------- until here */

  /****************************************************
         if all_knum==1, calculate CDM and EDM
  ****************************************************/

  dtime(&Stime);

  if (all_knum==1){

    dtime(&Stime0);

    /* initialize CDM1 and EDM1 */

    for (i=0; i<size_H1; i++){
      CDM1[i] = 0.0;
      EDM1[i] = 0.0;
    }

    /* calculate CDM and EDM */

    spin = myworld1;
    kloop = S_knum;

    k1 = T_KGrids1[kloop];
    k2 = T_KGrids2[kloop];
    k3 = T_KGrids3[kloop];

    /* weight of k-point */ 

    kw = (double)T_k_op[kloop];

    /* store Fermi function */

    po = 0;
    l = 1;
    do{

      eig = EIGEN[spin][kloop][l];
      x = (eig - ChemP)*Beta;

      if      (x<-x_cut)  FermiF = 1.0;
      else if (x>x_cut)   FermiF = 0.0;
      else                FermiF = 1.0/(1.0 + exp(x));

      VecFkw[l]  = FermiF*kw; 
      VecFkwE[l] = VecFkw[l]*eig;

      if ( FermiF<=FermiEps && po==0 ) {
	lmax = l;  
	po = 1;
      }

      l++;

    } while(po==0 && l<=MaxN);

    if (po==0) lmax = MaxN;

    dtime(&Etime0);
    time81 += Etime0 - Stime0;

    dtime(&Stime0);

    /* predetermination of k 
       H is used as temporal array 
    */ 

    k = 0;
    for (AN=1; AN<=atomnum; AN++){

      GA_AN = order_GA[AN];
      wanA = WhatSpecies[GA_AN];
      tnoA = Spe_Total_CNO[wanA];

      H[0][AN].r = (double)k;

      for (LB_AN=0; LB_AN<=FNAN[GA_AN]; LB_AN++){
	GB_AN = natn[GA_AN][LB_AN];
	Rn = ncn[GA_AN][LB_AN];
	wanB = WhatSpecies[GB_AN];
	tnoB = Spe_Total_CNO[wanB];
	k += tnoA*tnoB;
      }
    }

    /* DM and EDM */

#pragma omp parallel shared(numprocs0,My_NZeros,SP_NZeros,MPI_CDM1_flag,EDM1,CDM1,VecFkwE,VecFkw,H,lmax,k1,k2,k3,atv_ijk,ncn,natn,FNAN,MP,Spe_Total_CNO,WhatSpecies,order_GA,atomnum) private(OMPID,Nthrds,Nprocs,AN,GA_AN,wanA,tnoA,Anum,k,LB_AN,GB_AN,Rn,wanB,tnoB,Bnum,l1,l2,l3,kRn,si,co,i,ia,j,jb,d1,d2,l,tmp,po,ID)
    { 

      /* get info. on OpenMP */ 

      OMPID = omp_get_thread_num();
      Nthrds = omp_get_num_threads();
      Nprocs = omp_get_num_procs();

      for (AN=1+OMPID; AN<=atomnum; AN+=Nthrds){

	GA_AN = order_GA[AN];
	wanA = WhatSpecies[GA_AN];
	tnoA = Spe_Total_CNO[wanA];
	Anum = MP[GA_AN];

	k = (int)H[0][AN].r;

	for (LB_AN=0; LB_AN<=FNAN[GA_AN]; LB_AN++){
	  GB_AN = natn[GA_AN][LB_AN];
	  Rn = ncn[GA_AN][LB_AN];
	  wanB = WhatSpecies[GB_AN];
	  tnoB = Spe_Total_CNO[wanB];
	  Bnum = MP[GB_AN];

	  l1 = atv_ijk[Rn][1];
	  l2 = atv_ijk[Rn][2];
	  l3 = atv_ijk[Rn][3];
	  kRn = k1*(double)l1 + k2*(double)l2 + k3*(double)l3;

	  si = sin(2.0*PI*kRn);
	  co = cos(2.0*PI*kRn);

	  for (i=0; i<tnoA; i++){

	    ia = Anum + i; 

	    for (j=0; j<tnoB; j++){

	      jb = Bnum + j;

	      /***************************************************************
               Note that the imagiary part is zero, 
               since

               at k 
               A = (co + i si)(Re + i Im) = (co*Re - si*Im) + i (co*Im + si*Re) 
               at -k
               B = (co - i si)(Re - i Im) = (co*Re - si*Im) - i (co*Im + si*Re) 
               Thus, Re(A+B) = 2*(co*Re - si*Im)
                     Im(A+B) = 0
	      ***************************************************************/

	      po = 0;
	      ID = 0;
	      do { 
		if (MPI_CDM1_flag[ID] && SP_NZeros[ID]<=k && k<(SP_NZeros[ID]+My_NZeros[ID])) po = 1;
		ID++;
	      } while (po==0 && ID<numprocs0);

	      if (po==1){

		d1 = 0.0;
		d2 = 0.0;
	
		for (l=1; l<=lmax; l++){

		  tmp = co*(H[ia][l].r*H[jb][l].r + H[ia][l].i*H[jb][l].i)
		       -si*(H[ia][l].r*H[jb][l].i - H[ia][l].i*H[jb][l].r);

		  d1 += VecFkw[l]*tmp;
		  d2 += VecFkwE[l]*tmp;;
		}

		CDM1[k] += d1;
		EDM1[k] += d2; 
	      }

	      /* increment of k */

	      k++;

	    }
	  }

	} /* LB_AN */
      } /* AN */

    } /* #pragma omp parallel */

    /* sum of CDM1 and EDM1 by Allreduce in MPI */

    dtime(&Etime0);
    time82 += Etime0 - Stime0;

    dtime(&Stime0);

    for (ID=0; ID<numprocs0; ID++){
      if (MPI_CDM1_flag[ID]){
        k = SP_NZeros[ID];
        MPI_Reduce(&CDM1[k], &H1[k], My_NZeros[ID], MPI_DOUBLE, MPI_SUM, 0, MPI_CommWD_CDM1[ID]);

	/*
        if (SCF_iter%3==1){ 
	*/
        if (1){ 
          MPI_Reduce(&EDM1[k], &S1[k], My_NZeros[ID], MPI_DOUBLE, MPI_SUM, 0, MPI_CommWD_CDM1[ID]);
	}
      }
    }

    dtime(&Etime0);
    time83 += Etime0 - Stime0;

    dtime(&Stime0);

    /* CDM and EDM */

    k = 0;
    for (AN=1; AN<=atomnum; AN++){
      GA_AN = order_GA[AN];
      MA_AN = F_G2M[GA_AN]; 

      wanA = WhatSpecies[GA_AN];
      tnoA = Spe_Total_CNO[wanA];

      for (LB_AN=0; LB_AN<=FNAN[GA_AN]; LB_AN++){
	GB_AN = natn[GA_AN][LB_AN];
	wanB = WhatSpecies[GB_AN];
	tnoB = Spe_Total_CNO[wanB];

	for (i=0; i<tnoA; i++){
	  for (j=0; j<tnoB; j++){

	    if (1<=MA_AN && MA_AN<=Matomnum){   

	      CDM[spin][MA_AN][LB_AN][i][j] = H1[k];

	      /*
              if (SCF_iter%3==1){ 
	      */
              if (1){ 
  	        EDM[spin][MA_AN][LB_AN][i][j] = S1[k];
	      }
	    }

	    k++;

	  }
	}
      }
    }

    dtime(&Etime0);
    time84 += Etime0 - Stime0;

    dtime(&Stime0);

    /* if necessary, MPI communication of CDM and EDM */

    if (1<numprocs0 && SpinP_switch==1){

      /* set spin */

      if (myworld1==0){
	spin = 1;
      }
      else{
	spin = 0;
      } 

      /* communicate CDM1 and EDM1 */

      for (i=0; i<=1; i++){

        for (ID=Comm_World_StartID1[i]; ID<(numprocs0+Comm_World_StartID1[i]); ID++){

          /* ID0: zeroth world */

          ID0 = ID % numprocs0;

          /* ID's for sending and receiving in the zeroth world */

          IDS = Comm_World_StartID1[i] + (ID-Comm_World_StartID1[i]) % NPROCS_WD1[i];
          IDR = ID0;

          k = SP_NZeros[IDR];

          if (IDS!=IDR){

	    /* CDM1 */

	    if (myid0==IDS){
	      MPI_Isend(&H1[k], My_NZeros[IDR], MPI_DOUBLE, IDR, tag, mpi_comm_level1, &request);
	    } 

	    if (myid0==IDR){
	      MPI_Recv(&CDM1[k], My_NZeros[IDR], MPI_DOUBLE, IDS, tag, mpi_comm_level1, &stat);
	    }

	    if (myid0==IDS){
	      MPI_Wait(&request,&stat);
	    }

	    /* EDM1 */

	    /*
	    if (SCF_iter%3==1){ 
	    */
	    if (1){ 
	      if (myid0==IDS){
		MPI_Isend(&S1[k], My_NZeros[IDR], MPI_DOUBLE, IDR, tag, mpi_comm_level1, &request);
	      } 

	      if (myid0==IDR){
		MPI_Recv(&EDM1[k], My_NZeros[IDR], MPI_DOUBLE, IDS, tag, mpi_comm_level1, &stat);
	      }

	      if (myid0==IDS){
		MPI_Wait(&request,&stat);
	      }
	    }

	  }
        }
      }

      /* put CDM1 and EDM1 into CDM and EDM */

      k = 0;
      for (AN=1; AN<=atomnum; AN++){
	GA_AN = order_GA[AN];
	MA_AN = F_G2M[GA_AN]; 

	wanA = WhatSpecies[GA_AN];
	tnoA = Spe_Total_CNO[wanA];

	for (LB_AN=0; LB_AN<=FNAN[GA_AN]; LB_AN++){
	  GB_AN = natn[GA_AN][LB_AN];
	  wanB = WhatSpecies[GB_AN];
	  tnoB = Spe_Total_CNO[wanB];

	  for (i=0; i<tnoA; i++){
	    for (j=0; j<tnoB; j++){

	      if (1<=MA_AN && MA_AN<=Matomnum){   
		CDM[spin][MA_AN][LB_AN][i][j] = CDM1[k];

		/*
                if (SCF_iter%3==1){ 
		*/
                if (1){ 
	  	  EDM[spin][MA_AN][LB_AN][i][j] = EDM1[k];
		}
	      }

	      k++;

	    }
	  }
	}
      }
    }

    dtime(&Etime0);
    time85 += Etime0 - Stime0;

    /*---------- added by TOYODA 16/FEB/2010 */
    if (g_exx_switch) {
      /* clear buffer */
      for (iep=0; iep<nep; iep++) {
        GA_AN = exx_ep_atom1[iep]+1;
        GB_AN = exx_ep_atom2[iep]+1;
        tnoA = Spe_Total_CNO[WhatSpecies[GA_AN]];
	tnoB = Spe_Total_CNO[WhatSpecies[GB_AN]];
        for (i=0; i<tnoA; i++){
          for (j=0; j<tnoB; j++){
            exx_CDM[0][iep][i][j].r = 0.0;
            exx_CDM[0][iep][i][j].i = 0.0;
          }
        }
      }
      /* calculate DM */
      for (iep=0; iep<nep; iep++) {
        GA_AN = exx_ep_atom1[iep]+1;
        GB_AN = exx_ep_atom2[iep]+1;
        iRn   = exx_ep_cell[iep];
        tnoA = Spe_Total_CNO[WhatSpecies[GA_AN]];
	tnoB = Spe_Total_CNO[WhatSpecies[GB_AN]];
        Anum = MP[GA_AN];
	Bnum = MP[GB_AN];

        /* phase */
        iRn_x = iRn%ncd - nshell_ep;
        iRn_y = (iRn/ncd)%ncd - nshell_ep;
        iRn_z = (iRn/ncd/ncd)%ncd - nshell_ep;
        kRn = k1*(double)iRn_x + k2*(double)iRn_y + k3*(double)iRn_z;
        si = sin(2.0*PI*kRn);
        co = cos(2.0*PI*kRn);

        for (i=0; i<tnoA; i++){
          ia = Anum + i; 
          for (j=0; j<tnoB; j++){
            jb = Bnum + j;
            d1 = 0.0;
            d2 = 0.0;
            for (l=1; l<=lmax; l++) {
              tmp = co*(H[ia][l].r*H[jb][l].r + H[ia][l].i*H[jb][l].i)
                    -si*(H[ia][l].r*H[jb][l].i - H[ia][l].i*H[jb][l].r);
              d1 += VecFkw[l]*tmp;
              tmp = si*(H[ia][l].r*H[jb][l].r + H[ia][l].i*H[jb][l].i)
                    +co*(H[ia][l].r*H[jb][l].i - H[ia][l].i*H[jb][l].r);
              d2 += VecFkw[l]*tmp;
            }
            exx_CDM[0][iep][i][j].r += d1;
            exx_CDM[0][iep][i][j].i += d2;
	  }
        }
      } /* loop of iep */
    } /* end if */
    /*---------- until here added by TOYODA 16/FEB/2010 */

  } /* if (all_knum==1) */

  dtime(&Etime);
  time8 += Etime - Stime;

  if (myid0==Host_ID && 0<level_stdout){
    printf("<Band_DFT>  Eigen, time=%lf\n", EiloopTime-SiloopTime);fflush(stdout);
  }

  dtime(&SiloopTime);

  /****************************************************
   ****************************************************
     diagonalization for calculating density matrix
   ****************************************************
  ****************************************************/

  if (all_knum!=1){

    /* spin=myworld1 */

    spin = myworld1;

  diagonalize2:

    /* set S1 */

    size_H1 = Get_OneD_HS_Col(1, CntOLP,   S1, MP, order_GA, My_NZeros, SP_NZeros, SP_Atoms);

    /* set H1 */

    if (SpinP_switch==0){ 
      size_H1 = Get_OneD_HS_Col(1, nh[0], H1,   MP, order_GA, My_NZeros, SP_NZeros, SP_Atoms);
    }
    else if (1<numprocs0){
      size_H1 = Get_OneD_HS_Col(1, nh[0], H1,   MP, order_GA, My_NZeros, SP_NZeros, SP_Atoms);
      size_H1 = Get_OneD_HS_Col(1, nh[1], CDM1, MP, order_GA, My_NZeros, SP_NZeros, SP_Atoms);

      if (myworld1){
	for (i=0; i<size_H1; i++){
	  H1[i] = CDM1[i];
	}
      }
    }
    else{
      size_H1 = Get_OneD_HS_Col(1, nh[spin], H1, MP, order_GA, My_NZeros, SP_NZeros, SP_Atoms);
    }

    /* initialize CDM1 and EDM1 */

    for (i=0; i<size_H1; i++){
      CDM1[i] = 0.0;
      EDM1[i] = 0.0;
    }

    /*---------- added by TOYODA 16/FEB/2010 */
    if (g_exx_switch) {
      /* clear exx_DM */
      for (iep=0; iep<nep; iep++) {
        GA_AN = exx_ep_atom1[iep]+1;
        GB_AN = exx_ep_atom2[iep]+1;
        tnoA = Spe_Total_CNO[WhatSpecies[GA_AN]];
	tnoB = Spe_Total_CNO[WhatSpecies[GB_AN]];
        for (i=0; i<tnoA; i++){
          for (j=0; j<tnoB; j++){
            exx_CDM[spin][iep][i][j].r = 0.0;
            exx_CDM[spin][iep][i][j].i = 0.0;
          }
        }
      }
    }
    /*---------- until here added by TOYODA 16/FEB/2010 */

    /* initialize CDM, EDM, and iDM */

    for (MA_AN=1; MA_AN<=Matomnum; MA_AN++){
      GA_AN = M2G[MA_AN];    
      wanA = WhatSpecies[GA_AN];
      tnoA = Spe_Total_CNO[wanA];
      Anum = MP[GA_AN];
      for (LB_AN=0; LB_AN<=FNAN[GA_AN]; LB_AN++){
	GB_AN = natn[GA_AN][LB_AN];
	wanB = WhatSpecies[GB_AN];
	tnoB = Spe_Total_CNO[wanB];
	Bnum = MP[GB_AN];

	for (i=0; i<tnoA; i++){
	  for (j=0; j<tnoB; j++){
	    CDM[spin][MA_AN][LB_AN][i][j] = 0.0;

	    /*
            if (SCF_iter%3==1){ 
	    */
            if (1){ 
	      EDM[spin][MA_AN][LB_AN][i][j] = 0.0;
	    }

	    iDM[0][0][MA_AN][LB_AN][i][j] = 0.0;
	    iDM[0][1][MA_AN][LB_AN][i][j] = 0.0;
	  }
	}
      }
    }

    /* for kloop */

    for (kloop0=0; kloop0<num_kloop0; kloop0++){

      kloop = kloop0 + S_knum;

      k1 = T_KGrids1[kloop];
      k2 = T_KGrids2[kloop];
      k3 = T_KGrids3[kloop];

      /* make S and H */

      for (i1=1; i1<=n; i1++){
	for (j1=1; j1<=n; j1++){
	  H[i1][j1] = Complex(0.0,0.0);
	} 
      } 

      k = 0;
      for (AN=1; AN<=atomnum; AN++){
	GA_AN = order_GA[AN];
	wanA = WhatSpecies[GA_AN];
	tnoA = Spe_Total_CNO[wanA];
	Anum = MP[GA_AN];

	for (LB_AN=0; LB_AN<=FNAN[GA_AN]; LB_AN++){
	  GB_AN = natn[GA_AN][LB_AN];
	  Rn = ncn[GA_AN][LB_AN];
	  wanB = WhatSpecies[GB_AN];
	  tnoB = Spe_Total_CNO[wanB];
	  Bnum = MP[GB_AN];

	  l1 = atv_ijk[Rn][1];
	  l2 = atv_ijk[Rn][2];
	  l3 = atv_ijk[Rn][3];
	  kRn = k1*(double)l1 + k2*(double)l2 + k3*(double)l3;

	  si = sin(2.0*PI*kRn);
	  co = cos(2.0*PI*kRn);

	  for (i=0; i<tnoA; i++){
	    for (j=0; j<tnoB; j++){

	      H[Anum+i][Bnum+j].r += S1[k]*co;
	      H[Anum+i][Bnum+j].i += S1[k]*si;

	      k++;

	    }
	  }
	}
      }

      for(i=0;i<na_rows;i++){
	for(j=0;j<na_cols;j++){
	  ig = np_rows*nblk*((i)/nblk) + (i)%nblk + ((np_rows+my_prow)%np_rows)*nblk + 1;
	  jg = np_cols*nblk*((j)/nblk) + (j)%nblk + ((np_cols+my_pcol)%np_cols)*nblk + 1;
	  Cs[j*na_rows+i].r = H[ig][jg].r;
	  Cs[j*na_rows+i].i = H[ig][jg].i;
	}
      }


      for (i1=1; i1<=n; i1++){
	for (j1=1; j1<=n; j1++){
	  H[i1][j1] = Complex(0.0,0.0);
	} 
      } 

      k = 0;
      for (AN=1; AN<=atomnum; AN++){
	GA_AN = order_GA[AN];
	wanA = WhatSpecies[GA_AN];
	tnoA = Spe_Total_CNO[wanA];
	Anum = MP[GA_AN];

	for (LB_AN=0; LB_AN<=FNAN[GA_AN]; LB_AN++){
	  GB_AN = natn[GA_AN][LB_AN];
	  Rn = ncn[GA_AN][LB_AN];
	  wanB = WhatSpecies[GB_AN];
	  tnoB = Spe_Total_CNO[wanB];
	  Bnum = MP[GB_AN];

	  l1 = atv_ijk[Rn][1];
	  l2 = atv_ijk[Rn][2];
	  l3 = atv_ijk[Rn][3];
	  kRn = k1*(double)l1 + k2*(double)l2 + k3*(double)l3;

	  si = sin(2.0*PI*kRn);
	  co = cos(2.0*PI*kRn);

	  for (i=0; i<tnoA; i++){
	    for (j=0; j<tnoB; j++){

	      H[Anum+i][Bnum+j].r += H1[k]*co;
	      H[Anum+i][Bnum+j].i += H1[k]*si;

	      k++;

	    }
	  }
	}
      }

      for(i=0;i<na_rows;i++){
	for(j=0;j<na_cols;j++){
	  ig = np_rows*nblk*((i)/nblk) + (i)%nblk + ((np_rows+my_prow)%np_rows)*nblk + 1;
	  jg = np_cols*nblk*((j)/nblk) + (j)%nblk + ((np_cols+my_pcol)%np_cols)*nblk + 1;
	  Hs[j*na_rows+i].r = H[ig][jg].r;
	  Hs[j*na_rows+i].i = H[ig][jg].i;
	}
      }

      /* diagonalize S */

      dtime(&Stime);


      MPI_Comm_split(MPI_CommWD2[myworld2],my_pcol,my_prow,&mpi_comm_rows);
      MPI_Comm_split(MPI_CommWD2[myworld2],my_prow,my_pcol,&mpi_comm_cols);

      mpi_comm_rows_int = MPI_Comm_c2f(mpi_comm_rows);
      mpi_comm_cols_int = MPI_Comm_c2f(mpi_comm_cols);

      F77_NAME(solve_evp_complex,SOLVE_EVP_COMPLEX)(&n, &n, Cs, &na_rows, &ko[1], Ss, &na_rows, &nblk, &mpi_comm_rows_int, &mpi_comm_cols_int);

      MPI_Comm_free(&mpi_comm_rows);
      MPI_Comm_free(&mpi_comm_cols);

      dtime(&Etime);
      time9 += Etime - Stime;

      if (3<=level_stdout){
	printf(" myid0=%2d kloop %2d  k1 k2 k3 %10.6f %10.6f %10.6f\n",
	       myid0,kloop,T_KGrids1[kloop],T_KGrids2[kloop],T_KGrids3[kloop]);
	for (i1=1; i1<=n; i1++){
	  printf("  Eigenvalues of OLP  %2d  %15.12f\n",i1,ko[i1]);
	}
      }

      /* minus eigenvalues to 1.0e-14 */

      for (l=1; l<=n; l++){
	if (ko[l]<0.0) ko[l] = 1.0e-14;
	koS[l] = ko[l];
      }

      /* calculate S*1/sqrt(ko) */

      for (l=1; l<=n; l++) ko[l] = 1.0/sqrt(ko[l]);

      /* S * 1.0/sqrt(ko[l])  */


    for(i=0;i<na_rows;i++){
      for(j=0;j<na_cols;j++){
	jg = np_cols*nblk*((j)/nblk) + (j)%nblk + ((np_cols+my_pcol)%np_cols)*nblk + 1;
	Ss[j*na_rows+i].r = Ss[j*na_rows+i].r*ko[jg];
	Ss[j*na_rows+i].i = Ss[j*na_rows+i].i*ko[jg];
      }
    }


      /****************************************************
            1/sqrt(ko) * U^t * H * U * 1/sqrt(ko)
      ****************************************************/

    /* pzgemm */

    /* H * U * 1/sqrt(ko) */
    
    for(i=0;i<na_rows_max*na_cols_max;i++){
      Cs[i].r = 0.0;
      Cs[i].i = 0.0;
    }

      Cblacs_barrier(ictxt2,"A");

      F77_NAME(pzgemm,PZGEMM)("N","N",&n,&n,&n,&alpha,Hs,&ONE,&ONE,descH,Ss,&ONE,&ONE,descS,&beta,Cs,&ONE,&ONE,descC);

      /* 1/sqrt(ko) * U^+ H * U * 1/sqrt(ko) */

      for(i=0;i<na_rows*na_cols;i++){
	Hs[i].r = 0.0;
	Hs[i].i = 0.0;
      }

      Cblacs_barrier(ictxt2,"C");

      F77_NAME(pzgemm,PZGEMM)("C","N",&n,&n,&n,&alpha,Ss,&ONE,&ONE,descS,Cs,&ONE,&ONE,descC,&beta,Hs,&ONE,&ONE,descH);



    /* penalty for ill-conditioning states */

    EV_cut0 = Threshold_OLP_Eigen;

    for (i1=1; i1<=n; i1++){

      ig = i1;
      jg = i1;
              
      brow = (ig-1)/nblk;
      bcol = (jg-1)/nblk;
    
      prow = brow%np_rows;
      pcol = bcol%np_cols;

      if(my_prow==prow && my_pcol==pcol){
	il = (brow/np_rows+1)*nblk+1;
	jl = (bcol/np_cols+1)*nblk+1;
	if(((my_prow+np_rows)%np_rows) >= (brow%np_rows)){
	  if(my_prow==prow){
	    il = il+(ig-1)%nblk;
	  }
	  il = il-nblk;
	}
	if(((my_pcol+np_cols)%np_cols) >= (bcol%np_cols)){
	  if(my_pcol==pcol){
	    jl = jl+(jg-1)%nblk;
	  }
	  jl = jl-nblk;
	}
	if(koS[i1]<EV_cut0){
	  Hs[(jl-1)*na_rows+il-1].r += pow((koS[i1]/EV_cut0),-2.0) - 1.0;
	}
	mC_spin_i1 = Hs[(jl-1)*na_rows+il-1].r;
      }
      else{
	mC_spin_i1 = 0.0;
      }

      MPI_Allreduce(&mC_spin_i1, &C_spin_i1, 1, MPI_DOUBLE, MPI_SUM, MPI_CommWD2[myworld2]);
 
      /* cutoff the interaction between the ill-conditioned state */

      if (1.0e+3<C_spin_i1){
	for (j1=1; j1<=n; j1++){

	  ig = i1;
	  jg = j1;
              
	  brow = (ig-1)/nblk;
	  bcol = (jg-1)/nblk;

	  prow = brow%np_rows;
	  pcol = bcol%np_cols;

	  if(my_prow==prow && my_pcol==pcol){
	    il = (brow/np_rows+1)*nblk+1;
	    jl = (bcol/np_cols+1)*nblk+1;
	    if(((my_prow+np_rows)%np_rows) >= (brow%np_rows)){
	      if(my_prow==prow){
		il = il+(ig-1)%nblk;
	      }
	      il = il-nblk;
	    }
	    if(((my_pcol+np_cols)%np_cols) >= (bcol%np_cols)){
	      if(my_pcol==pcol){
		jl = jl+(jg-1)%nblk;
	      }
	      jl = jl-nblk;
	    }
	    Hs[(jl-1)*na_rows+il-1] = Complex(0.0,0.0);
	  }

	  ig = j1;
	  jg = i1;
              
	  brow = (ig-1)/nblk;
	  bcol = (jg-1)/nblk;

	  prow = brow%np_rows;
	  pcol = bcol%np_cols;

	  if(my_prow==prow && my_pcol==pcol){
	    il = (brow/np_rows+1)*nblk+1;
	    jl = (bcol/np_cols+1)*nblk+1;
	    if(((my_prow+np_rows)%np_rows) >= (brow%np_rows)){
	      if(my_prow==prow){
		il = il+(ig-1)%nblk;
	      }
	      il = il-nblk;
	    }
	    if(((my_pcol+np_cols)%np_cols) >= (bcol%np_cols)){
	      if(my_pcol==pcol){
		jl = jl+(jg-1)%nblk;
	      }
	      jl = jl-nblk;
	    }
	    Hs[(jl-1)*na_rows+il-1] = Complex(0.0,0.0);
	  }
	}

	ig = i1;
	jg = i1;
              
	brow = (ig-1)/nblk;
	bcol = (jg-1)/nblk;

	prow = brow%np_rows;
	pcol = bcol%np_cols;

	if(my_prow==prow && my_pcol==pcol){
	  il = (brow/np_rows+1)*nblk+1;
	  jl = (bcol/np_cols+1)*nblk+1;
	  if(((my_prow+np_rows)%np_rows) >= (brow%np_rows)){
	    if(my_prow==prow){
	      il = il+(ig-1)%nblk;
	    }
	    il = il-nblk;
	  }
	  if(((my_pcol+np_cols)%np_cols) >= (bcol%np_cols)){
	    if(my_pcol==pcol){
	      jl = jl+(jg-1)%nblk;
	    }
	    jl = jl-nblk;
	  }
	  Hs[(jl-1)*na_rows+il-1].r = 1.0e+4;
	}
      }
      
    }


      /* diagonalize H' */

      dtime(&Stime);

      MPI_Comm_split(MPI_CommWD2[myworld2],my_pcol,my_prow,&mpi_comm_rows);
      MPI_Comm_split(MPI_CommWD2[myworld2],my_prow,my_pcol,&mpi_comm_cols);

      mpi_comm_rows_int = MPI_Comm_c2f(mpi_comm_rows);
      mpi_comm_cols_int = MPI_Comm_c2f(mpi_comm_cols);

      F77_NAME(solve_evp_complex,SOLVE_EVP_COMPLEX)(&n, &MaxN, Hs, &na_rows, &ko[1], Cs, &na_rows, &nblk, &mpi_comm_rows_int, &mpi_comm_cols_int);

      MPI_Comm_free(&mpi_comm_rows);
      MPI_Comm_free(&mpi_comm_cols);


      dtime(&Etime);
      time10 += Etime - Stime;

      if (3<=level_stdout && 0<=kloop){
	printf("  kloop %i, k1 k2 k3 %10.6f %10.6f %10.6f\n",
	       kloop,T_KGrids1[kloop],T_KGrids2[kloop],T_KGrids3[kloop]);
	for (i1=1; i1<=n; i1++){
	  printf("  Eigenvalues of Kohn-Sham(DM) spin=%2d i1=%2d %15.12f\n",
		 spin,i1,ko[i1]);
	}
      }

      /****************************************************
        transformation to the original eigenvectors.
	     NOTE JRCAT-244p and JAIST-2122p 
      ****************************************************/

      for(i=0;i<na_rows*na_cols;i++){
	Hs[i].r = 0.0;
	Hs[i].i = 0.0;
      }

      F77_NAME(pzgemm,PZGEMM)("N","N",&n,&n,&n,&alpha,Ss,&ONE,&ONE,descS,Cs,&ONE,&ONE,descC,&beta,Hs,&ONE,&ONE,descH);
      Cblacs_barrier(ictxt2,"A");


      if(myid2==0){

	for(node=0;node<numprocs2;node++){

	  if(node==0){

	    for(i=0;i<na_rows;i++){
	      for(j=0;j<na_cols;j++){
		ig = np_rows*nblk*((i)/nblk) + (i)%nblk + ((np_rows+my_prow)%np_rows)*nblk + 1;
		jg = np_cols*nblk*((j)/nblk) + (j)%nblk + ((np_cols+my_pcol)%np_cols)*nblk + 1;
		H[ig][jg].r = Hs[j*na_rows+i].r;
		H[ig][jg].i = Hs[j*na_rows+i].i;
	      }
	    }
	  }

	  else{
         
	    MPI_Recv(&irow, 1, MPI_INT, node, 10, MPI_CommWD2[myworld2], stat_send2);
	    MPI_Recv(&icol, 1, MPI_INT, node, 20, MPI_CommWD2[myworld2], stat_send2);
	    MPI_Recv(&LOCr, 1, MPI_INT, node, 40, MPI_CommWD2[myworld2], stat_send2);
	    MPI_Recv(&LOCc, 1, MPI_INT, node, 50, MPI_CommWD2[myworld2], stat_send2);
         
	    MPI_Recv(Cs, LOCr*LOCc*2, MPI_DOUBLE, node, 30, MPI_CommWD2[myworld2], stat_send2);

	    for(i=0;i<LOCr;i++){
	      for(j=0;j<LOCc;j++){
		ig = np_rows*nblk*((i)/nblk) + (i)%nblk + ((np_rows+irow)%np_rows)*nblk + 1;
		jg = np_cols*nblk*((j)/nblk) + (j)%nblk + ((np_cols+icol)%np_cols)*nblk + 1;
		H[ig][jg].r = Cs[j*LOCr+i].r;
		H[ig][jg].i = Cs[j*LOCr+i].i;
	      }
	    }
	  }
	}
      }
      else{
	MPI_Send(&my_prow, 1, MPI_INT, 0, 10, MPI_CommWD2[myworld2]);
	MPI_Send(&my_pcol, 1, MPI_INT, 0, 20, MPI_CommWD2[myworld2]);
	MPI_Send(&na_rows, 1, MPI_INT, 0, 40, MPI_CommWD2[myworld2]);
	MPI_Send(&na_cols, 1, MPI_INT, 0, 50, MPI_CommWD2[myworld2]);
	MPI_Send(Hs, na_rows*na_cols*2, MPI_DOUBLE, 0, 30, MPI_CommWD2[myworld2]);
      } 

      /*
	! Broadcast the eigenvectors to all proceses 
      */

      for(i=1;i<=n;i++){
	MPI_Bcast(H[i],(n+1)*2,MPI_DOUBLE,0,MPI_CommWD2[myworld2]);
      }



      /****************************************************
                   calculate DM and EDM
      ****************************************************/

      dtime(&Stime);

      /* weight of k-point */ 

      kw = (double)T_k_op[kloop];

      /* store Fermi function */

      po = 0;
      l = 1;
      do{

	eig = EIGEN[spin][kloop][l];
	x = (eig - ChemP)*Beta;

	if      (x<-x_cut)  FermiF = 1.0;
	else if (x>x_cut)   FermiF = 0.0;
	else                FermiF = 1.0/(1.0 + exp(x));

	VecFkw[l]  = FermiF*kw; 
	VecFkwE[l] = VecFkw[l]*eig;

	if ( FermiF<=FermiEps && po==0 ) {
	  lmax = l;  
	  po = 1;
	}

	l++;

      } while(po==0 && l<=MaxN);

      if (po==0) lmax = MaxN;

      /* predetermination of k 
         H is used as temporal array 
      */ 

      k = 0;
      for (AN=1; AN<=atomnum; AN++){

	GA_AN = order_GA[AN];
	wanA = WhatSpecies[GA_AN];
	tnoA = Spe_Total_CNO[wanA];

        H[0][AN].r = (double)k;

	for (LB_AN=0; LB_AN<=FNAN[GA_AN]; LB_AN++){
	  GB_AN = natn[GA_AN][LB_AN];
	  Rn = ncn[GA_AN][LB_AN];
	  wanB = WhatSpecies[GB_AN];
	  tnoB = Spe_Total_CNO[wanB];
          k += tnoA*tnoB;
	}
      }

      /* DM and EDM */

#pragma omp parallel shared(EDM1,CDM1,VecFkwE,VecFkw,H,lmax,k1,k2,k3,atv_ijk,ncn,natn,FNAN,MP,Spe_Total_CNO,WhatSpecies,order_GA,atomnum) private(OMPID,Nthrds,Nprocs,AN,GA_AN,wanA,tnoA,Anum,k,LB_AN,GB_AN,Rn,wanB,tnoB,Bnum,l1,l2,l3,kRn,si,co,i,ia,j,jb,d1,d2,l,tmp)
      { 

	/* get info. on OpenMP */ 

	OMPID = omp_get_thread_num();
	Nthrds = omp_get_num_threads();
	Nprocs = omp_get_num_procs();

	for (AN=1+OMPID; AN<=atomnum; AN+=Nthrds){

	  GA_AN = order_GA[AN];
	  wanA = WhatSpecies[GA_AN];
	  tnoA = Spe_Total_CNO[wanA];
	  Anum = MP[GA_AN];

	  k = (int)H[0][AN].r;

	  for (LB_AN=0; LB_AN<=FNAN[GA_AN]; LB_AN++){
	    GB_AN = natn[GA_AN][LB_AN];
	    Rn = ncn[GA_AN][LB_AN];
	    wanB = WhatSpecies[GB_AN];
	    tnoB = Spe_Total_CNO[wanB];
	    Bnum = MP[GB_AN];

	    l1 = atv_ijk[Rn][1];
	    l2 = atv_ijk[Rn][2];
	    l3 = atv_ijk[Rn][3];
	    kRn = k1*(double)l1 + k2*(double)l2 + k3*(double)l3;

	    si = sin(2.0*PI*kRn);
	    co = cos(2.0*PI*kRn);

	    for (i=0; i<tnoA; i++){

	      ia = Anum + i; 

	      for (j=0; j<tnoB; j++){

		jb = Bnum + j;

		/***************************************************************
                Note that the imagiary part is zero, 
                 since

                 at k 
                 A = (co + i si)(Re + i Im) = (co*Re - si*Im) + i (co*Im + si*Re) 
                 at -k
                 B = (co - i si)(Re - i Im) = (co*Re - si*Im) - i (co*Im + si*Re) 
                 Thus, Re(A+B) = 2*(co*Re - si*Im)
                       Im(A+B) = 0
		***************************************************************/

		d1 = 0.0;
		d2 = 0.0;

		for (l=1; l<=lmax; l++){

		  tmp = co*(H[ia][l].r*H[jb][l].r + H[ia][l].i*H[jb][l].i)
		       -si*(H[ia][l].r*H[jb][l].i - H[ia][l].i*H[jb][l].r);

		  d1 += VecFkw[l]*tmp;
		  d2 += VecFkwE[l]*tmp;;

		}

		CDM1[k] += d1; 
		EDM1[k] += d2; 

		/* increment of k */

		k++;

	      }
	    }
	  }
	}

      } /* #pragma omp parallel */

      dtime(&Etime);
      time11 += Etime - Stime;

      /*---------- added by TOYODA 16/FEB/2010 */
      if (g_exx_switch) {
        for (iep=0; iep<nep; iep++) {
          GA_AN = exx_ep_atom1[iep]+1;
          GB_AN = exx_ep_atom2[iep]+1;
          iRn   = exx_ep_cell[iep];
          tnoA = Spe_Total_CNO[WhatSpecies[GA_AN]];
          tnoB = Spe_Total_CNO[WhatSpecies[GB_AN]];
          Anum = MP[GA_AN];
          Bnum = MP[GB_AN];

          /* phase */
          iRn_x = iRn%ncd - nshell_ep;
          iRn_y = (iRn/ncd)%ncd - nshell_ep;
          iRn_z = (iRn/ncd/ncd)%ncd - nshell_ep;
          kRn = k1*(double)iRn_x + k2*(double)iRn_y + k3*(double)iRn_z;
          si = sin(2.0*PI*kRn);
          co = cos(2.0*PI*kRn);

          for (i=0; i<tnoA; i++){
            ia = Anum + i; 
            for (j=0; j<tnoB; j++){
              jb = Bnum + j;
              d1 = 0.0;
              d2 = 0.0;
              for (l=1; l<=lmax; l++){
                tmp = co*(H[ia][l].r*H[jb][l].r + H[ia][l].i*H[jb][l].i)
                      -si*(H[ia][l].r*H[jb][l].i - H[ia][l].i*H[jb][l].r);
                d1 += VecFkw[l]*tmp;
                tmp = si*(H[ia][l].r*H[jb][l].r + H[ia][l].i*H[jb][l].i)
                      +co*(H[ia][l].r*H[jb][l].i - H[ia][l].i*H[jb][l].r);
                d2 += VecFkw[l]*tmp;
              }
              exx_CDM[spin][iep][i][j].r += d1; 
              exx_CDM[spin][iep][i][j].i += d2; 
            } 
          }
        } /* loop of iep */
      }
      /*---------- until here */

    } /* kloop0 */

    /*******************************************************
         sum of CDM1 and EDM1 by Allreduce in MPI
    *******************************************************/

    dtime(&Stime);

    if (parallel_mode){
      tmp = 1.0/(double)numprocs2;
      for (i=0; i<size_H1; i++){
	CDM1[i] *= tmp;
	EDM1[i] *= tmp;
      }
    }

    MPI_Allreduce(&CDM1[0], &H1[0], size_H1, MPI_DOUBLE, MPI_SUM, MPI_CommWD1[myworld1]);
    MPI_Allreduce(&EDM1[0], &S1[0], size_H1, MPI_DOUBLE, MPI_SUM, MPI_CommWD1[myworld1]);

    /* CDM and EDM */

    k = 0;
    for (AN=1; AN<=atomnum; AN++){
      GA_AN = order_GA[AN];
      MA_AN = F_G2M[GA_AN]; 

      wanA = WhatSpecies[GA_AN];
      tnoA = Spe_Total_CNO[wanA];

      for (LB_AN=0; LB_AN<=FNAN[GA_AN]; LB_AN++){
	GB_AN = natn[GA_AN][LB_AN];
	wanB = WhatSpecies[GB_AN];
	tnoB = Spe_Total_CNO[wanB];

	for (i=0; i<tnoA; i++){
	  for (j=0; j<tnoB; j++){

	    if (1<=MA_AN && MA_AN<=Matomnum){   

	      CDM[spin][MA_AN][LB_AN][i][j] = H1[k];

	      /*
              if (SCF_iter%3==1){ 
	      */
              if (1){ 
	        EDM[spin][MA_AN][LB_AN][i][j] = S1[k];
	      }
	    }

	    k++;

	  }
	}
      }
    }

    dtime(&Etime);
    time12 += Etime - Stime;

    /*---------- added by TOYODA 16/FEB/2010 */
    if (g_exx_switch) { 
      EXX_Reduce_DM(exx, exx_CDM[spin]); 
    }
    /*---------- until here */

    if (SpinP_switch==1 && numprocs0==1 && spin==0){
      spin++;  
      goto diagonalize2; 
    }

    /* if necessary, MPI communication of CDM and EDM */

    if (1<numprocs0 && SpinP_switch==1){

      /* set spin */

      if (myworld1==0){
	spin = 1;
      }
      else{
	spin = 0;
      } 

      /* communicate CDM1 and EDM1 */

      for (i=0; i<=1; i++){
    
	IDS = Comm_World_StartID1[i%2];
	IDR = Comm_World_StartID1[(i+1)%2];

	if (myid0==IDS){
	  MPI_Isend(&H1[0], size_H1, MPI_DOUBLE, IDR, tag, mpi_comm_level1, &request);
	}

	if (myid0==IDR){
	  MPI_Recv(&CDM1[0], size_H1, MPI_DOUBLE, IDS, tag, mpi_comm_level1, &stat);
	}

	if (myid0==IDS){
	  MPI_Wait(&request,&stat);
	}

	if (myid0==IDS){
	  MPI_Isend(&S1[0], size_H1, MPI_DOUBLE, IDR, tag, mpi_comm_level1, &request);
	}

	if (myid0==IDR){
	  MPI_Recv(&EDM1[0], size_H1, MPI_DOUBLE, IDS, tag, mpi_comm_level1, &stat);
	}

	if (myid0==IDS){
	  MPI_Wait(&request,&stat);
	}
      }

      MPI_Bcast(&CDM1[0], size_H1, MPI_DOUBLE, 0, MPI_CommWD1[myworld1]);
      MPI_Bcast(&EDM1[0], size_H1, MPI_DOUBLE, 0, MPI_CommWD1[myworld1]);

      /* put CDM1 and EDM1 into CDM and EDM */

      k = 0;
      for (AN=1; AN<=atomnum; AN++){
	GA_AN = order_GA[AN];
	MA_AN = F_G2M[GA_AN]; 

	wanA = WhatSpecies[GA_AN];
	tnoA = Spe_Total_CNO[wanA];

	for (LB_AN=0; LB_AN<=FNAN[GA_AN]; LB_AN++){
	  GB_AN = natn[GA_AN][LB_AN];
	  wanB = WhatSpecies[GB_AN];
	  tnoB = Spe_Total_CNO[wanB];

	  for (i=0; i<tnoA; i++){
	    for (j=0; j<tnoB; j++){

	      if (1<=MA_AN && MA_AN<=Matomnum){   
		CDM[spin][MA_AN][LB_AN][i][j] = CDM1[k];

		/*
                if (SCF_iter%3==1){ 
		*/
                if (1){ 
		  EDM[spin][MA_AN][LB_AN][i][j] = EDM1[k];
		}
	      }

	      k++;

	    }
	  }
	}
      }
    }

  } /* if (all_knum!=1) */

  /****************************************************
           normalization of CDM, EDM, and iDM 
  ****************************************************/

  dtime(&EiloopTime);

  if (myid0==Host_ID && 0<level_stdout){
    printf("<Band_DFT>  DM, time=%lf\n", EiloopTime-SiloopTime);fflush(stdout);
  }

  dum = 1.0/sum_weights;

  for (spin=0; spin<=SpinP_switch; spin++){
    for (MA_AN=1; MA_AN<=Matomnum; MA_AN++){
      GA_AN = M2G[MA_AN];    
      wanA = WhatSpecies[GA_AN];
      tnoA = Spe_Total_CNO[wanA];
      Anum = MP[GA_AN];
      for (LB_AN=0; LB_AN<=FNAN[GA_AN]; LB_AN++){
	GB_AN = natn[GA_AN][LB_AN];
	wanB = WhatSpecies[GB_AN];
	tnoB = Spe_Total_CNO[wanB];
	Bnum = MP[GB_AN];

	for (i=0; i<tnoA; i++){
	  for (j=0; j<tnoB; j++){
	    CDM[spin][MA_AN][LB_AN][i][j]    = CDM[spin][MA_AN][LB_AN][i][j]*dum;

	    /*
            if (SCF_iter%3==1){ 
	    */
            if (1){ 
  	      EDM[spin][MA_AN][LB_AN][i][j]    = EDM[spin][MA_AN][LB_AN][i][j]*dum;
	    }

	    iDM[0][spin][MA_AN][LB_AN][i][j] = iDM[0][spin][MA_AN][LB_AN][i][j]*dum;
	  }
	}
      }
    }
  }

  /*---------- added by TOYODA 16/FEB/2010 */
  if (g_exx_switch) {
    for (spin=0; spin<=SpinP_switch; spin++){
      for (iep=0; iep<nep; iep++) {
        GA_AN = exx_ep_atom1[iep]+1;
        GB_AN = exx_ep_atom2[iep]+1;
        tnoA = Spe_Total_CNO[WhatSpecies[GA_AN]];
        tnoB = Spe_Total_CNO[WhatSpecies[GB_AN]];
        for (i=0; i<tnoA; i++){
          for (j=0; j<tnoB; j++){
            exx_CDM[spin][iep][i][j].r *= dum;
            exx_CDM[spin][iep][i][j].i *= dum;
          }
        }
      }
    }
  }
  /*---------- until here */

  /****************************************************
                       bond-energies
  ****************************************************/

  My_Eele1[0] = 0.0;
  My_Eele1[1] = 0.0;
  for (MA_AN=1; MA_AN<=Matomnum; MA_AN++){
    GA_AN = M2G[MA_AN];    
    wanA = WhatSpecies[GA_AN];
    tnoA = Spe_Total_CNO[wanA];

    for (j=0; j<=FNAN[GA_AN]; j++){
      GB_AN = natn[GA_AN][j];  
      wanB = WhatSpecies[GB_AN];
      tnoB = Spe_Total_CNO[wanB];

      for (k=0; k<tnoA; k++){
	for (l=0; l<tnoB; l++){
	  for (spin=0; spin<=SpinP_switch; spin++){
	    My_Eele1[spin] += CDM[spin][MA_AN][j][k][l]*nh[spin][MA_AN][j][k][l];
	  }
	}
      }

      /*
      printf("GA_AN=%2d LB_AN=%2d GB_AN=%2d RnB=%2d\n",GA_AN,LB_AN,GB_AN,ncn[GA_AN][j]);
      for (k=0; k<tnoA; k++){
	for (l=0; l<tnoB; l++){
	  for (spin=0; spin<=SpinP_switch; spin++){
	    printf("%15.12f ",CDM[spin][MA_AN][j][k][l]);
	  }
	}
        printf("\n");
      }
      */
  
    }
  }

  /* MPI, My_Eele1 */
  MPI_Barrier(mpi_comm_level1);
  for (spin=0; spin<=SpinP_switch; spin++){
    MPI_Allreduce(&My_Eele1[spin], &Eele1[spin], 1, MPI_DOUBLE,
                   MPI_SUM, mpi_comm_level1);
  }

  if (SpinP_switch==0){
    Eele1[1] = Eele1[0];
  }

  if (3<=level_stdout && myid0==Host_ID){
    printf("Eele00=%15.12f Eele01=%15.12f\n",Eele0[0],Eele0[1]);
    printf("Eele10=%15.12f Eele11=%15.12f\n",Eele1[0],Eele1[1]);
  }

  /****************************************************
                        output
  ****************************************************/

  if (myid0==Host_ID){
  
    strcpy(file_EV,".EV");
    fnjoint(filepath,filename,file_EV);

    if ((fp_EV = fopen(file_EV,"w")) != NULL){

#ifdef xt3
      setvbuf(fp_EV,buf,_IOFBF,fp_bsize); 
#endif

      fprintf(fp_EV,"\n");
      fprintf(fp_EV,"***********************************************************\n");
      fprintf(fp_EV,"***********************************************************\n");
      fprintf(fp_EV,"           Eigenvalues (Hartree) of SCF KS-eq.           \n");
      fprintf(fp_EV,"***********************************************************\n");
      fprintf(fp_EV,"***********************************************************\n\n");
      fprintf(fp_EV,"   Chemical Potential (Hatree) = %18.14f\n",ChemP);
      fprintf(fp_EV,"   Number of States            = %18.14f\n",Num_State);
      fprintf(fp_EV,"   Eigenvalues\n");
      fprintf(fp_EV,"              Up-spin           Down-spin\n");

      for (kloop=0; kloop<T_knum; kloop++){

	k1 = T_KGrids1[kloop];
	k2 = T_KGrids2[kloop];
	k3 = T_KGrids3[kloop];

	if (0<T_k_op[kloop]){

	  fprintf(fp_EV,"\n");
	  fprintf(fp_EV,"   kloop=%i\n",kloop);
	  fprintf(fp_EV,"   k1=%10.5f k2=%10.5f k3=%10.5f\n\n",k1,k2,k3);
	  for (l=1; l<=MaxN; l++){
	    if (SpinP_switch==0){
	      fprintf(fp_EV,"%5d  %18.14f %18.14f\n",
		      l,EIGEN[0][kloop][l],EIGEN[0][kloop][l]);
	    }
	    else if (SpinP_switch==1){
	      fprintf(fp_EV,"%5d  %18.14f %18.14f\n",
		      l,EIGEN[0][kloop][l],EIGEN[1][kloop][l]);
	    }
	  }
	}
      }
      fclose(fp_EV);
    }
    else{
      printf("Failure of saving the EV file.\n");
      fclose(fp_EV);
    }  
  }

  /****************************************************
                       free arrays
  ****************************************************/

  if (all_knum==1){

    free(stat_send);
    free(request_send);
    free(request_recv);

    free(is1);
    free(ie1);

    free(is2);
    free(ie2);

    for (ID=0; ID<numprocs0; ID++){
      if (MPI_CDM1_flag[ID]){
        MPI_Comm_free(&MPI_CommWD_CDM1[ID]);
      }
    }
  }

  free(VecFkw);
  free(VecFkwE);

  /*
  free(BLAS_H);
  free(BLAS_C);
  */
  
  free(stat_send2);

  free(My_NZeros);
  free(SP_NZeros);
  free(SP_Atoms);

  free(MPI_CommWD_CDM1);
  free(MPI_CDM1_flag);

  /* for PrintMemory and allocation */
  firsttime=0;

  /* for elapsed time */

  if (measure_time){
    printf("myid0=%2d time1 =%9.4f\n",myid0,time1);fflush(stdout);
    printf("myid0=%2d time2 =%9.4f\n",myid0,time2);fflush(stdout);
    printf("myid0=%2d time3 =%9.4f\n",myid0,time3);fflush(stdout);
    printf("myid0=%2d time4 =%9.4f\n",myid0,time4);fflush(stdout);
    printf("myid0=%2d time5 =%9.4f\n",myid0,time5);fflush(stdout);
    printf("myid0=%2d time51=%9.4f\n",myid0,time51);fflush(stdout);
    printf("myid0=%2d time6 =%9.4f\n",myid0,time6);fflush(stdout);
    printf("myid0=%2d time7 =%9.4f\n",myid0,time7);fflush(stdout);
    printf("myid0=%2d time8 =%9.4f\n",myid0,time8);fflush(stdout);
    printf("myid0=%2d time81=%9.4f\n",myid0,time81);fflush(stdout);
    printf("myid0=%2d time82=%9.4f\n",myid0,time82);fflush(stdout);
    printf("myid0=%2d time83=%9.4f\n",myid0,time83);fflush(stdout);
    printf("myid0=%2d time84=%9.4f\n",myid0,time84);fflush(stdout);
    printf("myid0=%2d time85=%9.4f\n",myid0,time85);fflush(stdout);
    printf("myid0=%2d time9 =%9.4f\n",myid0,time9);fflush(stdout);
    printf("myid0=%2d time10=%9.4f\n",myid0,time10);fflush(stdout);
    printf("myid0=%2d time11=%9.4f\n",myid0,time11);fflush(stdout);
    printf("myid0=%2d time12=%9.4f\n",myid0,time12);fflush(stdout);

  }

  MPI_Barrier(mpi_comm_level1);
  dtime(&TEtime);
  time0 = TEtime - TStime;
  return time0;
}

#endif
