[a0bcf1] | 1 | void CalculatePerturbedEnergy(struct Problem *P, int l, int DoGradient)
|
---|
| 2 | {
|
---|
| 3 | struct Lattice *Lat = &P->Lat;
|
---|
| 4 | struct Psis *Psi = &Lat->Psi;
|
---|
| 5 | struct Energy *E = Lat->E;
|
---|
| 6 | struct PseudoPot *PP = &P->PP;
|
---|
| 7 | struct RunStruct *R = &P->R;
|
---|
| 8 | struct LatticeLevel *LevS = R->LevS;
|
---|
| 9 | int state = R->CurrentMin;
|
---|
| 10 | int l_normal = Psi->TypeStartIndex[Occupied] + (l - Psi->TypeStartIndex[state]); // offset l to \varphi_l^{(0)}
|
---|
| 11 | int ActNum = l - Psi->TypeStartIndex[state] + Psi->TypeStartIndex[1] * Psi->LocalPsiStatus[l].my_color_comm_ST_Psi;
|
---|
| 12 | int g, i, m, j;
|
---|
| 13 | double lambda, Lambda;
|
---|
| 14 | double RElambda10, RELambda10;
|
---|
| 15 | double RElambda01, RELambda01;
|
---|
| 16 | double IMlambda10, IMLambda10;
|
---|
| 17 | double IMlambda01, IMLambda01;
|
---|
| 18 | fftw_complex *source = LevS->LPsi->LocalPsi[l];
|
---|
| 19 | fftw_complex *grad = P->Grad.GradientArray[ActualGradient];
|
---|
| 20 | fftw_complex *Hc_grad = P->Grad.GradientArray[HcGradient];
|
---|
| 21 | fftw_complex *H1c_grad = P->Grad.GradientArray[H1cGradient];
|
---|
| 22 | fftw_complex *TempPsi_0 = H1c_grad;
|
---|
| 23 | fftw_complex *TempPsi_1 = P->Grad.GradientArray[TempGradient];
|
---|
| 24 | fftw_complex *varphi_1, *varphi_0;
|
---|
| 25 | struct OnePsiElement *OnePsiB, *LOnePsiB;
|
---|
| 26 | fftw_complex *LPsiDatB=NULL;
|
---|
| 27 | int ElementSize = (sizeof(fftw_complex) / sizeof(double)), RecvSource;
|
---|
| 28 | MPI_Status status;
|
---|
| 29 |
|
---|
| 30 | // ============ Calculate H^(0) psi^(1) =============================
|
---|
| 31 | SetArrayToDouble0((double *)Hc_grad,2*R->InitLevS->MaxG);
|
---|
| 32 | ApplyTotalHamiltonian(P,source,Hc_grad, PP->fnl[l], 1, 1);
|
---|
| 33 |
|
---|
| 34 | // ============ ENERGY FUNCTIONAL Evaluation PART 1 ================
|
---|
| 35 | varphi_0 = LevS->LPsi->LocalPsi[l_normal];
|
---|
| 36 | varphi_1 = LevS->LPsi->LocalPsi[l];
|
---|
| 37 | switch (state) {
|
---|
| 38 | case Perturbed_P0:
|
---|
| 39 | CalculatePerturbationOperator_P(P,varphi_0,TempPsi_0,0,0); // \nabla_0 | \varphi_l^{(0)} \rangle
|
---|
| 40 | CalculatePerturbationOperator_P(P,varphi_1,TempPsi_1,0,0); // \nabla_0 | \varphi_l^{(1)} \rangle
|
---|
| 41 | break;
|
---|
| 42 | case Perturbed_P1:
|
---|
| 43 | CalculatePerturbationOperator_P(P,varphi_0,TempPsi_0,1,0); // \nabla_1 | \varphi_l^{(0)} \rangle
|
---|
| 44 | CalculatePerturbationOperator_P(P,varphi_1,TempPsi_1,1,0); // \nabla_1 | \varphi_l^{(1)} \rangle
|
---|
| 45 | break;
|
---|
| 46 | case Perturbed_P2:
|
---|
| 47 | CalculatePerturbationOperator_P(P,varphi_0,TempPsi_0,2,0); // \nabla_1 | \varphi_l^{(0)} \rangle
|
---|
| 48 | CalculatePerturbationOperator_P(P,varphi_1,TempPsi_1,2,0); // \nabla_1 | \varphi_l^{(1)} \rangle
|
---|
| 49 | break;
|
---|
| 50 | case Perturbed_RxP0:
|
---|
| 51 | CalculatePerturbationOperator_RxP(P,varphi_0,TempPsi_0,l,0,0); // r \times \nabla | \varphi_l^{(0)} \rangle
|
---|
| 52 | CalculatePerturbationOperator_RxP(P,varphi_1,TempPsi_1,l,0,0); // r \times \nabla | \varphi_l^{(1)} \rangle
|
---|
| 53 | //CalculatePerturbationOperator_R(P,varphi_0,TempPsi_0,0,l); // r \times \nabla | \varphi_l^{(0)} \rangle
|
---|
| 54 | //CalculatePerturbationOperator_R(P,varphi_1,TempPsi_1,0,l); // r \times \nabla | \varphi_l^{(1)} \rangle
|
---|
| 55 | break;
|
---|
| 56 | case Perturbed_RxP1:
|
---|
| 57 | CalculatePerturbationOperator_RxP(P,varphi_0,TempPsi_0,l,1,0); // r \times \nabla | \varphi_l^{(0)} \rangle
|
---|
| 58 | CalculatePerturbationOperator_RxP(P,varphi_1,TempPsi_1,l,1,0); // r \times \nabla | \varphi_l^{(1)} \rangle
|
---|
| 59 | //CalculatePerturbationOperator_R(P,varphi_0,TempPsi_0,1,l); // r \times \nabla | \varphi_l^{(0)} \rangle
|
---|
| 60 | //CalculatePerturbationOperator_R(P,varphi_1,TempPsi_1,1,l); // r \times \nabla | \varphi_l^{(1)} \rangle
|
---|
| 61 | break;
|
---|
| 62 | case Perturbed_RxP2:
|
---|
| 63 | CalculatePerturbationOperator_RxP(P,varphi_0,TempPsi_0,l,2,0); // r \times \nabla | \varphi_l^{(0)} \rangle
|
---|
| 64 | CalculatePerturbationOperator_RxP(P,varphi_1,TempPsi_1,l,2,0); // r \times \nabla | \varphi_l^{(1)} \rangle
|
---|
| 65 | //CalculatePerturbationOperator_R(P,varphi_0,TempPsi_0,2,l); // r \times \nabla | \varphi_l^{(0)} \rangle
|
---|
| 66 | //CalculatePerturbationOperator_R(P,varphi_1,TempPsi_1,2,l); // r \times \nabla | \varphi_l^{(1)} \rangle
|
---|
| 67 | break;
|
---|
| 68 | default:
|
---|
| 69 | fprintf(stderr,"(%i) CalculatePerturbedEnergy called whilst not within perturbation run: CurrentMin = %i !\n",P->Par.me, R->CurrentMin);
|
---|
| 70 | break;
|
---|
| 71 | }
|
---|
| 72 |
|
---|
| 73 | // ============ GRADIENT and EIGENVALUE Evaluation Part 1==============
|
---|
| 74 | lambda = 0.0;
|
---|
| 75 | if ((DoGradient) && (grad != NULL)) {
|
---|
| 76 | g = 0;
|
---|
| 77 | if (LevS->GArray[0].GSq == 0.0) {
|
---|
| 78 | lambda += Hc_grad[0].re*source[0].re;
|
---|
| 79 | grad[0].re = -(Hc_grad[0].re + TempPsi_0[0].re);
|
---|
| 80 | grad[0].im = -(Hc_grad[0].im + TempPsi_0[0].im);
|
---|
| 81 | g++;
|
---|
| 82 | }
|
---|
| 83 | for (;g<LevS->MaxG;g++) {
|
---|
| 84 | lambda += 2.*(Hc_grad[g].re*source[g].re + Hc_grad[g].im*source[g].im);
|
---|
| 85 | grad[g].re = -(Hc_grad[g].re + TempPsi_0[g].re);
|
---|
| 86 | grad[g].im = -(Hc_grad[g].im + TempPsi_0[g].im);
|
---|
| 87 | }
|
---|
| 88 |
|
---|
| 89 | m = -1;
|
---|
| 90 | for (j=0; j < Psi->MaxPsiOfType+P->Par.Max_me_comm_ST_PsiT; j++) { // go through all wave functions
|
---|
| 91 | OnePsiB = &Psi->AllPsiStatus[j]; // grab OnePsiB
|
---|
| 92 | if (OnePsiB->PsiType == state) { // drop all but the ones of current min state
|
---|
| 93 | m++; // increase m if it is type-specific wave function
|
---|
| 94 | if (OnePsiB->my_color_comm_ST_Psi == P->Par.my_color_comm_ST_Psi) // local?
|
---|
| 95 | LOnePsiB = &Psi->LocalPsiStatus[OnePsiB->MyLocalNo];
|
---|
| 96 | else
|
---|
| 97 | LOnePsiB = NULL;
|
---|
| 98 | if (LOnePsiB == NULL) { // if it's not local ... receive it from respective process into TempPsi
|
---|
| 99 | RecvSource = OnePsiB->my_color_comm_ST_Psi;
|
---|
| 100 | MPI_Recv( LevS->LPsi->TempPsi, LevS->MaxG*ElementSize, MPI_DOUBLE, RecvSource, PerturbedTag, P->Par.comm_ST_PsiT, &status );
|
---|
| 101 | LPsiDatB=LevS->LPsi->TempPsi;
|
---|
| 102 | } else { // .. otherwise send it to all other processes (Max_me... - 1)
|
---|
| 103 | for (i=0;i<P->Par.Max_me_comm_ST_PsiT;i++)
|
---|
| 104 | if (i != OnePsiB->my_color_comm_ST_Psi)
|
---|
| 105 | MPI_Send( LevS->LPsi->LocalPsi[OnePsiB->MyLocalNo], LevS->MaxG*ElementSize, MPI_DOUBLE, i, PerturbedTag, P->Par.comm_ST_PsiT);
|
---|
| 106 | LPsiDatB=LevS->LPsi->LocalPsi[OnePsiB->MyLocalNo];
|
---|
| 107 | } // LPsiDatB is now set to the coefficients of OnePsi either stored or MPI_Received
|
---|
| 108 |
|
---|
| 109 | g = 0;
|
---|
| 110 | if (LevS->GArray[0].GSq == 0.0) { // perform the summation
|
---|
| 111 | grad[0].re += Lat->Psi.lambda[ActNum][m]*LPsiDatB[0].re;
|
---|
| 112 | grad[0].im += Lat->Psi.lambda[ActNum][m]*LPsiDatB[0].im;
|
---|
| 113 | g++;
|
---|
| 114 | }
|
---|
| 115 | for (;g<LevS->MaxG;g++) {
|
---|
| 116 | grad[g].re += Lat->Psi.lambda[ActNum][m]*LPsiDatB[g].re;
|
---|
| 117 | grad[g].im += Lat->Psi.lambda[ActNum][m]*LPsiDatB[g].im;
|
---|
| 118 | }
|
---|
| 119 | }
|
---|
| 120 | }
|
---|
| 121 | } else {
|
---|
| 122 | g = 0;
|
---|
| 123 | if (LevS->GArray[0].GSq == 0.0) {
|
---|
| 124 | lambda += Hc_grad[0].re*source[0].re;
|
---|
| 125 | g++;
|
---|
| 126 | }
|
---|
| 127 | for (;g<LevS->MaxG;g++)
|
---|
| 128 | lambda += 2.*(Hc_grad[g].re*source[g].re + Hc_grad[g].im*source[g].im);
|
---|
| 129 | }
|
---|
| 130 | MPI_Allreduce ( &lambda, &Lambda, 1, MPI_DOUBLE, MPI_SUM, P->Par.comm_ST_Psi);
|
---|
| 131 | //fprintf(stderr,"(%i) Lambda[%i] = %lg\n",P->Par.me, l, Lambda);
|
---|
| 132 | Lat->Psi.AddData[l].Lambda = Lambda;
|
---|
| 133 |
|
---|
| 134 | // ============ ENERGY FUNCTIONAL Evaluation PART 2 ================
|
---|
| 135 | // varphi_1 jas negative symmetry, returning TemPsi_0 from CalculatePerturbedOperator also, thus real part of scalar product
|
---|
| 136 | // "-" due to purely imaginary wave function is on left hand side, thus becomes complex conjugated: i -> -i
|
---|
| 137 | // (-i goes into pert. op., "-" remains when on right hand side)
|
---|
| 138 | IMlambda10 = GradImSP(P,LevS,varphi_1,TempPsi_0) * sqrt(Psi->LocalPsiStatus[l].PsiFactor * Psi->LocalPsiStatus[l_normal].PsiFactor);
|
---|
| 139 | IMlambda01 = -GradImSP(P,LevS,varphi_0,TempPsi_1) * sqrt(Psi->LocalPsiStatus[l].PsiFactor * Psi->LocalPsiStatus[l_normal].PsiFactor);
|
---|
| 140 | RElambda10 = GradSP(P,LevS,varphi_1,TempPsi_0) * sqrt(Psi->LocalPsiStatus[l].PsiFactor * Psi->LocalPsiStatus[l_normal].PsiFactor);
|
---|
| 141 | RElambda01 = -GradSP(P,LevS,varphi_0,TempPsi_1) * sqrt(Psi->LocalPsiStatus[l].PsiFactor * Psi->LocalPsiStatus[l_normal].PsiFactor);
|
---|
| 142 |
|
---|
| 143 | MPI_Allreduce ( &RElambda10, &RELambda10, 1, MPI_DOUBLE, MPI_SUM, P->Par.comm_ST_Psi);
|
---|
| 144 | MPI_Allreduce ( &RElambda01, &RELambda01, 1, MPI_DOUBLE, MPI_SUM, P->Par.comm_ST_Psi);
|
---|
| 145 | MPI_Allreduce ( &IMlambda10, &IMLambda10, 1, MPI_DOUBLE, MPI_SUM, P->Par.comm_ST_Psi);
|
---|
| 146 | MPI_Allreduce ( &IMlambda01, &IMLambda01, 1, MPI_DOUBLE, MPI_SUM, P->Par.comm_ST_Psi);
|
---|
| 147 |
|
---|
| 148 | E->PsiEnergy[Perturbed1_0Energy][l] = RELambda10;
|
---|
| 149 | E->PsiEnergy[Perturbed0_1Energy][l] = RELambda01;
|
---|
| 150 | if (P->Par.me == 0) {
|
---|
| 151 | fprintf(stderr,"RE.Lambda10[%i] = %lg\t RE.Lambda01[%i] = %lg\n", l, RELambda10, l, RELambda01);
|
---|
| 152 | fprintf(stderr,"IM.Lambda10[%i] = %lg\t IM.Lambda01[%i] = %lg\n", l, IMLambda10, l, IMLambda01);
|
---|
| 153 | }
|
---|
| 154 | }
|
---|
| 155 |
|
---|
| 156 | void CalculatePerturbationOperator_RxP(struct Problem *P, fftw_complex *source, fftw_complex *dest, int l, int index, int symmetry)
|
---|
| 157 | {
|
---|
| 158 | struct RunStruct *R = &P->R;
|
---|
| 159 | struct LatticeLevel *Lev0 = R->Lev0;
|
---|
| 160 | struct LatticeLevel *LevS = R->LevS;
|
---|
| 161 | struct Lattice *Lat = &P->Lat;
|
---|
| 162 | struct fft_plan_3d *plan = Lat->plan;
|
---|
| 163 | struct Density *Dens0 = Lev0->Dens;
|
---|
| 164 | fftw_complex *tempdestRC = Dens0->DensityCArray[CurrentDensity0];
|
---|
| 165 | fftw_real *tempdestR = (fftw_real *) tempdestRC;
|
---|
| 166 | fftw_complex *tempdestRC2 = Dens0->DensityCArray[CurrentDensity1];
|
---|
| 167 | fftw_real *tempdestR2 = (fftw_real *) tempdestRC2;
|
---|
| 168 | fftw_complex *work = Dens0->DensityCArray[TempDensity];
|
---|
| 169 | fftw_complex *PsiC = (fftw_complex *) Dens0->DensityCArray[ActualPsiDensity];
|
---|
| 170 | fftw_real *PsiCR = (fftw_real *) PsiC;
|
---|
| 171 | fftw_real *RealPhiR = (fftw_real *) Dens0->DensityArray[TempDensity];
|
---|
| 172 | fftw_real *RealPhiR2 = (fftw_real *) Dens0->DensityArray[Temp2Density];
|
---|
| 173 | fftw_complex *posfac, *destsnd, *destrcv, *destsnd2, *destrcv2;
|
---|
| 174 | double x[NDIM], fac[NDIM], *WCentre;
|
---|
| 175 | int n[NDIM], N0, n0, g, Index, pos, iS, i0;
|
---|
| 176 |
|
---|
| 177 | // init pointers and values
|
---|
| 178 | int myPE = P->Par.me_comm_ST_Psi;
|
---|
| 179 | int N[NDIM], NUp[NDIM];
|
---|
| 180 | N[0] = LevS->Plan0.plan->N[0];
|
---|
| 181 | N[1] = LevS->Plan0.plan->N[1];
|
---|
| 182 | N[2] = LevS->Plan0.plan->N[2];
|
---|
| 183 | NUp[0] = LevS->NUp[0];
|
---|
| 184 | NUp[1] = LevS->NUp[1];
|
---|
| 185 | NUp[2] = LevS->NUp[2];
|
---|
| 186 | double FFTFactor = 1./LevS->MaxN;
|
---|
| 187 | N0 = LevS->Plan0.plan->local_nx;
|
---|
| 188 | WCentre = Lat->Psi.AddData[l].WannierCentre;
|
---|
| 189 |
|
---|
| 190 | // blow up source coefficients
|
---|
| 191 | SetArrayToDouble0((double *)tempdestRC ,Dens0->TotalSize*2);
|
---|
| 192 | SetArrayToDouble0((double *)tempdestRC2,Dens0->TotalSize*2);
|
---|
| 193 | SetArrayToDouble0((double *)RealPhiR ,Dens0->TotalSize*2);
|
---|
| 194 | SetArrayToDouble0((double *)RealPhiR2,Dens0->TotalSize*2);
|
---|
| 195 | SetArrayToDouble0((double *)PsiC,Dens0->TotalSize*2);
|
---|
| 196 | for (g=0; g<LevS->MaxG; g++) {
|
---|
| 197 | Index = LevS->GArray[g].Index;
|
---|
| 198 | posfac = &LevS->PosFactorUp[LevS->MaxNUp*g];
|
---|
| 199 | destrcv = &tempdestRC[LevS->MaxNUp*Index];
|
---|
| 200 | destrcv2 = &tempdestRC2[LevS->MaxNUp*Index];
|
---|
| 201 | for (pos=0; pos<LevS->MaxNUp; pos++) {
|
---|
| 202 | destrcv [pos].re = LevS->GArray[g].G[cross(index,1)]*(( source[g].im)*posfac[pos].re-(-source[g].re)*posfac[pos].im);
|
---|
| 203 | destrcv [pos].im = LevS->GArray[g].G[cross(index,1)]*(( source[g].im)*posfac[pos].im+(-source[g].re)*posfac[pos].re);
|
---|
| 204 | destrcv2[pos].re = LevS->GArray[g].G[cross(index,3)]*(( source[g].im)*posfac[pos].re-(-source[g].re)*posfac[pos].im);
|
---|
| 205 | destrcv2[pos].im = LevS->GArray[g].G[cross(index,3)]*(( source[g].im)*posfac[pos].im+(-source[g].re)*posfac[pos].re);
|
---|
| 206 | }
|
---|
| 207 | }
|
---|
| 208 | for (g=0; g<LevS->MaxDoubleG; g++) {
|
---|
| 209 | destsnd = &tempdestRC [LevS->DoubleG[2*g]*LevS->MaxNUp];
|
---|
| 210 | destrcv = &tempdestRC [LevS->DoubleG[2*g+1]*LevS->MaxNUp];
|
---|
| 211 | destsnd2 = &tempdestRC2[LevS->DoubleG[2*g]*LevS->MaxNUp];
|
---|
| 212 | destrcv2 = &tempdestRC2[LevS->DoubleG[2*g+1]*LevS->MaxNUp];
|
---|
| 213 | for (pos=0; pos<LevS->MaxNUp; pos++) {
|
---|
| 214 | destrcv [pos].re = destsnd [pos].re;
|
---|
| 215 | destrcv [pos].im = -destsnd [pos].im;
|
---|
| 216 | destrcv2[pos].re = destsnd2[pos].re;
|
---|
| 217 | destrcv2[pos].im = -destsnd2[pos].im;
|
---|
| 218 | }
|
---|
| 219 | }
|
---|
| 220 |
|
---|
| 221 | // fourier transform blown up wave function
|
---|
| 222 | fft_3d_complex_to_real(plan,LevS->LevelNo, FFTNFUp, tempdestRC , work);
|
---|
| 223 | DensityRTransformPos(LevS,tempdestR ,RealPhiR );
|
---|
| 224 | fft_3d_complex_to_real(plan,LevS->LevelNo, FFTNFUp, tempdestRC2, work);
|
---|
| 225 | DensityRTransformPos(LevS,tempdestR2,RealPhiR2);
|
---|
| 226 |
|
---|
| 227 | //fft_Psi(P,source,RealPhiR ,cross(index,1),6);
|
---|
| 228 | //fft_Psi(P,source,RealPhiR2,cross(index,3),6);
|
---|
| 229 |
|
---|
| 230 | // for every point on the real grid multiply with component of position vector
|
---|
| 231 | for (n0=0; n0<N0; n0++)
|
---|
| 232 | for (n[1]=0; n[1]<N[1]; n[1]++)
|
---|
| 233 | for (n[2]=0; n[2]<N[2]; n[2]++) {
|
---|
| 234 | n[0] = n0 + N0 * myPE;
|
---|
| 235 | fac[0] = (double)(n[0])/(double)((N[0]));
|
---|
| 236 | fac[1] = (double)(n[1])/(double)((N[1]));
|
---|
| 237 | fac[2] = (double)(n[2])/(double)((N[2]));
|
---|
| 238 | RMat33Vec3(x,Lat->RealBasis,fac);
|
---|
| 239 | iS = n[2] + N[2]*(n[1] + N[1]*n0); // mind splitting of x axis due to multiple processes
|
---|
| 240 | i0 = n[2]*NUp[2]+N[2]*NUp[2]*(n[1]*NUp[1]+N[1]*NUp[1]*n0*NUp[0]);
|
---|
[f5586e] | 241 | //PsiCR[iS] = ((double)n[cross(index,0)]/(double)N[cross(index,0)]*sqrt(Lat->RealBasisSQ[cross(index,0)]) - WCentre[cross(index,0)])*RealPhiR[i0] - ((double)n[cross(index,2)]/(double)N[cross(index,2)]*sqrt(Lat->RealBasisQ[cross(index,2)]) - WCentre[cross(index,2)])*RealPhiR2[i0];
|
---|
[a0bcf1] | 242 | PsiCR[iS] =
|
---|
| 243 | MinImageConv(Lat,x[cross(index,0)],WCentre[cross(index,0)],cross(index,0)) * RealPhiR [i0]
|
---|
| 244 | - MinImageConv(Lat,x[cross(index,2)],WCentre[cross(index,2)],cross(index,2)) * RealPhiR2[i0];
|
---|
| 245 | //tmp += truedist(Lat,x[index_r],WCentre[index_r],index_r) * RealPhiR[i0];
|
---|
| 246 | //tmp += sawtooth(P,truedist(Lat,x[index_r],WCentre[index_r],index_r), index_r)*RealPhiR[i0];
|
---|
| 247 | //(Fehler mit falschem Ort ist vor dieser Stelle!): ueber result = RealPhiR[i0] * (x[index_r]) * RealPhiR[i0]; gecheckt
|
---|
| 248 | }
|
---|
| 249 |
|
---|
| 250 | // inverse fourier transform
|
---|
| 251 | fft_3d_real_to_complex(plan,LevS->LevelNo, FFTNF1, PsiC, work);
|
---|
| 252 |
|
---|
| 253 | // copy to destination array
|
---|
| 254 | for (g=0; g<LevS->MaxG; g++) {
|
---|
| 255 | Index = LevS->GArray[g].Index;
|
---|
| 256 | dest[g].re = ( PsiC[Index].re)*FFTFactor;
|
---|
| 257 | dest[g].im = ( PsiC[Index].im)*FFTFactor;
|
---|
| 258 | if (LevS->GArray[g].GSq == 0)
|
---|
| 259 | dest[g].im = 0; // imaginary of G=0 is zero
|
---|
| 260 | }
|
---|
| 261 | }
|
---|