void FATR cpi_parse_
#if defined(USE_FCD)
(Integer *debug_ptr,
Integer *lmax_ptr,
Integer *locp_ptr,
double *rlocal_ptr,
const _fcd fcd_sdir_name,
Integer *n9,
const _fcd fcd_dir_name,
Integer *n0,
const _fcd fcd_in_filename,
Integer *n1,
const _fcd fcd_out_filename,
Integer *n2,
const _fcd fcd_atom,
Integer *n3)
{
char *sdir_name = _fcdtocp(fcd_sdir_name);
char *dir_name = _fcdtocp(fcd_dir_name);
char *in_filename = _fcdtocp(fcd_in_filename);
char *out_filename = _fcdtocp(fcd_out_filename);
char *atom = _fcdtocp(fcd_atom);
#else
(debug_ptr,lmax_ptr,locp_ptr,rlocal_ptr,
sdir_name,n9,dir_name,n0,in_filename,n1,out_filename,n2,atom,n3)
Integer *debug_ptr;
Integer *lmax_ptr;
Integer *locp_ptr;
double *rlocal_ptr;
char sdir_name[];
Integer *n9;
char dir_name[];
Integer *n0;
char in_filename[];
Integer *n1;
char out_filename[];
Integer *n2;
char atom[];
Integer *n3;
{
#endif
int debug;
int lmax_out,locp_out;
double rlocal_out;
int lmax;
double Zion; /* local psp parameters */
double over_fourpi;
int *nl;
int i,j,k,p,p1;
int Ngrid,nrl;
double *rgrid,*psi,*psp;
double *rl, *tmp, *tmp2, *sc_rho, *sc_rhol, *sc_drho, *sc_drhol,
**psil,
**pspl;
double r,ul,vl,amesh,al,drl,r_semicore,rmax;
int lmaxp;
double dum1,dum2,dum3,dum4,r0;
int idum;
char *w,*tc;
FILE *fp;
char comment[255];
int argc,value;
int m9 = ((int) (*n9));
int m0 = ((int) (*n0));
int m1 = ((int) (*n1));
int m2 = ((int) (*n2));
int m3 = ((int) (*n3));
char *infile = (char *) malloc(m9+m1+5);
char *outfile = (char *) malloc(m0+m2+5);
char *atom_out = (char *) malloc(m3+5);
char *full_filename = (char *) malloc(m9+25+5);
debug = *debug_ptr;
lmax_out = *lmax_ptr;
locp_out = *locp_ptr;
rlocal_out = *rlocal_ptr;
(void) strncpy(infile, sdir_name, m9);
infile[m9] = '\0';
strcat(infile,"/");
infile[m9+1] = '\0';
strncat(infile,in_filename,m1);
infile[m9+m1+1] = '\0';
(void) strncpy(outfile, dir_name, m0);
outfile[m0] = '\0';
(void) strcat(outfile,"/");
outfile[m0+1] = '\0';
(void) strncat(outfile,out_filename,m2);
outfile[m0+m2+1] = '\0';
(void) strncpy(atom_out, atom, m3);
atom_out[m3] = '\0';
over_fourpi = 1.0/(16.0*atan(1.0));
/* find the comment */
strcpy(comment,"CPI formatted pseudopotential");
fp = fopen(infile,"r+");
w = get_word(fp);
while ((w!=NIL) && (strcmp("<comment>",w)!=0))
w = get_word(fp);
if (w!=NIL)
{
w = get_word(fp);
p = 0;
tc = comment;
while ((w!=NIL)&&(strcmp("<end>",w) != 0))
{
p = (strlen(w));
strcpy(tc, w);
for (p1=0;p1<p; ++p1) ++tc;
strcpy(tc, " ");
++tc;
w = get_word(fp);
}
}
fclose(fp);
/* define linear grid */
nrl = 2001;
rmax = 40.0;
drl = rmax/((double) (nrl-1));
fp = fopen(infile,"r+");
w = get_word(fp);
while ((w != ((char *) EOF)) && (strcmp("<linear>",w) != 0))
w = get_word(fp);
if (w!=((char *) EOF))
{
fscanf(fp,"%d %lf",&nrl,&drl);
rmax = ((double) (nrl-1))*drl;
}
fclose(fp);
/* Read CPI psp */
fp = fopen(infile,"r+");
w = get_word(fp);
while ((w!=NIL) && (strcmp("<CPI>",w)!=0))
w = get_word(fp);
/* Error occured */
if (w==NIL)
{
printf("Error: <CPI> section not found\n");
fclose(fp);
exit(99);
}
argc = to_eoln(fp);
fscanf(fp,"%lf %d",&Zion,&lmaxp);
lmax = lmaxp-1;
fscanf(fp,"%lf %lf %lf %lf",&dum1,&dum2,&dum3,&dum4);
fscanf(fp,"%lf %lf %lf ",&dum1,&dum2,&dum3);
fscanf(fp,"%lf %lf %lf ",&dum1,&dum2,&dum3);
fscanf(fp,"%lf %lf %lf ",&dum1,&dum2,&dum3);
fscanf(fp,"%lf %lf %lf ",&dum1,&dum2,&dum3);
fscanf(fp,"%lf %lf %lf ",&dum1,&dum2,&dum3);
fscanf(fp,"%lf %lf %lf ",&dum1,&dum2,&dum3);
fscanf(fp,"%lf %lf %lf ",&dum1,&dum2,&dum3);
fscanf(fp,"%lf %lf %lf ",&dum1,&dum2,&dum3);
fscanf(fp,"%lf %lf %lf ",&dum1,&dum2,&dum3);
fscanf(fp,"%d %lf",&Ngrid,&amesh);
al = log(amesh);
psi = (double *) malloc(Ngrid*sizeof(double));
psp = (double *) malloc(Ngrid*sizeof(double));
rgrid = (double *) malloc(Ngrid*sizeof(double));
tmp = (double *) malloc(Ngrid*sizeof(double));
tmp2 = (double *) malloc(Ngrid*sizeof(double));
sc_rho = (double *) malloc(Ngrid*sizeof(double));
sc_drho = (double *) malloc(Ngrid*sizeof(double));
for (i=0; i<Ngrid; ++i)
{
fscanf(fp,"%d %lf %lf %lf",&j, &r,&ul,&vl);
rgrid[i] = r;
psi[i] = ul;
psp[i] = vl;
}
/* check linear grid and redefine if necessary */
if (rmax > rgrid[Ngrid-5])
{
rmax = rgrid[Ngrid-5];
drl = rmax/((double) (nrl-1));
}
/* generate linear meshes */
rl = (double *) malloc(nrl*sizeof(double));
nl = (int *) malloc(nrl*sizeof(int));
psil = (double **) malloc(lmaxp*sizeof(double*));
pspl = (double **) malloc(lmaxp*sizeof(double*));
sc_rhol = (double *) malloc(nrl*sizeof(double));
sc_drhol = (double *) malloc(nrl*sizeof(double));
r0 = rgrid[0];
rl[0] = rgrid[0];
for (i=1; i<nrl; ++i)
{
rl[i] = drl*((double) i);
nl[i] = rint(log(rl[i]/r0)/al -0.5);
}
psil[0] = (double *) malloc(nrl*sizeof(double));
pspl[0] = (double *) malloc(nrl*sizeof(double));
cpi_Spline(rgrid,psp,Ngrid-4,0.0,0.0,tmp,tmp2);
pspl[0][0] = psp[0];
for (i=1; i<nrl; ++i)
{
pspl[0][i] = cpi_Splint(rgrid,psp,tmp,Ngrid-4,nl[i],rl[i]);
}
cpi_Spline(rgrid,psi,Ngrid-4,0.0,0.0,tmp,tmp2);
psil[0][0] = psi[0];
for (i=1; i<nrl; ++i)
{
psil[0][i] = cpi_Splint(rgrid,psi,tmp,Ngrid-4,nl[i],rl[i]);
}
for (p=1; p<lmaxp; ++p)
{
fscanf(fp,"%d %lf",&idum,&dum1);
for (i=0; i<Ngrid; ++i)
{
fscanf(fp,"%d %lf %lf %lf",&j, &r,&ul,&vl);
rgrid[i] = r;
psi[i] = ul;
psp[i] = vl;
}
psil[p] = (double *) malloc(nrl*sizeof(double));
pspl[p] = (double *) malloc(nrl*sizeof(double));
cpi_Spline(rgrid,psp,Ngrid-4,0.0,0.0,tmp,tmp2);
pspl[p][0] = psp[0];
for (i=1; i<nrl; ++i)
{
pspl[p][i] = cpi_Splint(rgrid,psp,tmp,Ngrid-4,nl[i],rl[i]);
}
cpi_Spline(rgrid,psi,Ngrid-4,0.0,0.0,tmp,tmp2);
psil[p][0] = psi[0];
for (i=1; i<nrl; ++i)
{
psil[p][i] = cpi_Splint(rgrid,psi,tmp,Ngrid-4,nl[i],rl[i]);
}
}
/* read semi-core */
r_semicore = 0.0;
value = fscanf(fp,"%lf %lf %lf %lf", &r,&ul,&vl,&dum1);
if (value!=EOF)
{
r_semicore = 99.99; /* not known?? */
rgrid[0] = r; sc_rho[0] = ul; sc_drho[0] = vl;
for (i=1; i<Ngrid; ++i)
{
fscanf(fp,"%lf %lf %lf %lf", &r,&ul,&vl,&dum1);
rgrid[i] = r;
sc_rho[i] = ul;
sc_drho[i] = vl;
}
cpi_Spline(rgrid,sc_rho,Ngrid-4,0.0,0.0,tmp,tmp2);
sc_rhol[0] = sc_rho[0];
for (i=1; i<nrl; ++i)
{
sc_rhol[i] = cpi_Splint(rgrid,sc_rho,tmp,Ngrid-4,nl[i],rl[i]);
}
cpi_Spline(rgrid,sc_drho,Ngrid-4,0.0,0.0,tmp,tmp2);
sc_drhol[0] = sc_drho[0];
for (i=1; i<nrl; ++i)
{
sc_drhol[i] = cpi_Splint(rgrid,sc_drho,tmp,Ngrid-4,nl[i],rl[i]);
}
}
free(nl);
free(rgrid);
free(psi);
free(psp);
free(tmp);
free(tmp2);
free(sc_rho);
free(sc_drho);
fclose(fp);
/* write outfile */
fp = fopen(outfile,"w+");
fprintf(fp,"%s\n",atom_out);
fprintf(fp,"%lf %lf %d %d %d %lf\n",Zion,0.0,lmax,lmax_out,locp_out,rlocal_out);
for (p=0; p<=lmax; ++p)
fprintf(fp,"%lf ", -1.0);
fprintf(fp,"\n");
fprintf(fp,"%d %lf\n",nrl,drl);
fprintf(fp,"%s\n",comment);
/* appending pseudopotentials */
for (k=0; k<nrl; ++k)
{
fprintf(fp,"%12.8lf", rl[k]);
for (p=0; p<=lmax; ++p)
fprintf(fp," %12.8lf", pspl[p][k]);
fprintf(fp,"\n");
}
for (p=0; p<=lmax; ++p) free(pspl[p]);
free(pspl);
/* appending pseudowavefunctions */
for (k=0; k<nrl; ++k)
{
fprintf(fp,"%12.8lf", rl[k]);
for (p=0; p<=lmax; ++p)
fprintf(fp," %12.8lf", psil[p][k]);
fprintf(fp,"\n");
}
for (p=0; p<=lmax; ++p) free(psil[p]);
free(psil);
/* append semicore corrections */
if (r_semicore != 0.0)
{
fprintf(fp,"%lf\n",r_semicore);
for (k=0; k<nrl; ++k)
fprintf(fp,"%12.8lf %12.8lf\n", rl[k],
fabs(sc_rhol[k]*over_fourpi));
for (k=0; k<nrl; ++k)
fprintf(fp,"%12.8lf %12.8lf\n", rl[k],
(sc_drhol[k]*over_fourpi));
}
free(sc_drhol);
free(sc_rhol);
free(rl);
fclose(fp);
if (debug)
{
printf("CPI pseudopotential Parameters\n\n");
printf("atom : %s\n",atom);
printf("Zion : %lf\n",Zion);
printf(" lmax: %d\n",lmax);
printf(" locp: %d\n",locp_out);
printf(" rlocal: %lf\n\n",rlocal_out);
printf(" r_semicore: %lf\n",r_semicore);
}
/* free malloc memory */
free(infile);
free(outfile);
free(full_filename);
free(atom_out);
fflush(stdout);
return;
} /* main */
/********************************
* *
* cpi_Spline *
* *
********************************/
void cpi_Spline(x,y,n,yp1,ypn,y2,u)
double x[],
y[];
int n;
double yp1;
double ypn;
double y2[];
double u[];
{
int i,k;
double sig,qn,un,p;
if (yp1 > 0.99e30)
{
y2[0] = 0.0;
u[0] = 0.0;
}
else
{
y2[0] = -0.5;
u[0] = 3.0/(x[1]-x[0]) * ((y[1]-y[0])/(x[1]-x[0]) - yp1);
}
for (i=1; i<(n-1); ++i)
{
sig = (x[i]-x[i-1])/(x[i+1] - x[i-1]);
p = sig*y2[i-1] + 2.0;
y2[i] = (sig-1.0)/p;
u[i] = ( 6.0 *
((y[i+1]-y[i])/(x[i+1]-x[i]) - (y[i]-y[i-1])/(x[i]-x[i-1]))
/(x[i+1]-x[i-1])
- sig*u[i-1]
) / p;
}
if (ypn > 0.99e30)
{
qn = 0.0;
un = 0.0;
}
else
{
qn = 0.5;
un = 3.0/(x[n-1]-x[n-2]) * (ypn - (y[n-1]-y[n-2])/(x[n-1]-x[n-2]));
}
y2[n-1] = (un-qn*u[n-2])/(qn*y2[n-2] + 1.0);
for (k=n-2; k>=0; --k)
y2[k] = y2[k]*y2[k+1] + u[k];
} /* cpi_Spline */
/********************************
* *
* cpi_Splint *
* *
********************************/
double cpi_Splint(xa,ya,y2a,n,nx,x)
double xa[];
double ya[];
double y2a[];
int n;
int nx;
double x;
{
int khi,klo;
double h,a,b;
double y;
khi = nx+1;
klo = nx;
while ( (xa[klo] > x) || ( xa[khi] < x))
{
/*
printf("Error in Splint ");
printf("%d -> %le %le %le",klo,x,xa[klo],xa[khi]);
*/
if (xa[klo] > x)
{
--klo;
--khi;
/*
printf(" <\n");
*/
}
if (xa[khi] < x)
{
++klo;
++khi;
/*
printf(" >\n");
*/
}
}
h = xa[khi] - xa[klo];
a = (xa[khi] - x)/h;
b = (x - xa[klo])/h;
y = a*ya[klo] + b*ya[khi]
+ ( (a*a*a-a)*y2a[klo] + (b*b*b-b)*y2a[khi] ) * (h*h)/6.0;
return y;
} /* cpi_Splint */
void FATR hgh_parse_
#if defined(USE_FCD)
(Integer *debug_ptr,
Integer *lmax_ptr,
Integer *locp_ptr,
double *rlocal_ptr,
const _fcd fcd_sdir_name,
Integer *n9,
const _fcd fcd_dir_name,
Integer *n0,
const _fcd fcd_in_filename,
Integer *n1,
const _fcd fcd_out_filename,
Integer *n2)
{
char *sdir_name = _fcdtocp(fcd_sdir_name);
char *dir_name = _fcdtocp(fcd_dir_name);
char *in_filename = _fcdtocp(fcd_in_filename);
char *out_filename = _fcdtocp(fcd_out_filename);
#else
(debug_ptr,lmax_ptr,locp_ptr,rlocal_ptr,
sdir_name,n9,dir_name,n0,in_filename,n1,out_filename,n2)
Integer *debug_ptr;
Integer *lmax_ptr;
Integer *locp_ptr;
double *rlocal_ptr;
char sdir_name[];
Integer *n9;
char dir_name[];
Integer *n0;
char in_filename[];
Integer *n1;
char out_filename[];
Integer *n2;
{
#endif
int debug,done;
int lmax_out,locp_out;
double rlocal_out;
int lmax;
int nmax_l[4];
char atom[10];
int Zion; /* local psp parameters */
double rloc,C1,C2,C3,C4;
double r[4]; /* projector radii */
double H[3][4]; /* diagonal overlap coefficients */
double K[3][4]; /* diagonal overlap coefficients */
int i,p,p1;
char *w,*tc;
FILE *fp;
char comment[255];
char line[255];
int argc,value;
char words[20][80];
int m9 = ((int) (*n9));
int m0 = ((int) (*n0));
int m1 = ((int) (*n1));
int m2 = ((int) (*n2));
char *infile = (char *) malloc(m9+m1+5);
char *outfile = (char *) malloc(m0+m2+5);
char *full_filename = (char *) malloc(m9+25+5);
debug = *debug_ptr;
lmax_out = *lmax_ptr;
locp_out = *locp_ptr;
rlocal_out = *rlocal_ptr;
(void) strncpy(infile, sdir_name, m9);
infile[m9] = '\0';
strcat(infile,"/");
infile[m9+1] = '\0';
strncat(infile,in_filename,m1);
infile[m9+m1+1] = '\0';
(void) strncpy(outfile, dir_name, m0);
outfile[m0] = '\0';
strcat(outfile,"/");
outfile[m0+1] = '\0';
strncat(outfile,out_filename,m2);
outfile[m0+m2+1] = '\0';
Zion = 0;
rloc = 0.0;
C1 = 0.0;
C2 = 0.0;
C3 = 0.0;
C4 = 0.0;
r[0] = 0.0;
r[1] = 0.0;
r[2] = 0.0;
r[3] = 0.0;
H[0][0] = 0.0; /*s*/
H[1][0] = 0.0;
H[2][0] = 0.0;
H[0][1] = 0.0; /*p*/
H[1][1] = 0.0;
H[2][1] = 0.0;
H[0][2] = 0.0; /*d*/
H[1][2] = 0.0;
H[2][2] = 0.0;
H[0][3] = 0.0; /*f*/
H[1][3] = 0.0;
H[2][3] = 0.0;
K[0][0] = 0.0; /*s*/
K[1][0] = 0.0;
K[2][0] = 0.0;
K[0][1] = 0.0; /*p*/
K[1][1] = 0.0;
K[2][1] = 0.0;
K[0][2] = 0.0; /*d*/
K[1][2] = 0.0;
K[2][2] = 0.0;
K[0][3] = 0.0; /*f*/
K[1][3] = 0.0;
K[2][3] = 0.0;
/* find the comment */
strcpy(comment,"Hartwigsen, Goedecker and Hutter pseudopotential");
fp = fopen(infile,"r+");
w = get_word(fp);
while ((w!=NIL) && (strcmp("<comment>",w)!=0))
w = get_word(fp);
if (w!=NIL)
{
w = get_word(fp);
p = 0;
tc = comment;
while ((w!=NIL)&&(strcmp("<end>",w) != 0))
{
p = (strlen(w));
strcpy(tc, w);
for (p1=0; p1<p; ++p1) ++tc;
strcpy(tc, " ");
++tc;
w = get_word(fp);
}
}
fclose(fp);
/* Read HGH psp */
fp = fopen(infile,"r+");
w = get_word(fp);
while ((w!=NIL) && (strcmp("<HGH>",w)!=0))
w = get_word(fp);
/* Error occured */
if (w==NIL)
{
printf("Error: <HGH> section not found\n");
fclose(fp);
exit(99);
}
argc = to_eoln(fp);
if (!get_string(fp,atom)) printf("NO ATOM NAME\n");
if (!get_int(fp,&Zion)) printf("NO ZION\n");
if (!get_float(fp,&rloc)) printf("NO rlocN\n");
if (!get_float(fp,&C1)) C1 = 0.0;
if (!get_float(fp,&C2)) C2 = 0.0;
if (!get_float(fp,&C3)) C3 = 0.0;
if (!get_float(fp,&C4)) C4 = 0.0;
argc = to_eoln(fp);
done = get_end(fp);
i = 0;
if (!done)
{
if (!get_float(fp,&(r[i]))) r[i] = 0.0;
if (!get_float(fp,&(H[0][i]))) H[0][i] = 0.0;
if (!get_float(fp,&(H[1][i]))) H[1][i] = 0.0;
if (!get_float(fp,&(H[2][i]))) H[2][i] = 0.0;
argc = to_eoln(fp);
done = get_end(fp);
++i;
while (!done)
{
if (!get_float(fp,&(r[i]))) r[i] = 0.0;
if (!get_float(fp,&(H[0][i]))) H[0][i] = 0.0;
if (!get_float(fp,&(H[1][i]))) H[1][i] = 0.0;
if (!get_float(fp,&(H[2][i]))) H[2][i] = 0.0;
argc = to_eoln(fp);
done = get_end(fp);
if (!done)
{
if (!get_float(fp,&(K[0][i]))) K[0][i] = 0.0;
if (!get_float(fp,&(K[1][i]))) K[1][i] = 0.0;
if (!get_float(fp,&(K[2][i]))) K[2][i] = 0.0;
argc = to_eoln(fp);
done = get_end(fp);
}
++i;
}
}
lmax = i-1;
fclose(fp);
/* write outfile */
fp = fopen(outfile,"w+");
fprintf(fp,"%d\n",1); /* set psp_type */
fprintf(fp,"%s\n",atom);
fprintf(fp,"%d\n",Zion);
if (lmax<0) fprintf(fp,"%d",0);
else fprintf(fp,"%d\n",lmax);
fprintf(fp,"%lf %lf %lf %lf %lf\n",rloc,C1,C2,C3,C4);
if (lmax>=0)
{
fprintf(fp,"%lf %lf %lf %lf\n",r[0],H[0][0],H[1][0],H[2][0]);
for (i=1; i<=lmax; ++i)
{
fprintf(fp,"%lf %lf %lf %lf\n",r[i],H[0][i],H[1][i],H[2][i]);
fprintf(fp,"%lf %lf %lf\n", K[0][i],K[1][i],K[2][i]);
}
}
fprintf(fp,"%s\n",comment);
fclose(fp);
if (debug)
{
printf("HGH pseudopotential Parameters\n\n");
printf("atom : %s\n",atom);
printf("Zion : %d\n",Zion);
printf(" lmax: %d\n\n",lmax);
printf(" vloc: %lf %lf %lf %lf %lf\n\n",rloc,C1,C2,C3,C4);
if (lmax>=0)
{
printf("l=%d r=%lf \t H= %lf %lf %lf\n\n",0,r[0],H[0][0],H[1][0],H[2][0]);
for (i=1; i<=lmax; ++i)
{
printf("l=%d r=%lf \t H= %lf %lf %lf\n",i,r[i],H[0][i],H[1][i],H[2][i]);
printf(" \t\t K= %lf %lf %lf\n\n", K[0][i],K[1][i],K[2][i]);
}
}
}
/* free malloc memory */
free(infile);
free(outfile);
free(full_filename);
fflush(stdout);
return;
} /* main */
void FATR teter_parse_
#if defined(USE_FCD)
(Integer *debug_ptr,
Integer *lmax_ptr,
Integer *locp_ptr,
double *rlocal_ptr,
const _fcd fcd_sdir_name,
Integer *n9,
const _fcd fcd_dir_name,
Integer *n0,
const _fcd fcd_in_filename,
Integer *n1,
const _fcd fcd_out_filename,
Integer *n2,
const _fcd fcd_atom,
Integer *n3)
{
char *sdir_name = _fcdtocp(fcd_sdir_name);
char *dir_name = _fcdtocp(fcd_dir_name);
char *in_filename = _fcdtocp(fcd_in_filename);
char *out_filename = _fcdtocp(fcd_out_filename);
char *atom = _fcdtocp(fcd_atom);
#else
(debug_ptr,lmax_ptr,locp_ptr,rlocal_ptr,
sdir_name,n9,dir_name,n0,in_filename,n1,out_filename,n2,atom,n3)
Integer *debug_ptr;
Integer *lmax_ptr;
Integer *locp_ptr;
double *rlocal_ptr;
char sdir_name[];
Integer *n9;
char dir_name[];
Integer *n0;
char in_filename[];
Integer *n1;
char out_filename[];
Integer *n2;
char atom[];
Integer *n3;
{
#endif
int debug;
int lmax_out,locp_out;
double rlocal_out;
double zatom,zion; /* local psp parameters */
double over_fourpi;
int *nl;
int i,k,l,p,p1;
int Ngrid,nrl;
double *rgrid,*psi,*psp;
double *rl, *tmp, *tmp2, *sc_rho, *sc_rhol, *sc_drho, *sc_drhol,
**psil,
**pspl;
double drl,rmax;
int lmax,locp,lmaxp;
double r0,xx;
int n[10];
int pspdat,pspcode,pspxc;
double r2well,rcore[10],e99,e999;
double rchrg,fchrg,qchrg,pi;
char *w,*tc;
FILE *fp;
char comment[255];
int argc;
int m9 = ((int) (*n9));
int m0 = ((int) (*n0));
int m1 = ((int) (*n1));
int m2 = ((int) (*n2));
int m3 = ((int) (*n3));
char *infile = (char *) malloc(m9+m1+5);
char *outfile = (char *) malloc(m0+m2+5);
char *atom_out = (char *) malloc(m3+5);
char *full_filename = (char *) malloc(m9+25+5);
debug = *debug_ptr;
lmax_out = *lmax_ptr;
locp_out = *locp_ptr;
rlocal_out = *rlocal_ptr;
(void) strncpy(infile, sdir_name, m9);
infile[m9] = '\0';
strcat(infile,"/");
infile[m9+1] = '\0';
strncat(infile,in_filename,m1);
infile[m9+m1+1] = '\0';
(void) strncpy(outfile, dir_name, m0);
outfile[m0] = '\0';
(void) strcat(outfile,"/");
outfile[m0+1] = '\0';
(void) strncat(outfile,out_filename,m2);
outfile[m0+m2+1] = '\0';
(void) strncpy(atom_out, atom, m3);
atom_out[m3] = '\0';
pi = 4.0*atan(1.0);
over_fourpi = 1.0/(4.0*pi);
/* define linear grid */
nrl = 2001;
rmax = 40.0;
drl = rmax/((double) (nrl-1));
fp = fopen(infile,"r+");
w = get_word(fp);
while ((w != ((char *) EOF)) && (strcmp("<linear>",w) != 0))
w = get_word(fp);
if (w!=((char *) EOF))
{
fscanf(fp,"%d %lf",&nrl,&drl);
rmax = ((double) (nrl-1))*drl;
}
fclose(fp);
/* Read TETER psp */
fp = fopen(infile,"r+");
w = get_word(fp);
while ((w!=NIL) && (strcmp("<TETER>",w)!=0))
w = get_word(fp);
/* Error occured */
if (w==NIL)
{
printf("Error: <TETER> section not found\n");
fclose(fp);
exit(99);
}
argc = to_eoln(fp);
argc= get_line(fp,comment,255);
fscanf(fp,"%lf %lf %d",&zatom,&zion,&pspdat);
argc=to_eoln(fp);
fscanf(fp,"%d %d %d %d %d %lf",&pspcode,&pspxc,&lmax,&locp,&Ngrid,&r2well);
lmaxp = lmax+1;
argc=to_eoln(fp);
for (p=0; p<=lmax; ++p)
{
fscanf(fp,"%d %lf %lf %d %lf",&l,&e99,&e999,&(n[p]),&(rcore[p]));
to_eoln(fp);
to_eoln(fp);
}
fscanf(fp,"%lf %lf %lf",&rchrg,&fchrg,&qchrg);
psi = (double *) malloc(Ngrid*sizeof(double));
psp = (double *) malloc(Ngrid*sizeof(double));
rgrid = (double *) malloc(Ngrid*sizeof(double));
tmp = (double *) malloc(Ngrid*sizeof(double));
tmp2 = (double *) malloc(Ngrid*sizeof(double));
sc_rho = (double *) malloc(Ngrid*sizeof(double));
sc_drho = (double *) malloc(Ngrid*sizeof(double));
/* define Teter grid */
for (i=0; i<Ngrid; ++i)
{
xx = ((double) i);
xx=xx/((double) (Ngrid-1));
xx = (xx+0.01);
xx = xx*xx*xx*xx*xx;
rgrid[i]=100.0*xx-1.0e-8;
}
/* check linear grid and redefine if necessary */
if (rmax > rgrid[Ngrid-5])
{
rmax = rgrid[Ngrid-5];
drl = rmax/((double) (nrl-1));
}
/* generate linear meshes */
rl = (double *) malloc(nrl*sizeof(double));
nl = (int *) malloc(nrl*sizeof(int));
psil = (double **) malloc(lmaxp*sizeof(double*));
pspl = (double **) malloc(lmaxp*sizeof(double*));
sc_rhol = (double *) malloc(nrl*sizeof(double));
sc_drhol = (double *) malloc(nrl*sizeof(double));
r0 = rgrid[280];
rl[0] = rgrid[280];
for (i=1; i<nrl; ++i)
{
rl[i] = drl*((double) i);
xx = (rl[i] + 1.0e-8)/100.0;
xx = pow(xx,0.2);
xx = xx-0.01;
xx = (Ngrid-1)*xx;
nl[i] = rint(xx-0.5);
}
/* read in pseudopotentials */
for (p=0; p<=lmax; ++p)
{
pspl[p] = (double *) malloc(nrl*sizeof(double));
to_eoln(fp);
to_eoln(fp);
for (i=0; i<Ngrid; ++i) fscanf(fp,"%lf",&(psp[i]));
cpi_Spline(rgrid,psp,Ngrid-4,0.0,0.0,tmp,tmp2);
pspl[p][0] = psp[280];
for (i=1; i<nrl; ++i)
{
pspl[p][i] = cpi_Splint(rgrid,psp,tmp,Ngrid-4,nl[i],rl[i]);
}
}
/* read in wavefunctions */
for (p=0; p<=lmax; ++p)
{
psil[p] = (double *) malloc(nrl*sizeof(double));
to_eoln(fp);
to_eoln(fp);
for (i=0; i<Ngrid; ++i) fscanf(fp,"%lf",&(psi[i]));
cpi_Spline(rgrid,psi,Ngrid-4,0.0,0.0,tmp,tmp2);
psil[p][0] = psi[280];
for (i=1; i<nrl; ++i)
{
psil[p][i] = cpi_Splint(rgrid,psi,tmp,Ngrid-4,nl[i],rl[i]);
}
}
/* define semicore */
if (rchrg>0.0)
{
for (i=0; i<Ngrid; ++i)
{
/*
xx = rgrid[i]/(rchrg);
gg=sin(2.0*pi*xx)/( (2.0*pi*xx)*(1.0-4.0*xx*xx)*(1.0-xx*xx) );
gg=gg*gg;
*/
xx = rgrid[i]/(rchrg);
sc_rho[i] = 4*pi*fchrg*tetercc(xx);
}
cpi_Spline(rgrid,sc_rho,Ngrid-4,0.0,0.0,tmp,tmp2);
sc_rhol[0] = sc_rho[280];
for (i=1; i<nrl; ++i)
{
sc_rhol[i] = cpi_Splint(rgrid,sc_rho,tmp,Ngrid-4,nl[i],rl[i]);
}
/* define to be zero for now since it is not used */
for (i=1; i<nrl; ++i)
{
sc_drhol[i] = 0.0;
}
}
fclose(fp);
free(tmp2);
free(tmp);
free(rgrid);
free(psp);
free(psi);
free(sc_rho);
free(sc_drho);
free(nl);
/* find the comment */
fp = fopen(infile,"r+");
w = get_word(fp);
while ((w!=NIL) && (strcmp("<comment>",w)!=0))
w = get_word(fp);
if (w!=NIL)
{
w = get_word(fp);
p = 0;
tc = comment;
while ((w!=NIL)&&(strcmp("<end>",w) != 0))
{
p = (strlen(w));
strcpy(tc, w);
for (p1=0; p1<p; ++p1) ++tc;
strcpy(tc, " ");
++tc;
w = get_word(fp);
}
}
fclose(fp);
/* write outfile */
fp = fopen(outfile,"w+");
fprintf(fp,"%s\n",atom_out);
if (locp_out!=-1) locp=locp_out;
fprintf(fp,"%lf %lf %d %d %d %lf\n",zion,0.0,lmax,lmax_out,locp,rlocal_out);
for (p=0; p<=lmax; ++p)
fprintf(fp,"%lf ", rcore[p]);
fprintf(fp,"\n");
fprintf(fp,"%d %lf\n",nrl,drl);
fprintf(fp,"%s",comment);
/* appending pseudopotentials */
for (k=0; k<nrl; ++k)
{
fprintf(fp,"%14.9lf", rl[k]);
for (p=0; p<=lmax; ++p)
fprintf(fp," %12.8lf", pspl[p][k]);
fprintf(fp,"\n");
}
for (p=0; p<=lmax; ++p) free(pspl[p]);
free(pspl);
/* appending pseudowavefunctions */
for (k=0; k<nrl; ++k)
{
fprintf(fp,"%14.9lf", rl[k]);
for (p=0; p<=lmax; ++p)
fprintf(fp," %12.8lf", psil[p][k]);
fprintf(fp,"\n");
}
for (p=0; p<=lmax; ++p) free(psil[p]);
free(psil);
/* append semicore corrections */
if (rchrg != 0.0)
{
fprintf(fp,"%lf\n",rchrg);
for (k=0; k<nrl; ++k)
fprintf(fp,"%14.9lf %12.8lf\n", rl[k],
fabs(sc_rhol[k]*over_fourpi));
for (k=0; k<nrl; ++k)
fprintf(fp,"%14.9lf %12.8lf\n", rl[k],
(sc_drhol[k]*over_fourpi));
}
free(sc_rhol);
free(sc_drhol);
free(rl);
fclose(fp);
if (debug)
{
printf("TETER pseudopotential Parameters\n\n");
printf("atom : %s\n",atom_out);
printf("Zatom= %lf\n",zatom);
printf("Zion = %lf\n",zion);
printf(" lmax= %d\n",lmax);
printf(" locp= %d\n",locp);
printf(" rlocal= %lf\n\n",rlocal_out);
printf(" rcrhg=%lf fchrg=%lf qchrg=%lf\n",rchrg,fchrg,qchrg);
printf("rcore: ");
for (p=0; p<=lmax; ++p)
printf("%lf ", rcore[p]);
printf("\n");
printf(" nrl=%d drl=%lf\n",nrl,drl);
printf("comment:%s\n",comment);
fflush(stdout);
}
/* free malloc memory */
free(infile);
free(outfile);
free(full_filename);
free(atom_out);
return;
} /* main */
double tetercc(double xx)
{
/*The c s are coefficients for Taylor expansion of the analytic form near xx=0, 1/2, and 1. */
double c21,c22,c23,c24;
double c31,c32,c33,c34;
/*local variables */
double pi,gg1cc,yy;
pi = 4.0*atan(1.0);
c21= 4.00/9.00;
c22= -40.00/27.00;
c23= 20.00/3.00-16.00*pi*pi/27.00;
c24= -4160.00/243.00+160.00*pi*pi/81.00;
c31= 1.00/36.00;
c32= -25.00/108.00;
c33= 485.00/432.00-pi*pi/27.00;
c34=-4055.00/972.00+25.00*pi*pi/81.00;
/* Cut off beyond 3/gcut=xcccrc */
if (xx>3.000)
gg1cc=0.000;
/* Take care of difficult limits near x=0, 1/2, and 1 */
else if (fabs(xx)<=1.e-9)
gg1cc=1.00;
else if (fabs(xx-0.500)<=1.0e-4)
gg1cc=c21+(xx-0.500)*(c22+(xx-0.500)*(c23+(xx-0.500)*c24));
else if (fabs(xx-1.00)<=1.e-04)
gg1cc=c31+(xx-1.000)*(c32+(xx-1.000)*(c33+(xx-1.000)*c34));
else
{
yy=sin(2.0*pi*xx)/( (2.0*pi*xx)*(1.0-4.0*xx*xx)*(1.0-xx*xx) );
gg1cc=yy*yy;
}
return gg1cc;
}