double df1dim(double x)
{
int j;
double df1=0.0;
matrix xt=NULL,df=NULL;
alloc_mtx(&xt,dncom,1);
alloc_mtx(&df,dncom,1);
for (j=1;j<=dncom;j++) xt[j][1]=dpcom[j][1]+x*dxicom[j][1];
(*nrdfun)(xt,df);
for (j=1;j<=dncom;j++) df1 += df[j][1]*dxicom[j][1];
free_mtx(&df);
free_mtx(&xt);
return (df1);
}
matrix prepare_prox_mtx(FILE *fp,int dim)
{
int i,j,n;
matrix RES=NULL;
double dist;
fscanf(fp,"%d",&pnts);
alloc_mtx(&RES,pnts,pnts);
/*
for (i=1; i<=pnts; i++) {
for (j=1; j<=pnts; j++){
fscanf(fp,"%lf",&RES[i][j]);
}
}
*/
for (i=1; i<=pnts; i++)
for (j=1; j<=pnts; j++) RES[i][j] = LARGE_COEFF;
while ((n=fscanf(fp,"%d %d %lf",&i,&j,&dist))==3) {
RES[i][j] = dist;
if (dim!=1) RES[j][i] = dist;
else RES[j][i] = -dist;
}
return(RES);
}
//build C matrix for a given molecule/system, with atom indicies (offset)/3..(offset+dim)/3
struct mtx * build_M ( int dim, int offset, double ** Am, double * sqrtKinv ) {
int i; //dummy
int iA, jA; //Am indicies
int iC, jC; //Cm indicies
int nonzero; //non-zero col/rows in Am
struct mtx * Cm; //return matrix Cm
//count non-zero elements
nonzero=0;
for ( i=offset; i<dim+offset; i++ )
if ( sqrtKinv[i] != 0 ) nonzero++;
//allocate
Cm = alloc_mtx(nonzero);
//build lapack compatible matrix from Am[offset..dim, offset..dim]
iC=jC=-1; //C index
for ( iA=offset; iA<dim+offset; iA++ ) {
if ( sqrtKinv[iA] == 0 ) continue; //suppress rows/cols full of zeros
iC++;
jC=-1;
for ( jA=offset; jA<=iA; jA++ ) {
if ( sqrtKinv[jA] == 0 ) continue; //suppress
jC++;
(Cm->val)[iC+jC*(Cm->dim)]=
Am[iA][jA]*sqrtKinv[iA]*sqrtKinv[jA];
}
}
return Cm;
}
matrix mds2res(matrix MDS, int dim)
{
int i,d;
matrix RES=NULL;
alloc_mtx(&RES,pnts,dim);
for (i=1; i<=pnts; i++)
for (d=1; d<=dim; d++)
RES[i][d] = VecEntry(MDS,dim,i,d);
return(RES);
}
/* return a vector with the first guess */
matrix generate_first_guess(int dim ,int pointNum,int range)
{
int i,j,k;
matrix guess=NULL;
alloc_mtx(&guess,dim*pointNum,1);
for (k=1; k<=dim; k++)
for (i=1; i<=pointNum; i++)
VecEntry(guess,dim,i,k) = unif_distr(0.0,(double)range);
/* guess[dim*pointNum+1][1] = unif_distr(0.0,1.0) ; trying 3 views !!!!! */
return(guess);
}
//calculate T matrix element for a particular separation
double e2body(system_t * system, atom_t * atom, pair_t * pair, double r) {
double energy;
double lr = system->polar_damp * r;
double lr2 = lr*lr;
double lr3 = lr*lr2;
double Txx = pow(r,-3)*(-2.0+(0.5*lr3+lr2+2*lr+2)*exp(-lr));
double Tyy = pow(r,-3)*(1-(0.5*lr2+lr+1)*exp(-lr));
double * eigvals;
struct mtx * M = alloc_mtx(6);
//only the sub-diagonals are non-zero
M->val[1]=M->val[2]=M->val[4]=M->val[5]=M->val[6]=M->val[8]=M->val[9]=M->val[11]=0;
M->val[12]=M->val[13]=M->val[15]=M->val[16]=M->val[19]=M->val[20]=M->val[22]=M->val[23]=0;
M->val[24]=M->val[26]=M->val[27]=M->val[29]=M->val[30]=M->val[31]=M->val[33]=M->val[34]=0;
//true diagonals
M->val[0]=M->val[7]=M->val[14]=(atom->omega)*(atom->omega);
M->val[21]=M->val[28]=M->val[35]=(pair->atom->omega)*(pair->atom->omega);
//sub-diagonals
M->val[3]=M->val[18]=
(atom->omega)*(pair->atom->omega)*sqrt(atom->polarizability*pair->atom->polarizability)*Txx;
M->val[10]=M->val[17]=M->val[25]=M->val[32]=
(atom->omega)*(pair->atom->omega)*sqrt(atom->polarizability*pair->atom->polarizability)*Tyy;
eigvals=lapack_diag(M,1);
energy = eigen2energy(eigvals, 6, system->temperature);
//subtract energy of atoms at infinity
// energy -= 3*wtanh(atom->omega, system->temperature);
energy -= 3*atom->omega;
// energy -= 3*wtanh(pair->atom->omega, system->temperature);
energy -= 3*pair->atom->omega;
free(eigvals);
free_mtx(M);
return energy * au2invsec * halfHBAR;
}
/* DJ_ee differential of the Stress Function
See declaration in Duda & Hart
the matrix M is a (pointcount*DIM)x1 matrix
----------------------------------------------*/
void DJ_ee(matrix M,matrix D)
{
int i,j,k,q;
double tot_delta,stat_coeff,Dij();
double coeff_i,d_kj;
matrix Y_k=NULL,Y_j=NULL,vec_kj=NULL,diff_k=NULL;
tot_delta = 0.0;
for (i=1; i<=pointcount; i++)
for (j=1 ; j<i; j++)
if (delta[i][j] != LARGE_COEFF)
tot_delta += delta[i][j]*delta[i][j];
stat_coeff = 2.0/tot_delta;
for (k=1; k<=pointcount; k++) {
Y_k = mtx_ver_cut(M,Sentry(k,Dim),Eentry(k,Dim));
alloc_mtx(&diff_k,Dim,1);
for (j=1; j<=pointcount; j++) {
if ((j!=k) && (delta[k][j] != LARGE_COEFF) ){
d_kj = Dij(M,k,j);
coeff_i = (d_kj - delta[k][j])/d_kj;
Y_j = mtx_ver_cut(M,Sentry(j,Dim),Eentry(j,Dim));
vec_kj = sub_mtx(Y_k,Y_j);
mul_scalar_in_mtx(vec_kj,coeff_i);
add_in_mtx(diff_k,vec_kj,1,1);
free_all_mtx(2,&Y_j,&vec_kj);
}
}
mul_scalar_in_mtx(diff_k,stat_coeff);
for (q=1; q<=Dim; q++)
VecEntry(D,Dim,k,q) = diff_k[q][1] ;
free_all_mtx(2,&Y_k,&diff_k);
}
}
