source: pcp/src/grad.c@ 774ae8

Last change on this file since 774ae8 was 64fa9e, checked in by Frederik Heber <heber@…>, 17 years ago

Free(): now takes a debug string to know where free error occured

  • Property mode set to 100644
File size: 58.0 KB
Line 
1/** \file grad.c
2 * Gradient Calculation.
3 *
4 * The most important structure is Gradient with its Gradient::GradientArray.
5 * It contains the various stages of the calculated conjugate direction, beginning
6 * from the Psis::LocalPsiStatus. Subsequently, CalculateCGGradient(), CalculatePreConGrad(),
7 * CalculateConDir() and CalculateLineSearch() are called which use earlier stages to
8 * calculate the latter ones: ActualGradient, PreConDirGradient, ConDirGradient and OldConDirGradient,
9 * do the one-dimensional minimisation and finally update the coefficients of the wave function,
10 * whilst these ought to remain orthogonal.
11 *
12 * Initialization of the Gradient structure and arrays is done in InitGradients(), deallocation
13 * in RemoveGradients().
14 *
15 * Small functions calculate the scalar product between two gradient directions GradSP(), find
16 * the minimal angle in the line search CalculateDeltaI() or evaluate complex expressions
17 * CalculateConDirHConDir(), down to basic calculation of the gradient of the wave function
18 * CalculateGradientNoRT(). CalculateHamiltonian() sets up the Hamiltonian for the Kohn-Sham
19 * orbitals and calculates the eigenvalues.
20 *
21 * Other functions update the coefficients after the position of the ion has changed -
22 * CalcAlphaForUpdateWaveAfterIonMove() and UpdateWaveAfterIonMove().
23 *
24 *
25 Project: ParallelCarParrinello
26 \author Jan Hamaekers
27 \date 2000
28
29 File: grad.c
30 $Id: grad.c,v 1.90 2007-03-29 13:38:04 foo Exp $
31*/
32
33#include <stdlib.h>
34#include <stdio.h>
35#include <stddef.h>
36#include <math.h>
37#include <string.h>
38#include <gsl/gsl_matrix.h>
39#include <gsl/gsl_eigen.h>
40#include <gsl/gsl_heapsort.h>
41#include <gsl/gsl_complex.h>
42#include <gsl/gsl_complex_math.h>
43#include <gsl/gsl_sort_vector.h>
44#include <gsl/gsl_blas.h>
45
46#include "mymath.h"
47#include "data.h"
48#include "errors.h"
49#include "energy.h"
50#include "helpers.h"
51#include "myfft.h"
52#include "density.h"
53#include "gramsch.h"
54#include "perturbed.h"
55#include "pseudo.h"
56#include "grad.h"
57#include "run.h"
58#include "wannier.h"
59
60/** Initialization of Gradient Calculation.
61 * Gradient::GradientArray[GraSchGradient] is set onto "extra" Psis::LocalPsi (needed
62 * for orthogonal conjugate gradient directions!),
63 * for the remaining GradientTypes memory is allocated and zerod.
64 * \param *P Problem at hand
65 * \param *Grad Gradient structure
66 */
67void InitGradients(struct Problem *P, struct Gradient *Grad)
68{
69 struct Lattice *Lat = &P->Lat;
70 struct RunStruct *R = &P->R;
71 struct LatticeLevel *LevS = R->LevS;
72 struct LatticeLevel *ILevS = R->InitLevS;
73 struct Psis *Psi = &Lat->Psi;
74 int i;
75 Grad->GradientArray[GraSchGradient] = LevS->LPsi->LocalPsi[Psi->LocalNo];
76 for (i=1; i<MaxGradientArrayTypes; i++) {
77 Grad->GradientArray[i] = (fftw_complex *) Malloc(sizeof(fftw_complex)*ILevS->MaxG, "InitGradients");
78 SetArrayToDouble0((double*)Grad->GradientArray[i], 2*ILevS->MaxG);
79 }
80}
81
82/** Deallocates memory used in Gradient::GradientArray.
83 * Gradient::GradientArray[GraSchGradient] is set to null.
84 * \param *P Problem at hand
85 * \param *Grad Gradient structure
86 */
87void RemoveGradients(struct Problem *P, struct Gradient *Grad)
88{
89 int i;
90 P=P;
91 Grad->GradientArray[GraSchGradient] = NULL;
92 for (i=1; i<MaxGradientArrayTypes; i++)
93 Free(Grad->GradientArray[i], "RemoveGradients: Grad->GradientArray[i]");
94}
95
96/** Calculates the scalar product of two wave functions with equal symmetry.
97 * \param *P Problem at hand
98 * \param *Lev LatticeLevel structure
99 * \param *LPsiDatA first array of complex wave functions coefficients
100 * \param *LPsiDatB second array of complex wave functions coefficients
101 * \return complex scalar product of the two wave functions.
102 * \warning MPI_Allreduce has to be done still, remember coefficients are shared among processes!
103 */
104double GradSP(struct Problem *P, struct LatticeLevel *Lev, const fftw_complex *LPsiDatA, const fftw_complex *LPsiDatB) {
105 double LocalSP=0.0;
106 int i = 0;
107 if (Lev->GArray[0].GSq == 0.0) {
108 LocalSP += LPsiDatA[0].re * LPsiDatB[0].re;
109 i++;
110 }
111 for (; i < Lev->MaxG; i++) {
112 LocalSP += 2.*(LPsiDatA[i].re * LPsiDatB[i].re + LPsiDatA[i].im * LPsiDatB[i].im); // factor 2 because of the symmetry arising from gamma point!
113 }
114 return(LocalSP);
115}
116
117/** Calculates the scalar product of two wave functions with unequal symmetry.
118 * \param *P Problem at hand
119 * \param *Lev LatticeLevel structure
120 * \param *LPsiDatA first array of complex wave functions coefficients
121 * \param *LPsiDatB second array of complex wave functions coefficients
122 * \return complex scalar product of the two wave functions.
123 * \warning MPI_Allreduce has to be done still, remember coefficients are shared among processes!
124 */
125double GradImSP(struct Problem *P, struct LatticeLevel *Lev, fftw_complex *LPsiDatA, fftw_complex *LPsiDatB) {
126 double LocalSP=0.0;
127 int i = 0;
128 if (Lev->GArray[0].GSq == 0.0) {
129 i++;
130 }
131 for (; i < Lev->MaxG; i++) {
132 LocalSP += 2.*(LPsiDatA[i].re * LPsiDatB[i].im - LPsiDatA[i].im * LPsiDatB[i].re); // factor 2 because of the symmetry arising from gamma point!
133 }
134 return(LocalSP);
135}
136
137/** Calculation of gradient of wave function(without RiemannTensor).
138 * We want to calculate the variational derivative \f$\frac{\delta}{\delta \psi^*_j} E[{\psi^*_j}]\f$,
139 * which we need for the minimisation of the energy functional. In the plane wave basis this evaluates to
140 * \f[
141 * \langle \chi_G| -\frac{1}{2}\nabla^2 + \underbrace{V^H + V^{ps,loc} + V^{XC}}_{V^{loc}} + V^{ps,nl} | \psi_i \rangle
142 * \qquad (section 4.3)
143 * \f]
144 * Therefore, DensityType#HGDensity is back-transformed, exchange correlation potential added up (CalculateXCPotentialNoRT()),
145 * and vector multiplied with the wave function Psi (per node R), transformation into reciprocal grid space and we are back
146 * in the plane wave basis set as desired. CalculateAddNLPot() adds the non-local potential. Finally, the kinetic term
147 * is added up (simple in reciprocal space). The energy eigenvalue \a *Lambda is computed by summation over all reciprocal grid
148 * vectors and in the meantime also the gradient direction (negative derivative) stored in \a *grad while the old values
149 * are moved to \a *oldgrad. At last, \a *Lambda is summed up among all processes.
150 * \f[
151 * \varphi_i^{(m)} (G) = \frac{1}{2} |G|^2 c_{i,G} + \underbrace{V^H (G) + V^{ps,loc} (G)}_{+V^{HG} (G)} + V^{ps,nl} (G) | \psi_i (G) \rangle
152 * \qquad (\textnormal{end of section 4.5.2})
153 * \f]
154 * \param *P Problem at hand, contains Lattice and RunStruct
155 * \param *source source wave function coefficients
156 * \param PsiFactor occupation number, see Psis::PsiFactor
157 * \param *Lambda eigenvalue \f$\lambda_i = \langle \psi_i |h|\psi_i \rangle\f$, see OnePsiElementAddData::Lambda
158 * \param ***fnl non-local form factors over ion type, ion of type and reciprocal grid vector, see PseudoPot::fnl
159 * \param *grad return array for (negative) gradient coefficients \f$\varphi_i^{(m)} (G)\f$
160 * \param *oldgrad return array for (negative) gradient coefficients \f$\varphi_i^{(m-1)} (G)\f$
161 * \param *Hc_grad return array for complex coefficients of \f$H | \psi_i (G) \rangle\f$, see GradientArray#HcGradient
162 * \sa CalculateConDirHConDir() - similar calculation for another explanation.
163 */
164void CalculateGradientNoRT(struct Problem *P, fftw_complex *source, const double PsiFactor, double *Lambda, fftw_complex ***fnl, fftw_complex *grad, fftw_complex *oldgrad, fftw_complex *Hc_grad)
165{
166 struct Lattice *Lat = &P->Lat;
167 struct RunStruct *R = &P->R;
168 struct LatticeLevel *Lev0 = R->Lev0;
169 struct LatticeLevel *LevS = R->LevS;
170 struct Density *Dens0 = Lev0->Dens;
171 struct fft_plan_3d *plan = Lat->plan;
172 int Index, g;
173 fftw_complex *work = Dens0->DensityCArray[TempDensity];
174 fftw_real *HGcR = Dens0->DensityArray[HGcDensity];
175 fftw_complex *HGcRC = (fftw_complex*)HGcR;
176 fftw_complex *HGC = Dens0->DensityCArray[HGDensity];
177 fftw_real *HGCR = (fftw_real *)HGC;
178 fftw_complex *PsiC = Dens0->DensityCArray[ActualPsiDensity];
179 fftw_real *PsiCR = (fftw_real *)PsiC;
180 int nx,ny,nz,iS,i0,s;
181 const int Nx = LevS->Plan0.plan->local_nx;
182 const int Ny = LevS->Plan0.plan->N[1];
183 const int Nz = LevS->Plan0.plan->N[2];
184 const int NUpx = LevS->NUp[0];
185 const int NUpy = LevS->NUp[1];
186 const int NUpz = LevS->NUp[2];
187 double lambda;
188 const double HGcRCFactor = 1./LevS->MaxN;
189 SpeedMeasure(P, LocTime, StartTimeDo);
190 // back-transform HGDensity
191 fft_3d_complex_to_real(plan, Lev0->LevelNo, FFTNF1, HGC, work);
192 // evaluate exchange potential with this density, add up onto HGCR
193 //if (isnan(HGCR[0])) { fprintf(stderr,"WARNGING: CalculateGradientNoRT(): HGcR[%i]_%i = NaN!\n", 0, R->ActualLocalPsiNo); Error(SomeError, "NaN-Fehler!"); }
194 CalculateXCPotentialNoRT(P, HGCR); // add V^{xc} or \epsilon^{xc} upon V^H + V^{ps}
195 for (nx=0;nx<Nx;nx++)
196 for (ny=0;ny<Ny;ny++)
197 for (nz=0;nz<Nz;nz++) {
198 i0 = nz*NUpz+Nz*NUpz*(ny*NUpy+Ny*NUpy*nx*NUpx);
199 iS = nz+Nz*(ny+Ny*nx);
200 HGcR[iS] = HGCR[i0]*PsiCR[i0]; /* Matrix Vector Mult */
201 //if (isnan(HGCR[i0])) { fprintf(stderr,"WARNGING: CalculateGradientNoRT(): HGcR[%i]_%i = NaN!\n", i0, R->ActualLocalPsiNo); Error(SomeError, "NaN-Fehler!"); }
202 }
203 fft_3d_real_to_complex(plan, LevS->LevelNo, FFTNF1, HGcRC, work);
204 SpeedMeasure(P, LocTime, StopTimeDo);
205 /* NonLocalPP */
206 //SpeedMeasure(P, NonLocTime, StartTimeDo);
207 CalculateAddNLPot(P, Hc_grad, fnl, PsiFactor); // also resets Hc_grad beforehand
208 //SetArrayToDouble0((double *)Hc_grad,2*LevS->MaxG);
209 SpeedMeasure(P, NonLocTime, StopTimeDo);
210 /* Lambda und Grad */
211 for (g=0;g<LevS->MaxG;g++) {
212 Index = LevS->GArray[g].Index; /* FIXME - factoren */
213 Hc_grad[g].re += PsiFactor*(HGcRC[Index].re*HGcRCFactor + 0.5*LevS->GArray[g].GSq*source[g].re);
214 Hc_grad[g].im += PsiFactor*(HGcRC[Index].im*HGcRCFactor + 0.5*LevS->GArray[g].GSq*source[g].im);
215 //if (isnan(source[g].re)) { fprintf(stderr,"WARNGING: CalculateGradientNoRT(): source_%i(%i) = NaN!\n", R->ActualLocalPsiNo, g); Error(SomeError, "NaN-Fehler!"); }
216 }
217 if (grad != NULL) {
218 lambda = 0.0;
219 s = 0;
220 if (LevS->GArray[0].GSq == 0.0) {
221 lambda += Hc_grad[0].re*source[0].re + Hc_grad[0].im*source[0].im;
222 oldgrad[0].re = grad[0].re; // store away old preconditioned steepest decent gradient
223 oldgrad[0].im = grad[0].im;
224 grad[0].re = -Hc_grad[0].re;
225 grad[0].im = -Hc_grad[0].im;
226 s++;
227 }
228 for (g=s;g<LevS->MaxG;g++) {
229 lambda += 2.*(Hc_grad[g].re*source[g].re + Hc_grad[g].im*source[g].im);
230 oldgrad[g].re = grad[g].re; // store away old preconditioned steepest decent gradient
231 oldgrad[g].im = grad[g].im;
232 grad[g].re = -Hc_grad[g].re;
233 grad[g].im = -Hc_grad[g].im;
234 //if (isnan(Hc_grad[g].re)) { fprintf(stderr,"WARNGING: CalculateGradientNoRT(): Hc_grad_%i(%i) = NaN!\n", R->ActualLocalPsiNo, g); Error(SomeError, "NaN-Fehler!"); }
235 }
236 MPI_Allreduce ( &lambda, Lambda, 1, MPI_DOUBLE, MPI_SUM, P->Par.comm_ST_Psi);
237 //fprintf(stderr,"(%i) Lambda = %e\n",P->Par.me, *Lambda);
238 }
239}
240
241
242/** Calculates the Hamiltonian matrix in Kohn-Sham basis set and outputs to file.
243 * In a similiar manner to TestGramSch() all necessary coefficients are retrieved from the
244 * other processes and \f$\langle Psi_i | H | Psi_j \rangle\f$ = \f$\lambda_{i,j}\f$ calculated.
245 * \param *P Problem at hand
246 * \sa CalculateGradientNoRT() - same calculation (of \f$\lambda_i\f$), yet only for diagonal elements
247 */
248void CalculateHamiltonian(struct Problem *P) {
249 struct Lattice *Lat = &P->Lat;
250 struct FileData *F = &P->Files;
251 struct RunStruct *R = &P->R;
252 struct Psis *Psi = &Lat->Psi;
253 struct LatticeLevel *Lev0 = R->Lev0;
254 struct LatticeLevel *LevS = R->LevS;
255 //struct LevelPsi *LPsi = LevS->LPsi;
256 struct Density *Dens0 = Lev0->Dens;
257 int Index;
258 struct fft_plan_3d *plan = Lat->plan;
259 fftw_complex *work = Dens0->DensityCArray[TempDensity];
260 fftw_real *HGcR = Dens0->DensityArray[HGcDensity];
261 fftw_complex *HGcRC = (fftw_complex*)HGcR;
262 fftw_complex *HGC = Dens0->DensityCArray[HGDensity];
263 fftw_real *HGCR = (fftw_real *)HGC;
264 fftw_complex *PsiC = Dens0->DensityCArray[ActualPsiDensity];
265 fftw_real *PsiCR = (fftw_real *)PsiC;
266 fftw_complex ***fnl;
267 fftw_complex *Hc_grad = P->Grad.GradientArray[HcGradient];
268 int nx,ny,nz,iS,i0,s;
269 const int Nx = LevS->Plan0.plan->local_nx;
270 const int Ny = LevS->Plan0.plan->N[1];
271 const int Nz = LevS->Plan0.plan->N[2];
272 const int NUpx = LevS->NUp[0];
273 const int NUpy = LevS->NUp[1];
274 const int NUpz = LevS->NUp[2];
275 double lambda, Lambda;
276 const double HGcRCFactor = 1./LevS->MaxN;
277 double pot_xc, Pot_xc;
278 int PsiFactorA = 1;
279 int PsiFactorB = 1;
280 int NoPsis = 0;
281 int NoOfPsis = 0;
282
283 if (P->Call.out[LeaderOut])
284 fprintf(stderr, "(%i)Setting up Hamiltonian for Level %d...",P->Par.me, LevS->LevelNo);
285 if (P->Call.out[StepLeaderOut])
286 fprintf(stderr, "\n(%i) H = \n",P->Par.me);
287
288 ApplyTotalHamiltonian(P,LevS->LPsi->LocalPsi[0],Hc_grad, P->PP.fnl[0], 1., 1); // update HGDensity->
289
290 // go through all pairs of orbitals
291 int i,k,l,m,j=0,RecvSource;
292 MPI_Status status;
293 struct OnePsiElement *OnePsiB, *OnePsiA, *LOnePsiA, *LOnePsiB;
294 int ElementSize = (sizeof(fftw_complex) / sizeof(double));
295 fftw_complex *LPsiDatA=NULL, *LPsiDatB;
296
297 l = -1;
298 switch (Psi->PsiST) {
299 case SpinDouble:
300 NoOfPsis = NoPsis = Psi->GlobalNo[PsiMaxNoDouble];
301 NoOfPsis += Psi->GlobalNo[PsiMaxAdd];
302 break;
303 case SpinUp:
304 NoOfPsis = NoPsis = Psi->GlobalNo[PsiMaxNoUp];
305 NoOfPsis += Psi->GlobalNo[PsiMaxAdd];
306 break;
307 case SpinDown:
308 NoOfPsis = NoPsis = Psi->GlobalNo[PsiMaxNoDown];
309 NoOfPsis += Psi->GlobalNo[PsiMaxAdd];
310 break;
311 };
312 gsl_matrix *H = gsl_matrix_calloc(NoOfPsis,NoOfPsis);
313 for (i=0; i < Psi->MaxPsiOfType+P->Par.Max_me_comm_ST_PsiT; i++) { // go through all wave functions
314 //fprintf(stderr,"(%i) GlobalNo: %d\tLocalNo: %d\n", P->Par.me,Psi->AllPsiStatus[i].MyGlobalNo,Psi->AllPsiStatus[i].MyLocalNo);
315 OnePsiA = &Psi->AllPsiStatus[i]; // grab OnePsiA
316 if (OnePsiA->PsiType <= UnOccupied) { // drop the extra and perturbed ones
317 l++;
318 if (OnePsiA->my_color_comm_ST_Psi == P->Par.my_color_comm_ST_Psi) // local?
319 LOnePsiA = &Psi->LocalPsiStatus[OnePsiA->MyLocalNo];
320 else
321 LOnePsiA = NULL;
322 if (LOnePsiA == NULL) { // if it's not local ... receive it from respective process into TempPsi
323 RecvSource = OnePsiA->my_color_comm_ST_Psi;
324 MPI_Recv( LevS->LPsi->TempPsi, LevS->MaxG*ElementSize, MPI_DOUBLE, RecvSource, HamiltonianTag, P->Par.comm_ST_PsiT, &status );
325 LPsiDatA=LevS->LPsi->TempPsi;
326 } else { // .. otherwise send it to all other processes (Max_me... - 1)
327 for (k=0;k<P->Par.Max_me_comm_ST_PsiT;k++)
328 if (k != OnePsiA->my_color_comm_ST_Psi)
329 MPI_Send( LevS->LPsi->LocalPsi[OnePsiA->MyLocalNo], LevS->MaxG*ElementSize, MPI_DOUBLE, k, HamiltonianTag, P->Par.comm_ST_PsiT);
330 LPsiDatA=LevS->LPsi->LocalPsi[OnePsiA->MyLocalNo];
331 } // LPsiDatA is now set to the coefficients of OnePsi either stored or MPI_Received
332
333 if (LOnePsiA != NULL) { // if fnl (!) are locally available!
334 // Trick is: fft wave function by moving it to higher level and there take only each ...th element into account
335 PsiFactorA = 1; //Psi->LocalPsiStatus[OnePsiA->MyLocalNo].PsiFactor;
336 CalculateOneDensityR(Lat, LevS, Dens0, LPsiDatA, Dens0->DensityArray[ActualDensity], R->FactorDensityR*PsiFactorA, 1);
337 // note: factor is not used when storing result in DensityCArray[ActualPsiDensity] in CalculateOneDensityR()!
338 for (nx=0;nx<Nx;nx++)
339 for (ny=0;ny<Ny;ny++)
340 for (nz=0;nz<Nz;nz++) {
341 i0 = nz*NUpz+Nz*NUpz*(ny*NUpy+Ny*NUpy*nx*NUpx);
342 iS = nz+Nz*(ny+Ny*nx);
343 HGcR[iS] = HGCR[i0]*PsiCR[i0]; /* Matrix Vector Mult */
344 }
345 // V^{HG} (R) + V^{XC} (R) | \Psi_b (R) \rangle
346 fft_3d_real_to_complex(plan, LevS->LevelNo, FFTNF1, HGcRC, work);
347 // V^{HG} (G) + V^{XC} (G) | \Psi_b (G) \rangle
348 /* NonLocalPP */
349 fnl = P->PP.fnl[OnePsiA->MyLocalNo]; // fnl only locally available!
350 CalculateAddNLPot(P, Hc_grad, fnl, PsiFactorA); // sets Hc_grad to zero beforehand
351 // V^{ps,nl} (G)| \Psi_b (G) + [V^{HG} (G) + V^{XC} (G)] | \Psi_b (G) \rangle
352 /* Lambda und Grad */
353 s = 0;
354 if (LevS->GArray[0].GSq == 0.0) {
355 Index = LevS->GArray[0].Index; /* FIXME - factoren */
356 Hc_grad[0].re += PsiFactorA*(HGcRC[Index].re*HGcRCFactor + 0.5*LevS->GArray[0].GSq*LPsiDatA[0].re);
357 Hc_grad[0].im += PsiFactorA*(HGcRC[Index].im*HGcRCFactor + 0.5*LevS->GArray[0].GSq*LPsiDatA[0].im);
358 s++;
359 }
360 for (;s<LevS->MaxG;s++) {
361 Index = LevS->GArray[s].Index; /* FIXME - factoren */
362 Hc_grad[s].re += PsiFactorA*(HGcRC[Index].re*HGcRCFactor + 0.5*LevS->GArray[s].GSq*LPsiDatA[s].re);
363 Hc_grad[s].im += PsiFactorA*(HGcRC[Index].im*HGcRCFactor + 0.5*LevS->GArray[s].GSq*LPsiDatA[s].im);
364 }
365 // 1/2 |G|^2 + V^{ps,nl} (G) + V^{HG} (G) + V^{XC} (G) | \Psi_b (G) \rangle
366 } else {
367 SetArrayToDouble0((double *)Hc_grad,2*LevS->MaxG);
368 }
369
370 m = -1;
371 // former border of following loop: Psi->GlobalNo[Psi->PsiST+1]+Psi->GlobalNo[Psi->PsiST+4]+P->Par.Max_me_comm_ST_PsiT
372 for (j=0; j < Psi->MaxPsiOfType+P->Par.Max_me_comm_ST_PsiT; j++) { // go through all wave functions
373 OnePsiB = &Psi->AllPsiStatus[j]; // grab OnePsiA
374 if (OnePsiB->PsiType <= UnOccupied) { // drop the extra ones
375 m++;
376 if (OnePsiB->my_color_comm_ST_Psi == P->Par.my_color_comm_ST_Psi) // local?
377 LOnePsiB = &Psi->LocalPsiStatus[OnePsiB->MyLocalNo];
378 else
379 LOnePsiB = NULL;
380 if (LOnePsiB == NULL) { // if it's not local ... receive it from respective process into TempPsi
381 RecvSource = OnePsiB->my_color_comm_ST_Psi;
382 MPI_Recv( LevS->LPsi->TempPsi, LevS->MaxG*ElementSize, MPI_DOUBLE, RecvSource, HamiltonianTag, P->Par.comm_ST_PsiT, &status );
383 LPsiDatB=LevS->LPsi->TempPsi;
384 } else { // .. otherwise send it to all other processes (Max_me... - 1)
385 for (k=0;k<P->Par.Max_me_comm_ST_PsiT;k++)
386 if (k != OnePsiB->my_color_comm_ST_Psi)
387 MPI_Send( LevS->LPsi->LocalPsi[OnePsiB->MyLocalNo], LevS->MaxG*ElementSize, MPI_DOUBLE, k, HamiltonianTag, P->Par.comm_ST_PsiT);
388 LPsiDatB=LevS->LPsi->LocalPsi[OnePsiB->MyLocalNo];
389 } // LPsiDatB is now set to the coefficients of OnePsi either stored or MPI_Received
390
391 PsiFactorB = 1; //Psi->LocalPsiStatus[OnePsiB->MyLocalNo].PsiFactor;
392 lambda = 0; //PsiFactorB * GradSP(P, LevS, LPsiDatB, Hc_grad);
393 Lambda = 0;
394 s=0;
395 if (LevS->GArray[0].GSq == 0.0) {
396 lambda += GSL_REAL(gsl_complex_mul(gsl_complex_conjugate(convertComplex(LPsiDatB[s])), convertComplex(Hc_grad[s])));
397 s++;
398 }
399 for (; s < LevS->MaxG; s++) {
400 lambda += GSL_REAL(gsl_complex_mul(gsl_complex_conjugate(convertComplex(LPsiDatB[s])), convertComplex(Hc_grad[s])));
401 lambda += GSL_REAL(gsl_complex_mul(convertComplex(LPsiDatB[s]), gsl_complex_conjugate(convertComplex(Hc_grad[s])))); // c(-G) = c^\ast (G) due to gamma point symmetry !
402 } // due to the symmetry the resulting lambda is both real and symmetric in l,m (i,j) !
403 lambda *= PsiFactorB;
404 // \langle \Psi_a | 1/2 |G|^2 + V^{ps,nl} (G) + V^{HG} (G) + V^{XC} (G) | \Psi_b (G) \rangle
405 MPI_Allreduce ( &lambda, &Lambda, 1, MPI_DOUBLE, MPI_SUM, P->Par.comm_ST); // gather from all(!) (coeffs- and Psis-sharing) groups
406
407 //if (P->Par.me == 0) {
408 // and Output
409 if (P->Call.out[StepLeaderOut])
410 fprintf(stderr,"%2.5lg\t",Lambda);
411 if (P->Par.me == 0) fprintf(F->HamiltonianFile, "%lg\t", Lambda);
412 //}
413 if (m < NoOfPsis && l < NoOfPsis) {
414 //fprintf(stderr,"Index (%i/%i,%i/%i): %e \n",l,NoOfPsis,m,NoOfPsis, Lambda);
415 gsl_matrix_set(H,l,m,Lambda);
416 } else
417 fprintf(stderr,"Index (%i,%i) out of range %i\n",l,m,NoOfPsis);
418 }
419 if ((P->Par.me == 0) && (j == NoOfPsis-1))
420 fprintf(F->HamiltonianFile, "\n");
421 if ((P->Call.out[StepLeaderOut]) && (j == NoOfPsis-1))
422 fprintf(stderr,"\n");
423 }
424 }
425 }
426 if (P->Par.me == 0) {
427 fprintf(F->HamiltonianFile, "\n");
428 fflush(F->HamiltonianFile);
429 }
430 if ((P->Call.out[LeaderOut]) && (!P->Call.out[StepLeaderOut])) {
431 fprintf(stderr,"finished.\n");
432 }
433
434 // storing H matrix for latter use in perturbed calculation
435 for (i=0;i<Psi->NoOfPsis;i++)
436 for (j=0;j<Psi->NoOfPsis;j++)
437 Psi->lambda[i][j] = gsl_matrix_get(H,i,j);
438
439 // retrieve EW from H
440 gsl_vector *eval = gsl_vector_alloc(NoOfPsis);
441 gsl_eigen_symm_workspace *w = gsl_eigen_symm_alloc(NoOfPsis);
442 gsl_eigen_symm(H, eval, w);
443 gsl_eigen_symm_free(w);
444 gsl_matrix_free(H);
445
446 // print eigenvalues
447 if(P->Call.out[LeaderOut]) {
448 fprintf(stderr,"(%i) Unsorted Eigenvalues:", P->Par.me);
449 for (i=0;i<NoOfPsis;i++)
450 fprintf(stderr,"\t%lg",gsl_vector_get(eval,i));
451 fprintf(stderr,"\n");
452 }
453 gsl_sort_vector(eval); // sort eigenvalues
454 // print eigenvalues
455 if(P->Call.out[LeaderOut]) {
456 fprintf(stderr,"(%i) All Eigenvalues:", P->Par.me);
457 for (i=0;i<NoOfPsis;i++)
458 fprintf(stderr,"\t%lg",gsl_vector_get(eval,i));
459 fprintf(stderr,"\n");
460 fprintf(stderr,"(%i) KS Eigenvalues:", P->Par.me);
461 for (i=0;i<NoOfPsis;i++)
462 fprintf(stderr,"\t%lg",Psi->AddData[i].Lambda);
463 fprintf(stderr,"\n");
464 }
465
466 // print difference between highest occupied and lowest unoccupied
467 if (P->Lat.Psi.GlobalNo[PsiMaxAdd] != 0) {
468 Lat->Energy[UnOccupied].bandgap = gsl_vector_get(eval, Psi->NoOfPsis) - gsl_vector_get(eval, Psi->NoOfPsis-1);
469 if (P->Call.out[NormalOut])
470 fprintf(stderr,"(%i) Band gap: \\epsilon_{%d+%d}(%d+1) - \\epsilon_{%d+%d}(%d) = %lg Ht\n", P->Par.me, NoPsis,P->Lat.Psi.GlobalNo[PsiMaxAdd],NoPsis, NoPsis, P->Lat.Psi.GlobalNo[PsiMaxAdd], NoPsis, Lat->Energy[UnOccupied].bandgap);
471 }
472 // now, calculate \int v_xc (r) n(r) d^3r
473 SetArrayToDouble0((double *)HGCR,2*Dens0->TotalSize);
474 CalculateXCPotentialNoRT(P, HGCR); /* FIXME - kann man halbieren */
475 pot_xc = 0;
476 Pot_xc = 0;
477 for (i=0;i<Dens0->LocalSizeR;i++)
478 pot_xc += HGCR[i]*Dens0->DensityArray[TotalDensity][i];
479 MPI_Allreduce ( &pot_xc, &Pot_xc, 1, MPI_DOUBLE, MPI_SUM, P->Par.comm_ST_Psi);
480 if (P->Call.out[StepLeaderOut]) {
481 fprintf(stderr,"(%i) Exchange-Correlation potential energy: \\int v_xc[n] (r) n(r) d^3r = %lg\n", P->Par.me, HGcRCFactor*Pot_xc*Lat->Volume);
482 }
483 gsl_vector_free(eval);
484}
485
486
487/** Calculation of direction of steepest descent.
488 * The Gradient has been evaluated in CalculateGradient(). Now the SD-direction
489 * \f$\zeta_i = - (H-\lambda_i)\psi_i\f$ is stored in
490 * Gradient::GradientArray[GradientTypes#GraSchGradient].
491 * Afterwards, the "extra" local Psi (which is the above gradient) is orthogonalized
492 * under exclusion of the to be minimialized Psi to ascertain Orthonormality of this
493 * gradient with respect to all other states/orbits.
494 * \param *P Problem at hand, contains Lattice and RunStruct
495 * \param *source source wave function coefficients, \f$\psi_i\f$
496 * \param *grad gradient coefficients, see CalculateGradient(), on return contains conjugate gradient coefficients, \f$\varphi_i^{(m)}\f$
497 * \param *Lambda eigenvalue \f$\lambda_i\f$ = \f$\langle \psi_i^{(m)}|H|\psi_i^{(m)} \rangle\f$
498 * \warning coefficients in \a *grad are overwritten
499 */
500static void CalculateCGGradient(struct Problem *P, fftw_complex *source, fftw_complex *grad, double Lambda)
501{
502 struct Lattice *Lat = &P->Lat;
503 struct RunStruct *R = &P->R;
504 struct Psis *Psi = &Lat->Psi;
505 struct LatticeLevel *LevS = R->LevS;
506 fftw_complex *GradOrtho = P->Grad.GradientArray[GraSchGradient];
507 int g;
508 int ElementSize = (sizeof(fftw_complex) / sizeof(double));
509 for (g=0;g<LevS->MaxG;g++) {
510 GradOrtho[g].re = grad[g].re+Lambda*source[g].re;
511 GradOrtho[g].im = grad[g].im+Lambda*source[g].im;
512 }
513 // include the ExtraPsi (which is the GraSchGradient!)
514 SetGramSchExtraPsi(P, Psi, NotOrthogonal);
515 // exclude the minimised Psi
516 SetGramSchActualPsi(P, Psi, NotUsedToOrtho);
517 SpeedMeasure(P, GramSchTime, StartTimeDo);
518 // makes conjugate gradient orthogonal to all other orbits
519 //fprintf(stderr,"CalculateCGGradient: GramSch() for extra orbital\n");
520 GramSch(P, LevS, Psi, Orthogonalize);
521 SpeedMeasure(P, GramSchTime, StopTimeDo);
522 SetGramSchActualPsi(P, Psi, IsOrthonormal);
523 memcpy(grad, GradOrtho, ElementSize*LevS->MaxG*sizeof(double));
524}
525
526/** Preconditioning for the gradient calculation.
527 * A suitable matrix for preconditioning is [TPA89]
528 * \f[
529 * M_{G,G'} = \delta_{G,G'} \frac{27+18x+12x^2+8x^3}{27+18x+12x^2+8x^3+16x^4} \qquad (5.3)
530 * \f]
531 * where \f$x= \frac{\langle \xi_G|-\frac{1}{2}\nabla^2|\xi_G \rangle}
532 * {\langle \psi_i^{(m)}|-\frac{1}{2}\nabla^2|\psi_i^{(m)} \rangle}\f$.
533 * (This simple form is due to the diagonal dominance of the kinetic term in Hamiltonian, and
534 * x is much simpler to evaluate in reciprocal space!)
535 * With this one the higher plane wave states are being transformed such that they
536 * nearly equal the error vector and converge at an equal rate.
537 * So that the new steepest descent direction is \f$M \tilde{\zeta}_i\f$.
538 * Afterwards, the new direction is orthonormalized via GramSch() and the "extra"
539 * local Psi in a likewise manner to CalculateCGGradient().
540 *
541 * \param *P Problem at hand, contains LatticeLevel and RunStruct
542 * \param *grad array of steepest descent coefficients, \f$\varphi_i^{(m)}\f$
543 * \param *PCgrad return array for preconditioned steepest descent coefficients, \f$\tilde{\varphi}_i^{(m)}\f$
544 * \param T kinetic eigenvalue \f$\langle \psi_i | - \frac{1}{2} \nabla^2 | \psi_i \rangle\f$
545 */
546static void CalculatePreConGrad(struct Problem *P, fftw_complex *grad, fftw_complex *PCgrad, double T)
547{
548 struct RunStruct *R = &P->R;
549 struct LatticeLevel *LevS = R->LevS;
550 int g;
551 double x, K, dK;
552 struct Psis *Psi = &P->Lat.Psi;
553 fftw_complex *PCOrtho = P->Grad.GradientArray[GraSchGradient];
554 int ElementSize = (sizeof(fftw_complex) / sizeof(double));
555 if (fabs(T) < MYEPSILON) T = 1;
556 for (g=0;g<LevS->MaxG;g++) {
557 x = LevS->GArray[g].GSq;
558 x /= T;
559 K = (((8*x+12)*x +18)*x+27);
560 dK = ((((16*x+8)*x +12)*x+18)*x+27);
561 K /= dK;
562 c_re(PCOrtho[g]) = K*c_re(grad[g]);
563 c_im(PCOrtho[g]) = K*c_im(grad[g]);
564 }
565 SetGramSchExtraPsi(P, Psi, NotOrthogonal);
566 SpeedMeasure(P, GramSchTime, StartTimeDo);
567 // preconditioned direction is orthogonalized
568 //fprintf(stderr,"CalculatePreConGrad: GramSch() for extra orbital\n");
569 GramSch(P, LevS, Psi, Orthogonalize);
570 SpeedMeasure(P, GramSchTime, StopTimeDo);
571 memcpy(PCgrad, PCOrtho, ElementSize*LevS->MaxG*sizeof(double));
572}
573
574/** Calculation of conjugate direction.
575 * The new conjugate direction is according to the algorithm of Fletcher-Reeves:
576 * \f[
577 * \varphi^{(m)}_i =
578 * \tilde{\eta}^{(m)}_i + \frac{\langle \tilde{\eta}^{(m)}_i | \tilde{\varphi}_i^{(m)} \rangle}{\langle \tilde{\eta}^{(m-1)}_i | \tilde{\varphi}_i^{(m-1)} \rangle} \varphi_i^{(m-1)}
579 * \f]
580 * Instead we use the algorithm of Polak-Ribiere:
581 * \f[
582 * \varphi^{(m)}_i =
583 * \tilde{\eta}^{(m)}_i + \frac{\langle \tilde{\eta}^{(m)}_i | \bigl (\tilde{\varphi}_i^{(m)} \rangle - \tilde{\varphi}_i^{(m-1)} \rangle \bigr)}{\langle \tilde{\eta}^{(m-1)}_i | \tilde{\varphi}_i^{(m-1)} \rangle} \varphi_i^{(m-1)}
584 * \f]
585 * with an additional automatic restart:
586 * \f[
587 * \varphi^{(m)}_i = \tilde{\eta}^{(m)}_i \quad \textnormal{if}\ \frac{\langle \tilde{\eta}^{(m)}_i | \bigl (\tilde{\varphi}_i^{(m)} \rangle - \tilde{\varphi}_i^{(m-1)} \rangle \bigr)}{\langle \tilde{\eta}^{(m-1)}_i | \tilde{\varphi}_i^{(m-1)} \rangle} <= 0
588 * \f]
589 * That's why ConDirGradient and OldConDirGradient are stored, the scalar product - summed up among all processes -
590 * is saved in OnePsiAddData::Gamma. The conjugate direction is again orthonormalized by GramSch() and stored
591 * in \a *ConDir.
592 * \param *P Problem at hand, containing LatticeLevel and RunStruct
593 * \param step minimisation step m
594 * \param *GammaDiv scalar product \f$\langle \tilde{\eta}^{(m-1)}_i | \tilde{\varphi}_i^{(m-1)} \rangle\f$, on calling expects (m-1), on return contains (m)
595 * \param *grad array for coefficients of steepest descent direction \f$\tilde{\zeta}_i^{(m)}\f$
596 * \param *oldgrad array for coefficients of steepest descent direction of \a step-1 \f$\tilde{\zeta}_i^{(m-1)}\f$
597 * \param *PCgrad array for coefficients of preconditioned steepest descent direction \f$\tilde{\eta}_i^{(m)}\f$
598 * \param *ConDir return array for coefficients of conjugate array of \a step, \f$\tilde{\varphi}_i^{(m)}\f$ = \f$\frac{\tilde{\varphi}_i^{(m)}} {||\tilde{\varphi}_i^{(m)}||}\f$
599 * \param *ConDir_old array for coefficients of conjugate array of \a step-1, \f$\tilde{\varphi}_i^{(m-1)}\f$
600 */
601static void CalculateConDir(struct Problem *P, int step, double *GammaDiv,
602 fftw_complex *grad,
603 fftw_complex *oldgrad,
604 fftw_complex *PCgrad,
605 fftw_complex *ConDir, fftw_complex *ConDir_old) {
606 struct RunStruct *R = &P->R;
607 struct LatticeLevel *LevS = R->LevS;
608 struct Psis *Psi = &P->Lat.Psi;
609 fftw_complex *Ortho = P->Grad.GradientArray[GraSchGradient];
610 int ElementSize = (sizeof(fftw_complex) / sizeof(double));
611 int g;
612 double S[3], Gamma, GammaDivOld = *GammaDiv;
613 double LocalSP[2], PsiSP[2];
614 LocalSP[0] = GradSP(P, LevS, PCgrad, grad);
615 LocalSP[1] = GradSP(P, LevS, PCgrad, oldgrad);
616
617 MPI_Allreduce ( LocalSP, PsiSP, 2, MPI_DOUBLE, MPI_SUM, P->Par.comm_ST_Psi);
618 *GammaDiv = S[0] = PsiSP[0];
619 S[1] = GammaDivOld;
620 S[2] = PsiSP[1];
621 if (step) { // only in later steps is the scalar product used, but always condir stored in oldcondir and Ortho (working gradient)
622 if (fabs(S[1]) < MYEPSILON) fprintf(stderr,"CalculateConDir: S[1] = %lg\n",S[1]);
623 Gamma = (S[0]-S[2])/S[1]; // the final CG beta coefficient (Polak-Ribiere)
624 if (fabs(S[1]) < MYEPSILON) {
625 if (fabs((S[0]-S[2])) < MYEPSILON)
626 Gamma = 1.0;
627 else
628 Gamma = 0.0;
629 }
630 if (Gamma < 0) { // Polak-Ribiere with automatic restart: gamma = max {0, gamma}
631 Gamma = 0.;
632 if (P->Call.out[StepLeaderOut]) fprintf(stderr,"(%i) Polak-Ribiere: Restarting iteration by setting gamma = 0.\n", P->Par.me);
633 }
634 for (g=0; g < LevS->MaxG; g++) {
635 c_re(ConDir[g]) = c_re(PCgrad[g]) + Gamma*c_re(ConDir_old[g]);
636 c_im(ConDir[g]) = c_im(PCgrad[g]) + Gamma*c_im(ConDir_old[g]);
637 c_re(ConDir_old[g]) = c_re(ConDir[g]);
638 c_im(ConDir_old[g]) = c_im(ConDir[g]);
639 c_re(Ortho[g]) = c_re(ConDir[g]);
640 c_im(Ortho[g]) = c_im(ConDir[g]);
641 }
642 } else {
643 Gamma = 0.0;
644 for (g=0; g < LevS->MaxG; g++) {
645 c_re(ConDir[g]) = c_re(PCgrad[g]);
646 c_im(ConDir[g]) = c_im(PCgrad[g]);
647 c_re(ConDir_old[g]) = c_re(ConDir[g]);
648 c_im(ConDir_old[g]) = c_im(ConDir[g]);
649 c_re(Ortho[g]) = c_re(ConDir[g]);
650 c_im(Ortho[g]) = c_im(ConDir[g]);
651 }
652 }
653 // orthonormalize
654 SetGramSchExtraPsi(P, Psi, NotOrthogonal);
655 SpeedMeasure(P, GramSchTime, StartTimeDo);
656 //fprintf(stderr,"CalculateConDir: GramSch() for extra orbital\n");
657 GramSch(P, LevS, Psi, Orthonormalize);
658 SpeedMeasure(P, GramSchTime, StopTimeDo);
659 memcpy(ConDir, Ortho, ElementSize*LevS->MaxG*sizeof(double));
660}
661
662/** Calculation of \f$\langle \widetilde{\widetilde{\varphi}}_i^{(m)}|H|\widetilde{\widetilde{\varphi}}_i^{(m)} \rangle\f$.
663 * Evaluates most of the parts of the second derivative of the energy functional \f$\frac{\delta^2 E}{\delta \Theta^2}|_{\Theta=0}\f$,
664 * most importantly the energy expection value of the conjugate direction.
665 * \f[
666 * \langle \widetilde{\widetilde{\varphi}}_i^{(m)} (G) | -\frac{1}{2} \nabla^2 + \underbrace{V^H (G) + V^{ps,loc} (G)}_{=V^{HG}(G)} + V^{ps,nl} | \widetilde{\widetilde{\varphi}} (G) \rangle
667 * \f]
668 * The conjugate direction coefficients \f$\varphi_i^{(m)} (G)\f$ are fftransformed to \f$\varphi_i^{(m)} (R)\f$,
669 * times the DoubleDensityTypes#HGDensity \f$V^{HG} (R) \f$we have the first part,
670 * then \f$\rho (R) = 2\frac{f_i}{V} \Re (\varphi_i^{(m)} (R) \cdot \psi_i (R))\f$is evaluated,
671 * HGDensity is fftransformed to \f$V^{HG} | \varphi_i^{(m)} (G) \rangle\f$,
672 * CalculateAddNLPot() adds non-local potential \f$V^{ps,nl} (G)\f$ to it,
673 * kinetic term is added in the reciprocal base as well \f$-\frac{1}{2} |G|^2\f$,
674 * and at last scalar product between it and the conjugate direction, and done.
675 *
676 * Meanwhile the fftransformed ConDir density \f$\rho (R)\f$ is used for the ddEddt0s \f$A_H\f$, \f$A_{XC}\f$.
677 * In case of RunStruct::DoCalcCGGauss in the following expression additionally \f$\hat{n}^{Gauss}\f$
678 * is evaluted, otherwise left out:
679 * \f[
680 * A^H = \frac{4\pi}{V} \sum_G \frac{|\frac{\rho(G)}{V^2 N} + \hat{n}^{Gauss}|}{|G|^2}
681 * \qquad (\textnormal{section 5.1, line search})
682 * \f]
683 * \param *P Problem at hand
684 * \param *ConDir conjugate direction \f$\tilde{\tilde{\varphi}}_i^{(m)}\f$
685 * \param PsiFactor occupation number, see Psis::PsiFactor
686 * \param *ConDirHConDir first return value: energy expectation value for conjugate direction
687 * \param *HartreeddEddt0 second return value: second derivative of Hartree energy \f$A_H\f$
688 * \param *XCddEddt0 third return value: second derivative of exchange correlation energy \f$A_{XC}\f$
689 * \warning The MPI_Allreduce for the scalar product in the end has not been done!
690 * \sa CalculateLineSearch() - used there
691 */
692void CalculateConDirHConDir(struct Problem *P, fftw_complex *ConDir, const double PsiFactor,
693 double *ConDirHConDir, double *HartreeddEddt0, double *XCddEddt0)
694{
695 struct Lattice *Lat = &P->Lat;
696 struct PseudoPot *PP = &P->PP;
697 struct RunStruct *R = &P->R;
698 struct LatticeLevel *Lev0 = R->Lev0;
699 struct LatticeLevel *LevS = R->LevS;
700 struct Density *Dens0 = Lev0->Dens;
701 int Index, g, i, pos, s=0;
702 struct fft_plan_3d *plan = Lat->plan;
703 fftw_complex *work = Dens0->DensityCArray[TempDensity];
704 fftw_real *PsiCD = (fftw_real *)work;
705 fftw_complex *PsiCDC = work;
706 fftw_real *PsiR = (fftw_real *)Dens0->DensityCArray[ActualPsiDensity];
707 fftw_complex *tempdestRC = (fftw_complex *)Dens0->DensityArray[TempDensity];
708 fftw_real *HGCDR = Dens0->DensityArray[HGcDensity];
709 fftw_complex *HGCDRC = (fftw_complex*)HGCDR;
710 fftw_complex *HGC = Dens0->DensityCArray[HGDensity];
711 fftw_real *HGCR = (fftw_real *)HGC;
712 fftw_complex *posfac, *destpos, *destRCS, *destRCD;
713 const double HartreeFactorR = 2.*R->FactorDensityR*PsiFactor;
714 double HartreeFactorC = 4.*PI*Lat->Volume;
715 double HartreeFactorCGauss = 1./Lev0->MaxN; //R->FactorDensityC*R->HGcFactor/Lev0->MaxN; // same expression as first and second factor cancel each other
716 int nx,ny,nz,iS,i0;
717 const int Nx = LevS->Plan0.plan->local_nx;
718 const int Ny = LevS->Plan0.plan->N[1];
719 const int Nz = LevS->Plan0.plan->N[2];
720 const int NUpx = LevS->NUp[0];
721 const int NUpy = LevS->NUp[1];
722 const int NUpz = LevS->NUp[2];
723 const double HGcRCFactor = 1./LevS->MaxN;
724 fftw_complex *HConDir = P->Grad.GradientArray[TempGradient];
725 int DoCalcCGGauss = R->DoCalcCGGauss;
726 fftw_complex rp, rhog;
727 int it;
728 struct Ions *I = &P->Ion;
729
730 /* ConDir H ConDir */
731 // (G)->(R): retrieve density from wave functions into PsiCD in the usual manner (yet within the same level!) (see CalculateOneDensityR())
732 SetArrayToDouble0((double *)tempdestRC, Dens0->TotalSize*2);
733 for (i=0;i<LevS->MaxG;i++) {
734 Index = LevS->GArray[i].Index;
735 posfac = &LevS->PosFactorUp[LevS->MaxNUp*i];
736 destpos = &tempdestRC[LevS->MaxNUp*Index];
737 for (pos=0; pos < LevS->MaxNUp; pos++) {
738 destpos[pos].re = ConDir[i].re*posfac[pos].re-ConDir[i].im*posfac[pos].im;
739 destpos[pos].im = ConDir[i].re*posfac[pos].im+ConDir[i].im*posfac[pos].re;
740 }
741 }
742 for (i=0; i<LevS->MaxDoubleG; i++) {
743 destRCS = &tempdestRC[LevS->DoubleG[2*i]*LevS->MaxNUp];
744 destRCD = &tempdestRC[LevS->DoubleG[2*i+1]*LevS->MaxNUp];
745 for (pos=0; pos < LevS->MaxNUp; pos++) {
746 destRCD[pos].re = destRCS[pos].re;
747 destRCD[pos].im = -destRCS[pos].im;
748 }
749 }
750 fft_3d_complex_to_real(plan, LevS->LevelNo, FFTNFUp, tempdestRC, work);
751 DensityRTransformPos(LevS,(fftw_real*)tempdestRC, PsiCD);
752 // HGCR contains real(!) HGDensity from CalculateGradientNoRT() !
753 for (nx=0;nx<Nx;nx++)
754 for (ny=0;ny<Ny;ny++)
755 for (nz=0;nz<Nz;nz++) {
756 i0 = nz*NUpz+Nz*NUpz*(ny*NUpy+Ny*NUpy*nx*NUpx);
757 iS = nz+Nz*(ny+Ny*nx);
758 HGCDR[iS] = HGCR[i0]*PsiCD[i0]; /* Matrix Vector Mult */
759 }
760 // now we have V^HG + V^XC | \varphi \rangle
761 /*
762 Hartree & Exchange Correlaton ddt0
763 */
764 for (i=0; i<Dens0->LocalSizeR; i++)
765 PsiCD[i] *= HartreeFactorR*PsiR[i]; // is rho(r) = PsiFactor times \psi_i is in PsiR times 1/V times \varphi_i^{(m)}
766 *XCddEddt0 = CalculateXCddEddt0NoRT(P, PsiCD); // calcs A^{XC}
767 fft_3d_real_to_complex(plan, Lev0->LevelNo, FFTNF1, PsiCDC, tempdestRC);
768 s = 0;
769 *HartreeddEddt0 = 0.0;
770 if (Lev0->GArray[0].GSq == 0.0)
771 s++;
772 if (DoCalcCGGauss) { // this part is wrong, n^Gauss is not part of HartreeddEddt0 (only appears in 2*(<phi_i| H |phi_i> - ...))
773 for (g=s; g < Lev0->MaxG; g++) {
774 Index = Lev0->GArray[g].Index;
775 rp.re = 0.0; rp.im = 0.0;
776 for (it = 0; it < I->Max_Types; it++) {
777 c_re(rp) += (c_re(I->I[it].SFactor[g])*PP->FacGauss[it][g]);
778 c_im(rp) += (c_im(I->I[it].SFactor[g])*PP->FacGauss[it][g]);
779 }
780 c_re(rhog) = c_re(PsiCDC[Index])*HartreeFactorCGauss+c_re(rp);
781 c_im(rhog) = c_im(PsiCDC[Index])*HartreeFactorCGauss+c_im(rp);
782 if (Lev0->GArray[g].GSq < MYEPSILON) fprintf(stderr,"CalculateConDirHConDir: Lev0->GArray[g].GSq = %lg",Lev0->GArray[g].GSq);
783 *HartreeddEddt0 += (c_re(rhog)*c_re(rhog)+c_im(rhog)*c_im(rhog))/(Lev0->GArray[g].GSq);
784 }
785 } else {
786 HartreeFactorC *= HartreeFactorCGauss*HartreeFactorCGauss;
787 for (g=s; g < Lev0->MaxG; g++) {
788 Index = Lev0->GArray[g].Index;
789 if (Lev0->GArray[g].GSq < MYEPSILON) fprintf(stderr,"CalculateConDirHConDir: Lev0->GArray[g].GSq = %lg",Lev0->GArray[g].GSq);
790 *HartreeddEddt0 += (c_re(PsiCDC[Index])*c_re(PsiCDC[Index])+c_im(PsiCDC[Index])*c_im(PsiCDC[Index]))/(Lev0->GArray[g].GSq);
791 }
792 }
793 *HartreeddEddt0 *= HartreeFactorC;
794 /* fertig mit ddEddt0 */
795
796 fft_3d_real_to_complex(plan, LevS->LevelNo, FFTNF1, HGCDRC, work);
797 CalculateCDfnl(P, ConDir, PP->CDfnl); // calculate needed non-local form factors
798 CalculateAddNLPot(P, HConDir, PP->CDfnl, PsiFactor); // add non-local potential, sets to zero beforehand
799 //SetArrayToDouble0((double *)HConDir,2*LevS->MaxG);
800 // now we have V^{HG} + V^{XC} + V^{ps,nl} | \varphi \rangle
801 for (g=0;g<LevS->MaxG;g++) { // factor by one over volume and add kinetic part
802 Index = LevS->GArray[g].Index; /* FIXME - factoren */
803 HConDir[g].re += PsiFactor*(HGCDRC[Index].re*HGcRCFactor + 0.5*LevS->GArray[g].GSq*ConDir[g].re);
804 HConDir[g].im += PsiFactor*(HGCDRC[Index].im*HGcRCFactor + 0.5*LevS->GArray[g].GSq*ConDir[g].im);
805 }
806 // now, T^{kin} + V^{HG} + V^{XC} + V^{ps,nl} | \varphi \rangle
807 *ConDirHConDir = GradSP(P, LevS, ConDir, HConDir);
808 // finally, \langle \varphi | V^{HG} + V^{XC} + V^{ps,nl} | \varphi \rangle which is returned
809}
810
811/** Find the minimal \f$\Theta_{min}\f$ for the line search.
812 * We find it as
813 * \f[
814 * \widetilde{\Theta}_{min} = \frac{1}{2} \tan^{-1} \Bigl ( -\frac{ \frac{\delta E}{\delta \Theta}_{|\Theta =0} }
815 * { \frac{1}{2} \frac{\delta^2 E}{\delta^2 \Theta}_{|\Theta =0} } \Bigr )
816 * \f]
817 * Thus, with given \f$E(0)\f$, \f$\frac{\delta E}{\delta \Theta}_{|\Theta =0}\f$ and \f$\frac{\delta^2 E}{\delta^2 \Theta}_{|\Theta =0}\f$
818 * \f$\Theta_{min}\f$is calculated and the unknowns A, B and C (see CalculateLineSearch()) obtained. So that our
819 * approximating formula \f$\widetilde{E}(\Theta) = A + B cos(2\Theta) + CSin(2\Theta)\f$ is fully known and we
820 * can evaluate the energy functional and its derivative at \f$\Theta_{min} \f$.
821 * \param E0 energy eigenvalue at \f$\Theta = 0\f$: \f$A= E(0) - B\f$
822 * \param dEdt0 first derivative of energy eigenvalue at \f$\Theta = 0\f$: \f$C = \frac{1}{2} \frac{\delta E}{\delta \Theta}|_{\Theta=0}\f$
823 * \param ddEddt0 first derivative of energy eigenvalue at \f$\Theta = 0\f$: \f$B = -\frac{1}{4} \frac{\delta^2 E}{\delta \Theta^2}|_{\Theta=0}\f$
824 * \param *E returned energy functional at \f$\Theta_{min}\f$
825 * \param *dE returned first derivative energy functional at \f$\Theta_{min}\f$
826 * \param *ddE returned second derivative energy functional at \f$\Theta_{min}\f$
827 * \param *dcos cosine of the found minimal angle
828 * \param *dsin sine of the found minimal angle
829 * \return \f$\Theta_{min}\f$
830 * \sa CalculateLineSearch() - used there
831 */
832double CalculateDeltaI(double E0, double dEdt0, double ddEddt0, double *E, double *dE, double *ddE, double *dcos, double *dsin)
833{
834 double delta, dcos2, dsin2, A, B, Eavg;
835 if (fabs(ddEddt0) < MYEPSILON) fprintf(stderr,"CalculateDeltaI: ddEddt0 = %lg",ddEddt0);
836 delta = atan(-2.*dEdt0/ddEddt0)/2.0; //.5*
837 *dcos = cos(delta);
838 *dsin = sin(delta);
839 dcos2 = cos(delta*2.0); //2.*
840 dsin2 = sin(delta*2.0); //2.*
841 A = -ddEddt0/4.;
842 B = dEdt0/2.;
843 //fprintf(stderr,"CalculateDeltaI: A = %lg, B = %lg\n", A, B);
844 Eavg = E0-A;
845 *E = Eavg + A*dcos2 + B*dsin2;
846 *dE = -2.*A*dsin2+2.*B*dcos2;
847 *ddE = -4.*A*dcos2-4.*B*dsin2;
848 if (*ddE < 0) { // if it's a maximum (indicated by positive second derivative at found theta)
849 if (delta < 0) { // go the minimum - the two are always separated by PI/2 by the ansatz
850 delta += PI/2.0; ///2.
851 } else {
852 delta -= PI/2.0; ///2.
853 }
854 *dcos = cos(delta);
855 *dsin = sin(delta);
856 dcos2 = cos(delta*2.0); //2.*
857 dsin2 = sin(delta*2.0); //2.*
858 *E = Eavg + A*dcos2 + B*dsin2;
859 *dE = -2.*A*dsin2+2.*B*dcos2;
860 *ddE = -4.*A*dcos2-4.*B*dsin2;
861 }
862 return(delta);
863}
864
865
866/** Line search: One-dimensional minimisation along conjugate direction.
867 * We want to minimize the energy functional along the calculated conjugate direction.
868 * States \f$\psi_i^{(m)}(\Theta) = \widetilde{\psi}_i^{(m)} \cos(\Theta) + \widetilde{\widetilde{\varphi}}_i^{(m)}
869 * \sin(\Theta)\f$ are normalized and orthogonal for every \f$\Theta \in {\cal R}\f$. Thus we
870 * want to find the minimal \f$\Theta_{min}\f$. Intenting to evaluate the energy functional as
871 * seldom as possible, we approximate it by:
872 * \f$\widetilde{E}(\Theta) = A + B cos(2\Theta) + CSin(2\Theta)\f$
873 * where the functions shall match the energy functional and its first and second derivative at
874 * \f$\Theta = 0\f$, fixing the unknowns A, B and C.\n
875 * \f$\frac{\delta E}{\delta \Theta}_{|\Theta =0} =
876 * 2 \Re \bigl ( \langle \widetilde{\widetilde{\varphi}}_i^{(m)}|H|\psi_i^{(m)} \rangle \bigr )\f$
877 * and
878 * \f$\frac{\delta^2 E}{\delta^2 \Theta}_{|\Theta =0} =
879 * 2\bigl( \langle \widetilde{\widetilde{\varphi}}_i^{(m)}|H|\widetilde{\widetilde{\varphi}}_i^{(m)} \rangle
880 * - \langle \psi_i^{(m)}|H|\psi_i^{(m)} \rangle
881 * + \underbrace{\int_\Omega \nu_H[\rho](r)\rho(r)dr}_{A_H}
882 * + \underbrace{\int_\Omega \rho(r)^2 \frac{\delta V^{xc}}{\delta n}(r) dr}_{A_{xc}}\f$. \n
883 * \f$A_H\f$ and \f$A_{xc}\f$ can be calculated from the Hartree respectively the exchange
884 * correlation energy.\n
885 * Basically, this boils down to using CalculateConDirHConDir() (we already have OnePsiAddData::Lambda),
886 * in evaluation of the energy functional and its derivatives as shown in the above formulas
887 * and calling with these CalculateDeltaI() which finds the above \f$\Theta_{min} \f$. \n
888 * The coefficients of the current wave function are recalculated, thus we have the new wave function,
889 * the total energy and its derivatives printed to stderr.\n
890 *
891 * \param *P Problem at hand
892 * \param *source current minimised wave function
893 * \param *ConDir conjugate direction, \f$\tilde{\tilde{\varphi}}_i^{(m)}\f$
894 * \param *Hc_grad complex coefficients of \f$H | \psi_i (G) \rangle\f$, see GradientArray#HcGradient
895 * \param x if NULL do approximative line search by second order taylor expansion, otherwise use given
896 * parameter between -M_PI...M_PI. Is simply put through to CalculateLineSearch()
897 * \param PsiFactor occupation number
898 */
899static void CalculateLineSearch(struct Problem *P,
900 fftw_complex *source,
901 fftw_complex *ConDir,
902 fftw_complex *Hc_grad, const double PsiFactor, const double *x)
903{
904 struct Lattice *Lat = &P->Lat;
905 struct RunStruct *R = &P->R;
906 struct LatticeLevel *LevS = R->LevS;
907 struct FileData *F = &P->Files;
908 //struct LatticeLevel *Lev0 = R->Lev0;
909 //struct Density *Dens = Lev0->Dens;
910 //struct Psis *Psi = &P->Lat.Psi;
911 struct Energy *En = Lat->E;
912 //int ElementSize = (sizeof(fftw_complex) / sizeof(double));
913 double dEdt0, ddEddt0, ConDirHConDir, Eavg, A, B;//, sourceHsource;
914 double E0, E, dE, ddE, delta, dcos, dsin, dcos2, dsin2;
915 double EI, dEI, ddEI, deltaI, dcosI, dsinI;
916 double HartreeddEddt0, XCddEddt0;
917 double d[4],D[4], Diff;
918 //double factorDR = R->FactorDensityR;
919 int g, i;
920 //int ActNum;
921
922 // ========= dE / dt | 0 ============
923 //fprintf(stderr,"(%i) |ConDir| = %lg, |Hc_grad| = %lg\n", P->Par.me, sqrt(GradSP(P, LevS, ConDir, ConDir)), sqrt(GradSP(P, LevS, Hc_grad, Hc_grad)));
924 d[0] = 2.*GradSP(P, LevS, ConDir, Hc_grad);
925
926 // ========== ddE / ddt | 0 =========
927 CalculateConDirHConDir(P, ConDir, PsiFactor, &d[1], &d[2], &d[3]);
928
929 MPI_Allreduce ( &d, &D, 4, MPI_DOUBLE, MPI_SUM, P->Par.comm_ST_Psi);
930 dEdt0 = D[0];
931 for (i=MAXOLD-1; i > 0; i--)
932 En->dEdt0[i] = En->dEdt0[i-1];
933 En->dEdt0[0] = dEdt0;
934 ConDirHConDir = D[1];
935 HartreeddEddt0 = D[2];
936 XCddEddt0 = D[3];
937 ddEddt0 = 0.0;
938 switch (R->CurrentMin) {
939 case Occupied:
940 ddEddt0 = HartreeddEddt0+XCddEddt0; // these terms drop out in unoccupied variation due to lacking dependence of n^{tot}
941 case UnOccupied:
942 ddEddt0 += 2.*(ConDirHConDir - Lat->Psi.AddData[R->ActualLocalPsiNo].Lambda);
943 break;
944 default:
945 ddEddt0 = 0.0;
946 break;
947 }
948 //if (R->CurrentMin <= UnOccupied)
949 //fprintf(stderr,"ConDirHConDir = %lg\tLambda = %lg\t Hartree = %lg\t XC = %lg\n",ConDirHConDir,Lat->Psi.AddData[R->ActualLocalPsiNo].Lambda,HartreeddEddt0,XCddEddt0);
950
951 for (i=MAXOLD-1; i > 0; i--)
952 En->ddEddt0[i] = En->ddEddt0[i-1];
953 En->ddEddt0[0] = ddEddt0;
954 E0 = En->TotalEnergy[0];
955
956 if (x == NULL) {
957 // delta
958 //if (isnan(E0)) { fprintf(stderr,"(%i) WARNING in CalculateLineSearch(): E0_%i[%i] = NaN!\n", P->Par.me, i, 0); Error(SomeError, "NaN-Fehler!"); }
959 //if (isnan(dEdt0)) { fprintf(stderr,"(%i) WARNING in CalculateLineSearch(): dEdt0_%i[%i] = NaN!\n", P->Par.me, i, 0); Error(SomeError, "NaN-Fehler!"); }
960 //if (isnan(ddEddt0)) { fprintf(stderr,"(%i) WARNING in CalculateLineSearch(): ddEddt0_%i[%i] = NaN!\n", P->Par.me, i, 0); Error(SomeError, "NaN-Fehler!"); }
961 deltaI = CalculateDeltaI(E0, dEdt0, ddEddt0,
962 &EI, &dEI, &ddEI, &dcosI, &dsinI);
963 } else {
964 deltaI = *x;
965 dcosI = cos(deltaI);
966 dsinI = sin(deltaI);
967 dcos2 = cos(deltaI*2.0); //2.*
968 dsin2 = sin(deltaI*2.0); //2.*
969 A = -ddEddt0/4.;
970 B = dEdt0/2.;
971 //fprintf(stderr,"CalculateDeltaI: A = %lg, B = %lg\n", A, B);
972 Eavg = E0-A;
973 EI = Eavg + A*dcos2 + B*dsin2;
974 dEI = -2.*A*dsin2+2.*B*dcos2;
975 ddEI = -4.*A*dcos2-4.*B*dsin2;
976 }
977 delta = deltaI; E = EI; dE = dEI; ddE = ddEI; dcos = dcosI; dsin = dsinI;
978 if (R->ScanPotential >= R->ScanAtStep) {
979 delta = (R->ScanPotential-(R->ScanAtStep-1))*R->ScanDelta;
980 dcos = cos(delta);
981 dsin = sin(delta);
982 //fprintf(stderr,"(%i) Scaning Potential form with delta %lg\n", P->Par.me, delta);
983 }
984 // shift energy delta values
985 for (i=MAXOLD-1; i > 0; i--) {
986 En->delta[i] = En->delta[i-1];
987 En->ATE[i] = En->ATE[i-1];
988 }
989 // store new one
990 En->delta[0] = delta;
991 En->ATE[0] = E;
992
993 if (R->MinStep != 0)
994 Diff = fabs(En->TotalEnergy[1] - E0)/(En->TotalEnergy[1] - E0)*fabs((E0 - En->ATE[1])/E0);
995 else
996 Diff = 0.;
997
998 // rotate local Psi and ConDir according to angle Theta
999 for (g = 0; g < LevS->MaxG; g++) { // Here all coefficients are updated for the new found wave function
1000 //if (isnan(ConDir[g].re)) { fprintf(stderr,"WARNGING: CalculateLineSearch(): ConDir_%i(%i) = NaN!\n", R->ActualLocalPsiNo, g); Error(SomeError, "NaN-Fehler!"); }
1001 c_re(source[g]) = c_re(source[g])*dcos + c_re(ConDir[g])*dsin;
1002 c_im(source[g]) = c_im(source[g])*dcos + c_im(ConDir[g])*dsin;
1003 }
1004 // print to stderr
1005 if (P->Call.out[StepLeaderOut] && x == NULL) {
1006 if (1)
1007 switch (R->CurrentMin) {
1008 case UnOccupied:
1009 fprintf(stderr, "(%i,%i,%i)S(%i,%i,%i):\tTGE: %e\tATGE: %e\t Diff: %e\t --- d: %e\tdEdt0: %e\tddEddt0: %e\n",P->Par.my_color_comm_ST,P->Par.me_comm_ST, P->Par.me_comm_ST_PsiT, R->MinStep, R->ActualLocalPsiNo, R->PsiStep, Lat->Energy[UnOccupied].TotalEnergy[0], E, Diff, delta, dEdt0, ddEddt0);
1010 break;
1011 default:
1012 fprintf(stderr, "(%i,%i,%i)S(%i,%i,%i):\tTE: %e\tATE: %e\t Diff: %e\t --- d: %e\tdEdt0: %e\tddEddt0: %e\n",P->Par.my_color_comm_ST,P->Par.me_comm_ST, P->Par.me_comm_ST_PsiT, R->MinStep, R->ActualLocalPsiNo, R->PsiStep, Lat->Energy[Occupied].TotalEnergy[0], E, Diff, delta, dEdt0, ddEddt0);
1013 break;
1014 }
1015 }
1016 if ((P->Par.me == 0) && (R->ScanFlag || (R->ScanPotential < R->ScanAtStep))) {
1017 fprintf(F->MinimisationFile, "%i\t%i\t%i\t%e\t%e\t%e\t%e\t%e\n",R->MinStep, R->ActualLocalPsiNo, R->PsiStep, E0, E, delta, dEdt0, ddEddt0);
1018 fflush(F->MinimisationFile);
1019 }
1020}
1021
1022/** Find the new minimised wave function.
1023 * Note, the gradient wave the function is expected in GradientTypes#ActualGradient. Then,
1024 * subsequently calls (performing thereby a conjugate gradient minimisation algorithm
1025 * of Fletchers&Reeves):
1026 * - CalculateCGGradient()\n
1027 * find direction of steepest descent: GradientTypes#ActualGradient
1028 * - CalculatePreConGrad()\n
1029 * precondition steepest descent direction: GradientTypes#PreConGradient
1030 * - CalculateConDir()\n
1031 * calculate conjugate direction: GradientTypes#ConDirGradient and GradientTypes#OldConDirGradient
1032 * - CalculateLineSearch()\n
1033 * perform the minimisation in this one-dimensional subspace: LevelPsi::LocalPsi[RunStruct::ActualLocalPsiNo]
1034 * \note CalculateGradient() is not re-done.
1035 * \param *P Problem at hand
1036 * \param x if NULL do approximative line search by second order taylor expansion, otherwise use given paramter between -M_PI...M_PI
1037 */
1038void CalculateNewWave(struct Problem *P, double *x)
1039{
1040 struct Lattice *Lat = &P->Lat;
1041 struct RunStruct *R = &P->R;
1042 struct LatticeLevel *LevS = R->LevS;
1043 const int i = R->ActualLocalPsiNo;
1044 const int ConDirStep = R->PsiStep;
1045 if (((!R->ScanPotential) || (R->ScanPotential < R->ScanAtStep)) && (Lat->Psi.LocalPsiStatus[R->ActualLocalPsiNo].DoBrent != 1)) { // only evaluate CG once
1046 //fprintf(stderr,"(%i) Evaluating ConDirGradient from SD direction...\n", P->Par.me);
1047 CalculateCGGradient(P, LevS->LPsi->LocalPsi[i],
1048 P->Grad.GradientArray[ActualGradient],
1049 Lat->Psi.AddData[i].Lambda);
1050 //fprintf(stderr,"CalculateCGGradient: %lg\n", GradSP(P, LevS, P->Grad.GradientArray[ActualGradient], P->Grad.GradientArray[ActualGradient]));
1051 //if (isnan(P->Grad.GradientArray[ActualGradient][0].re)) { fprintf(stderr,"(%i) WARNING in CalculateNewWave(): ActualGradient_%i[%i] = NaN!\n", P->Par.me, i, 0); Error(SomeError, "NaN-Fehler!"); }
1052 CalculatePreConGrad(P, P->Grad.GradientArray[ActualGradient],
1053 P->Grad.GradientArray[PreConGradient],
1054 Lat->Psi.AddData[i].T);
1055 //if (isnan(P->Grad.GradientArray[PreConGradient][0].re)) { fprintf(stderr,"(%i) WARNING in CalculateNewWave(): PreConGradient_%i[%i] = NaN!\n", P->Par.me, i, 0); Error(SomeError, "NaN-Fehler!"); }
1056 //fprintf(stderr,"CalculatePreConGrad: %lg\n", GradSP(P, LevS, P->Grad.GradientArray[PreConGradient], P->Grad.GradientArray[PreConGradient]));
1057 CalculateConDir(P, ConDirStep, &Lat->Psi.AddData[i].Gamma,
1058 P->Grad.GradientArray[ActualGradient],
1059 P->Grad.GradientArray[OldActualGradient],
1060 P->Grad.GradientArray[PreConGradient],
1061 P->Grad.GradientArray[ConDirGradient],
1062 P->Grad.GradientArray[OldConDirGradient]);
1063 //if (isnan(P->Grad.GradientArray[ConDirGradient][0].re)) { fprintf(stderr,"(%i) WARNING in CalculateNewWave(): ConDirGradient_%i[%i] = NaN!\n", P->Par.me, i, 0); Error(SomeError, "NaN-Fehler!"); }
1064 //fprintf(stderr,"CalculateConDir: %lg\n", GradSP(P, LevS, P->Grad.GradientArray[ConDirGradient], P->Grad.GradientArray[ConDirGradient]));
1065 } //else
1066 //TestForOrth(P,R->LevS,P->Grad.GradientArray[GraSchGradient]);
1067 //fprintf(stderr,"(%i) DoBrent[%i] = %i\n", P->Par.me, R->ActualLocalPsiNo, Lat->Psi.LocalPsiStatus[R->ActualLocalPsiNo].DoBrent);
1068 if (R->ScanPotential) R->ScanPotential++; // increment by one
1069 CalculateLineSearch(P,
1070 LevS->LPsi->LocalPsi[i],
1071 P->Grad.GradientArray[ConDirGradient],
1072 P->Grad.GradientArray[HcGradient],
1073 Lat->Psi.LocalPsiStatus[i].PsiFactor, x);
1074 //if (isnan(LevS->LPsi->LocalPsi[i][0].re)) { fprintf(stderr,"(%i) WARNING in CalculateNewWave(): {\\wildetilde \\varphi}_%i[%i] = NaN!\n", P->Par.me, i, 0); Error(SomeError, "NaN-Fehler!"); }
1075 SetGramSchExtraPsi(P, &Lat->Psi, NotUsedToOrtho);
1076 //TestForOrth(P,R->LevS,P->Grad.GradientArray[GraSchGradient]);
1077}
1078
1079
1080/** Calculates the parameter alpha for UpdateWaveAfterIonMove()
1081 * Takes ratios of differences of old and older positions with old and current,
1082 * respectively with old and older. Alpha is then the ratio between the two:
1083 * \f[
1084 * \alpha = \frac{v_x[old] \cdot v_x[now] + v_y[old] \cdot v_y[now] + v_z[old] \cdot v_z[now]}{v_x[old]^2 + v_y[old]^2 + v_z[old]^2}
1085 * \f]
1086 * Something like a rate of change in the ion velocity.
1087 * \param *P Problem at hand
1088 * \return alpha
1089 */
1090static double CalcAlphaForUpdateWaveAfterIonMove(struct Problem *P)
1091{
1092 struct Ions *I = &P->Ion;
1093 struct RunStruct *Run = &P->R;
1094 double alpha=0;
1095 double Sum1=0;
1096 double Sum2=0;
1097 int is,ia;
1098 double *R,*R_old,*R_old_old;
1099 Run->AlphaStep++;
1100 if (Run->AlphaStep <= 1) return(0.0);
1101 for (is=0; is < I->Max_Types; is++) {
1102 for (ia=0; ia < I->I[is].Max_IonsOfType; ia++) {
1103 if (I->I[is].IMT[ia] == MoveIon) {
1104 R = &I->I[is].R[NDIM*ia];
1105 R_old = &I->I[is].R_old[NDIM*ia];
1106 R_old_old = &I->I[is].R_old_old[NDIM*ia];
1107 Sum1 += (R_old[0]-R_old_old[0])*(R[0]-R_old[0]);
1108 Sum1 += (R_old[1]-R_old_old[1])*(R[1]-R_old[1]);
1109 Sum1 += (R_old[2]-R_old_old[2])*(R[2]-R_old[2]);
1110 Sum2 += (R_old[0]-R_old_old[0])*(R_old[0]-R_old_old[0]);
1111 Sum2 += (R_old[1]-R_old_old[1])*(R_old[1]-R_old_old[1]);
1112 Sum2 += (R_old[2]-R_old_old[2])*(R_old[2]-R_old_old[2]);
1113 }
1114 }
1115 }
1116 if (fabs(Sum2) > MYEPSILON) {
1117 alpha = Sum1/Sum2;
1118 } else {
1119 fprintf(stderr,"(%i) Sum2 <= MYEPSILON\n", P->Par.me);
1120 alpha = 0.0;
1121 }
1122 //if (isnan(alpha)) { fprintf(stderr,"(%i) CalcAlphaForUpdateWaveAfterIonMove: alpha is NaN!\n", P->Par.me); Error(SomeError, "NaN-Fehler!");}
1123 return (alpha);
1124}
1125
1126/** Updates Wave functions after UpdateIonsR.
1127 * LocalPsi coefficients are shifted by the difference between LevelPsi::LocalPsi and LevelPsi::OldLocalPsi
1128 * multiplied by alpha, new value stored in old one.
1129 * Afterwards all local wave functions are set to NotOrthogonal and then orthonormalized via
1130 * GramSch().
1131 *
1132 * \param *P Problem at hand
1133 * \sa CalcAlphaForUpdateWaveAfterIonMove() - alpha is calculated here
1134 */
1135double UpdateWaveAfterIonMove(struct Problem *P)
1136#if 0
1137static double CalculateDeltaII(double E0, double dEdt0, double E1, double deltastep, double *E, double *dE, double *ddE, double *dcos, double *dsin)
1138{
1139 double delta, dcos2, dsin2, A, B, Eavg;
1140 if (fabs(1-cos(2*deltastep) < MYEPSILON) fprintf(stderr,"CalculateDeltaII: (1-cos(2*deltastep) = %lg",(1-cos(2*deltastep));
1141 A = (E0-E1+0.5*dEdt0*sin(2*deltastep))/(1-cos(2*deltastep));
1142 B = 0.5*dEdt0;
1143 Eavg = E0-A;
1144 if (fabs(A) < MYEPSILON) fprintf(stderr,"CalculateDeltaII: A = %lg",A);
1145 delta = 0.5*atan(B/A);
1146 *dcos = cos(delta);
1147 *dsin = sin(delta);
1148 dcos2 = cos(2.*delta);
1149 dsin2 = sin(2.*delta);
1150 *E = Eavg + A*dcos2 + B*dsin2;
1151 *dE = -2.*A*dsin2+2.*B*dcos2;
1152 *ddE = -4.*A*dcos2-4.*B*dsin2;
1153 if (*ddE < 0) {
1154 if (delta < 0) {
1155 delta += PI/2.;
1156 } else {
1157 delta -= PI/2.;
1158 }
1159 *dcos = cos(delta);
1160 *dsin = sin(delta);
1161 dcos2 = cos(2.*delta);
1162 dsin2 = sin(2.*delta);
1163 *E = Eavg + A*dcos2 + B*dsin2;
1164 *dE = -2.*A*dsin2+2.*B*dcos2;
1165 *ddE = -4.*A*dcos2-4.*B*dsin2;
1166 }
1167 return(delta);
1168}
1169#endif
1170{
1171 struct RunStruct *R = &P->R;
1172 struct LatticeLevel *LevS = R->LevS;
1173 struct Lattice *Lat = &P->Lat;
1174 struct Psis *Psi = &Lat->Psi;
1175 double alpha=CalcAlphaForUpdateWaveAfterIonMove(P);
1176 int i,g,p,ResetNo=0;
1177 fftw_complex *source, *source_old;
1178 struct OnePsiElement *OnePsi = NULL;
1179 //fprintf(stderr, "%lg\n", alpha);
1180 if (P->R.AlphaStep > 1 && alpha != 0.0) {
1181 for (i=0; i < Psi->LocalNo; i++) {
1182 source = LevS->LPsi->LocalPsi[i];
1183 source_old = LevS->LPsi->OldLocalPsi[i];
1184 for (g=0; g < LevS->MaxG; g++) {
1185 c_re(source[g]) = c_re(source[g])+alpha*(c_re(source[g])-c_re(source_old[g]));
1186 c_im(source[g]) = c_im(source[g])+alpha*(c_im(source[g])-c_im(source_old[g]));
1187 c_re(source_old[g])=c_re(source[g]);
1188 c_im(source_old[g])=c_im(source[g]);
1189 }
1190 }
1191 } else {
1192 for (i=0; i < Psi->LocalNo; i++) {
1193 source = LevS->LPsi->LocalPsi[i];
1194 source_old = LevS->LPsi->OldLocalPsi[i];
1195 for (g=0; g < LevS->MaxG; g++) {
1196 c_re(source_old[g])=c_re(source[g]);
1197 c_im(source_old[g])=c_im(source[g]);
1198 }
1199 }
1200 }
1201 //fprintf(stderr, "%lg\n", alpha);
1202 if (alpha != 0.0) {
1203 for (p=0; p< Psi->LocalNo; p++) {
1204 Psi->LocalPsiStatus[p].PsiGramSchStatus = (Psi->LocalPsiStatus[p].PsiType == Occupied) ? (int)NotOrthogonal : (int)NotUsedToOrtho;
1205 //if (R->CurrentMin > UnOccupied) fprintf(stderr,"Setting L-Status of %i to %i\n",p, Psi->LocalPsiStatus[p].PsiGramSchStatus);
1206 }
1207 ResetNo=0;
1208 for (i=0; i < P->Par.Max_me_comm_ST_PsiT; i++) {
1209 for (p=ResetNo; p < ResetNo+Psi->AllLocalNo[i]-1; p++) {
1210 Psi->AllPsiStatus[p].PsiGramSchStatus = (Psi->LocalPsiStatus[p].PsiType == Occupied) ? (int)NotOrthogonal : (int)NotUsedToOrtho;
1211 //if (R->CurrentMin > UnOccupied) fprintf(stderr,"Setting A-Status of %i to %i\n",p, Psi->AllPsiStatus[p].PsiGramSchStatus);
1212 }
1213 ResetNo += Psi->AllLocalNo[i];
1214 OnePsi = &Psi->AllPsiStatus[ResetNo-1]; // extra wave function is set to NotUsed
1215 //if (R->CurrentMin > UnOccupied) fprintf(stderr,"Setting A-Status of %i to %i\n",ResetNo-1, NotUsedToOrtho);
1216 OnePsi->PsiGramSchStatus = (int)NotUsedToOrtho;
1217 }
1218 SpeedMeasure(P, InitGramSchTime, StartTimeDo);
1219 //fprintf(stderr,"UpdateWaveAfterIonMove: ResetGramSch() for %i orbital\n",p);
1220 GramSch(P, LevS, Psi, Orthonormalize);
1221 SpeedMeasure(P, InitGramSchTime, StartTimeDo);
1222 }
1223 return(alpha);
1224}
1225
Note: See TracBrowser for help on using the repository browser.