void dpsi_xpansion()
{
int i,Ngrid;
double al;
double *r,*p,*dp;
Ngrid = N_LogGrid();
r = r_LogGrid();
al = log_amesh_LogGrid();
p = alloc_LogGrid();
dp = alloc_LogGrid();
p_xpansion(p);
dp_xpansion(dp);
/* wl_prime = (d/di)wl */
for (i=0; i<=match; ++i)
wl_prime[i] = (al*r[i])*( (l+1.0) + r[i]*dp[i] )*pow(r[i],l)*exp(p[i]);
for (i=(match+1); i<Ngrid; ++i)
wl_prime[i] = ul_prime[i];
dealloc_LogGrid(p);
dealloc_LogGrid(dp);
} /* dpsi_xpansion */
void
solve_RelTroullier (int num_psp,
int *n_psp,
int *l_psp,
int *s_psp,
double *e_psp,
double *fill_psp,
double *rcut_psp,
double **r_psi_psp,
double **r_psi_prime_psp,
double *rho_psp,
double *rho_semicore,
double **V_psp, double *eall_psp,
double *eh_psp, double *ph_psp,
double *ex_psp, double *px_psp,
double *ec_psp, double *pc_psp)
{
int istate, i, l, k, p, s2, match, mch, Ngrid;
double al, amesh, rmax, Zion;
double gamma, gpr, nu0;
double ldpsi_match;
double el, eeig=0.0;
double ph, px, pc, eh, ex, ec;
double *ul, *ul_prime;
double *wl, *wl_prime;
double *r, *Vh, *Vx, *Vc, *rho_total, *Vall, *Vl;
/* Allocate Grids */
Vall = Vall_Atom ();
r = r_LogGrid ();
Ngrid = N_LogGrid ();
al = log_amesh_LogGrid ();
amesh = amesh_LogGrid ();
Zion = 0.0;
for (k = 0; k < Ngrid; ++k)
rho_psp[k] = 0.0;
if (debug_print ())
{
printf ("\n\nRelTroullier pseudopotential check\n\n");
printf
("l\trcore rmatch E in E psp norm test slope test\n");
}
for (p = 0; p < (num_psp); ++p)
{
l = l_psp[p];
s2 = s_psp[p];
wl = r_psi_psp[p];
wl_prime = r_psi_prime_psp[p];
Vl = V_psp[p];
/*******************************************/
/* Solve for scattering state if necessary */
/*******************************************/
if (fill_psp[p] < 1.e-15)
{
rmax = 10.0;
solve_Scattering_State_Atom (n_psp[p], l_psp[p], e_psp[p], rmax);
/* scattering state saved at the end of the atom list */
istate = Nvalence_Atom () + Ncore_Atom ();
if (s2 < 0)
istate += 1;
mch = (int) rint (log (rmax / r[0]) / al);
ul = r_psi_Atom (istate);
ul_prime = r_psi_prime_Atom (istate);
nu0 = Norm_LogGrid (mch, (l + 1.0), ul);
nu0 = 1.0 / sqrt (nu0);
for (i = 0; i < Ngrid; ++i)
{
ul[i] = ul[i] * nu0;
ul_prime[i] = ul_prime[i] * nu0;
}
}
/*******************************************/
/* find state of all-electron wavefunction */
/*******************************************/
else
istate = state_RelAtom (n_psp[p], l_psp[p], s_psp[p]);
/*************************************/
/* get the all-electron wavefunction */
/*************************************/
ul = r_psi_Atom (istate);
ul_prime = r_psi_prime_Atom (istate);
el = e_psp[p];
/*****************************/
/* find matching point stuff */
/*****************************/
match = (int) rint (log (rcut_psp[p] / r[0]) / al);
ldpsi_match = ul_prime[match] / ul[match];
/* make sure that wavefunctions are non-negative at the matching point */
if (ul[match] < 0.0)
{
nu0 = -1.0;
for (i = 0; i < Ngrid; ++i)
{
ul[i] = ul[i] * nu0;
ul_prime[i] = ul_prime[i] * nu0;
}
}
/**************************************/
/* generate troullier pseudopotential */
/**************************************/
init_xpansion (l, match, fill_psp[p], el, Vall, ul, ul_prime, Vl, wl,
wl_prime);
psi_xpansion ();
dpsi_xpansion ();
psp_xpansion ();
/******************/
/* verify psp Vl */
/******************/
/*******************/
/* psp bound state */
/*******************/
if (fill_psp[p] > 1.e-14)
{
R_Schrodinger (l_psp[p] + 1, l_psp[p], Vl, &mch, &el, wl, wl_prime);
}
/* scattering state */
else
{
R_Schrodinger_Fixed_Logderiv (l_psp[p] + 1, l_psp[p], Vl, match,
ldpsi_match, &el, wl, wl_prime);
R_Schrodinger_Fixed_E (l_psp[p] + 1, l_psp[p], Vl,
Ngrid - 1, el, wl, wl_prime);
/* normalize the scattering state to mch = 10.0 a.u. */
rmax = 10.0;
mch = rint (log (rmax / r[0]) / al);
nu0 = Norm_LogGrid (mch, (l + 1.0), wl);
nu0 = 1.0 / sqrt (nu0);
for (i = 0; i < Ngrid; ++i)
{
wl[i] = wl[i] * nu0;
wl_prime[i] = wl_prime[i] * nu0;
}
}
gamma = fabs (ul[match] / wl[match]);
gpr = fabs (ul_prime[match] / wl_prime[match]);
if (debug_print ())
{
/*printf("ul[match] wl[match]: %lf %lf\n",ul[match],wl[match]); */
printf ("%d\t%lf %lf %lf %lf %lf %lf\n", l_psp[p],
rcut_psp[p], r[match], e_psp[p], el, gamma, gpr);
}
/* Use the analytic form of pseudopotential */
el = e_psp[p];
psi_xpansion ();
dpsi_xpansion ();
psp_xpansion ();
if (fill_psp[p] > 1.e-14)
{
eeig += fill_psp[p] * el;
/* accumulate charges */
Zion += fill_psp[p];
for (k = 0; k < Ngrid; ++k)
rho_psp[k] += fill_psp[p] * pow (wl[k] / r[k], 2.0);
}
} /* for p */
/***************************************/
/* get the hartree potential an energy */
/* get the exchange potential and energy */
/* get the correlation potential and energy */
/***************************************/
Vh = alloc_LogGrid ();
Vx = alloc_LogGrid ();
Vc = alloc_LogGrid ();
ph = R_Hartree_DFT (rho_psp, Zion, Vh);
eh = 0.5 * ph;
rho_total = alloc_LogGrid ();
for (k = 0; k < Ngrid; ++k)
rho_total[k] = rho_psp[k] + rho_semicore[k];
R_Exchange_DFT (rho_total, Vx, &ex, &px);
R_Correlation_DFT (rho_total, Vc, &ec, &pc);
/* recalculate px and pc */
for (k = 0; k < Ngrid; ++k)
rho_total[k] = (rho_psp[k]) * Vx[k];
px = Integrate_LogGrid (rho_total);
for (k = 0; k < Ngrid; ++k)
rho_total[k] = (rho_psp[k]) * Vc[k];
pc = Integrate_LogGrid (rho_total);
*eall_psp = eeig + eh + ex + ec - ph - px - pc;
*eh_psp = eh;
*ph_psp = ph;
*ex_psp = ex;
*px_psp = px;
*ec_psp = ec;
*pc_psp = pc;
for (p = 0; p < num_psp; ++p)
for (k = 0; k < Ngrid; ++k)
V_psp[p][k] = V_psp[p][k] - Vh[k] - Vx[k] - Vc[k];
/* deallocate memory */
dealloc_LogGrid (Vh);
dealloc_LogGrid (Vx);
dealloc_LogGrid (Vc);
dealloc_LogGrid (rho_total);
} /* solve_Troullier */
void init_xpansion(int l_in,
int match_in,
double occupation_in,
double el_in,
double *Vall_in,
double *ul_in,
double *ul_prime_in,
double *Vl_in,
double *wl_in,
double *wl_prime_in)
{
int i,iteration;
double gamma,gamma_mid,dgamma;
double constraint1,constraint2,constraint_mid;
double gamma1,gamma2;
double Vall_match, dVall_match,ddVall_match;
double al;
double *r;
r = r_LogGrid();
al = log_amesh_LogGrid();
l = l_in;
match = match_in;
occupation = occupation_in;
el = el_in;
Vall = Vall_in;
ul = ul_in;
ul_prime = ul_prime_in;
Vl = Vl_in;
wl = wl_in;
wl_prime = wl_prime_in;
/* fix ul_prime = (d/dr)ul, rather then (d/di)ul */
ldpsi = ul_prime[match]/(al*r[match]*ul[match]);
Vall_match = Vall[match];
dVall_match = (1.0/(al*r[match]))*Derivative7_4(match,Vall);
ddVall_match = (-1.0/(r[match]*r[match]*al)) *Derivative7_4(match,Vall)
+ (+1.0/(r[match]*r[match]*al*al))*Laplacian7_4(match,Vall);
rc[0] = 1.0;
rc[1] = r[match];
for (i=2; i<13; ++i)
rc[i] = rc[1]*rc[i-1];
/******************************************/
/* Calculate the all-electron core charge */
/******************************************/
ae_core_charge = Norm_LogGrid(match,(l+1.0),ul);
/**************************************************************/
/* define p(rcl), p'(rcl), p''(rcl), p'''(rcl) and p''''(rcl) */
/**************************************************************/
poly[0] = log(ul[match]/pow(rc[1],(l+1.0)));
poly[1] = ldpsi - (l+1.0)/rc[1];
poly[2] = 2.0*Vall_match
- 2.0*el
- (2.0*(l+1.0)/rc[1])*poly[1]
- poly[1]*poly[1];
poly[3] = 2.0*dVall_match
+ (2.0*(l+1.0)/rc[2])*poly[1]
- (2.0*(l+1.0)/rc[1])*poly[2]
- 2.0*poly[1]*poly[2];
poly[4] = 2.0*ddVall_match
- (4.0*(l+1.0)/rc[3])*poly[1]
+ (4.0*(l+1.0)/rc[2])*poly[2]
- (2.0*(l+1.0)/rc[1])*poly[3]
- 2.0*poly[2]*poly[2]
- 2.0*poly[1]*poly[3];
/* get initial guess for gamma */
get_c0_c10();
/* Bracket gamma, so that constraint==0 can be found */
gamma1 = c[1];
gamma2 = -c[1];
constraint1 = get_c0_c12(gamma1);
constraint2 = get_c0_c12(gamma2);
iteration = 0;
while ((constraint1*constraint2 > 0.0) && (iteration <=50))
{
++iteration;
if (fabs(constraint1) < fabs(constraint2))
{
gamma1 = gamma1 + 1.6*(gamma1-gamma2);
constraint1 = get_c0_c12(gamma1);
}
else
{
gamma2 = gamma2 + 1.6*(gamma2-gamma1);
constraint2 = get_c0_c12(gamma2);
}
}
/* perform bisection of gamma1 and gamma2 until constraint==0 */
constraint1 = get_c0_c12(gamma1);
constraint2 = get_c0_c12(gamma2);
if (constraint1 < 0.0)
{
gamma = gamma1;
dgamma = (gamma2-gamma1);
}
else
{
gamma = gamma2;
dgamma = (gamma1-gamma2);
}
iteration = 0;
constraint_mid = 1.0;
while ((fabs(dgamma) > SMALL) && (constraint_mid != 0.0) && (iteration<=80))
{
++iteration;
dgamma = 0.5*dgamma;
gamma_mid = gamma+dgamma;
constraint_mid = get_c0_c12(gamma_mid);
if (constraint_mid < 0.0)
gamma = gamma_mid;
}
} /*init_xpansion */
int init_xpansion2(int l_in,
int match_in,
double el_in,
double *Vall_in,
double *ul_in,
double *ul_prime_in,
double *Vl_in,
double *wl_in,
double *wl_prime_in)
{
int i;
double Vall_match, dVall_match,ddVall_match;
double al;
double *r;
r = r_LogGrid();
al = log_amesh_LogGrid();
l = l_in;
match = match_in;
el = el_in;
Vall = Vall_in;
ul = ul_in;
ul_prime = ul_prime_in;
Vl = Vl_in;
wl = wl_in;
wl_prime = wl_prime_in;
/* fix ul_prime = (d/dr)ul, rather then (d/di)ul */
ldpsi = ul_prime[match]/(al*r[match]*ul[match]);
Vall_match = Vall[match];
dVall_match = (1.0/(al*r[match]))*Derivative7_4(match,Vall);
ddVall_match = (-1.0/(r[match]*r[match]*al)) *Derivative7_4(match,Vall)
+ (+1.0/(r[match]*r[match]*al*al))*Laplacian7_4(match,Vall);
rc[0] = 1.0;
rc[1] = r[match];
for (i=2; i<13; ++i)
rc[i] = rc[1]*rc[i-1];
/**************************************************************/
/* define p(rcl), p'(rcl), p''(rcl), p'''(rcl) and p''''(rcl) */
/**************************************************************/
poly[0] = log(ul[match]/pow(rc[1],(l+1.0)));
poly[1] = ldpsi - (l+1.0)/rc[1];
poly[2] = 2.0*Vall_match
- 2.0*el
- (2.0*(l+1.0)/rc[1])*poly[1]
- poly[1]*poly[1];
poly[3] = 2.0*dVall_match
+ (2.0*(l+1.0)/rc[2])*poly[1]
- (2.0*(l+1.0)/rc[1])*poly[2]
- 2.0*poly[1]*poly[2];
poly[4] = 2.0*ddVall_match
- (4.0*(l+1.0)/rc[3])*poly[1]
+ (4.0*(l+1.0)/rc[2])*poly[2]
- (2.0*(l+1.0)/rc[1])*poly[3]
- 2.0*poly[2]*poly[2]
- 2.0*poly[1]*poly[3];
/* generate trouulier-Martin expansion, if possible */
return get_c0_c10_xpansion2();
} /*init_xpansion2 */
