int main(int argc, char *argv[])
{
static int ct_AN,h_AN,Gh_AN,i,j,TNO1,TNO2;
static int spin,Rn,num0,num1,num2,num3;
int II,JJ ; // dummy variables for loop
int Anum; // temporary variable
int Number_Choo ; // the number of Choosen atom
int TNumOrbs,TNumOrbs3;
int SPI,SPJ;
int optEV ; // variable to be used for option of eigenvector-printing
int gcube_on;
int *MP ; // array which specify a head position of a full matrix
double ***SmallHks, ***O_SmallHks ;
double **SmallOLP, **O_SmallOLP ;
/* variable & arrays for PART-2; same with that of Cluster_DFT.c */
static int l,n,n2,n1,i1,j0,j1,k1,l1;
static int P_min,num_eigen ;
static double **ko, *M1;
static double **B, ***C, **D;
static double sum,sum1,Tsum; // v
static double coef[6];
static double **LDOS;
read_scfout(argv);
read_coordinates(argv);
printf("Number of choosen atoms?\n");
scanf("%d",&Number_Choo);
if (Number_Choo<=0){
printf("Invalid number\n");
}
/*************************************************************************
PART-1 : Constructing the selected-full Hamiltonian & Overlap matrix
**************************************************************************/
/*
allocation of arrays:
int Choo_atom[Number_Choo];
int MP[Number_Choo];
double **SmallHks ;
double **SmallOLP ;
*/
Choo_atom = (int*)malloc(sizeof(int)*Number_Choo);
MP = (int*)malloc(sizeof(int)*Number_Choo);
/* read Choo_atom */
printf("Specify choosen atoms\n");
for (i=0; i<Number_Choo; i++){
scanf("%d",&Choo_atom[i]);
}
/*
make an array MP which specify the starting
position of atom II in the martix such as
a full but small Hamiltonian
*/
Anum = 1;
for (i=0; i<Number_Choo; i++){
MP[i] = Anum;
ct_AN = Choo_atom[i];
Anum = Anum + Total_NumOrbs[ct_AN];
}
TNumOrbs = Anum - 1;
TNumOrbs3 = TNumOrbs + 3;
for (i=0; i<Number_Choo; i++){
ct_AN = Choo_atom[i];
printf("i=%i ct_AN=%i Total_NumOrbs=%i MP=%i\n",
i,ct_AN,Total_NumOrbs[ct_AN],MP[i]);
}
/*
allocation of arrays:
double **SmallHks ;
double **SmallOLP ;
*/
SmallHks = (double***)malloc(sizeof(double**)*(SpinP_switch+1));
for (spin=0; spin<=SpinP_switch; spin++){
SmallHks[spin] = (double**)malloc(sizeof(double*)*TNumOrbs3);
for (i=0; i<TNumOrbs3; i++){
SmallHks[spin][i] = (double*)malloc(sizeof(double)*TNumOrbs3);
}
}
SmallOLP = (double**)malloc(sizeof(double*)*TNumOrbs3);
for (i=0; i<TNumOrbs3; i++){
SmallOLP[i] = (double*)malloc(sizeof(double)*TNumOrbs3);
}
O_SmallHks = (double***)malloc(sizeof(double**)*(SpinP_switch+1));
for (spin=0; spin<=SpinP_switch; spin++){
O_SmallHks[spin] = (double**)malloc(sizeof(double*)*TNumOrbs3);
for (i=0; i<TNumOrbs3; i++){
O_SmallHks[spin][i] = (double*)malloc(sizeof(double)*TNumOrbs3);
}
}
O_SmallOLP = (double**)malloc(sizeof(double*)*TNumOrbs3);
for (i=0; i<TNumOrbs3; i++){
O_SmallOLP[i] = (double*)malloc(sizeof(double)*TNumOrbs3);
}
// sorting ?
for (spin=0; spin<=SpinP_switch; spin++){
// printf("Kohn-Sham Hamiltonian spin=%i\n",spin); // v
for (II=0; II<Number_Choo; II++){
SPI = MP[II];
for (JJ=0; JJ<Number_Choo; JJ++){
SPJ = MP[JJ];
ct_AN = Choo_atom[II] ;
TNO1 = Total_NumOrbs[ct_AN];
for (h_AN=0; h_AN<=FNAN[ct_AN]; h_AN++){
Gh_AN = natn[ct_AN][h_AN];
if (Gh_AN == Choo_atom[JJ]){
Rn = ncn[ct_AN][h_AN];
TNO2 = Total_NumOrbs[Gh_AN];
for (i=0; i<TNO1; i++){
for (j=0; j<TNO2; j++){
SmallHks[spin][i+SPI][j+SPJ] = Hks[spin][ct_AN][h_AN][i][j];
SmallOLP[i+SPI][j+SPJ] = OLP[ct_AN][h_AN][i][j];
}
}
/*
printf("glbal index=%i local index=%i (grobal=%i, Rn=%i)\n",
ct_AN,h_AN,Gh_AN,Rn);
for (i=0; i<TNO1; i++){
for (j=0; j<TNO2; j++){
printf("%10.7f ",Hks[spin][ct_AN][h_AN][i][j]);
}
printf("\n");
}
*/
}
}
}
}
}
/* store original selected Hks and S */
for (spin=0; spin<=SpinP_switch; spin++){
printf("spin=%i Full Hamiltonian matrix of selected atoms\n",spin);
for (i=1; i<=TNumOrbs; i++){
for (j=1; j<=TNumOrbs; j++){
printf("%7.3f ",SmallHks[spin][i][j]);
// store original information
O_SmallHks[spin][i][j] = SmallHks[spin][i][j];
}
printf("\n");
}
}
for (i=1; i<=TNumOrbs; i++){
for (j=1; j<=TNumOrbs; j++){
printf("%7.3f ",SmallOLP[i][j]);
O_SmallOLP[i][j] = SmallOLP[i][j]; // store original information
}
printf("\n");
}
for (spin=0; spin<=SpinP_switch; spin++){
printf("spin=%i Full Hamiltonian matrix of selected atoms\n",spin);
for (i=1; i<=TNumOrbs; i++){
for (j=1; j<=TNumOrbs; j++){
printf("%7.3f ",SmallHks[spin][i][j]);
}
printf("\n");
}
}
printf("Full overlap matrix of selected atoms\n");
for (i=1; i<=TNumOrbs; i++){
for (j=1; j<=TNumOrbs; j++){
printf("%7.3f ",SmallOLP[i][j]);
}
printf("\n");
}
/*************************************************************************
PART-2 : Starting the part that diagonalize the selected-full
Hamiltonian & Overlap matrix
**************************************************************************/
/*******************************************
allocation of arrays:
double ko[SpinP_switch+1][TNumOrbs3];
double M1[TNumOrbs3];
double B[TNumOrbs3][TNumOrbs3];
********************************************/
ko = (double**)malloc(sizeof(double*)*(SpinP_switch+1));
for (spin=0; spin<=SpinP_switch; spin++){
ko[spin] = (double*)malloc(sizeof(double)*TNumOrbs3);
}
M1 = (double*)malloc(sizeof(double)*TNumOrbs3);
B = (double**)malloc(sizeof(double*)*TNumOrbs3);
for (i=0; i<TNumOrbs3; i++){
B[i] = (double*)malloc(sizeof(double)*TNumOrbs3);
}
C = (double***)malloc(sizeof(double**)*(SpinP_switch+1));
for (spin=0; spin<=SpinP_switch; spin++){
C[spin] = (double**)malloc(sizeof(double*)*TNumOrbs3);
for (i=0; i<TNumOrbs3; i++){
C[spin][i] = (double*)malloc(sizeof(double)*TNumOrbs3);
}
}
D = (double**)malloc(sizeof(double*)*TNumOrbs3);
for (i=0; i<TNumOrbs3; i++){
D[i] = (double*)malloc(sizeof(double)*TNumOrbs3);
}
/*******************************************
diagonalize the overlap matrix
first
SmallOLP -> OLP matrix
after call Eigen_lapack
SmallOLP -> eigenvectors of OLP matrix
********************************************/
Eigen_lapack(SmallOLP,ko[0],TNumOrbs);
for (l=1; l<=TNumOrbs; l++){
M1[l] = 1.0/sqrt(ko[0][l]);
}
/*
for (l=1; l<=TNumOrbs; l++){
printf("%i %15.12f\n",l,M1[l]);
}
*/
/****************************************************
Calculations of eigenvalues for up and down spins
****************************************************/
n = TNumOrbs;
for (spin=0; spin<=SpinP_switch; spin++){
for (i1=1; i1<=n; i1++){
for (j1=1; j1<=n; j1++){
sum = 0.0;
for (l=1; l<=n; l++){
sum = sum + SmallHks[spin][i1][l]*SmallOLP[l][j1]*M1[j1];
}
C[spin][i1][j1] = sum;
}
}
for (i1=1; i1<=n; i1++){
for (j1=1; j1<=n; j1++){
sum = 0.0;
for (l=1; l<=n; l++){
sum = sum + M1[i1]*SmallOLP[l][i1]*C[spin][l][j1];
//sum = sum + M1[i1]*SmallOLP[l][i1]*C[spin][l][j1];
}
B[i1][j1] = sum;
}
}
for (i1=1; i1<=n; i1++){
for (j1=1; j1<=n; j1++){
D[i1][j1] = B[i1][j1];
}
}
Eigen_lapack(D,ko[spin],n);
/****************************************************
Transformation to the original eigen vectors.
NOTE 244P
****************************************************/
for (i1=1; i1<=n; i1++){
for (j1=1; j1<=n; j1++){
C[spin][i1][j1] = 0.0;
}
}
for (i1=1; i1<=n; i1++){
for (j1=1; j1<=n; j1++){
sum = 0.0;
for (l=P_min; l<=n; l++){
sum = sum + SmallOLP[i1][l]*M1[l]*D[l][j1];
}
C[spin][i1][j1] = sum;
}
}
}
for (spin=0; spin<=SpinP_switch; spin++){
printf("\nspin=%i \n",spin); // v
for (i=1; i<=TNumOrbs; i++){
printf("%ith eigenvalue of HC=eSC: %15.12f\n",i,ko[spin][i]);
}
}
/*
for (spin=0; spin<=SpinP_switch; spin++){
printf("C spin=%i\n",spin);
for (i1=1; i1<=n; i1++){
for (j1=1; j1<=n; j1++){
printf("%7.4f ",C[spin][i1][j1]);
}
printf("\n");
}
}
*/
/****************************************************
Part for Checking 'HC=eSC'
****************************************************/
for (spin=0; spin<=SpinP_switch; spin++){
printf("spin=%i \n", spin);
for (j1=1; j1<=n; j1++){
for (i1=1; i1<=n; i1++){
sum = 0.0;
sum1= 0.0;
for (l=1; l<=n; l++){
sum = sum + O_SmallHks[spin][i1][l]*C[spin][l][j1];
sum1 = sum1 + O_SmallOLP[i1][l]*C[spin][l][j1]; // *ko[spin][j1];
}
sum1 = ko[spin][j1] * sum1 ; // ko[spin][i1]??
Tsum = Tsum + fabs(sum-sum1);
}
printf("Check ko=%i |HC-eSC|=%15.12f\n",j1,Tsum);
}
}
/*
for (spin=0; spin<=SpinP_switch; spin++){
printf("spin=%i \n", spin);
for (i1=1; i1<=n; i1++){
for (j1=1; j1<=n; j1++){
sum = 0.0;
sum1= 0.0;
for (l=1; l<=n; l++){
sum = sum + O_SmallHks[spin][i1][l]*C[spin][l][j1];
sum1 = sum1 + O_SmallOLP[i1][l]*C[spin][l][j1]; // *ko[spin][j1];
}
sum1 = ko[spin][j1] * sum1 ; // ko[spin][i1]??
printf("l.h.s - r.h.s = %10.7f\n", sum-sum1 );
}
}
}
*/
/****************************************************
printing out the eigenvectors
****************************************************/
printf("\nDo you want eigenvectors also? (yes:1 / no:0)");
scanf("%i",&optEV);
if (optEV == 1){
num0 = 7;
for (spin=0; spin<=SpinP_switch; spin++){
printf("\nspin=%i \n",spin); // v
num1 = TNumOrbs/num0;
num2 = TNumOrbs%num0;
for (i1=0; i1<=num1; i1++){
j0 = i1*num0;
for (i=-2; i<=TNumOrbs; i++){
for (j=0; j<=num0; j++){
j1 = j0 + j;
if (j1<=TNumOrbs){
if (i==-2){
if (j==0)
printf(" ");
else
printf("%7d ",j1);
}
else if (i==-1){
if (j==0)
printf(" ");
else
printf("%10.7f ",ko[spin][j1]);
}
else if (i==0){
if (j==0)
printf(" ");
else
printf(" ");
}
else {
if (j==0)
printf("%4d ",i);
else
printf("%10.7f ",C[spin][i][j1]);
}
}
}
printf("\n");
}
}
}
}
/*
printf("\nDo you want eigenvectors also? (yes:1 / no:0)");
scanf("%i",&optEV);
if (optEV == 1){
for (spin=0; spin<=SpinP_switch; spin++){
printf("\nspin=%i \n",spin); // v
for (i=1; i<=TNumOrbs; i++){
printf("%ith eigenvector: ",i);
printf("{");
for (j=1; j<=TNumOrbs; j++){
printf("%15.12f,",C[spin][i][j]);
}
printf("}\n");
}
}
}
*/
/****************************************************
making Gaussian cube data of MO(d-orbitals)
****************************************************/
printf("\nDo you want Gcube of MO (d-orbitals)? (yes:1 / no:0)");
scanf("%i",&gcube_on);
if (gcube_on == 1){
printf("\nWhich eigenstate? (yes:1 / no:0)");
scanf("%i",&num_eigen);
printf("\n up or down? (up:0 / down:0)");
scanf("%i",&spin);
coef[1] = C[spin][10][num_eigen];
coef[2] = C[spin][11][num_eigen];
coef[3] = C[spin][12][num_eigen];
coef[4] = C[spin][13][num_eigen];
coef[5] = C[spin][14][num_eigen];
Draw_Gcube(coef);
}
/****************************************************
calculate PDOS of Mn atom
****************************************************/
LDOS = (double**)malloc(sizeof(double*)*30);
for (i=0; i<30; i++){
LDOS[i] = (double*)malloc(sizeof(double)*TNumOrbs3);
}
for (spin=0; spin<=SpinP_switch; spin++){
printf("\nPDOS spin=%i\n",spin);
for (i1=10; i1<=14; i1++){
for (i=1; i<=TNumOrbs; i++){
LDOS[i1][i] = 0.0;
for (j=1; j<=TNumOrbs; j++){
LDOS[i1][i] += C[spin][i1][i]*C[spin][j][i]*O_SmallOLP[j][i1];
}
}
}
for (i=1; i<=TNumOrbs; i++){
sum = 0.0;
for (i1=10; i1<=14; i1++) sum = sum + LDOS[i1][i];
printf("%15.12f %15.12f\n",(ko[spin][i]+0.15)*27.2113845,sum);
}
}
} // the end of 'main'
void Initial_CntCoes2(double *****nh, double *****OLP)
{
static int firsttime=1;
int i,j,l,n,n2,i1,j1;
int wan;
int po;
int Second_switch;
double time0;
int Mc_AN,Gc_AN,wanA;
int q,q0,al0,al1,pmax;
int Mul0,Mul1,deg_on,deg_num;
int al,p,L0,M0,p0,Np;
int ig,im,jg,ian,jan,kl,m,Gi;
int mu,nu,Anum,Bnum,NUM,maxp;
int h_AN,Gh_AN,Hwan,tno1,tno2,Cwan,spin;
double Beta0,scaleF,maxc;
double *ko,*C0,*koSys;
double **S,**Hks,**D,*abs_sum,*M1,**C,**B;
int *jun,*ponu;
double tmp0,tmp1,Max0,rc1,fugou,MaxV;
double sum,TZ;
double Num_State,x,FermiF,Dnum;
double LChemP_MAX,LChemP_MIN,LChemP;
double TStime,TEtime;
double *tmp_array;
double *tmp_array2;
int *MP,*dege;
int **tmp_index;
int ***tmp_index1;
int ***tmp_index2;
double *Tmp_CntCoes;
double **Check_ko;
double *Weight_ko;
double ***CntCoes_Spe;
double ***My_CntCoes_Spe;
double **InProd;
int *Snd_CntCoes_Size;
int *Rcv_CntCoes_Size;
int *Snd_H_Size,*Rcv_H_Size;
int *Snd_S_Size,*Rcv_S_Size;
int size1,size2,num;
int numprocs,myid,tag=999,ID,IDS,IDR;
MPI_Status stat;
MPI_Request request;
/* MPI */
MPI_Comm_size(mpi_comm_level1,&numprocs);
MPI_Comm_rank(mpi_comm_level1,&myid);
dtime(&TStime);
/****************************************************
allocation of arrays:
int MP[List_YOUSO[8]];
int tmp_index[List_YOUSO[25]+1]
[2*(List_YOUSO[25]+1)+1];
int tmp_index1[List_YOUSO[25]+1]
[List_YOUSO[24]]
[2*(List_YOUSO[25]+1)+1];
int tmp_index2[List_YOUSO[25]+1]
[List_YOUSO[24]]
[2*(List_YOUSO[25]+1)+1];
double Tmp_CntCoes[List_YOUSO[24]]
double Check_ko[List_YOUSO[25]+1]
[2*(List_YOUSO[25]+1)+1];
double Weight_ko[List_YOUSO[7]];
****************************************************/
MP = (int*)malloc(sizeof(int)*List_YOUSO[8]);
tmp_index = (int**)malloc(sizeof(int*)*(List_YOUSO[25]+1));
for (i=0; i<(List_YOUSO[25]+1); i++){
tmp_index[i] = (int*)malloc(sizeof(int)*(2*(List_YOUSO[25]+1)+1));
}
tmp_index1 = (int***)malloc(sizeof(int**)*(List_YOUSO[25]+1));
for (i=0; i<(List_YOUSO[25]+1); i++){
tmp_index1[i] = (int**)malloc(sizeof(int*)*List_YOUSO[24]);
for (j=0; j<List_YOUSO[24]; j++){
tmp_index1[i][j] = (int*)malloc(sizeof(int)*(2*(List_YOUSO[25]+1)+1));
}
}
tmp_index2 = (int***)malloc(sizeof(int**)*(List_YOUSO[25]+1));
for (i=0; i<(List_YOUSO[25]+1); i++){
tmp_index2[i] = (int**)malloc(sizeof(int*)*List_YOUSO[24]);
for (j=0; j<List_YOUSO[24]; j++){
tmp_index2[i][j] = (int*)malloc(sizeof(int)*(2*(List_YOUSO[25]+1)+1));
}
}
Tmp_CntCoes = (double*)malloc(sizeof(double)*List_YOUSO[24]);
Check_ko = (double**)malloc(sizeof(double*)*(List_YOUSO[25]+1));
for (i=0; i<(List_YOUSO[25]+1); i++){
Check_ko[i] = (double*)malloc(sizeof(double)*(2*(List_YOUSO[25]+1)+1));
}
Weight_ko = (double*)malloc(sizeof(double)*List_YOUSO[7]);
Snd_CntCoes_Size = (int*)malloc(sizeof(int)*Num_Procs);
Rcv_CntCoes_Size = (int*)malloc(sizeof(int)*Num_Procs);
Snd_H_Size = (int*)malloc(sizeof(int)*Num_Procs);
Rcv_H_Size = (int*)malloc(sizeof(int)*Num_Procs);
Snd_S_Size = (int*)malloc(sizeof(int)*Num_Procs);
Rcv_S_Size = (int*)malloc(sizeof(int)*Num_Procs);
/* PrintMemory */
if (firsttime) {
PrintMemory("Initial_CntCoes: tmp_index",sizeof(int)*(List_YOUSO[25]+1)*
(2*(List_YOUSO[25]+1)+1),NULL);
PrintMemory("Initial_CntCoes: tmp_index1",sizeof(int)*(List_YOUSO[25]+1)*
List_YOUSO[24]*(2*(List_YOUSO[25]+1)+1) ,NULL);
PrintMemory("Initial_CntCoes: tmp_index2",sizeof(int)*(List_YOUSO[25]+1)*
List_YOUSO[24]*(2*(List_YOUSO[25]+1)+1) ,NULL);
PrintMemory("Initial_CntCoes: Check_ko",sizeof(double)*(List_YOUSO[25]+1)*
(2*(List_YOUSO[25]+1)+1),NULL);
firsttime=0;
}
/****************************************************
MPI:
nh(=H)
****************************************************/
/***********************************
set data size
************************************/
for (ID=0; ID<numprocs; ID++){
IDS = (myid + ID) % numprocs;
IDR = (myid - ID + numprocs) % numprocs;
if (ID!=0){
tag = 999;
/* find data size to send block data */
if (F_Snd_Num[IDS]!=0){
size1 = 0;
for (spin=0; spin<=SpinP_switch; spin++){
for (n=0; n<F_Snd_Num[IDS]; n++){
Mc_AN = Snd_MAN[IDS][n];
Gc_AN = Snd_GAN[IDS][n];
Cwan = WhatSpecies[Gc_AN];
tno1 = Spe_Total_NO[Cwan];
for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
Gh_AN = natn[Gc_AN][h_AN];
Hwan = WhatSpecies[Gh_AN];
tno2 = Spe_Total_NO[Hwan];
size1 += tno1*tno2;
}
}
}
Snd_H_Size[IDS] = size1;
MPI_Isend(&size1, 1, MPI_INT, IDS, tag, mpi_comm_level1, &request);
}
else{
Snd_H_Size[IDS] = 0;
}
/* receiving of size of data */
if (F_Rcv_Num[IDR]!=0){
MPI_Recv(&size2, 1, MPI_INT, IDR, tag, mpi_comm_level1, &stat);
Rcv_H_Size[IDR] = size2;
}
else{
Rcv_H_Size[IDR] = 0;
}
if (F_Snd_Num[IDS]!=0) MPI_Wait(&request,&stat);
}
else{
Snd_H_Size[IDS] = 0;
Rcv_H_Size[IDR] = 0;
}
}
/***********************************
data transfer
************************************/
tag = 999;
for (ID=0; ID<numprocs; ID++){
IDS = (myid + ID) % numprocs;
IDR = (myid - ID + numprocs) % numprocs;
if (ID!=0){
/*****************************
sending of data
*****************************/
if (F_Snd_Num[IDS]!=0){
size1 = Snd_H_Size[IDS];
/* allocation of array */
tmp_array = (double*)malloc(sizeof(double)*size1);
/* multidimentional array to vector array */
num = 0;
for (spin=0; spin<=SpinP_switch; spin++){
for (n=0; n<F_Snd_Num[IDS]; n++){
Mc_AN = Snd_MAN[IDS][n];
Gc_AN = Snd_GAN[IDS][n];
Cwan = WhatSpecies[Gc_AN];
tno1 = Spe_Total_NO[Cwan];
for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
Gh_AN = natn[Gc_AN][h_AN];
Hwan = WhatSpecies[Gh_AN];
tno2 = Spe_Total_NO[Hwan];
for (i=0; i<tno1; i++){
for (j=0; j<tno2; j++){
tmp_array[num] = nh[spin][Mc_AN][h_AN][i][j];
num++;
}
}
}
}
}
MPI_Isend(&tmp_array[0], size1, MPI_DOUBLE, IDS, tag, mpi_comm_level1, &request);
}
/*****************************
receiving of block data
*****************************/
if (F_Rcv_Num[IDR]!=0){
size2 = Rcv_H_Size[IDR];
/* allocation of array */
tmp_array2 = (double*)malloc(sizeof(double)*size2);
MPI_Recv(&tmp_array2[0], size2, MPI_DOUBLE, IDR, tag, mpi_comm_level1, &stat);
num = 0;
for (spin=0; spin<=SpinP_switch; spin++){
Mc_AN = S_TopMAN[IDR] - 1; /* S_TopMAN should be used. */
for (n=0; n<F_Rcv_Num[IDR]; n++){
Mc_AN++;
Gc_AN = Rcv_GAN[IDR][n];
Cwan = WhatSpecies[Gc_AN];
tno1 = Spe_Total_NO[Cwan];
for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
Gh_AN = natn[Gc_AN][h_AN];
Hwan = WhatSpecies[Gh_AN];
tno2 = Spe_Total_NO[Hwan];
for (i=0; i<tno1; i++){
for (j=0; j<tno2; j++){
nh[spin][Mc_AN][h_AN][i][j] = tmp_array2[num];
num++;
}
}
}
}
}
/* freeing of array */
free(tmp_array2);
}
if (F_Snd_Num[IDS]!=0){
MPI_Wait(&request,&stat);
free(tmp_array); /* freeing of array */
}
}
}
/****************************************************
MPI:
OLP[0]
****************************************************/
/***********************************
set data size
************************************/
for (ID=0; ID<numprocs; ID++){
IDS = (myid + ID) % numprocs;
IDR = (myid - ID + numprocs) % numprocs;
if (ID!=0){
tag = 999;
/* find data size to send block data */
if (F_Snd_Num[IDS]!=0){
size1 = 0;
for (n=0; n<F_Snd_Num[IDS]; n++){
Mc_AN = Snd_MAN[IDS][n];
Gc_AN = Snd_GAN[IDS][n];
Cwan = WhatSpecies[Gc_AN];
tno1 = Spe_Total_NO[Cwan];
for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
Gh_AN = natn[Gc_AN][h_AN];
Hwan = WhatSpecies[Gh_AN];
tno2 = Spe_Total_NO[Hwan];
size1 += tno1*tno2;
}
}
Snd_S_Size[IDS] = size1;
MPI_Isend(&size1, 1, MPI_INT, IDS, tag, mpi_comm_level1, &request);
}
else{
Snd_S_Size[IDS] = 0;
}
/* receiving of size of data */
if (F_Rcv_Num[IDR]!=0){
MPI_Recv(&size2, 1, MPI_INT, IDR, tag, mpi_comm_level1, &stat);
Rcv_S_Size[IDR] = size2;
}
else{
Rcv_S_Size[IDR] = 0;
}
if (F_Snd_Num[IDS]!=0) MPI_Wait(&request,&stat);
}
else{
Snd_S_Size[IDS] = 0;
Rcv_S_Size[IDR] = 0;
}
}
/***********************************
data transfer
************************************/
tag = 999;
for (ID=0; ID<numprocs; ID++){
IDS = (myid + ID) % numprocs;
IDR = (myid - ID + numprocs) % numprocs;
if (ID!=0){
/*****************************
sending of data
*****************************/
if (F_Snd_Num[IDS]!=0){
size1 = Snd_S_Size[IDS];
/* allocation of array */
tmp_array = (double*)malloc(sizeof(double)*size1);
/* multidimentional array to vector array */
num = 0;
for (n=0; n<F_Snd_Num[IDS]; n++){
Mc_AN = Snd_MAN[IDS][n];
Gc_AN = Snd_GAN[IDS][n];
Cwan = WhatSpecies[Gc_AN];
tno1 = Spe_Total_NO[Cwan];
for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
Gh_AN = natn[Gc_AN][h_AN];
Hwan = WhatSpecies[Gh_AN];
tno2 = Spe_Total_NO[Hwan];
for (i=0; i<tno1; i++){
for (j=0; j<tno2; j++){
tmp_array[num] = OLP[0][Mc_AN][h_AN][i][j];
num++;
}
}
}
}
MPI_Isend(&tmp_array[0], size1, MPI_DOUBLE, IDS, tag, mpi_comm_level1, &request);
}
/*****************************
receiving of block data
*****************************/
if (F_Rcv_Num[IDR]!=0){
size2 = Rcv_S_Size[IDR];
/* allocation of array */
tmp_array2 = (double*)malloc(sizeof(double)*size2);
MPI_Recv(&tmp_array2[0], size2, MPI_DOUBLE, IDR, tag, mpi_comm_level1, &stat);
num = 0;
Mc_AN = S_TopMAN[IDR] - 1; /* S_TopMAN should be used. */
for (n=0; n<F_Rcv_Num[IDR]; n++){
Mc_AN++;
Gc_AN = Rcv_GAN[IDR][n];
Cwan = WhatSpecies[Gc_AN];
tno1 = Spe_Total_NO[Cwan];
for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
Gh_AN = natn[Gc_AN][h_AN];
Hwan = WhatSpecies[Gh_AN];
tno2 = Spe_Total_NO[Hwan];
for (i=0; i<tno1; i++){
for (j=0; j<tno2; j++){
OLP[0][Mc_AN][h_AN][i][j] = tmp_array2[num];
num++;
}
}
}
}
/* freeing of array */
free(tmp_array2);
}
if (F_Snd_Num[IDS]!=0){
MPI_Wait(&request,&stat);
free(tmp_array); /* freeing of array */
}
}
}
/****************************************************
set of "initial" coefficients of the contraction
****************************************************/
Second_switch = 1;
Simple_InitCnt[0] = 0;
Simple_InitCnt[1] = 0;
Simple_InitCnt[2] = 0;
Simple_InitCnt[3] = 0;
Simple_InitCnt[4] = 0;
Simple_InitCnt[5] = 0;
for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
Gc_AN = M2G[Mc_AN];
wan = WhatSpecies[Gc_AN];
for (al=0; al<Spe_Total_CNO[wan]; al++){
for (p=0; p<Spe_Specified_Num[wan][al]; p++){
CntCoes[Mc_AN][al][p] = 0.0;
}
}
al = -1;
for (L0=0; L0<=Spe_MaxL_Basis[wan]; L0++){
for (Mul0=0; Mul0<Spe_Num_CBasis[wan][L0]; Mul0++){
for (M0=0; M0<=2*L0; M0++){
al++;
CntCoes[Mc_AN][al][Mul0] = 1.0;
}
}
}
}
if (SICnt_switch==2) goto Simple_Init;
/****************************************************
Setting of Hamiltonian and overlap matrices
MP indicates the starting position of
atom i in arraies H and S
****************************************************/
for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
Gc_AN = M2G[Mc_AN];
wan = WhatSpecies[Gc_AN];
if ( FNAN[Gc_AN]<30 ) scaleF = 1.6;
else if ( FNAN[Gc_AN]<40 ) scaleF = 1.4;
else if ( FNAN[Gc_AN]<50 ) scaleF = 1.2;
else scaleF = 1.0;
rc1 = scaleF*Spe_Atom_Cut1[wan];
/***********************************************
MP indicates the starting position of
atom i in arraies H and S
***********************************************/
Anum = 1;
TZ = 0.0;
for (i=0; i<=FNAN[Gc_AN]; i++){
if (Dis[Gc_AN][i]<=rc1){
MP[i] = Anum;
Gi = natn[Gc_AN][i];
wanA = WhatSpecies[Gi];
Anum = Anum + Spe_Total_NO[wanA];
TZ = TZ + Spe_Core_Charge[wanA];
}
}
NUM = Anum - 1;
/****************************************************
allocation
****************************************************/
n2 = NUM + 3;
koSys = (double*)malloc(sizeof(double)*n2);
ko = (double*)malloc(sizeof(double)*n2);
abs_sum = (double*)malloc(sizeof(double)*n2);
M1 = (double*)malloc(sizeof(double)*n2);
dege = (int*)malloc(sizeof(int)*n2);
C0 = (double*)malloc(sizeof(double)*n2);
S = (double**)malloc(sizeof(double*)*n2);
Hks = (double**)malloc(sizeof(double*)*n2);
D = (double**)malloc(sizeof(double*)*n2);
C = (double**)malloc(sizeof(double*)*n2);
B = (double**)malloc(sizeof(double*)*n2);
for (i=0; i<n2; i++){
S[i] = (double*)malloc(sizeof(double)*n2);
Hks[i] = (double*)malloc(sizeof(double)*n2);
D[i] = (double*)malloc(sizeof(double)*n2);
C[i] = (double*)malloc(sizeof(double)*n2);
B[i] = (double*)malloc(sizeof(double)*n2);
}
jun = (int*)malloc(sizeof(int)*n2);
ponu = (int*)malloc(sizeof(int)*n2);
InProd = (double**)malloc(sizeof(double*)*n2);
for (i=0; i<n2; i++){
InProd[i] = (double*)malloc(sizeof(double)*n2);
}
/****************************************************
calc
****************************************************/
if (3<=level_stdout){
printf("<Initial_CntCoes> Mc_AN=%2d Gc_AN=%2d NUM=%2d\n",Mc_AN,Gc_AN,NUM);
}
for (i=0; i<=FNAN[Gc_AN]; i++){
if (Dis[Gc_AN][i]<=rc1){
ig = natn[Gc_AN][i];
im = S_G2M[ig]; /* S_G2M must be used. */
ian = Spe_Total_NO[WhatSpecies[ig]];
Anum = MP[i];
for (j=0; j<=FNAN[Gc_AN]; j++){
if (Dis[Gc_AN][j]<=rc1){
kl = RMI1[Mc_AN][i][j];
jg = natn[Gc_AN][j];
jan = Spe_Total_NO[WhatSpecies[jg]];
Bnum = MP[j];
if (0<=kl){
for (m=0; m<ian; m++){
for (n=0; n<jan; n++){
S[Anum+m][Bnum+n] = OLP[0][im][kl][m][n];
if (SpinP_switch==0)
Hks[Anum+m][Bnum+n] = nh[0][im][kl][m][n];
else
Hks[Anum+m][Bnum+n] = 0.5*(nh[0][im][kl][m][n]
+ nh[1][im][kl][m][n]);
}
}
}
else{
for (m=0; m<ian; m++){
for (n=0; n<jan; n++){
S[Anum+m][Bnum+n] = 0.0;
Hks[Anum+m][Bnum+n] = 0.0;
}
}
}
}
}
}
}
if (3<=level_stdout){
printf("\n");
printf("overlap matrix Gc_AN=%2d\n",Gc_AN);
for (i1=1; i1<=NUM; i1++){
for (j1=1; j1<=NUM; j1++){
printf("%6.3f ",S[i1][j1]);
}
printf("\n");
}
printf("\n");
printf("hamiltonian matrix Gc_AN=%2d\n",Gc_AN);
for (i1=1; i1<=NUM; i1++){
for (j1=1; j1<=NUM; j1++){
printf("%6.3f ",Hks[i1][j1]);
}
printf("\n");
}
printf("\n");
}
/***********************************************
Solve the generalized eigenvalue problem
***********************************************/
Eigen_lapack(S,koSys,NUM,NUM);
/***********************************************
Searching of negative eigenvalues
************************************************/
for (l=1; l<=NUM; l++){
if (koSys[l]<0.0){
koSys[l] = 1.0e-7;
if (3<=level_stdout){
printf("<Init_CntCoes> Negative EV of OLP %2d %15.12f\n",l,koSys[l]);
}
}
}
for (l=1; l<=NUM; l++){
M1[l] = 1.0/sqrt(koSys[l]);
}
for (i1=1; i1<=NUM; i1++){
for (j1=i1+1; j1<=NUM; j1++){
tmp0 = S[i1][j1];
tmp1 = S[j1][i1];
S[j1][i1] = tmp0;
S[i1][j1] = tmp1;
}
}
for (i1=1; i1<=NUM; i1++){
for (j1=1; j1<=NUM; j1++){
sum = 0.0;
tmp0 = M1[j1];
for (l=1; l<=NUM; l++){
sum = sum + Hks[i1][l]*S[j1][l]*tmp0;
}
C[j1][i1] = sum;
}
}
for (i1=1; i1<=NUM; i1++){
for (j1=1; j1<=NUM; j1++){
sum = 0.0;
tmp0 = M1[i1];
for (l=1; l<=NUM; l++){
sum = sum + tmp0*S[i1][l]*C[j1][l];
}
B[i1][j1] = sum;
}
}
for (i1=1; i1<=NUM; i1++){
for (j1=1; j1<=NUM; j1++){
D[i1][j1] = B[i1][j1];
}
}
Eigen_lapack(D,koSys,NUM,NUM);
/***********************************************
transformation to the original eigenvectors.
NOTE 244P
***********************************************/
for (i1=1; i1<=NUM; i1++){
for (j1=1; j1<=NUM; j1++){
C[i1][j1] = 0.0;
}
}
for (i1=1; i1<=NUM; i1++){
for (j1=i1+1; j1<=NUM; j1++){
tmp0 = S[i1][j1];
tmp1 = S[j1][i1];
S[j1][i1] = tmp0;
S[i1][j1] = tmp1;
tmp0 = D[i1][j1];
tmp1 = D[j1][i1];
D[j1][i1] = tmp0;
D[i1][j1] = tmp1;
}
}
for (i1=1; i1<=NUM; i1++){
for (j1=1; j1<=NUM; j1++){
sum = 0.0;
for (l=1; l<=NUM; l++){
sum = sum + S[i1][l]*M1[l]*D[j1][l];
}
C[i1][j1] = sum;
}
}
/****************************************************
searching of a local chemical potential
****************************************************/
po = 0;
LChemP_MAX = 10.0;
LChemP_MIN =-10.0;
Beta0 = 1.0/(kB*1500.0/eV2Hartree);
do{
LChemP = 0.50*(LChemP_MAX + LChemP_MIN);
Num_State = 0.0;
for (i1=1; i1<=NUM; i1++){
x = (koSys[i1] - LChemP)*Beta0;
if (x<=-30.0) x = -30.0;
if (30.0<=x) x = 30.0;
FermiF = 2.0/(1.0 + exp(x));
Num_State = Num_State + FermiF;
}
Dnum = TZ - Num_State;
if (0.0<=Dnum) LChemP_MIN = LChemP;
else LChemP_MAX = LChemP;
if (fabs(Dnum)<0.000000000001) po = 1;
}
while (po==0);
if (3<=level_stdout){
for (i1=1; i1<=NUM; i1++){
x = (koSys[i1] - LChemP)*Beta0;
if (x<=-30.0) x = -30.0;
if (30.0<=x) x = 30.0;
FermiF = 1.0/(1.0 + exp(x));
printf("<Init_CntCoes> %2d eigenvalue=%15.12f FermiF=%15.12f\n",
i1,koSys[i1],FermiF);
}
}
if (3<=level_stdout){
printf("\n");
printf("first C Gc_AN=%2d\n",Gc_AN);
for (i1=1; i1<=NUM; i1++){
for (j1=1; j1<=NUM; j1++){
printf("%10.6f ",C[i1][j1]);
}
printf("\n");
}
}
if (3<=level_stdout){
printf("<Init_CntCoes> LChemP=%15.12f\n",LChemP);
}
/************************************************
maximize the "overlap" between wave functions
and contracted basis functions
************************************************/
/* make a table function converting [L0][Mul0][M0] to "al" for primitive orbitals */
al = -1;
for (L0=0; L0<=Spe_MaxL_Basis[wan]; L0++){
for (Mul0=0; Mul0<Spe_Num_Basis[wan][L0]; Mul0++){
for (M0=0; M0<=2*L0; M0++){
al++;
tmp_index1[L0][Mul0][M0] = al;
}
}
}
/* make a table function converting [L0][Mul0][M0] to "al" for contracted orbitals */
al = -1;
for (L0=0; L0<=Spe_MaxL_Basis[wan]; L0++){
for (Mul0=0; Mul0<Spe_Num_CBasis[wan][L0]; Mul0++){
for (M0=0; M0<=2*L0; M0++){
al++;
tmp_index2[L0][Mul0][M0] = al;
}
}
}
/* loop for L0 */
for (L0=0; L0<=Spe_MaxL_Basis[wan]; L0++){
for (Mul0=0; Mul0<Spe_Num_Basis[wan][L0]; Mul0++){
for (Mul1=0; Mul1<Spe_Num_Basis[wan][L0]; Mul1++){
Hks[Mul0+1][Mul1+1] = 0.0;
}
}
for (M0=0; M0<=2*L0; M0++){
for (Mul0=0; Mul0<Spe_Num_Basis[wan][L0]; Mul0++){
i = tmp_index1[L0][Mul0][M0];
for (mu=1; mu<=NUM; mu++){
InProd[mu][Mul0] = C[MP[0]+i][mu];
} /* mu */
} /* Mul0 */
for (Mul0=0; Mul0<Spe_Num_Basis[wan][L0]; Mul0++){
for (Mul1=0; Mul1<Spe_Num_Basis[wan][L0]; Mul1++){
sum = 0.0;
for (mu=1; mu<=NUM; mu++){
x = (koSys[mu] - LChemP)*Beta0;
if (x<=-30.0) x = -30.0;
if (30.0<=x) x = 30.0;
FermiF = 1.0/(1.0 + exp(x));
sum += FermiF*InProd[mu][Mul0]*InProd[mu][Mul1];
}
Hks[Mul0+1][Mul1+1] -= sum;
}
/* for calculation of a single atom */
tmp0 = (double)(Spe_Num_Basis[wan][L0]-Mul0);
Hks[Mul0+1][Mul0+1] += -1.0e-9*tmp0*tmp0;
}
} /* M0 */
/*
M0 = 0;
for (Mul0=0; Mul0<Spe_Num_Basis[wan][L0]; Mul0++){
i = tmp_index1[L0][Mul0][M0];
for (Mul1=0; Mul1<Spe_Num_Basis[wan][L0]; Mul1++){
j = tmp_index1[L0][Mul1][M0];
S[Mul0+1][Mul1+1] = OLP[0][Mc_AN][0][i][j];
}
}
*/
for (Mul0=0; Mul0<Spe_Num_Basis[wan][L0]; Mul0++){
for (Mul1=0; Mul1<Spe_Num_Basis[wan][L0]; Mul1++){
S[Mul0+1][Mul1+1] = 0.0;
}
S[Mul0+1][Mul0+1] = 1.0;
}
if (3<=level_stdout){
printf("<Hks Gc_AN=%2d L0=%2d>\n",Gc_AN,L0);
for (Mul0=0; Mul0<Spe_Num_Basis[wan][L0]; Mul0++){
for (Mul1=0; Mul1<Spe_Num_Basis[wan][L0]; Mul1++){
printf("%15.10f ",Hks[Mul0+1][Mul1+1]);
}
printf("\n");
}
}
if (3<=level_stdout){
printf("<S Gc_AN=%2d L0=%2d>\n",Gc_AN,L0);
for (Mul0=0; Mul0<Spe_Num_Basis[wan][L0]; Mul0++){
for (Mul1=0; Mul1<Spe_Num_Basis[wan][L0]; Mul1++){
printf("%15.10f ",S[Mul0+1][Mul1+1]);
}
printf("\n");
}
}
/* diagonalization */
Np = Spe_Num_Basis[wan][L0];
Eigen_lapack(S,ko,Np,Np);
for (l=1; l<=Np; l++){
M1[l] = 1.0/sqrt(ko[l]);
}
for (i1=1; i1<=Np; i1++){
for (j1=1; j1<=Np; j1++){
sum = 0.0;
for (l=1; l<=Np; l++){
sum = sum + Hks[i1][l]*S[l][j1]*M1[j1];
}
C[i1][j1] = sum;
}
}
for (i1=1; i1<=Np; i1++){
for (j1=1; j1<=Np; j1++){
sum = 0.0;
for (l=1; l<=Np; l++){
sum = sum + M1[i1]*S[l][i1]*C[l][j1];
}
B[i1][j1] = sum;
}
}
for (i1=1; i1<=Np; i1++){
for (j1=1; j1<=Np; j1++){
D[i1][j1] = B[i1][j1];
}
}
Eigen_lapack(D,ko,Np,Np);
/* transformation to the original eigenvectors */
for (i1=1; i1<=Np; i1++){
for (j1=1; j1<=Np; j1++){
C[i1][j1] = 0.0;
}
}
for (i1=1; i1<=Np; i1++){
for (j1=1; j1<=Np; j1++){
sum = 0.0;
for (l=1; l<=Np; l++){
sum = sum + S[i1][l]*M1[l]*D[l][j1];
}
C[i1][j1] = sum;
}
}
if (3<=level_stdout){
printf("<Eigenvalues Gc_AN=%2d L0=%2d>\n",Gc_AN,L0);
for (Mul0=0; Mul0<Spe_Num_Basis[wan][L0]; Mul0++){
printf("Mul=%2d ko=%15.12f\n",Mul0,ko[Mul0+1]);
}
printf("<C Gc_AN=%2d L0=%2d>\n",Gc_AN,L0);
for (Mul0=0; Mul0<Spe_Num_Basis[wan][L0]; Mul0++){
for (Mul1=0; Mul1<Spe_Num_Basis[wan][L0]; Mul1++){
printf("%15.10f ",C[Mul0+1][Mul1+1]);
}
printf("\n");
}
}
/* set up contraction coefficients */
for (M0=0; M0<=2*L0; M0++){
for (Mul0=0; Mul0<Spe_Num_CBasis[wan][L0]; Mul0++){
al = tmp_index2[L0][Mul0][M0];
/* if (SCnt_switch==1) */
if ( SCnt_switch==1 && Mul0==(Spe_Num_CBasis[wan][L0]-1) ){
for (p=0; p<Spe_Num_Basis[wan][L0]; p++){
CntCoes[Mc_AN][al][p] = C[p+1][1];
}
}
else {
for (p=0; p<Spe_Num_Basis[wan][L0]; p++){
CntCoes[Mc_AN][al][p] = C[p+1][Mul0+1];;
}
}
maxc = -1.0e+10;
for (p=0; p<Spe_Num_Basis[wan][L0]; p++){
if (maxc<fabs(CntCoes[Mc_AN][al][p])){
maxc = fabs(CntCoes[Mc_AN][al][p]);
maxp = p;
}
}
tmp0 = sgn(CntCoes[Mc_AN][al][maxp]);
for (p=0; p<Spe_Num_Basis[wan][L0]; p++){
CntCoes[Mc_AN][al][p] *= tmp0;
}
}
}
} /* L0 */
if (3<=level_stdout){
for (al=0; al<Spe_Total_CNO[wan]; al++){
for (p=0; p<Spe_Specified_Num[wan][al]; p++){
printf("A Init_CntCoes Mc_AN=%2d Gc_AN=%2d al=%2d p=%2d %15.12f\n",
Mc_AN,Gc_AN,al,p,CntCoes[Mc_AN][al][p]);
}
}
}
/****************************************************
free arrays
****************************************************/
for (i=0; i<n2; i++){
free(InProd[i]);
}
free(InProd);
free(koSys);
free(ko);
free(abs_sum);
free(M1);
free(dege);
free(jun);
free(ponu);
free(C0);
for (i=0; i<n2; i++){
free(S[i]);
free(Hks[i]);
free(D[i]);
free(C[i]);
free(B[i]);
}
free(S);
free(Hks);
free(D);
free(C);
free(B);
} /* Mc_AN */
/*************************************************************
in case of optimization of only the last orbital in each L
*************************************************************/
if (SCnt_switch==1){
for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
Gc_AN = M2G[Mc_AN];
wan = WhatSpecies[Gc_AN];
al = -1;
for (L0=0; L0<=Spe_MaxL_Basis[wan]; L0++){
for (Mul0=0; Mul0<Spe_Num_CBasis[wan][L0]; Mul0++){
for (M0=0; M0<=2*L0; M0++){
al++;
if ( Mul0!=(Spe_Num_CBasis[wan][L0]-1) ){
for (p=0; p<Spe_Specified_Num[wan][al]; p++){
CntCoes[Mc_AN][al][p] = 0.0;
}
CntCoes[Mc_AN][al][Mul0] = 1.0;
}
}
}
}
}
}
/****************************************************
average contraction coefficients
****************************************************/
if (ACnt_switch==1){
/* allocation */
My_CntCoes_Spe = (double***)malloc(sizeof(double**)*(SpeciesNum+1));
for (i=0; i<=SpeciesNum; i++){
My_CntCoes_Spe[i] = (double**)malloc(sizeof(double*)*List_YOUSO[7]);
for (j=0; j<List_YOUSO[7]; j++){
My_CntCoes_Spe[i][j] = (double*)malloc(sizeof(double)*List_YOUSO[24]);
}
}
CntCoes_Spe = (double***)malloc(sizeof(double**)*(SpeciesNum+1));
for (i=0; i<=SpeciesNum; i++){
CntCoes_Spe[i] = (double**)malloc(sizeof(double*)*List_YOUSO[7]);
for (j=0; j<List_YOUSO[7]; j++){
CntCoes_Spe[i][j] = (double*)malloc(sizeof(double)*List_YOUSO[24]);
}
}
/* initialize */
for (wan=0; wan<SpeciesNum; wan++){
for (i=0; i<List_YOUSO[7]; i++){
for (j=0; j<List_YOUSO[24]; j++){
My_CntCoes_Spe[wan][i][j] = 0.0;
}
}
}
/* local sum in a proccessor */
for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
Gc_AN = M2G[Mc_AN];
wan = WhatSpecies[Gc_AN];
for (al=0; al<Spe_Total_CNO[wan]; al++){
for (p=0; p<Spe_Specified_Num[wan][al]; p++){
My_CntCoes_Spe[wan][al][p] += CntCoes[Mc_AN][al][p];
}
}
}
/* global sum by MPI */
for (wan=0; wan<SpeciesNum; wan++){
for (al=0; al<Spe_Total_CNO[wan]; al++){
for (p=0; p<Spe_Specified_Num[wan][al]; p++){
MPI_Allreduce(&My_CntCoes_Spe[wan][al][p], &CntCoes_Spe[wan][al][p],
1, MPI_DOUBLE, MPI_SUM, mpi_comm_level1);
}
}
}
/* copy CntCoes_Spe to CntCoes_Species */
for (wan=0; wan<SpeciesNum; wan++){
for (al=0; al<Spe_Total_CNO[wan]; al++){
for (p=0; p<Spe_Specified_Num[wan][al]; p++){
CntCoes_Species[wan][al][p] = CntCoes_Spe[wan][al][p];
}
}
}
/* CntCoes_Spe to CntCoes */
for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
Gc_AN = M2G[Mc_AN];
wan = WhatSpecies[Gc_AN];
for (al=0; al<Spe_Total_CNO[wan]; al++){
for (p=0; p<Spe_Specified_Num[wan][al]; p++){
CntCoes[Mc_AN][al][p] = CntCoes_Spe[wan][al][p];
}
}
}
/* free */
for (i=0; i<=SpeciesNum; i++){
for (j=0; j<List_YOUSO[7]; j++){
free(My_CntCoes_Spe[i][j]);
}
free(My_CntCoes_Spe[i]);
}
free(My_CntCoes_Spe);
for (i=0; i<=SpeciesNum; i++){
for (j=0; j<List_YOUSO[7]; j++){
free(CntCoes_Spe[i][j]);
}
free(CntCoes_Spe[i]);
}
free(CntCoes_Spe);
}
/**********************************************
transformation of optimized orbitals by
an extended Gauss elimination and
the Gram-Schmidt orthogonalization
***********************************************/
for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
Gc_AN = M2G[Mc_AN];
wan = WhatSpecies[Gc_AN];
al = -1;
for (L0=0; L0<=Spe_MaxL_Basis[wan]; L0++){
for (Mul0=0; Mul0<Spe_Num_CBasis[wan][L0]; Mul0++){
for (M0=0; M0<=2*L0; M0++){
al++;
tmp_index2[L0][Mul0][M0] = al;
}
}
}
for (L0=0; L0<=Spe_MaxL_Basis[wan]; L0++){
for (M0=0; M0<=2*L0; M0++){
/**********************************************
extended Gauss elimination
***********************************************/
for (Mul0=0; Mul0<Spe_Num_CBasis[wan][L0]; Mul0++){
al0 = tmp_index2[L0][Mul0][M0];
for (Mul1=0; Mul1<Spe_Num_CBasis[wan][L0]; Mul1++){
al1 = tmp_index2[L0][Mul1][M0];
if (Mul1!=Mul0){
tmp0 = CntCoes[Mc_AN][al0][Mul0];
tmp1 = CntCoes[Mc_AN][al1][Mul0];
for (p=0; p<Spe_Specified_Num[wan][al0]; p++){
CntCoes[Mc_AN][al1][p] -= CntCoes[Mc_AN][al0][p]/tmp0*tmp1;
}
}
}
}
/**********************************************
orthonormalization of initial contraction
coefficients
***********************************************/
for (Mul0=0; Mul0<Spe_Num_CBasis[wan][L0]; Mul0++){
al0 = tmp_index2[L0][Mul0][M0];
/* x - sum_i <x|e_i>e_i */
for (p=0; p<Spe_Specified_Num[wan][al0]; p++){
Tmp_CntCoes[p] = 0.0;
}
for (Mul1=0; Mul1<Mul0; Mul1++){
al1 = tmp_index2[L0][Mul1][M0];
sum = 0.0;
for (p=0; p<Spe_Specified_Num[wan][al0]; p++){
sum = sum + CntCoes[Mc_AN][al0][p]*CntCoes[Mc_AN][al1][p];
}
for (p=0; p<Spe_Specified_Num[wan][al0]; p++){
Tmp_CntCoes[p] = Tmp_CntCoes[p] + sum*CntCoes[Mc_AN][al1][p];
}
}
for (p=0; p<Spe_Specified_Num[wan][al0]; p++){
CntCoes[Mc_AN][al0][p] = CntCoes[Mc_AN][al0][p] - Tmp_CntCoes[p];
}
/* Normalize */
sum = 0.0;
Max0 = -100.0;
pmax = 0;
for (p=0; p<Spe_Specified_Num[wan][al0]; p++){
sum = sum + CntCoes[Mc_AN][al0][p]*CntCoes[Mc_AN][al0][p];
if (Max0<fabs(CntCoes[Mc_AN][al0][p])){
Max0 = fabs(CntCoes[Mc_AN][al0][p]);
pmax = p;
}
}
if (fabs(sum)<1.0e-11)
tmp0 = 0.0;
else
tmp0 = 1.0/sqrt(sum);
tmp1 = sgn(CntCoes[Mc_AN][al0][pmax]);
for (p=0; p<Spe_Specified_Num[wan][al0]; p++){
CntCoes[Mc_AN][al0][p] = tmp0*tmp1*CntCoes[Mc_AN][al0][p];
}
}
}
}
} /* Mc_AN */
/****************************************************
Normalization
****************************************************/
for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
Gc_AN = M2G[Mc_AN];
wan = WhatSpecies[Gc_AN];
for (al=0; al<Spe_Total_CNO[wan]; al++){
sum = 0.0;
for (p=0; p<Spe_Specified_Num[wan][al]; p++){
p0 = Spe_Trans_Orbital[wan][al][p];
for (q=0; q<Spe_Specified_Num[wan][al]; q++){
q0 = Spe_Trans_Orbital[wan][al][q];
tmp0 = CntCoes[Mc_AN][al][p]*CntCoes[Mc_AN][al][q];
sum = sum + tmp0*OLP[0][Mc_AN][0][p0][q0];
}
}
tmp0 = 1.0/sqrt(sum);
for (p=0; p<Spe_Specified_Num[wan][al]; p++){
CntCoes[Mc_AN][al][p] = CntCoes[Mc_AN][al][p]*tmp0;
}
}
if (3<=level_stdout){
for (al=0; al<Spe_Total_CNO[wan]; al++){
for (p=0; p<Spe_Specified_Num[wan][al]; p++){
printf("B Init_CntCoes Mc_AN=%2d Gc_AN=%2d al=%2d p=%2d %15.12f\n",
Mc_AN,Gc_AN,al,p,CntCoes[Mc_AN][al][p]);
}
}
}
} /* Mc_AN */
Simple_Init:
/****************************************************
MPI:
CntCoes_Species
****************************************************/
for (wan=0; wan<SpeciesNum; wan++){
Gc_AN = 1;
po = 0;
do {
wanA = WhatSpecies[Gc_AN];
if (wan==wanA){
ID = G2ID[Gc_AN];
Mc_AN = F_G2M[Gc_AN];
for (al=0; al<Spe_Total_CNO[wan]; al++){
for (p=0; p<Spe_Specified_Num[wan][al]; p++){
if (ID==myid) tmp0 = CntCoes[Mc_AN][al][p];
MPI_Bcast(&tmp0, 1, MPI_DOUBLE, ID, mpi_comm_level1);
CntCoes_Species[wan][al][p] = tmp0;
}
}
po = 1;
}
Gc_AN++;
} while (po==0 && Gc_AN<=atomnum);
}
/****************************************************
MPI:
CntCoes
****************************************************/
/***********************************
set data size
************************************/
for (ID=0; ID<numprocs; ID++){
IDS = (myid + ID) % numprocs;
IDR = (myid - ID + numprocs) % numprocs;
if (ID!=0){
tag = 999;
/* find data size to send block data */
if (F_Snd_Num[IDS]!=0){
size1 = 0;
for (n=0; n<F_Snd_Num[IDS]; n++){
Mc_AN = Snd_MAN[IDS][n];
Gc_AN = Snd_GAN[IDS][n];
wan = WhatSpecies[Gc_AN];
for (al=0; al<Spe_Total_CNO[wan]; al++){
size1 += Spe_Specified_Num[wan][al];
}
}
Snd_CntCoes_Size[IDS] = size1;
MPI_Isend(&size1, 1, MPI_INT, IDS, tag, mpi_comm_level1, &request);
}
else{
Snd_CntCoes_Size[IDS] = 0;
}
/* receiving of size of data */
if (F_Rcv_Num[IDR]!=0){
MPI_Recv(&size2, 1, MPI_INT, IDR, tag, mpi_comm_level1, &stat);
Rcv_CntCoes_Size[IDR] = size2;
}
else{
Rcv_CntCoes_Size[IDR] = 0;
}
if (F_Snd_Num[IDS]!=0) MPI_Wait(&request,&stat);
}
else {
Snd_CntCoes_Size[myid] = 0;
Rcv_CntCoes_Size[myid] = 0;
}
}
/***********************************
data transfer
************************************/
tag = 999;
for (ID=0; ID<numprocs; ID++){
IDS = (myid + ID) % numprocs;
IDR = (myid - ID + numprocs) % numprocs;
if (ID!=0){
/*****************************
sending of data
*****************************/
if (F_Snd_Num[IDS]!=0){
size1 = Snd_CntCoes_Size[IDS];
/* allocation of array */
tmp_array = (double*)malloc(sizeof(double)*size1);
/* multidimentional array to vector array */
num = 0;
for (n=0; n<F_Snd_Num[IDS]; n++){
Mc_AN = Snd_MAN[IDS][n];
Gc_AN = Snd_GAN[IDS][n];
wan = WhatSpecies[Gc_AN];
for (al=0; al<Spe_Total_CNO[wan]; al++){
for (p=0; p<Spe_Specified_Num[wan][al]; p++){
tmp_array[num] = CntCoes[Mc_AN][al][p];
num++;
}
}
}
MPI_Isend(&tmp_array[0], size1, MPI_DOUBLE, IDS, tag, mpi_comm_level1, &request);
}
/*****************************
receiving of block data
*****************************/
if (F_Rcv_Num[IDR]!=0){
size2 = Rcv_CntCoes_Size[IDR];
/* allocation of array */
tmp_array2 = (double*)malloc(sizeof(double)*size2);
MPI_Recv(&tmp_array2[0], size2, MPI_DOUBLE, IDR, tag, mpi_comm_level1, &stat);
num = 0;
Mc_AN = F_TopMAN[IDR] - 1;
for (n=0; n<F_Rcv_Num[IDR]; n++){
Mc_AN++;
Gc_AN = Rcv_GAN[IDR][n];
wan = WhatSpecies[Gc_AN];
for (al=0; al<Spe_Total_CNO[wan]; al++){
for (p=0; p<Spe_Specified_Num[wan][al]; p++){
CntCoes[Mc_AN][al][p] = tmp_array2[num];
num++;
}
}
}
/* freeing of array */
free(tmp_array2);
}
if (F_Snd_Num[IDS]!=0){
MPI_Wait(&request,&stat);
free(tmp_array); /* freeing of array */
}
}
}
/****************************************************
freeing of arrays:
int MP[List_YOUSO[8]];
int tmp_index[List_YOUSO[25]+1]
[2*(List_YOUSO[25]+1)+1];
int tmp_index1[List_YOUSO[25]+1]
[List_YOUSO[24]]
[2*(List_YOUSO[25]+1)+1];
int tmp_index2[List_YOUSO[25]+1]
[List_YOUSO[24]]
[2*(List_YOUSO[25]+1)+1];
double Tmp_CntCoes[List_YOUSO[24]]
double Check_ko[List_YOUSO[25]+1]
[2*(List_YOUSO[25]+1)+1];
double Weight_ko[List_YOUSO[7]];
****************************************************/
free(MP);
for (i=0; i<(List_YOUSO[25]+1); i++){
free(tmp_index[i]);
}
free(tmp_index);
for (i=0; i<(List_YOUSO[25]+1); i++){
for (j=0; j<List_YOUSO[24]; j++){
free(tmp_index1[i][j]);
}
free(tmp_index1[i]);
}
free(tmp_index1);
for (i=0; i<(List_YOUSO[25]+1); i++){
for (j=0; j<List_YOUSO[24]; j++){
free(tmp_index2[i][j]);
}
free(tmp_index2[i]);
}
free(tmp_index2);
free(Tmp_CntCoes);
for (i=0; i<(List_YOUSO[25]+1); i++){
free(Check_ko[i]);
}
free(Check_ko);
free(Weight_ko);
free(Snd_CntCoes_Size);
free(Rcv_CntCoes_Size);
free(Snd_H_Size);
free(Rcv_H_Size);
free(Snd_S_Size);
free(Rcv_S_Size);
/* for elapsed time */
dtime(&TEtime);
time0 = TEtime - TStime;
}
double Cluster_NonCol_Dosout( int SpinP_switch,
double *****nh,
double *****ImNL,
double ****CntOLP)
{
int n,i,j,wanA,n2;
int l,ii1,jj1;
int *MP;
int n1min,iemin,iemax,spin,i1,j1,iemin0,iemax0,n1,ie;
int MA_AN, GA_AN, tnoA, Anum, LB_AN, GB_AN,wanB, tnoB, Bnum, k;
int MaxL;
int i_vec[10];
int file_ptr_size;
double EV_cut0;
double *ko; int N_ko, i_ko[10];
dcomplex **H; int N_H, i_H[10];
dcomplex **C; int N_C, i_C[10];
double **Ctmp; int N_Ctmp, i_Ctmp[10];
double *****CDM; int N_CDM,i_CDM[10];
double ***SD; int N_SD, i_SD[10];
double **SDup,**SDdn;
double TStime,TEtime,time0;
double sum_r,sum_i;
double sit,cot,sip,cop,theta,phi;
double sum,dum,tmp1,tmp2,tmp3;
float *fSD;
char file_eig[YOUSO10],file_ev[YOUSO10];
FILE *fp_eig, *fp_ev;
char buf1[fp_bsize]; /* setvbuf */
char buf2[fp_bsize]; /* setvbuf */
int numprocs,myid,ID,tag;
MPI_Status stat;
MPI_Request request;
/* MPI */
MPI_Comm_size(mpi_comm_level1,&numprocs);
MPI_Comm_rank(mpi_comm_level1,&myid);
printf("Cluster_DFT_Dosout: start\n"); fflush(stdout);
dtime(&TStime);
/****************************************************
calculation of the array size
****************************************************/
n = 0;
for (i=1; i<=atomnum; i++){
wanA = WhatSpecies[i];
n = n + Spe_Total_CNO[wanA];
}
n2 = 2*n + 2;
/****************************************************
Allocation
int MP[List_YOUSO[1]]
double ko[n2]
double H[n2][n2]
double C[n2][n2]
double Ctmp[n2][n2]
double CDM[5][Matomnum+1][List_YOUSO[8]]
[List_YOUSO[7]][List_YOUSO[7]]
double S[3]D[List_YOUSO[1]][List_YOUSO[7]]
float fSD[List_YOUSO[7]]
****************************************************/
MP = (int*)malloc(sizeof(int)*List_YOUSO[1]);
N_ko=1; i_ko[0]=n2;
ko=(double*)malloc_multidimarray("double",N_ko,i_ko);
N_H=2; i_H[0]=n2; i_H[1]=n2;
H=(dcomplex**)malloc_multidimarray("dcomplex",N_H, i_H);
N_C=2; i_C[0]=n2; i_C[1]=n2;
C=(dcomplex**)malloc_multidimarray("dcomplex",N_C, i_C);
N_Ctmp=2; i_Ctmp[0]=n2; i_Ctmp[1]=n2;
Ctmp=(double**)malloc_multidimarray("double",N_Ctmp, i_Ctmp);
N_CDM=5; i_CDM[0]=4; i_CDM[1]=Matomnum+1; i_CDM[2]=List_YOUSO[8];
i_CDM[3]=List_YOUSO[7]; i_CDM[4]=List_YOUSO[7];
CDM =(double*****)malloc_multidimarray("double",N_CDM,i_CDM);
N_SD=3; i_SD[0]=4; i_SD[1]=List_YOUSO[1]; i_SD[2]=List_YOUSO[7];
SD = (double***)malloc_multidimarray("double",N_SD, i_SD);
SDup = (double**)malloc(sizeof(double*)*List_YOUSO[1]);
for (i=0; i<List_YOUSO[1]; i++){
SDup[i] = (double*)malloc(sizeof(double)*List_YOUSO[7]);
}
SDdn = (double**)malloc(sizeof(double*)*List_YOUSO[1]);
for (i=0; i<List_YOUSO[1]; i++){
SDdn[i] = (double*)malloc(sizeof(double)*List_YOUSO[7]);
}
fSD=(float*)malloc(sizeof(float)*List_YOUSO[7]*2);
if (myid==Host_ID){
strcpy(file_eig,".Dos.val");
fnjoint(filepath,filename,file_eig);
if ( (fp_eig=fopen(file_eig,"w"))==NULL ) {
#ifdef xt3
setvbuf(fp_eig,buf1,_IOFBF,fp_bsize); /* setvbuf */
#endif
printf("can not open a file %s\n",file_eig);
}
strcpy(file_ev,".Dos.vec");
fnjoint(filepath,filename,file_ev);
if ( (fp_ev=fopen(file_ev,"w"))==NULL ) {
#ifdef xt3
setvbuf(fp_ev,buf2,_IOFBF,fp_bsize); /* setvbuf */
#endif
printf("can not open a file %s\n",file_ev);
}
}
file_ptr_size=sizeof(FILE *);
MPI_Bcast(&fp_eig,file_ptr_size,MPI_BYTE,Host_ID,mpi_comm_level1);
MPI_Bcast(&fp_ev,file_ptr_size,MPI_BYTE,Host_ID,mpi_comm_level1);
if ( fp_eig==NULL || fp_ev==NULL ) {
goto Finishing;
}
if (myid==Host_ID){
fprintf(fp_eig,"mode 1\n");
fprintf(fp_eig,"NonCol 1\n");
fprintf(fp_eig,"N %d\n",n);
fprintf(fp_eig,"Nspin %d\n",1); /* switch to 1 */
fprintf(fp_eig,"Erange %lf %lf\n",Dos_Erange[0],Dos_Erange[1]);
/* fprintf(fp_eig,"irange %d %d\n",iemin,iemax); */
fprintf(fp_eig,"Kgrid %d %d %d\n",1,1,1);
fprintf(fp_eig,"atomnum %d\n",atomnum);
fprintf(fp_eig,"<WhatSpecies\n");
for (i=1;i<=atomnum;i++) {
fprintf(fp_eig,"%d ",WhatSpecies[i]);
}
fprintf(fp_eig,"\nWhatSpecies>\n");
fprintf(fp_eig,"SpeciesNum %d\n",SpeciesNum);
fprintf(fp_eig,"<Spe_Total_CNO\n");
for (i=0;i<SpeciesNum;i++) {
fprintf(fp_eig,"%d ",Spe_Total_CNO[i]);
}
fprintf(fp_eig,"\nSpe_Total_CNO>\n");
MaxL=Supported_MaxL;
fprintf(fp_eig,"MaxL %d\n",Supported_MaxL);
fprintf(fp_eig,"<Spe_Num_CBasis\n");
for (i=0;i<SpeciesNum;i++) {
for (l=0;l<=MaxL;l++) {
fprintf(fp_eig,"%d ",Spe_Num_CBasis[i][l]);
}
fprintf(fp_eig,"\n");
}
fprintf(fp_eig,"Spe_Num_CBasis>\n");
fprintf(fp_eig,"ChemP %lf\n",ChemP);
fprintf(fp_eig,"<SpinAngle\n");
for (i=1; i<=atomnum; i++) {
fprintf(fp_eig,"%lf %lf\n",Angle0_Spin[i],Angle1_Spin[i]);
}
fprintf(fp_eig,"SpinAngle>\n");
printf("write eigenvalues\n");
printf("write eigenvectors\n");
}
Overlap_Cluster(CntOLP,S,MP);
if (myid==Host_ID){
n = S[0][0];
Eigen_lapack(S,ko,n,n);
/* minus eigenvalues to 1.0e-14 */
for (l=1; l<=n; l++){
if (ko[l]<0.0) ko[l] = 1.0e-14;
EV_S[l] = ko[l];
}
/* print to the standard output */
if (2<=level_stdout && myid==Host_ID){
for (l=1; l<=n; l++){
printf(" <Cluster_DFT_Dosout> Eigenvalues of OLP %2d %18.15f\n",l,ko[l]);
}
}
/* calculate S*1/sqrt(ko) */
for (l=1; l<=n; l++){
IEV_S[l] = 1.0/sqrt(ko[l]);
}
}
/****************************************************
Calculations of eigenvalues for up and down spins
Note:
MP indicates the starting position of
atom i in arraies H and S
****************************************************/
Hamiltonian_Cluster_NC(nh, ImNL, H, MP);
if (myid==Host_ID){
/* H * U * lambda^{-1/2} */
for (i1=1; i1<=2*n; i1++){
for (j1=1; j1<=n; j1++){
for (k=0; k<=1; k++){
sum_r = 0.0;
sum_i = 0.0;
for (l=1; l<=n; l++){
sum_r = sum_r + H[i1][l+k*n].r*S[l][j1]*IEV_S[j1];
sum_i = sum_i + H[i1][l+k*n].i*S[l][j1]*IEV_S[j1];
}
jj1 = 2*j1 - 1 + k;
C[i1][jj1].r = sum_r;
C[i1][jj1].i = sum_i;
}
}
}
/* lambda^{-1/2} * U^+ H * U * lambda^{-1/2} */
for (i1=1; i1<=n; i1++){
for (k=0; k<=1; k++){
ii1 = 2*i1 - 1 + k;
for (j1=1; j1<=2*n; j1++){
sum_r = 0.0;
sum_i = 0.0;
for (l=1; l<=n; l++){
sum_r = sum_r + IEV_S[i1]*S[l][i1]*C[l+k*n][j1].r;
sum_i = sum_i + IEV_S[i1]*S[l][i1]*C[l+k*n][j1].i;
}
H[ii1][j1].r = sum_r;
H[ii1][j1].i = sum_i;
}
}
}
/* H to C */
for (i1=1; i1<=2*n; i1++){
for (j1=1; j1<=2*n; j1++){
C[i1][j1].r = H[i1][j1].r;
C[i1][j1].i = H[i1][j1].i;
}
}
/* penalty for ill-conditioning states */
EV_cut0 = Threshold_OLP_Eigen;
for (i1=1; i1<=n; i1++){
if (EV_S[i1]<EV_cut0){
C[2*i1-1][2*i1-1].r += pow((EV_S[i1]/EV_cut0),-2.0) - 1.0;
C[2*i1 ][2*i1 ].r += pow((EV_S[i1]/EV_cut0),-2.0) - 1.0;
}
/* cutoff the interaction between the ill-conditioned state */
if (1.0e+3<C[2*i1-1][2*i1-1].r){
for (j1=1; j1<=2*n; j1++){
C[2*i1-1][j1 ] = Complex(0.0,0.0);
C[j1 ][2*i1-1] = Complex(0.0,0.0);
C[2*i1 ][j1 ] = Complex(0.0,0.0);
C[j1 ][2*i1 ] = Complex(0.0,0.0);
}
C[2*i1-1][2*i1-1] = Complex(1.0e+4,0.0);
C[2*i1 ][2*i1 ] = Complex(1.0e+4,0.0);
}
}
/* solve eigenvalue problem */
n1 = 2*n;
EigenBand_lapack(C,ko,n1,1);
for (i1=1; i1<=n1; i1++){
for (j1=1; j1<=n1; j1++){
H[i1][j1].r = C[i1][j1].r;
H[i1][j1].i = C[i1][j1].i;
}
}
/****************************************************
Transformation to the original eigenvectors.
JRCAT NOTE 244P C = U * lambda^{-1/2} * D
****************************************************/
for (i1=1; i1<=2*n; i1++){
for (j1=1; j1<=2*n; j1++){
C[i1][j1].r = 0.0;
C[i1][j1].i = 0.0;
}
}
for (k=0; k<=1; k++){
for (i1=1; i1<=n; i1++){
for (j1=1; j1<=n1; j1++){
sum_r = 0.0;
sum_i = 0.0;
for (l=1; l<=n; l++){
sum_r = sum_r + S[i1][l]*IEV_S[l]*H[2*(l-1)+1+k][j1].r;
sum_i = sum_i + S[i1][l]*IEV_S[l]*H[2*(l-1)+1+k][j1].i;
}
C[i1+k*n][j1].r = sum_r;
C[i1+k*n][j1].i = sum_i;
}
}
}
} /* if (myid==Host_ID) */
if (myid==Host_ID){
iemin = 1;
for (i1=1;i1<=n1;i1++) {
if (ko[i1]>ChemP+Dos_Erange[0]){
iemin=i1-1;
break;
}
}
if (iemin<1) iemin=1;
iemax = n1;
for (i1=iemin; i1<=n1; i1++) {
if (ko[i1]>ChemP+Dos_Erange[1]) {
iemax=i1;
break;
}
}
if (iemax>n1) iemax=n1;
}
/* MPI, iemin, iemax */
MPI_Bcast(&iemin, 1, MPI_INT, Host_ID, mpi_comm_level1);
MPI_Bcast(&iemax, 1, MPI_INT, Host_ID, mpi_comm_level1);
if (myid==Host_ID){
fprintf(fp_eig,"irange %d %d\n",iemin,iemax);
fprintf(fp_eig,"<Eigenvalues\n");
for (spin=0; spin<=1; spin++) {
fprintf(fp_eig,"%d %d %d ",0,0,0);
for (ie=iemin; ie<=iemax; ie++) {
fprintf(fp_eig,"%lf ",ko[ie]);
}
fprintf(fp_eig,"\n");
/* printf("\n"); */
}
fprintf(fp_eig,"Eigenvalues>\n");
}
/****************************************************
MPI:
C
****************************************************/
for (i1=0; i1<=2*n; i1++){
for (j1=0; j1<=2*n; j1++){
Ctmp[i1][j1] = C[i1][j1].r;
}
}
for (i1=1; i1<=2*n; i1++){
MPI_Bcast(&Ctmp[i1][0], 2*n, MPI_DOUBLE, Host_ID, mpi_comm_level1);
}
for (i1=0; i1<=2*n; i1++){
for (j1=0; j1<=2*n; j1++){
C[i1][j1].r = Ctmp[i1][j1];
}
}
for (i1=0; i1<=2*n; i1++){
for (j1=0; j1<=2*n; j1++){
Ctmp[i1][j1] = C[i1][j1].i;
}
}
for (i1=1; i1<=2*n; i1++){
MPI_Bcast(&Ctmp[i1][0], 2*n, MPI_DOUBLE, Host_ID, mpi_comm_level1);
}
for (i1=0; i1<=2*n; i1++){
for (j1=0; j1<=2*n; j1++){
C[i1][j1].i = Ctmp[i1][j1];
}
}
/****************************************************
calculate fraction of density matrix
****************************************************/
for (k=iemin; k<=iemax; k++){
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++){
/* Re11 */
dum = C[Anum+i][k].r*C[Bnum+j][k].r + C[Anum+i][k].i*C[Bnum+j][k].i;
CDM[0][MA_AN][LB_AN][i][j] = dum;
/* Re22 */
dum = C[Anum+i+n][k].r*C[Bnum+j+n][k].r + C[Anum+i+n][k].i*C[Bnum+j+n][k].i;
CDM[1][MA_AN][LB_AN][i][j] = dum;
/* Re12 */
dum = C[Anum+i][k].r*C[Bnum+j+n][k].r + C[Anum+i][k].i*C[Bnum+j+n][k].i;
CDM[2][MA_AN][LB_AN][i][j] = dum;
/* Im12
conjugate complex of Im12 due to difference in the definition
between density matrix and charge density
*/
dum = -(C[Anum+i][k].r*C[Bnum+j+n][k].i - C[Anum+i][k].i*C[Bnum+j+n][k].r);
CDM[3][MA_AN][LB_AN][i][j] = dum;
}
}
}
}
/*******************************************
M_i = S_ij D_ji
D_ji = C_nj C_ni
S_ij : CntOLP
D_ji : CDM
*******************************************/
for (GA_AN=1; GA_AN<=atomnum; GA_AN++){
wanA = WhatSpecies[GA_AN];
tnoA = Spe_Total_CNO[wanA];
for (i1=0; i1<tnoA; i1++){
SD[0][GA_AN][i1] = 0.0;
SD[1][GA_AN][i1] = 0.0;
SD[2][GA_AN][i1] = 0.0;
SD[3][GA_AN][i1] = 0.0;
}
}
for (spin=0; spin<=3; spin++){
for (MA_AN=1; MA_AN<=Matomnum; MA_AN++){
GA_AN = M2G[MA_AN];
wanA = WhatSpecies[GA_AN];
tnoA = Spe_Total_CNO[wanA];
for (i1=0; i1<tnoA; i1++){
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 (j1=0; j1<tnoB; j1++){
SD[spin][GA_AN][i1] += CDM[spin][MA_AN][LB_AN][i1][j1]*
CntOLP[MA_AN][LB_AN][i1][j1];
}
}
}
}
}
/* transform to up and down states */
for (MA_AN=1; MA_AN<=Matomnum; MA_AN++){
GA_AN = M2G[MA_AN];
wanA = WhatSpecies[GA_AN];
tnoA = Spe_Total_CNO[wanA];
theta = Angle0_Spin[GA_AN];
phi = Angle1_Spin[GA_AN];
sit = sin(theta);
cot = cos(theta);
sip = sin(phi);
cop = cos(phi);
for (i1=0; i1<tnoA; i1++){
tmp1 = 0.5*(SD[0][GA_AN][i1] + SD[1][GA_AN][i1]);
tmp2 = 0.5*cot*(SD[0][GA_AN][i1] - SD[1][GA_AN][i1]);
tmp3 = (SD[2][GA_AN][i1]*cop - SD[3][GA_AN][i1]*sip)*sit;
SDup[GA_AN][i1] = tmp1 + tmp2 + tmp3;
SDdn[GA_AN][i1] = tmp1 - tmp2 - tmp3;
}
}
/* writting a binary file */
i_vec[0]=i_vec[1]=i_vec[2]=0;
if (myid==Host_ID) fwrite(i_vec,sizeof(int),3,fp_ev);
for (GA_AN=1; GA_AN<=atomnum; GA_AN++){
wanA = WhatSpecies[GA_AN];
tnoA = Spe_Total_CNO[wanA];
ID = G2ID[GA_AN];
if (ID==myid){
for (i1=0; i1<tnoA; i1++){
fSD[i1] = SDup[GA_AN][i1];
}
for (i1=0; i1<tnoA; i1++){
fSD[tnoA+i1] = SDdn[GA_AN][i1];
}
if (myid!=Host_ID){
tag = 999;
MPI_Isend(&fSD[0], 2*tnoA, MPI_FLOAT, Host_ID, tag, mpi_comm_level1, &request);
MPI_Wait(&request,&stat);
}
}
if (myid==Host_ID && ID!=Host_ID){
tag = 999;
MPI_Recv(&fSD[0], 2*tnoA, MPI_FLOAT, ID, tag, mpi_comm_level1, &stat);
}
if (myid==Host_ID) fwrite(fSD,sizeof(float),2*tnoA,fp_ev);
MPI_Barrier(mpi_comm_level1);
} /* GA_AN */
} /* for (k=iemin; k<=iemax; k++){ */
Finishing: ;
if (myid==Host_ID){
if (fp_eig) fclose(fp_eig);
if (fp_ev) fclose(fp_ev);
}
/****************************************************
Free
****************************************************/
free(MP);
free(ko);
for (i=0; i<i_H[0]; i++){
free(H[i]);
}
free(H);
for (i=0; i<i_C[0]; i++){
free(C[i]);
}
free(C);
for (i=0; i<i_Ctmp[0]; i++){
free(Ctmp[i]);
}
free(Ctmp);
for (i=0; i<i_CDM[0]; i++){
for (j=0; j<i_CDM[1]; j++){
for (k=0; k<i_CDM[2]; k++){
for (l=0; l<i_CDM[3]; l++){
free(CDM[i][j][k][l]);
}
free(CDM[i][j][k]);
}
free(CDM[i][j]);
}
free(CDM[i]);
}
free(CDM);
for (i=0; i<i_SD[0]; i++){
for (j=0; j<i_SD[1]; j++){
free(SD[i][j]);
}
free(SD[i]);
}
free(SD);
for (i=0; i<List_YOUSO[1]; i++){
free(SDup[i]);
}
free(SDup);
for (i=0; i<List_YOUSO[1]; i++){
free(SDdn[i]);
}
free(SDdn);
free(fSD);
/* for elapsed time */
dtime(&TEtime);
time0 = TEtime - TStime;
return time0;
}
void Inverse(int n, double **a, double **ia)
{
int i,j,k;
double sum;
double **a0,*ko,*iko;
/***************************************************
allocation of arrays:
***************************************************/
a0 = (double**)malloc(sizeof(double*)*(Extrapolated_Charge_History+3));
for (i=0; i<(Extrapolated_Charge_History+3); i++){
a0[i] = (double*)malloc(sizeof(double)*(Extrapolated_Charge_History+3));
}
ko = (double*)malloc(sizeof(double)*(Extrapolated_Charge_History+3));
iko = (double*)malloc(sizeof(double)*(Extrapolated_Charge_History+3));
/***************************************************
calculate the inverse
***************************************************/
for (i=0; i<=n; i++){
for (j=0; j<=n; j++){
a0[i+1][j+1] = a[i][j];
}
}
Eigen_lapack(a0,ko,n+1,n+1);
for (i=1; i<=(n+1); i++){
if (fabs(ko[i])<1.0e-12)
iko[i] = 0.0;
else
iko[i] = 1.0/ko[i];
}
for (i=1; i<=(n+1); i++){
for (j=1; j<=(n+1); j++){
sum = 0.0;
for (k=1; k<=(n+1); k++){
sum += a0[i][k]*iko[k]*a0[j][k];
}
ia[i-1][j-1] = sum;
}
}
/***************************************************
freeing of arrays:
***************************************************/
for (i=0; i<(Extrapolated_Charge_History+3); i++){
free(a0[i]);
}
free(a0);
free(ko);
free(iko);
}
double Cluster_Col_Dosout( int SpinP_switch, double *****nh, double ****CntOLP)
{
int n,i,j,l,wanA,n2;
int *MP;
int n1min,iemin,iemax,spin,i1,j1,iemin0,iemax0,n1,ie;
int MA_AN, GA_AN, tnoA, Anum, LB_AN, GB_AN,wanB, tnoB, Bnum, k;
int MaxL;
int i_vec[10];
int file_ptr_size;
double EV_cut0;
double **ko; int N_ko, i_ko[10];
double ***H; int N_H, i_H[10];
double ***C; int N_C, i_C[10];
double **Ctmp; int N_Ctmp, i_Ctmp[10];
double ****CDM; int N_CDM=4,i_CDM[10];
double **SD; int N_SD=2, i_SD[10];
double TStime,TEtime,time0;
/* optical conductivity */
double **Ovlp; int N_Ovlp, i_Ovlp[10];
double **Sinv; int N_Sinv, i_Sinv[10];
double ***J; int N_J, i_J[10];
FILE *fp_opt;
char file_opt[YOUSO10];
double sum,dum;
float *fSD;
char buf1[fp_bsize]; /* setvbuf */
char buf2[fp_bsize]; /* setvbuf */
char buf3[fp_bsize]; /* setvbuf */
char file_eig[YOUSO10],file_ev[YOUSO10];
FILE *fp_eig, *fp_ev;
int numprocs,myid,ID,tag;
MPI_Status stat;
MPI_Request request;
/* MPI */
MPI_Comm_size(mpi_comm_level1,&numprocs);
MPI_Comm_rank(mpi_comm_level1,&myid);
if (myid==Host_ID) {
printf("Cluster_DFT_Dosout: start\n"); fflush(stdout);
}
dtime(&TStime);
/****************************************************
calculation of the array size
****************************************************/
n = 0;
for (i=1; i<=atomnum; i++){
wanA = WhatSpecies[i];
n = n + Spe_Total_CNO[wanA];
}
n2 = n + 2;
/****************************************************
Allocation
int MP[List_YOUSO[1]]
double ko[List_YOUSO[23]][n2]
double H[List_YOUSO[23]][n2][n2]
double C[List_YOUSO[23]][n2][n2]
double Ctmp[n2][n2]
double CDM[Matomnum+1][List_YOUSO[8]]
[List_YOUSO[7]][List_YOUSO[7]]
double SD[List_YOUSO[1]][List_YOUSO[7]]
float fSD[List_YOUSO[7]]
****************************************************/
MP = (int*)malloc(sizeof(int)*List_YOUSO[1]);
N_ko=2; i_ko[0]=List_YOUSO[23]; i_ko[1]=n2;
ko=(double**)malloc_multidimarray("double",N_ko,i_ko);
N_H=3; i_H[0]=List_YOUSO[23]; i_H[1]=n2; i_H[2]=n2;
H=(double***)malloc_multidimarray("double",N_H, i_H);
N_C=3; i_C[0]=List_YOUSO[23]; i_C[1]=n2; i_C[2]=n2;
C=(double***)malloc_multidimarray("double",N_C, i_C);
N_Ctmp=2; i_Ctmp[0]=n2; i_Ctmp[1]=n2;
Ctmp=(double**)malloc_multidimarray("double",N_Ctmp, i_Ctmp);
N_CDM=4; i_CDM[0]=Matomnum+1; i_CDM[1]=List_YOUSO[8];
i_CDM[2]=List_YOUSO[7]; i_CDM[3]=List_YOUSO[7];
CDM =(double****)malloc_multidimarray("double",N_CDM,i_CDM);
N_SD=2; i_SD[0]=List_YOUSO[1]; i_SD[1]=List_YOUSO[7];
SD = (double**)malloc_multidimarray("double",N_SD, i_SD);
/* optical conductivity */
if (Opticalconductivity_fileout) {
N_Ovlp=2; i_Ovlp[0]=n2; i_Ovlp[1]=n2;
Ovlp=(double**)malloc_multidimarray("double",N_Ovlp, i_Ovlp);
N_Sinv=2; i_Sinv[0]=n2; i_Sinv[1]=n2;
Sinv=(double**)malloc_multidimarray("double",N_Sinv, i_Sinv);
N_J=3; i_J[0]=3; i_J[1]=n2; i_J[2]=n2;
J=(double***)malloc_multidimarray("double",N_J, i_J);
}
fSD=(float*)malloc(sizeof(float)*List_YOUSO[7]);
if (myid==Host_ID){
strcpy(file_eig,".Dos.val");
fnjoint(filepath,filename,file_eig);
if ( (fp_eig=fopen(file_eig,"w"))==NULL ) {
#ifdef xt3
setvbuf(fp_eig,buf1,_IOFBF,fp_bsize); /* setvbuf */
#endif
printf("can not open a file %s\n",file_eig);
}
strcpy(file_ev,".Dos.vec");
fnjoint(filepath,filename,file_ev);
if ( (fp_ev=fopen(file_ev,"w"))==NULL ) {
#ifdef xt3
setvbuf(fp_ev,buf2,_IOFBF,fp_bsize); /* setvbuf */
#endif
printf("can not open a file %s\n",file_ev);
}
/* optical conductivity */
fp_opt=NULL;
if (Opticalconductivity_fileout) {
strcpy(file_opt,".optical");
fnjoint(filepath,filename,file_opt);
if ( (fp_opt=fopen(file_opt,"w"))==NULL ) {
#ifdef xt3
setvbuf(fp_opt,buf3,_IOFBF,fp_bsize); /* setvbuf */
#endif
printf("can not open a file %s\n",file_opt);
}
}
}
file_ptr_size=sizeof(FILE *);
MPI_Bcast(&fp_eig,file_ptr_size,MPI_BYTE,Host_ID,mpi_comm_level1);
MPI_Bcast(&fp_ev,file_ptr_size,MPI_BYTE,Host_ID,mpi_comm_level1);
/* optical conductivity */
if (Opticalconductivity_fileout) {
MPI_Bcast(&fp_opt,file_ptr_size,MPI_BYTE,Host_ID,mpi_comm_level1);
}
#if 0
/*debug*/
MPI_Barrier(mpi_comm_level1);
printf("%d: fp_opt=%d\n",myid,fp_opt);
MPI_Barrier(mpi_comm_level1);
#endif
if ( fp_eig==NULL || fp_ev==NULL ) {
goto Finishing;
}
if (myid==Host_ID){
fprintf(fp_eig,"mode 1\n");
fprintf(fp_eig,"NonCol 0\n");
fprintf(fp_eig,"N %d\n",n);
fprintf(fp_eig,"Nspin %d\n",SpinP_switch);
fprintf(fp_eig,"Erange %lf %lf\n",Dos_Erange[0],Dos_Erange[1]);
/* fprintf(fp_eig,"irange %d %d\n",iemin,iemax); */
fprintf(fp_eig,"Kgrid %d %d %d\n",1,1,1);
fprintf(fp_eig,"atomnum %d\n",atomnum);
fprintf(fp_eig,"<WhatSpecies\n");
for (i=1;i<=atomnum;i++) {
fprintf(fp_eig,"%d ",WhatSpecies[i]);
}
fprintf(fp_eig,"\nWhatSpecies>\n");
fprintf(fp_eig,"SpeciesNum %d\n",SpeciesNum);
fprintf(fp_eig,"<Spe_Total_CNO\n");
for (i=0;i<SpeciesNum;i++) {
fprintf(fp_eig,"%d ",Spe_Total_CNO[i]);
}
fprintf(fp_eig,"\nSpe_Total_CNO>\n");
MaxL=Supported_MaxL;
fprintf(fp_eig,"MaxL %d\n",Supported_MaxL);
fprintf(fp_eig,"<Spe_Num_CBasis\n");
for (i=0;i<SpeciesNum;i++) {
for (l=0;l<=MaxL;l++) {
fprintf(fp_eig,"%d ",Spe_Num_CBasis[i][l]);
}
fprintf(fp_eig,"\n");
}
fprintf(fp_eig,"Spe_Num_CBasis>\n");
fprintf(fp_eig,"ChemP %lf\n",ChemP);
/* optical conductivity */
if (fp_opt) {
fprintf(fp_opt,"nspin %d\n",SpinP_switch);
fprintf(fp_opt,"N %d\n",n);
}
printf("write eigenvalues\n");
printf("write eigenvectors\n");
} /* if (myid==Host_ID */
Overlap_Cluster(CntOLP,S,MP);
if (myid==Host_ID){
n = S[0][0];
/* optical conductivity */
if (Opticalconductivity_fileout) {
for (i=1; i<=n; i++){
for (j=1;j<=n;j++){
Ovlp[i][j] = S[i][j];
}
}
}
Eigen_lapack(S,ko[0],n,n);
/* S[i][j] contains jth eigenvector, not ith ! */
/****************************************************
searching of negative eigenvalues
****************************************************/
/* minus eigenvalues to 1.0e-14 */
for (l=1; l<=n; l++){
if (ko[0][l]<0.0) ko[0][l] = 1.0e-14;
EV_S[l] = ko[0][l];
}
/* print to the standard output */
if (2<=level_stdout && myid==Host_ID){
for (l=1; l<=n; l++){
printf(" <Cluster_DFT_Dosout> Eigenvalues of OLP %2d %18.15f\n",l,ko[0][l]);
}
}
/* calculate S*1/sqrt(ko) */
for (l=1; l<=n; l++){
IEV_S[l] = 1.0/sqrt(ko[0][l]);
}
/*********************************************************************
A = U^+ S U : A diagonal
A[n] delta_nm = U[j][n] S[j][i] U[i][m] =U^+[n][j] S[j][i] U[i][m]
1 = U A^-1 U^+ S
S^-1 =U A^-1 U^+
S^-1[i][j]= U[i][n] A^-1[n] U^+[n][j]
S^-1[i][j]= U[i][n] A^-1[n] U[j][n]
**********************************************************************/
/* optical conductivity */
if (Opticalconductivity_fileout) {
for (i=1;i<=n;i++) {
for (j=1;j<=n;j++) {
sum=0.0;
for (k=1;k<=n;k++) {
sum += S[i][k]/ko[0][k]*S[j][k];
}
Sinv[i][j]=sum;
}
}
}
/*
printf("Error check S S^{-1} =\n");
for (i=1;i<=n;i++) {
for (j=1;j<=n;j++) {
sum=0.0;
for (k=1;k<=n;k++) {
sum+= Ovlp[i][k]* Sinv[k][j];
}
printf("%lf ",sum);
}
printf("\n");
}
*/
} /* if (myid==Host_ID */
#if 0
for (i=1;i<=n;i++) {
printf("%d: ",myid);
for (j=1;j<=n;j++) {
sum=S[i][j];
printf("%lf ",sum);
}
printf("\n");
}
MPI_Finalize();
exit(0);
#endif
/****************************************************
Calculations of eigenvalues for up and down spins
Note:
MP indicates the starting position of
atom i in arraies H and S
****************************************************/
n1min=n;
iemin=n; iemax=1;
for (spin=0; spin<=SpinP_switch; spin++){
Hamiltonian_Cluster(nh[spin],H[spin],MP);
if (myid==Host_ID){
/* optical conductivity */
if (fp_opt) {
CurrentOpt_Cluster( n, H[spin], Ovlp, Sinv, J );
}
for (i1=1; i1<=n; i1++){
for (j1=1; j1<=n; j1++){
sum = 0.0;
for (l=1; l<=n; l++){
sum = sum + H[spin][i1][l]*S[l][j1]*IEV_S[j1];
}
C[spin][i1][j1] = sum;
}
}
for (i1=1; i1<=n; i1++){
for (j1=1; j1<=n; j1++){
sum = 0.0;
for (l=1; l<=n; l++){
sum = sum + IEV_S[i1]*S[l][i1]*C[spin][l][j1];
}
H[spin][i1][j1] = sum;
}
}
/***** H -> B_nl in the note *****/
for (i1=1; i1<=n; i1++){
for (j1=1; j1<=n; j1++){
C[spin][i1][j1] = H[spin][i1][j1];
}
}
/* penalty for ill-conditioning states */
EV_cut0 = Threshold_OLP_Eigen;
for (i1=1; i1<=n; i1++){
if (EV_S[i1]<EV_cut0){
C[spin][i1][i1] += pow((EV_S[i1]/EV_cut0),-2.0) - 1.0;
}
/* cutoff the interaction between the ill-conditioned state */
if (1.0e+3<C[spin][i1][i1]){
for (j1=1; j1<=n; j1++){
C[spin][i1][j1] = 0.0;
C[spin][j1][i1] = 0.0;
}
C[spin][i1][i1] = 1.0e+4;
}
}
/* diagonalize the matrix */
n1 = n;
Eigen_lapack(C[spin],ko[spin],n1,n1);
for (i1=1; i1<=n; i1++){
for (j1=1; j1<=n1; j1++){
H[spin][i1][j1] = C[spin][i1][j1];
}
}
/* print to the standard output */
if (2<=level_stdout && myid==Host_ID){
for (l=1; l<=n; l++){
printf(" <Cluster_DFT_Dosout> Eigenvalues of H spin=%2d %2d %18.15f\n",
spin,l,ko[spin][l]);
}
}
/***** H => D in the note *****/
if (n1min>n1) n1min=n1;
iemin0=1;
for (i1=1;i1<n1;i1++) {
if (ko[spin][i1]>ChemP+Dos_Erange[0]) {
iemin0=i1-1;
break;
}
}
if (iemin0<1) iemin0=1;
iemax0=n1;
for (i1=iemin0;i1<n1;i1++) {
if (ko[spin][i1]>ChemP+Dos_Erange[1]) {
iemax0=i1;
break;
}
}
if (iemax0>n1) iemax0=n1;
if (iemin>iemin0) iemin = iemin0;
if (iemax<iemax0) iemax = iemax0;
/****************************************************
Transformation to the original eigenvectors.
AIST NOTE 244P
****************************************************/
for (i1=1; i1<=n; i1++){
for (j1=1; j1<=n; j1++){
C[spin][i1][j1] = 0.0;
}
}
for (i1=1; i1<=n; i1++){
for (j1=1; j1<=n1; j1++){
sum = 0.0;
for (l=1; l<=n; l++){
sum = sum + S[i1][l]*IEV_S[l]*H[spin][l][j1];
}
C[spin][i1][j1] = sum;
}
}
/***** C -> c_pn in the note *****/
/* optical conductivity */
if (fp_opt) {
#if 0
printf("C=\n");
for (i1=1;i1<=n;i1++) { /* a */
for (j1=1;j1<=n;j1++) { /* m */
printf("%lf ",C[spin][i1][j1]);
}
printf("\n");
}
printf("%d: calculation of barJ start n=%d\n",myid,n);
#endif
/*** <n|\bar{J} |m> = sum C_na <a|J|b> C_mb
= sum_ab C[a][n] J[a][b] C[b][m] ***/
for (k=0;k<3;k++) { /* direction */
/* first J * C */
for (i1=1;i1<=n;i1++) { /* a */
for (j1=1;j1<=n;j1++) { /* m */
H[spin][i1][j1] =0.0;
for (i=1;i<=n;i++) { /* b */
H[spin][i1][j1] += J[k][i1][i]* C[spin][i][j1];
}
}
}
/* C * (J * C) */
for (i1=1;i1<=n;i1++) { /* n */
for (j1=1;j1<=n;j1++) { /* m */
Ctmp[i1][j1]=0.0;
for (i=1;i<=n;i++) { /* a */
Ctmp[i1][j1] += C[spin][i][i1] * H[spin][i][j1];
}
}
}
/* output */
fprintf(fp_opt, "<barJ.spin=%d.axis=%d\n",spin,k+1);
for (i1=1;i1<=n;i1++) { /* n */
for (j1=1;j1<=n;j1++) { /* m */
fprintf( fp_opt, "%lf ",Ctmp[i1][j1]);
}
fprintf( fp_opt,"\n");
}
fprintf(fp_opt, "barJ.spin=%d.dim=%d>\n",spin,k+1);
} /* k, direction */
#if 0
printf("%d: calculation of barJ end\n",myid);
#endif
} /* fp_opt */
} /* if (myid==Host_ID) */
} /* spin */
if (myid==Host_ID){
if (iemax>n1min) iemax=n1min;
printf("iemin iemax= %d %d\n",iemin,iemax);
}
/* MPI, iemin, iemax */
MPI_Bcast(&iemin, 1, MPI_INT, Host_ID, mpi_comm_level1);
MPI_Bcast(&iemax, 1, MPI_INT, Host_ID, mpi_comm_level1);
if (myid==Host_ID){
fprintf(fp_eig,"irange %d %d\n",iemin,iemax);
fprintf(fp_eig,"<Eigenvalues\n");
for (spin=0; spin<=SpinP_switch; spin++) {
fprintf(fp_eig,"%d %d %d ",0,0,0);
for (ie=iemin;ie<=iemax;ie++) {
fprintf(fp_eig,"%lf ",ko[spin][ie]);
/* printf("%lf ",ko[spin][ie]); */
}
fprintf(fp_eig,"\n");
/* printf("\n"); */
}
fprintf(fp_eig,"Eigenvalues>\n");
}
/****************************************************
MPI:
C
****************************************************/
for (spin=0; spin<=SpinP_switch; spin++){
for (i1=0; i1<=n; i1++){
for (j1=0; j1<=n; j1++){
Ctmp[i1][j1] = C[spin][i1][j1];
}
}
for (i1=0; i1<=n; i1++){
MPI_Bcast(&Ctmp[i1][0], n+1, MPI_DOUBLE, Host_ID, mpi_comm_level1);
}
for (i1=0; i1<=n; i1++){
for (j1=0; j1<=n; j1++){
C[spin][i1][j1] = Ctmp[i1][j1];
}
}
}
#if 0
printf("%d: Bcast C end %d %d\n",myid,iemin,iemax);
MPI_Barrier(mpi_comm_level1);
#endif
/****************************************************
Density and energy density matrices
for up and down spins
****************************************************/
for (spin=0; spin<=SpinP_switch; spin++){
for (k=iemin; k<=iemax; k++){
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++){
dum = C[spin][Anum+i][k]*C[spin][Bnum+j][k];
CDM[MA_AN][LB_AN][i][j] = dum;
}
}
}
}
#if 0
printf("%d: step1 %d %d\n",myid,spin,k);
#endif
/*******************************************
M_i = S_ij D_ji
D_ji = C_nj C_ni
S_ij : CntOLP
D_ji : CDM
******************************************/
for (GA_AN=1; GA_AN<=atomnum; GA_AN++){
wanA = WhatSpecies[GA_AN];
tnoA = Spe_Total_CNO[wanA];
for (i1=0; i1<=(tnoA-1); i1++){
SD[GA_AN][i1]=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 (i1=0; i1<tnoA; i1++){
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 (j1=0; j1<tnoB; j1++){
SD[GA_AN][i1] += CDM[MA_AN][LB_AN][i1][j1]*
CntOLP[MA_AN][LB_AN][i1][j1];
}
}
}
}
#if 0
printf("%d: step2 %d %d\n",myid,spin,k);
#endif
#if 0
/* norm check */
/*
sum=0.0;
for (GA_AN=1; GA_AN<=atomnum; GA_AN++){
wanA = WhatSpecies[GA_AN];
tnoA = Spe_Total_CNO[wanA];
for (i1=0; i1<tnoA; i1++){
sum+=SD[GA_AN][i1];
}
}
if (fabs(sum-1.0)>1.0e-3) { printf("norm = %lf\n",sum); }
*/
#endif
i_vec[0]=i_vec[1]=i_vec[2]=0;
if (myid==Host_ID) fwrite(i_vec,sizeof(int),3,fp_ev);
for (GA_AN=1; GA_AN<=atomnum; GA_AN++){
wanA = WhatSpecies[GA_AN];
tnoA = Spe_Total_CNO[wanA];
ID = G2ID[GA_AN];
if (ID==myid){
for (i1=0; i1<tnoA; i1++){
fSD[i1]=SD[GA_AN][i1];
}
if (myid!=Host_ID){
tag = 999;
MPI_Isend(&fSD[0],tnoA,MPI_FLOAT,Host_ID,
tag,mpi_comm_level1,&request);
MPI_Wait(&request,&stat);
}
}
if (myid==Host_ID && ID!=Host_ID){
tag = 999;
MPI_Recv(&fSD[0], tnoA, MPI_FLOAT, ID, tag, mpi_comm_level1, &stat);
}
if (myid==Host_ID) fwrite(fSD,sizeof(float),tnoA,fp_ev);
MPI_Barrier(mpi_comm_level1);
}
} /* k */
} /* spin */
Finishing: ;
if (myid==Host_ID){
if (fp_eig) fclose(fp_eig);
if (fp_ev) fclose(fp_ev);
/* optical conductivity */
if (fp_opt) fclose(fp_opt);
}
/****************************************************
Free
****************************************************/
#if 0
printf("%d: free start\n",myid);
#endif
if (Opticalconductivity_fileout) {
free_multidimarray((void**)J, N_J, i_J);
free_multidimarray((void**)Sinv, N_Sinv, i_Sinv);
free_multidimarray((void**)Ovlp,N_Ovlp, i_Ovlp);
}
free(MP);
for (spin=0; spin<i_ko[0]; spin++){
free(ko[spin]);
}
free(ko);
for (spin=0; spin<i_H[0]; spin++){
for (i=0; i<i_H[1]; i++){
free(H[spin][i]);
}
free(H[spin]);
}
free(H);
for (spin=0; spin<i_C[0]; spin++){
for (i=0; i<i_C[1]; i++){
free(C[spin][i]);
}
free(C[spin]);
}
free(C);
for (i=0; i<i_Ctmp[0]; i++){
free(Ctmp[i]);
}
free(Ctmp);
for (i=0; i<i_CDM[0]; i++){
for (j=0; j<i_CDM[1]; j++){
for (k=0; k<i_CDM[2]; k++){
free(CDM[i][j][k]);
}
free(CDM[i][j]);
}
free(CDM[i]);
}
free(CDM);
for (i=0; i<i_SD[0]; i++){
free(SD[i]);
}
free(SD);
free(fSD);
#if 0
printf("%d: Dosout Barrier start\n",myid);
MPI_Barrier(mpi_comm_level1);
printf("%d: Dosout Barrier end\n",myid);
#endif
/* for elapsed time */
dtime(&TEtime);
time0 = TEtime - TStime;
return time0;
}
