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