int main(int argc, char **argv){ int i,j,k; FILE *outfile; double ***f; int n=33; int ncycle=2; f = d3tensor(1,n,1,n,1,n); f[16][16][16]=1.0; // for (i=2;i<n;++i) // for (j=2;j<n;++j) // f[i][j] = 2.0; time_t bgn, end; bgn = clock(); mglin(f,n,ncycle); end = clock(); int diff = (end - bgn)*1000/CLOCKS_PER_SEC; printf("Time in ms for n=%d is %d.\n", n, diff); outfile = fopen("soln.dat", "w"); fwrite(&f[1][1][1],sizeof(double),n*n*n,outfile); fclose(outfile); }
main() { /* Change of variables info */ double *r,*dr; int N; /* Physics variables */ double *V,*Rho,*Rhonew,*phi,*Vxc,*Depsxc,*integrand,Z; int lmax,*nmax,nmaxmax; double **E,***Psi,**F; double Etot; const double alpha = 0.35; /* Working variables */ int n,l,k; double x; /* Solver iteration varibles */ int it=0; /* Value of pi */ const double pi=4.*atan(1.); /* Specs for Sb */ Z=92.; lmax=3; nmax=ivector(0,lmax); nmax[0]=6; nmax[1]=4; nmax[2]=3; nmax[3]=1; nmaxmax=0; for (l=0; l<=lmax; l++) if (nmax[l]>nmaxmax) nmaxmax=nmax[l]; F=dmatrix(0,lmax,0,nmaxmax); F[0][0]=2.; /* 1s */ F[0][1]=2.; /* 2s */ F[0][2]=2.; F[0][3]=2.; /* 1s */ F[0][4]=2.; /* 2s */ F[0][5]=2.; F[0][6]=2.; F[1][0]=6.; /* 2p */ F[1][1]=6.; /* 3p */ F[1][2]=6.; /* 4p */ F[1][3]=6.; /* 5p */ F[1][4]=6.; /* 5p */ F[2][0]=10.; /* 2p */ F[2][1]=10.; /* 3p */ F[2][2]=10.; /* 4p */ F[2][3]=1.; /* 5p */ F[3][0]=14.; /* 2p */ F[3][1]=3.; /* 3p */ /* The rest is now general for ANY case */ E=dmatrix(0,lmax,0,nmaxmax); /* Make space for E's and Psi's */ Psi=d3tensor(0,lmax,0,nmaxmax,0,Nmx); Rho=dvector(0,Nmx); Rhonew=dvector(0,Nmx); phi=dvector(0,Nmx); Vxc=dvector(0,Nmx); Depsxc=dvector(0,Nmx); integrand=dvector(0,Nmx); /* Grid vectors */ r=dvector(0,Nmx); dr=dvector(0,Nmx); V=dvector(0,Nmx); N=4000; /* Set up grid */ for (k=0; k<=N; k++) { x=((double) k)/((double) N); r[k]=1/(1-x)-1-x-x*x-x*x*x; dr[k]=1/(1-x)/(1-x)-1-2*x-3*x*x; } dr[N]=0.; /* Initialize charge density */ for (k=0; k<=N; k++) Rho[k]=0.; while(1){ it++; /* Make potential from zero charge (debugs NaNs, etc.) */ getphi(phi,Rho,r,dr,N); getVxc(Vxc,Rho,r,dr,N); for (k=0; k<=N; k++) V[k]=-Z/r[k]+phi[k]+Vxc[k]; V[0]=0.; /* Get H 1s wave function, and DENSITY */ getallEs(E,lmax,nmax,Z,V,r,dr,N); getallPsis(Psi,E,lmax,nmax,V,r,dr,N); getRho(Rhonew,Psi,F,lmax,nmax,N); for(k=0;k<=N;k++)Rho[k]=(1. - alpha)*Rho[k]+alpha*Rhonew[k]; /* Compute and output total energy */ /* Get correction to sum of electron energies */ getDepsxc(Depsxc,Rho,r,dr,N); for (k=0; k<=N; k++) integrand[k]=(-0.5*phi[k]+Depsxc[k])*Rho[k]; Etot=simpint(integrand,r,dr,N); /* Add on the sum of the electron energies times the occupancies */ for (l=0; l<=lmax; l++) for (n=0; n<=nmax[l]; n++) Etot+=F[l][n]*E[l][n]; printf("%d \t Etot: %20.15f\t E (from NIST): %f \t error: %f\n",it, Etot, -25658.417889, fabs(Etot+25658.417889)); } /* Be a good citizen and clean up... */ free_dvector(r,0,Nmx); free_dvector(dr,0,Nmx); free_dvector(V,0,Nmx); free_dmatrix(E,0,lmax,0,nmaxmax); free_dmatrix(F,0,lmax,0,nmaxmax); free_d3tensor(Psi,0,lmax,0,nmaxmax,0,Nmx); free_dvector(Rho,0,Nmx); free_dvector(Rhonew,0,Nmx); free_dvector(phi,0,Nmx); free_dvector(Vxc,0,Nmx); free_dvector(Depsxc,0,Nmx); free_dvector(integrand,0,Nmx); free_ivector(nmax,0,lmax); }
int main() { clock_t bgn, end; bgn = clock(); double C = 10; int n = 80; double *xx = dvector(1,n); for (int i = 1; i < n; i++) { xx[i] = -2 + 4*(double)i/n; } int MAX_ITER = 1000; int nsteps = 100; double ***xold = d3tensor(1,n,1,n,1,n); for (int i = 1; i < n; i++) { for (int j = 1; j < n; j++) { for (int k = 1; k < n; k++) { xold[i][j][k]=exp(-2*pow(xx[i],2))*exp(-2*pow(xx[j],2))*exp(-2*pow(xx[k],2)); } } } double ***xnew = d3tensor(1,n,1,n,1,n); double ***x = d3tensor(1,n,1,n,1,n); for (int i=1; i<=n; i++) { //boundary conditions are six planes for (int j=1; j<=n; j++) { for (int k=1; k<=n; k++) { xnew[i][j][1]=0; xnew[i][j][n]=0; xnew[i][1][k]=0; xnew[i][n][k]=0; xnew[1][j][k]=0; xnew[n][j][k]=0; } } } for (int step=1; step<nsteps; step++) { copy(n,n,n,xold,x); for (int m=1; m<MAX_ITER; m++) { for (int i = 2; i < n; i++) { for (int j = 2; j < n; j++) { for (int k = 2; k < n; k++) { xnew[i][j][k]=C/(6*C+1)*(x[i-1][j][k]+x[i+1][j][k]+x[i][j-1][k] +x[i][j+1][k]+x[i][j][k-1]+x[i][j][k+1])+ (double)1/(6*C+1)*xold[i][j][k]; } } } //ascertain if error is less than threshold in order to break double sum=0; for (int i=1; i<=n; i++) { for (int j=1; j<=n; j++) { for (int k=1; k<=n; k++) { sum+=fabs(x[i][j][k]-xnew[i][j][k]); } } } double mean = sum/(double)(n*n*n); //printf("Step: %d, Iter: %d, Sum: %lf, Mean: %lf\n",step,m,sum,mean); if (mean < 0.000000001) break; copy(n,n,n,xnew,x); } /*if (step%20==0) { printToFile(n,n,n,xnew); }*/ copy(n,n,n,x,xold); } end = clock(); printf("%d\n",end); double diff = (end - bgn) * 1000 / CLOCKS_PER_SEC; printf("Time elapsed for %d cubic size is %lf ms.\n", n, diff); }
void rattle_46_rolli(GRP_BOND_CON *grp_bond_con, CLATOMS_INFO *clatoms_info,CLATOMS_POS *clatoms_pos, PTENS *ptens,double dt,BARO *baro,int ifirst, CLASS_COMM_FORC_PKG *class_comm_forc_pkg) /*==========================================================================*/ /* Begin Routine */ {/*Begin Routine*/ /*=======================================================================*/ /* Local Variable declarations */ #include "../typ_defs/typ_mask.h" double rmass_1,rmass_2,rmass_3,rmass_4; double avec[NCON_46+1]; double pnorm; double roll_sci,dlam; double f_lnv_inc; int i,j,k,iii; int igrp,*ind1,*ind2,*ind3,*ind4,jtyp; int ktemp,ktemp1,ktemp2,ktemp3,ktemp4; int na,job,info,ipvt[NCON_46+1]; /* For dgefa and dgesl */ double *rmass1,*rmass2,*rmass3,*rmass4; double **x,**y,**z; double **vx,**vy,**vz; double *p11,*p22,*p33,*p12,*p13,*p23; double ***rmassm; double **dvx,**dvy,**dvz; double **dx,**dy,**dz; double **amat,**xlam; double *txlam,*tamat; /* Local pointers */ double *clatoms_mass = clatoms_info->mass; double *clatoms_x = clatoms_pos->x; double *clatoms_y = clatoms_pos->y; double *clatoms_z = clatoms_pos->z; double *clatoms_vx = clatoms_pos->vx; double *clatoms_vy = clatoms_pos->vy; double *clatoms_vz = clatoms_pos->vz; int *grp_bond_con_j1_46 = grp_bond_con->j1_46; int *grp_bond_con_j2_46 = grp_bond_con->j2_46; int *grp_bond_con_j3_46 = grp_bond_con->j3_46; int *grp_bond_con_j4_46 = grp_bond_con->j4_46; int *grp_bond_con_jtyp_46 = grp_bond_con->jtyp_46; double *ptens_pvten_inc = ptens->pvten_inc; double *ptens_pvten_tmp = ptens->pvten_tmp; double *ptens_pvten_tmp2 = ptens->pvten_tmp_res; double *clatoms_roll_sc = clatoms_info->roll_sc; double baro_v_lnv_g = baro->v_lnv_g; int ngrp,irem,igrp_off; int ngrp_tot = grp_bond_con->num_46; int np_forc = class_comm_forc_pkg->num_proc; int myid_forc = class_comm_forc_pkg->myid; MPI_Comm comm_forc = class_comm_forc_pkg->comm; /*=======================================================================*/ ngrp = (ngrp_tot); igrp_off = 0; /*=======================================================================*/ if(ngrp > 0){ rmass1 = dvector(1,ngrp); rmass2 = dvector(1,ngrp); rmass3 = dvector(1,ngrp); rmass4 = dvector(1,ngrp); x = dmatrix(1,4,1,ngrp); y = dmatrix(1,4,1,ngrp); z = dmatrix(1,4,1,ngrp); vx = dmatrix(1,4,1,ngrp); vy = dmatrix(1,4,1,ngrp); vz = dmatrix(1,4,1,ngrp); p11 = dvector(1,ngrp); p12 = dvector(1,ngrp); p13 = dvector(1,ngrp); p22 = dvector(1,ngrp); p23 = dvector(1,ngrp); p33 = dvector(1,ngrp); rmassm = d3tensor(1,6,1,6,1,ngrp); dvx = dmatrix(1,6,1,ngrp); dvy = dmatrix(1,6,1,ngrp); dvz = dmatrix(1,6,1,ngrp); dx = dmatrix(1,6,1,ngrp); dy = dmatrix(1,6,1,ngrp); dz = dmatrix(1,6,1,ngrp); txlam = dvector(1,6); xlam = dmatrix(1,6,1,ngrp); amat = dmatrix(1,36,1,ngrp); tamat = dvector(1,36); ind1 = (int *)calloc((ngrp+1),sizeof(int)); ind2 = (int *)calloc((ngrp+1),sizeof(int)); ind3 = (int *)calloc((ngrp+1),sizeof(int)); ind4 = (int *)calloc((ngrp+1),sizeof(int)); }/*endif*/ /*=======================================================================*/ /* Malloc up some vectors and matrices */ na = NCON_46; pnorm = 2.0/dt; ptens_pvten_tmp[1] = 0.0; ptens_pvten_tmp[2] = 0.0; ptens_pvten_tmp[3] = 0.0; ptens_pvten_tmp[4] = 0.0; ptens_pvten_tmp[5] = 0.0; ptens_pvten_tmp[6] = 0.0; ptens_pvten_tmp[7] = 0.0; ptens_pvten_tmp[8] = 0.0; ptens_pvten_tmp[9] = 0.0; /* Gather masses, positions and velocities of atoms */ for(igrp=1;igrp <= ngrp; igrp++) { ind1[igrp] = grp_bond_con_j1_46[(igrp+igrp_off)]; ind2[igrp] = grp_bond_con_j2_46[(igrp+igrp_off)]; ind3[igrp] = grp_bond_con_j3_46[(igrp+igrp_off)]; ind4[igrp] = grp_bond_con_j4_46[(igrp+igrp_off)]; } for(igrp=1;igrp <= ngrp; igrp++) { ktemp= ind1[igrp]; x[1][igrp] = clatoms_x[ktemp]; y[1][igrp] = clatoms_y[ktemp]; z[1][igrp] = clatoms_z[ktemp]; rmass1[igrp] = 1.0/clatoms_mass[ktemp]; } for(igrp=1;igrp <= ngrp; igrp++) { ktemp= ind2[igrp]; x[2][igrp] = clatoms_x[ktemp]; y[2][igrp] = clatoms_y[ktemp]; z[2][igrp] = clatoms_z[ktemp]; rmass2[igrp] = 1.0/clatoms_mass[ktemp]; } for(igrp=1;igrp <= ngrp; igrp++) { ktemp= ind3[igrp]; x[3][igrp] = clatoms_x[ktemp]; y[3][igrp] = clatoms_y[ktemp]; z[3][igrp] = clatoms_z[ktemp]; rmass3[igrp] = 1.0/clatoms_mass[ktemp]; } for(igrp=1;igrp <= ngrp; igrp++) { ktemp= ind4[igrp]; x[4][igrp] = clatoms_x[ktemp]; y[4][igrp] = clatoms_y[ktemp]; z[4][igrp] = clatoms_z[ktemp]; rmass4[igrp] = 1.0/clatoms_mass[ktemp]; } for(igrp=1;igrp <= ngrp; igrp++) { ktemp= ind1[igrp]; ktemp3= ind3[igrp]; roll_sci=1.0/clatoms_roll_sc[ktemp3];/*all roll scales the same in same cons*/ vx[1][igrp] = clatoms_vx[ktemp]+x[1][igrp]*baro_v_lnv_g*roll_sci; vy[1][igrp] = clatoms_vy[ktemp]+y[1][igrp]*baro_v_lnv_g*roll_sci; vz[1][igrp] = clatoms_vz[ktemp]+z[1][igrp]*baro_v_lnv_g*roll_sci; } for(igrp=1;igrp <= ngrp; igrp++) { ktemp= ind2[igrp]; ktemp3= ind3[igrp]; roll_sci=1.0/clatoms_roll_sc[ktemp3];/*all roll scales the same in same cons*/ vx[2][igrp] = clatoms_vx[ktemp]+x[2][igrp]*baro_v_lnv_g*roll_sci; vy[2][igrp] = clatoms_vy[ktemp]+y[2][igrp]*baro_v_lnv_g*roll_sci; vz[2][igrp] = clatoms_vz[ktemp]+z[2][igrp]*baro_v_lnv_g*roll_sci; } for(igrp=1;igrp <= ngrp; igrp++) { ktemp= ind3[igrp]; roll_sci=1.0/clatoms_roll_sc[ktemp];/*all roll scales the same in same cons*/ vx[3][igrp] = clatoms_vx[ktemp]+x[3][igrp]*baro_v_lnv_g*roll_sci; vy[3][igrp] = clatoms_vy[ktemp]+y[3][igrp]*baro_v_lnv_g*roll_sci; vz[3][igrp] = clatoms_vz[ktemp]+z[3][igrp]*baro_v_lnv_g*roll_sci; } for(igrp=1;igrp <= ngrp; igrp++) { ktemp= ind4[igrp]; ktemp3= ind3[igrp]; roll_sci=1.0/clatoms_roll_sc[ktemp3];/*all roll scales the same in same cons*/ vx[4][igrp] = clatoms_vx[ktemp]+x[4][igrp]*baro_v_lnv_g*roll_sci; vy[4][igrp] = clatoms_vy[ktemp]+y[4][igrp]*baro_v_lnv_g*roll_sci; vz[4][igrp] = clatoms_vz[ktemp]+z[4][igrp]*baro_v_lnv_g*roll_sci; } /* Set reciprocal mass matrix */ for(igrp=1;igrp <= ngrp; igrp++) { rmass_1 = rmass1[igrp]; rmass_2 = rmass2[igrp]; rmass_3 = rmass3[igrp]; rmass_4 = rmass4[igrp]; rmassm[1][1][igrp] = -(rmass_1+rmass_2); rmassm[1][2][igrp] = rmassm[1][3][igrp] = -rmass_1; rmassm[1][4][igrp] = rmassm[1][5][igrp] = rmass_2; rmassm[1][6][igrp] = 0.0; rmassm[2][1][igrp] = -rmass_1; rmassm[2][2][igrp] = -(rmass_1+rmass_3); rmassm[2][3][igrp] = -rmass_1; rmassm[2][4][igrp] = -rmass_3; rmassm[2][5][igrp] = 0.0; rmassm[2][6][igrp] = rmass_3; rmassm[3][1][igrp] = rmassm[3][2][igrp] = -rmass_1; rmassm[3][3][igrp] = -(rmass_1+rmass_4); rmassm[3][4][igrp] = 0.0; rmassm[3][5][igrp] = rmassm[3][6][igrp] = -rmass_4; rmassm[4][1][igrp] = rmass_2; rmassm[4][2][igrp] = -rmass_3; rmassm[4][3][igrp] = 0.0; rmassm[4][4][igrp] = -(rmass_2+rmass_3); rmassm[4][5][igrp] = -rmass_2; rmassm[4][6][igrp] = rmass_3; rmassm[5][1][igrp] = rmass_2; rmassm[5][2][igrp] = 0.0; rmassm[5][3][igrp] = -rmass_4; rmassm[5][4][igrp] = -rmass_2; rmassm[5][5][igrp] = -(rmass_2+rmass_4); rmassm[5][6][igrp] = -rmass_4; rmassm[6][1][igrp] = 0.0; rmassm[6][2][igrp] = rmass_3; rmassm[6][3][igrp] = -rmass_4; rmassm[6][4][igrp] = rmass_3; rmassm[6][5][igrp] = -rmass_4; rmassm[6][6][igrp] = -(rmass_3+rmass_4); } for(igrp=1;igrp <= ngrp; igrp++) { dvx[1][igrp] = vx[1][igrp]-vx[2][igrp]; dvx[2][igrp] = vx[1][igrp]-vx[3][igrp]; dvx[3][igrp] = vx[1][igrp]-vx[4][igrp]; dvx[4][igrp] = vx[2][igrp]-vx[3][igrp]; dvx[5][igrp] = vx[2][igrp]-vx[4][igrp]; dvx[6][igrp] = vx[3][igrp]-vx[4][igrp]; } for(igrp=1;igrp <= ngrp; igrp++) { dvy[1][igrp] = vy[1][igrp]-vy[2][igrp]; dvy[2][igrp] = vy[1][igrp]-vy[3][igrp]; dvy[3][igrp] = vy[1][igrp]-vy[4][igrp]; dvy[4][igrp] = vy[2][igrp]-vy[3][igrp]; dvy[5][igrp] = vy[2][igrp]-vy[4][igrp]; dvy[6][igrp] = vy[3][igrp]-vy[4][igrp]; } for(igrp=1;igrp <= ngrp; igrp++) { dvz[1][igrp] = vz[1][igrp]-vz[2][igrp]; dvz[2][igrp] = vz[1][igrp]-vz[3][igrp]; dvz[3][igrp] = vz[1][igrp]-vz[4][igrp]; dvz[4][igrp] = vz[2][igrp]-vz[3][igrp]; dvz[5][igrp] = vz[2][igrp]-vz[4][igrp]; dvz[6][igrp] = vz[3][igrp]-vz[4][igrp]; } for(igrp=1;igrp <= ngrp; igrp++) { dx[1][igrp] = x[1][igrp]-x[2][igrp]; dx[2][igrp] = x[1][igrp]-x[3][igrp]; dx[3][igrp] = x[1][igrp]-x[4][igrp]; dx[4][igrp] = x[2][igrp]-x[3][igrp]; dx[5][igrp] = x[2][igrp]-x[4][igrp]; dx[6][igrp] = x[3][igrp]-x[4][igrp]; } for(igrp=1;igrp <= ngrp; igrp++) { dy[1][igrp] = y[1][igrp]-y[2][igrp]; dy[2][igrp] = y[1][igrp]-y[3][igrp]; dy[3][igrp] = y[1][igrp]-y[4][igrp]; dy[4][igrp] = y[2][igrp]-y[3][igrp]; dy[5][igrp] = y[2][igrp]-y[4][igrp]; dy[6][igrp] = y[3][igrp]-y[4][igrp]; } for(igrp=1;igrp <= ngrp; igrp++) { dz[1][igrp] = z[1][igrp]-z[2][igrp]; dz[2][igrp] = z[1][igrp]-z[3][igrp]; dz[3][igrp] = z[1][igrp]-z[4][igrp]; dz[4][igrp] = z[2][igrp]-z[3][igrp]; dz[5][igrp] = z[2][igrp]-z[4][igrp]; dz[6][igrp] = z[3][igrp]-z[4][igrp]; }/*endfor*/ /* ========================================================================== */ /* Get initial guess for lambda */ iii = 0; for(i=1; i <= NCON_46; i++){ for(j=1; j <= NCON_46; j++){ iii++; for(igrp=1;igrp <= ngrp; igrp++) { amat[iii][igrp] =-rmassm[i][j][igrp]* (dx[i][igrp]*dx[j][igrp] + dy[i][igrp]*dy[j][igrp] + dz[i][igrp]*dz[j][igrp]); }/*endfor*/ }/*endfor*/ }/*endfor*/ for(i=1; i <= NCON_46; i++){ for(igrp=1;igrp <= ngrp; igrp++) { avec[i] = dvx[i][igrp]*dx[i][igrp] + dvy[i][igrp]*dy[i][igrp] + dvz[i][igrp]*dz[i][igrp]; xlam[i][igrp] = avec[i]; }/*endfor*/ }/*endfor*/ /* Solve linear system A xlam = avec */ for(igrp=1;igrp <= ngrp; igrp++) { ipvt[1] = 0; ipvt[2] = 0; ipvt[3] = 0; ipvt[4] = 0; ipvt[5] = 0; ipvt[6] = 0; txlam[1] = xlam[1][igrp]; txlam[2] = xlam[2][igrp]; txlam[3] = xlam[3][igrp]; txlam[4] = xlam[4][igrp]; txlam[5] = xlam[5][igrp]; txlam[6] = xlam[6][igrp]; for(i=1;i<=36;i++) { tamat[i] = amat[i][igrp]; } #ifdef IBM_ESSL dgef(&(tamat[1]),&na,&na,&(ipvt[1])); #else DGEFA(&(tamat[1]),&na,&na,&(ipvt[1]),&info); #endif job = 1; #ifdef IBM_ESSL job = 1; /*changed from 0 */ dges(&(tamat[1]),&na,&na,&(ipvt[1]),&(txlam[1]),&job); #else DGESL(&(tamat[1]),&na,&na,&(ipvt[1]),&(txlam[1]),&job); #endif xlam[1][igrp] = txlam[1]; xlam[2][igrp] = txlam[2]; xlam[3][igrp] = txlam[3]; xlam[4][igrp] = txlam[4]; xlam[5][igrp] = txlam[5]; xlam[6][igrp] = txlam[6]; }/*end for*/ /* ====================================================================== */ /* Velocity update */ #ifndef NO_PRAGMA #pragma IVDEP #endif for(igrp=1;igrp <= ngrp; igrp++) { double xlam1,xlam2,xlam3,xlam4,xlam5,xlam6; double dx1,dx2,dx3,dx4,dx5,dx6; double dy1,dy2,dy3,dy4,dy5,dy6; double dz1,dz2,dz3,dz4,dz5,dz6; ktemp1 = ind1[igrp]; ktemp2 = ind2[igrp]; ktemp3 = ind3[igrp]; ktemp4 = ind4[igrp]; dx1 = dx[1][igrp]; dx2 = dx[2][igrp]; dx3 = dx[3][igrp]; dx4 = dx[4][igrp]; dx5 = dx[5][igrp]; dx6 = dx[6][igrp]; dy1 = dy[1][igrp]; dy2 = dy[2][igrp]; dy3 = dy[3][igrp]; dy4 = dy[4][igrp]; dy5 = dy[5][igrp]; dy6 = dy[6][igrp]; dz1 = dz[1][igrp]; dz2 = dz[2][igrp]; dz3 = dz[3][igrp]; dz4 = dz[4][igrp]; dz5 = dz[5][igrp]; dz6 = dz[6][igrp]; xlam1 = xlam[1][igrp]; xlam2 = xlam[2][igrp]; xlam3 = xlam[3][igrp]; xlam4 = xlam[4][igrp]; xlam5 = xlam[5][igrp]; xlam6 = xlam[6][igrp]; rmass_1 = rmass1[igrp]; rmass_2 = rmass2[igrp]; rmass_3 = rmass3[igrp]; rmass_4 = rmass4[igrp]; clatoms_vx[ktemp1] -= ( xlam1*dx1 + xlam2*dx2 + xlam3*dx3)*rmass_1; clatoms_vy[ktemp1] -= ( xlam1*dy1 + xlam2*dy2 + xlam3*dy3)*rmass_1; clatoms_vz[ktemp1] -= ( xlam1*dz1 + xlam2*dz2 + xlam3*dz3)*rmass_1; clatoms_vx[ktemp2] -= (-xlam1*dx1 + xlam4*dx4 + xlam5*dx5)*rmass_2; clatoms_vy[ktemp2] -= (-xlam1*dy1 + xlam4*dy4 + xlam5*dy5)*rmass_2; clatoms_vz[ktemp2] -= (-xlam1*dz1 + xlam4*dz4 + xlam5*dz5)*rmass_2; clatoms_vx[ktemp3] -= (-xlam2*dx2 - xlam4*dx4 + xlam6*dx6)*rmass_3; clatoms_vy[ktemp3] -= (-xlam2*dy2 - xlam4*dy4 + xlam6*dy6)*rmass_3; clatoms_vz[ktemp3] -= (-xlam2*dz2 - xlam4*dz4 + xlam6*dz6)*rmass_3; clatoms_vx[ktemp4] -= (-xlam3*dx3 - xlam5*dx5 - xlam6*dx6)*rmass_4; clatoms_vy[ktemp4] -= (-xlam3*dy3 - xlam5*dy5 - xlam6*dy6)*rmass_4; clatoms_vz[ktemp4] -= (-xlam3*dz3 - xlam5*dz5 - xlam6*dz6)*rmass_4; /* Pressure tensor update */ p11[igrp] = xlam1*dx1*dx1 + xlam2*dx2*dx2 + xlam3*dx3*dx3 + xlam4*dx4*dx4 + xlam5*dx5*dx5 + xlam6*dx6*dx6; p22[igrp] = xlam1*dy1*dy1 + xlam2*dy2*dy2 + xlam3*dy3*dy3 + xlam4*dy4*dy4 + xlam5*dy5*dy5 + xlam6*dy6*dy6; p33[igrp] = xlam1*dz1*dz1 + xlam2*dz2*dz2 + xlam3*dz3*dz3 + xlam4*dz4*dz4 + xlam5*dz5*dz5 + xlam6*dz6*dz6; p12[igrp] = xlam1*dx1*dy1 + xlam2*dx2*dy2 + xlam3*dx3*dy3 + xlam4*dx4*dy4 + xlam5*dx5*dy5 + xlam6*dx6*dy6; p13[igrp] = xlam1*dx1*dz1 + xlam2*dx2*dz2 + xlam3*dx3*dz3 + xlam4*dx4*dz4 + xlam5*dx5*dz5 + xlam6*dx6*dz6; p23[igrp] = xlam1*dy1*dz1 + xlam2*dy2*dz2 + xlam3*dy3*dz3 + xlam4*dy4*dz4 + xlam5*dy5*dz5 + xlam6*dy6*dz6; }/*endfor*/ #ifndef NO_PRAGMA #pragma IVDEP #endif for(igrp=1;igrp <= ngrp; igrp++) { ptens_pvten_tmp[1] -= (p11[igrp]*pnorm); ptens_pvten_tmp[2] -= (p12[igrp]*pnorm); ptens_pvten_tmp[3] -= (p13[igrp]*pnorm); ptens_pvten_tmp[4] -= (p12[igrp]*pnorm); ptens_pvten_tmp[5] -= (p22[igrp]*pnorm); ptens_pvten_tmp[6] -= (p23[igrp]*pnorm); ptens_pvten_tmp[7] -= (p13[igrp]*pnorm); ptens_pvten_tmp[8] -= (p23[igrp]*pnorm); ptens_pvten_tmp[9] -= (p33[igrp]*pnorm); } /* end for igrp */ /*=======================================================================*/ /* IV)Allreduce pvten_tmp */ if(np_forc > 1 ){ for(i=1;i<=9;i++){ ptens_pvten_tmp2[i] = ptens_pvten_tmp[i]; }/*endfor*/ Allreduce(&(ptens_pvten_tmp2[1]), &(ptens_pvten_tmp[1]),9,MPI_DOUBLE, MPI_SUM,0,comm_forc); }/*endif*/ ptens_pvten_inc[1] += ptens_pvten_tmp[1]; ptens_pvten_inc[2] += ptens_pvten_tmp[2]; ptens_pvten_inc[3] += ptens_pvten_tmp[3]; ptens_pvten_inc[4] += ptens_pvten_tmp[4]; ptens_pvten_inc[5] += ptens_pvten_tmp[5]; ptens_pvten_inc[6] += ptens_pvten_tmp[6]; ptens_pvten_inc[7] += ptens_pvten_tmp[7]; ptens_pvten_inc[8] += ptens_pvten_tmp[8]; ptens_pvten_inc[9] += ptens_pvten_tmp[9]; if(ifirst == 0){ f_lnv_inc = (ptens_pvten_tmp[1]+ptens_pvten_tmp[5] +ptens_pvten_tmp[9]); baro->f_lnv_p += f_lnv_inc; baro->v_lnv_g += f_lnv_inc*(baro->roll_scg)*0.5*dt/(baro->mass_lnv); } /* free locally assigned memory */ if(ngrp > 0){ free_dvector(rmass1,1,ngrp); free_dvector(rmass2,1,ngrp); free_dvector(rmass3,1,ngrp); free_dvector(rmass4,1,ngrp); free_dmatrix(x,1,4,1,ngrp); free_dmatrix(y,1,4,1,ngrp); free_dmatrix(z,1,4,1,ngrp); free_dmatrix(vx,1,4,1,ngrp); free_dmatrix(vy,1,4,1,ngrp); free_dmatrix(vz,1,4,1,ngrp); free_dvector(p11,1,ngrp); free_dvector(p12,1,ngrp); free_dvector(p13,1,ngrp); free_dvector(p22,1,ngrp); free_dvector(p23,1,ngrp); free_dvector(p33,1,ngrp); free_d3tensor(rmassm,1,6,1,6,1,ngrp); free_dmatrix(dvx,1,6,1,ngrp); free_dmatrix(dvy,1,6,1,ngrp); free_dmatrix(dvz,1,6,1,ngrp); free_dmatrix(dx,1,6,1,ngrp); free_dmatrix(dy,1,6,1,ngrp); free_dmatrix(dz,1,6,1,ngrp); free_dvector(txlam,1,6); free_dmatrix(xlam,1,6,1,ngrp); free_dmatrix(amat,1,36,1,ngrp); free_dvector(tamat,1,36); free(ind1); free(ind2); free(ind3); free(ind4); }/*endif*/ /*=======================================================================*/ /*=======================================================================*/ } /* end routine */
/*==========================================================================*/ void shake_46_rolli(GRP_BOND_CON *grp_bond_con, CLATOMS_INFO *clatoms_info,CLATOMS_POS *clatoms_pos, PTENS *ptens,double dt,double *aiter, BARO *baro, int ifirst, CLASS_COMM_FORC_PKG *class_comm_forc_pkg) /*==========================================================================*/ /* Begin Routine */ {/*Begin Routine*/ /*=======================================================================*/ /* Local Variable declarations */ #include "../typ_defs/typ_mask.h" double xl0[NCON_46+1],dmax; double rms1,rms2,rms3,rms4; double ftemp; double dts; int i,j,iii; int iter,igrp,*ind1,*ind2,*ind3,*ind4,jtyp; int ktemp,ktemp1,ktemp2,ktemp3,ktemp4; int na,job,info,ipvt[NCON_46+1]; /* For dgefa and dgesl */ /* AAA */ double *rmass1,*rmass2,*rmass3,*rmass4,*dlmax,*txlam,*tamat; double **dx,**dy,**dz; double **dxt,**dyt,**dzt; double **dxn,**dyn,**dzn; double **xlam,**avec,**dxl,**dij,**amat; double ***rmassm; double **x,**y,**z; double **xo,**yo,**zo; double *p11,*p12,*p13,*p22,*p23,*p33; /* Local pointers */ double *clatoms_mass = clatoms_info->mass; double *clatoms_x = clatoms_pos->x; double *clatoms_y = clatoms_pos->y; double *clatoms_z = clatoms_pos->z; double *clatoms_vx = clatoms_pos->vx; double *clatoms_vy = clatoms_pos->vy; double *clatoms_vz = clatoms_pos->vz; double *clatoms_xold = clatoms_info->xold; double *clatoms_yold = clatoms_info->yold; double *clatoms_zold = clatoms_info->zold; int *grp_bond_con_j1_46 = grp_bond_con->j1_46; int *grp_bond_con_j2_46 = grp_bond_con->j2_46; int *grp_bond_con_j3_46 = grp_bond_con->j3_46; int *grp_bond_con_j4_46 = grp_bond_con->j4_46; int *grp_bond_con_jtyp_46 = grp_bond_con->jtyp_46; double **grp_bond_con_eq_46 = grp_bond_con->eq_46; double **grp_bond_con_al_46 = grp_bond_con->al_46; double *ptens_pvten_inc = ptens->pvten_inc; double *ptens_pvten_tmp = ptens->pvten_tmp; double *ptens_pvten_tmp2 = ptens->pvten_tmp_res; double pnorm; double baro_roll_scv = baro->roll_scv; int ngrp,irem,igrp_off; int ngrp_tot = grp_bond_con->num_46; int np_forc = class_comm_forc_pkg->num_proc; int myid_forc = class_comm_forc_pkg->myid; MPI_Comm comm_forc = class_comm_forc_pkg->comm; /*=======================================================================*/ ngrp = (ngrp_tot); igrp_off = 0; /*=======================================================================*/ if(ngrp > 0){ dlmax= dvector(1,6); txlam= dvector(1,6); rmassm= d3tensor(1,6,1,6,1,ngrp); amat= dmatrix(1,36,1,ngrp); xlam= dmatrix(1,6,1,ngrp); avec= dmatrix(1,6,1,ngrp); dxl= dmatrix(1,6,1,ngrp); dij= dmatrix(1,6,1,ngrp); dx= dmatrix(1,6,1,ngrp); dy= dmatrix(1,6,1,ngrp); dz= dmatrix(1,6,1,ngrp); dxt= dmatrix(1,6,1,ngrp); dyt= dmatrix(1,6,1,ngrp); dzt= dmatrix(1,6,1,ngrp); dxn= dmatrix(1,6,1,ngrp); dyn= dmatrix(1,6,1,ngrp); dzn= dmatrix(1,6,1,ngrp); rmass1= dvector(1,ngrp); rmass2= dvector(1,ngrp); rmass3= dvector(1,ngrp); rmass4= dvector(1,ngrp); x= dmatrix(1,4,1,ngrp); y= dmatrix(1,4,1,ngrp); z= dmatrix(1,4,1,ngrp); xo= dmatrix(1,4,1,ngrp); yo= dmatrix(1,4,1,ngrp); zo= dmatrix(1,4,1,ngrp); p11= dvector(1,ngrp); p12= dvector(1,ngrp); p13= dvector(1,ngrp); p22= dvector(1,ngrp); p23= dvector(1,ngrp); p33= dvector(1,ngrp); tamat= dvector(1,36); ind1= (int *)calloc((ngrp+1),sizeof(int)); ind2= (int *)calloc((ngrp+1),sizeof(int)); ind3= (int *)calloc((ngrp+1),sizeof(int)); ind4= (int *)calloc((ngrp+1),sizeof(int)); }/*endif*/ /*=======================================================================*/ /* Malloc up some vectors and matrices */ na = NCON_46; /* AA */ dts = dt*dt; pnorm = 2.0/dts; *aiter = 0.0; ptens_pvten_tmp[1] = 0.0; ptens_pvten_tmp[2] = 0.0; ptens_pvten_tmp[3] = 0.0; ptens_pvten_tmp[4] = 0.0; ptens_pvten_tmp[5] = 0.0; ptens_pvten_tmp[6] = 0.0; ptens_pvten_tmp[7] = 0.0; ptens_pvten_tmp[8] = 0.0; ptens_pvten_tmp[9] = 0.0; if(ifirst == 2){ for(igrp=1;igrp <= ngrp; igrp++) { grp_bond_con_al_46[1][(igrp+igrp_off)] = 0.0; grp_bond_con_al_46[2][(igrp+igrp_off)] = 0.0; grp_bond_con_al_46[3][(igrp+igrp_off)] = 0.0; grp_bond_con_al_46[4][(igrp+igrp_off)] = 0.0; grp_bond_con_al_46[5][(igrp+igrp_off)] = 0.0; grp_bond_con_al_46[6][(igrp+igrp_off)] = 0.0; }/*endif*/ }/*endif*/ for(igrp=1;igrp <= ngrp; igrp++) { ind1[igrp] = grp_bond_con_j1_46[(igrp+igrp_off)]; ind2[igrp] = grp_bond_con_j2_46[(igrp+igrp_off)]; ind3[igrp] = grp_bond_con_j3_46[(igrp+igrp_off)]; ind4[igrp] = grp_bond_con_j4_46[(igrp+igrp_off)]; } for(igrp=1;igrp <= ngrp; igrp++) { ktemp= ind1[igrp]; x[1][igrp] = clatoms_x[ktemp]; y[1][igrp] = clatoms_y[ktemp]; z[1][igrp] = clatoms_z[ktemp]; rmass1[igrp] = 1.0/clatoms_mass[ktemp]; } for(igrp=1;igrp <= ngrp; igrp++) { ktemp= ind2[igrp]; x[2][igrp] = clatoms_x[ktemp]; y[2][igrp] = clatoms_y[ktemp]; z[2][igrp] = clatoms_z[ktemp]; rmass2[igrp] = 1.0/clatoms_mass[ktemp]; } for(igrp=1;igrp <= ngrp; igrp++) { ktemp= ind3[igrp]; x[3][igrp] = clatoms_x[ktemp]; y[3][igrp] = clatoms_y[ktemp]; z[3][igrp] = clatoms_z[ktemp]; rmass3[igrp] = 1.0/clatoms_mass[ktemp]; } for(igrp=1;igrp <= ngrp; igrp++) { ktemp= ind4[igrp]; x[4][igrp] = clatoms_x[ktemp]; y[4][igrp] = clatoms_y[ktemp]; z[4][igrp] = clatoms_z[ktemp]; rmass4[igrp] = 1.0/clatoms_mass[ktemp]; } for(igrp=1;igrp <= ngrp; igrp++) { ktemp= ind1[igrp]; xo[1][igrp] = clatoms_xold[ktemp]; yo[1][igrp] = clatoms_yold[ktemp]; zo[1][igrp] = clatoms_zold[ktemp]; } for(igrp=1;igrp <= ngrp; igrp++) { ktemp= ind2[igrp]; xo[2][igrp] = clatoms_xold[ktemp]; yo[2][igrp] = clatoms_yold[ktemp]; zo[2][igrp] = clatoms_zold[ktemp]; } for(igrp=1;igrp <= ngrp; igrp++) { ktemp= ind3[igrp]; xo[3][igrp] = clatoms_xold[ktemp]; yo[3][igrp] = clatoms_yold[ktemp]; zo[3][igrp] = clatoms_zold[ktemp]; } for(igrp=1;igrp <= ngrp; igrp++) { ktemp= ind4[igrp]; xo[4][igrp] = clatoms_xold[ktemp]; yo[4][igrp] = clatoms_yold[ktemp]; zo[4][igrp] = clatoms_zold[ktemp]; } /* ============================================================================= */ /* Gather the equilibrium bond lengths */ for(igrp=1;igrp <= ngrp; igrp++) { jtyp = grp_bond_con_jtyp_46[(igrp+igrp_off)]; dij[1][igrp] = grp_bond_con_eq_46[1][jtyp]; dij[2][igrp] = grp_bond_con_eq_46[2][jtyp]; dij[3][igrp] = grp_bond_con_eq_46[3][jtyp]; dij[4][igrp] = grp_bond_con_eq_46[4][jtyp]; dij[5][igrp] = grp_bond_con_eq_46[5][jtyp]; dij[6][igrp] = grp_bond_con_eq_46[6][jtyp]; }/*end for*/ /* ============================================================================= */ /* Calculate the recip mass tensor and bond distances */ for(igrp=1;igrp <= ngrp; igrp++) { rms1 = rmass1[igrp]; rms2 = rmass2[igrp]; rms3 = rmass3[igrp]; rms4 = rmass4[igrp]; rmassm[1][1][igrp] = -(rms1+rms2); rmassm[1][2][igrp] = rmassm[1][3][igrp] = -rms1; rmassm[1][4][igrp] = rmassm[1][5][igrp] = rms2; rmassm[1][6][igrp] = 0.0; rmassm[2][1][igrp] = -rms1; rmassm[2][2][igrp] = -(rms1+rms3); rmassm[2][3][igrp] = -rms1; rmassm[2][4][igrp] = -rms3; rmassm[2][5][igrp] = 0.0; rmassm[2][6][igrp] = rms3; rmassm[3][1][igrp] = rmassm[3][2][igrp] = -rms1; rmassm[3][3][igrp] = -(rms1+rms4); rmassm[3][4][igrp] = 0.0; rmassm[3][5][igrp] = rmassm[3][6][igrp] = -rms4; rmassm[4][1][igrp] = rms2; rmassm[4][2][igrp] = -rms3; rmassm[4][3][igrp] = 0.0; rmassm[4][4][igrp] = -(rms2+rms3); rmassm[4][5][igrp] = -rms2; rmassm[4][6][igrp] = rms3; rmassm[5][1][igrp] = rms2; rmassm[5][2][igrp] = 0.0; rmassm[5][3][igrp] = -rms4; rmassm[5][4][igrp] = -rms2; rmassm[5][5][igrp] = -(rms2+rms4); rmassm[5][6][igrp] = -rms4; rmassm[6][1][igrp] = 0.0; rmassm[6][2][igrp] = rms3; rmassm[6][3][igrp] = -rms4; rmassm[6][4][igrp] = rms3; rmassm[6][5][igrp] = -rms4; rmassm[6][6][igrp] = -(rms3+rms4); } /* Compute difference vectors : Old distances scaled*/ for(igrp=1;igrp <= ngrp; igrp++) { dxt[1][igrp] = x[1][igrp]-x[2][igrp]; dxt[2][igrp] = x[1][igrp]-x[3][igrp]; dxt[3][igrp] = x[1][igrp]-x[4][igrp]; dxt[4][igrp] = x[2][igrp]-x[3][igrp]; dxt[5][igrp] = x[2][igrp]-x[4][igrp]; dxt[6][igrp] = x[3][igrp]-x[4][igrp]; dyt[1][igrp] = y[1][igrp]-y[2][igrp]; dyt[2][igrp] = y[1][igrp]-y[3][igrp]; dyt[3][igrp] = y[1][igrp]-y[4][igrp]; dyt[4][igrp] = y[2][igrp]-y[3][igrp]; dyt[5][igrp] = y[2][igrp]-y[4][igrp]; dyt[6][igrp] = y[3][igrp]-y[4][igrp]; dzt[1][igrp] = z[1][igrp]-z[2][igrp]; dzt[2][igrp] = z[1][igrp]-z[3][igrp]; dzt[3][igrp] = z[1][igrp]-z[4][igrp]; dzt[4][igrp] = z[2][igrp]-z[3][igrp]; dzt[5][igrp] = z[2][igrp]-z[4][igrp]; dzt[6][igrp] = z[3][igrp]-z[4][igrp]; dx[1][igrp] = (xo[1][igrp]-xo[2][igrp])*baro_roll_scv; dx[2][igrp] = (xo[1][igrp]-xo[3][igrp])*baro_roll_scv; dx[3][igrp] = (xo[1][igrp]-xo[4][igrp])*baro_roll_scv; dx[4][igrp] = (xo[2][igrp]-xo[3][igrp])*baro_roll_scv; dx[5][igrp] = (xo[2][igrp]-xo[4][igrp])*baro_roll_scv; dx[6][igrp] = (xo[3][igrp]-xo[4][igrp])*baro_roll_scv; dy[1][igrp] = (yo[1][igrp]-yo[2][igrp])*baro_roll_scv; dy[2][igrp] = (yo[1][igrp]-yo[3][igrp])*baro_roll_scv; dy[3][igrp] = (yo[1][igrp]-yo[4][igrp])*baro_roll_scv; dy[4][igrp] = (yo[2][igrp]-yo[3][igrp])*baro_roll_scv; dy[5][igrp] = (yo[2][igrp]-yo[4][igrp])*baro_roll_scv; dy[6][igrp] = (yo[3][igrp]-yo[4][igrp])*baro_roll_scv; dz[1][igrp] = (zo[1][igrp]-zo[2][igrp])*baro_roll_scv; dz[2][igrp] = (zo[1][igrp]-zo[3][igrp])*baro_roll_scv; dz[3][igrp] = (zo[1][igrp]-zo[4][igrp])*baro_roll_scv; dz[4][igrp] = (zo[2][igrp]-zo[3][igrp])*baro_roll_scv; dz[5][igrp] = (zo[2][igrp]-zo[4][igrp])*baro_roll_scv; dz[6][igrp] = (zo[3][igrp]-zo[4][igrp])*baro_roll_scv; } /* end loop over groups */ /* =========================================================================== */ /* Get initial guess for lambda */ for(igrp=1;igrp <= ngrp; igrp++) { avec[1][igrp] = dij[1][igrp]*dij[1][igrp] - (dxt[1][igrp]*dxt[1][igrp] + dyt[1][igrp]*dyt[1][igrp] + dzt[1][igrp]*dzt[1][igrp]); avec[2][igrp] = dij[2][igrp]*dij[2][igrp] - (dxt[2][igrp]*dxt[2][igrp] + dyt[2][igrp]*dyt[2][igrp] + dzt[2][igrp]*dzt[2][igrp]); avec[3][igrp] = dij[3][igrp]*dij[3][igrp] - (dxt[3][igrp]*dxt[3][igrp] + dyt[3][igrp]*dyt[3][igrp] + dzt[3][igrp]*dzt[3][igrp]); avec[4][igrp] = dij[4][igrp]*dij[4][igrp] - (dxt[4][igrp]*dxt[4][igrp] + dyt[4][igrp]*dyt[4][igrp] + dzt[4][igrp]*dzt[4][igrp]); avec[5][igrp] = dij[5][igrp]*dij[5][igrp] - (dxt[5][igrp]*dxt[5][igrp] + dyt[5][igrp]*dyt[5][igrp] + dzt[5][igrp]*dzt[5][igrp]); avec[6][igrp] = dij[6][igrp]*dij[6][igrp] - (dxt[6][igrp]*dxt[6][igrp] + dyt[6][igrp]*dyt[6][igrp] + dzt[6][igrp]*dzt[6][igrp]); }/* endfor */ if(ifirst == 2 || ifirst == 0){ iii = 0; for(i=1; i <= NCON_46; i++){ for(j=1; j <= NCON_46; j++){ iii++; for(igrp=1;igrp <= ngrp; igrp++) { amat[iii][igrp] = 2.0*rmassm[i][j][igrp]* (dxt[i][igrp]*dx[j][igrp] + dyt[i][igrp]*dy[j][igrp] + dzt[i][igrp]*dz[j][igrp]); }/*endfor igrp*/ }/*endfor j*/ }/*endfor i*/ for(igrp=1;igrp <= ngrp; igrp++) { xlam[1][igrp] = avec[1][igrp]; xlam[2][igrp] = avec[2][igrp]; xlam[3][igrp] = avec[3][igrp]; xlam[4][igrp] = avec[4][igrp]; xlam[5][igrp] = avec[5][igrp]; xlam[6][igrp] = avec[6][igrp]; txlam[1]=xlam[1][igrp]; txlam[2]=xlam[2][igrp]; txlam[3]=xlam[3][igrp]; txlam[4]=xlam[4][igrp]; txlam[5]=xlam[5][igrp]; txlam[6]=xlam[6][igrp]; for(i=1; i<=36 ; i++) { tamat[i]= amat[i][igrp]; } /* Solve linear system A xlam = avec */ ipvt[1]=0; ipvt[2]=0; ipvt[3]=0; ipvt[4]=0; ipvt[5]=0; ipvt[6]=0; #ifdef IBM_ESSL dgef(&(tamat[1]),&na,&na,&(ipvt[1])); #else DGEFA(&(tamat[1]),&na,&na,&(ipvt[1]),&info); #endif job = 1; #ifdef IBM_ESSL job = 1; /*changed from 0 */ dges(&(tamat[1]),&na,&na,&(ipvt[1]),&(txlam[1]),&job); #else DGESL(&(tamat[1]),&na,&na,&(ipvt[1]),&(txlam[1]),&job); #endif xlam[1][igrp] = txlam[1]; xlam[2][igrp] = txlam[2]; xlam[3][igrp] = txlam[3]; xlam[4][igrp] = txlam[4]; xlam[5][igrp] = txlam[5]; xlam[6][igrp] = txlam[6]; } /* end loop over groups */ } else { for(igrp=1;igrp <= ngrp; igrp++) { xlam[1][igrp] = grp_bond_con_al_46[1][(igrp+igrp_off)]; xlam[2][igrp] = grp_bond_con_al_46[2][(igrp+igrp_off)]; xlam[3][igrp] = grp_bond_con_al_46[3][(igrp+igrp_off)]; xlam[4][igrp] = grp_bond_con_al_46[4][(igrp+igrp_off)]; xlam[5][igrp] = grp_bond_con_al_46[5][(igrp+igrp_off)]; xlam[6][igrp] = grp_bond_con_al_46[6][(igrp+igrp_off)]; grp_bond_con_al_46[1][(igrp+igrp_off)] = 0.0; grp_bond_con_al_46[2][(igrp+igrp_off)] = 0.0; grp_bond_con_al_46[3][(igrp+igrp_off)] = 0.0; grp_bond_con_al_46[4][(igrp+igrp_off)] = 0.0; grp_bond_con_al_46[5][(igrp+igrp_off)] = 0.0; grp_bond_con_al_46[6][(igrp+igrp_off)] = 0.0; } /* end for */ } /* Iterative loop to convergence */ if(ngrp > 0){ dmax = 1.0; iter = 0; do { ++iter; if(iter > grp_bond_con->max_iter) { printf("$$$$$$$$$$$$$$$$$$$$_WARNING_$$$$$$$$$$$$$$$$$$$$\n"); printf("Group constraint Shake not converged after %d iterations.\n", grp_bond_con->max_iter); printf("The present tolerance is %g \n",dmax); printf("The desired tolerance is %g \n",grp_bond_con->tol); printf("$$$$$$$$$$$$$$$$$$$$_WARNING_$$$$$$$$$$$$$$$$$$$$\n"); fflush(stdout); break; }/*endif*/ for(igrp=1;igrp <= ngrp; igrp++) { /* Set up guess of difference vectors */ dxn[1][igrp] = 2.0*dxt[1][igrp]; dxn[2][igrp] = 2.0*dxt[2][igrp]; dxn[3][igrp] = 2.0*dxt[3][igrp]; dxn[4][igrp] = 2.0*dxt[4][igrp]; dxn[5][igrp] = 2.0*dxt[5][igrp]; dxn[6][igrp] = 2.0*dxt[6][igrp]; dyn[1][igrp] = 2.0*dyt[1][igrp]; dyn[2][igrp] = 2.0*dyt[2][igrp]; dyn[3][igrp] = 2.0*dyt[3][igrp]; dyn[4][igrp] = 2.0*dyt[4][igrp]; dyn[5][igrp] = 2.0*dyt[5][igrp]; dyn[6][igrp] = 2.0*dyt[6][igrp]; dzn[1][igrp] = 2.0*dzt[1][igrp]; dzn[2][igrp] = 2.0*dzt[2][igrp]; dzn[3][igrp] = 2.0*dzt[3][igrp]; dzn[4][igrp] = 2.0*dzt[4][igrp]; dzn[5][igrp] = 2.0*dzt[5][igrp]; dzn[6][igrp] = 2.0*dzt[6][igrp]; }/*endfor*/ for(i=1; i <= NCON_46; i++) { for(j=1; j <= NCON_46; j++) { for(igrp=1;igrp <= ngrp; igrp++) { dxn[i][igrp] += rmassm[i][j][igrp]*xlam[j][igrp]*dx[j][igrp]; dyn[i][igrp] += rmassm[i][j][igrp]*xlam[j][igrp]*dy[j][igrp]; dzn[i][igrp] += rmassm[i][j][igrp]*xlam[j][igrp]*dz[j][igrp]; }/*endfor*/ }/*endfor*/ }/*endfor*/ /* Construct A-matrix */ iii = 0; for(i=1; i <= NCON_46; i++) { for(j=1; j <= NCON_46; j++) { iii++; for(igrp=1;igrp <= ngrp; igrp++) { amat[iii][igrp] = rmassm[i][j][igrp]* (dxn[i][igrp]*dx[j][igrp] + dyn[i][igrp]*dy[j][igrp] + dzn[i][igrp]*dz[j][igrp]); }/*endfor*/ }/*endfor*/ }/*endfor*/ for(igrp=1;igrp <= ngrp; igrp++) { xl0[1] = xlam[1][igrp]; xl0[2] = xlam[2][igrp]; xl0[3] = xlam[3][igrp]; xl0[4] = xlam[4][igrp]; xl0[5] = xlam[5][igrp]; xl0[6] = xlam[6][igrp]; xlam[1][igrp] = avec[1][igrp]; xlam[2][igrp] = avec[2][igrp]; xlam[3][igrp] = avec[3][igrp]; xlam[4][igrp] = avec[4][igrp]; xlam[5][igrp] = avec[5][igrp]; xlam[6][igrp] = avec[6][igrp]; txlam[1]= xlam[1][igrp]; txlam[2]= xlam[2][igrp]; txlam[3]= xlam[3][igrp]; txlam[4]= xlam[4][igrp]; txlam[5]= xlam[5][igrp]; txlam[6]= xlam[6][igrp]; for(i=1;i<=36; i++ ) { tamat[i]= amat[i][igrp]; } /* Solve linear system A xlam = avec */ ipvt[1] = 0; ipvt[2] = 0; ipvt[3] = 0; ipvt[4] = 0; ipvt[5] = 0; ipvt[6] = 0; #ifdef IBM_ESSL dgef(&(tamat[1]),&na,&na,&(ipvt[1])); #else DGEFA(&(tamat[1]),&na,&na,&(ipvt[1]),&info); #endif job = 1; #ifdef IBM_ESSL job = 1; /*changed from 0 */ dges(&(tamat[1]),&na,&na,&(ipvt[1]),&(txlam[1]),&job); #else DGESL(&(tamat[1]),&na,&na,&(ipvt[1]),&(txlam[1]),&job); #endif xlam[1][igrp] = txlam[1]; xlam[2][igrp] = txlam[2]; xlam[3][igrp] = txlam[3]; xlam[4][igrp] = txlam[4]; xlam[5][igrp] = txlam[5]; xlam[6][igrp] = txlam[6]; dxl[1][igrp] = fabs(xlam[1][igrp]-xl0[1]); dxl[2][igrp] = fabs(xlam[2][igrp]-xl0[2]); dxl[3][igrp] = fabs(xlam[3][igrp]-xl0[3]); dxl[4][igrp] = fabs(xlam[4][igrp]-xl0[4]); dxl[5][igrp] = fabs(xlam[5][igrp]-xl0[5]); dxl[6][igrp] = fabs(xlam[6][igrp]-xl0[6]); }/*endfor*/ /* Convergence criteria */ dlmax[1]= dxl[1][1]; dlmax[2]= dxl[2][1]; dlmax[3]= dxl[3][1]; dlmax[4]= dxl[4][1]; dlmax[5]= dxl[5][1]; dlmax[6]= dxl[6][1]; for(igrp=2;igrp <= ngrp; igrp++) { dlmax[1]= (dlmax[1] > dxl[1][igrp] ? dlmax[1]: dxl[1][igrp]); dlmax[2]= (dlmax[2] > dxl[2][igrp] ? dlmax[2]: dxl[2][igrp]); dlmax[3]= (dlmax[3] > dxl[3][igrp] ? dlmax[3]: dxl[3][igrp]); dlmax[4]= (dlmax[4] > dxl[4][igrp] ? dlmax[4]: dxl[4][igrp]); dlmax[5]= (dlmax[5] > dxl[5][igrp] ? dlmax[5]: dxl[5][igrp]); dlmax[6]= (dlmax[6] > dxl[6][igrp] ? dlmax[6]: dxl[6][igrp]); }/*end loop over groups */ dmax=dlmax[1]; for(i=2;i <= NCON_46; i++) { dmax = (dmax > dlmax[i] ? dmax : dlmax[i]); }/*endfor*/ } while(dmax > grp_bond_con->tol); *aiter += (double) iter; }/*endif for ngrp > 0*/ /* Position update */ #ifndef NO_PRAGMA #pragma IVDEP #endif for(igrp=1;igrp <= ngrp; igrp++) { double xlam1,xlam2,xlam3,xlam4,xlam5,xlam6; double dx1,dx2,dx3,dx4,dx5,dx6; double dy1,dy2,dy3,dy4,dy5,dy6; double dz1,dz2,dz3,dz4,dz5,dz6; ktemp1 =ind1[igrp]; ktemp2 =ind2[igrp]; ktemp3 =ind3[igrp]; ktemp4 =ind4[igrp]; xlam1= xlam[1][igrp]; xlam2= xlam[2][igrp]; xlam3= xlam[3][igrp]; xlam4= xlam[4][igrp]; xlam5= xlam[5][igrp]; xlam6= xlam[6][igrp]; rms1 = rmass1[igrp]; rms2 = rmass2[igrp]; rms3 = rmass3[igrp]; rms4 = rmass4[igrp]; x[1][igrp] = clatoms_x[ktemp1]; y[1][igrp] = clatoms_y[ktemp1]; z[1][igrp] = clatoms_z[ktemp1]; x[2][igrp] = clatoms_x[ktemp2]; y[2][igrp] = clatoms_y[ktemp2]; z[2][igrp] = clatoms_z[ktemp2]; x[3][igrp] = clatoms_x[ktemp3]; y[3][igrp] = clatoms_y[ktemp3]; z[3][igrp] = clatoms_z[ktemp3]; x[4][igrp] = clatoms_x[ktemp4]; y[4][igrp] = clatoms_y[ktemp4]; z[4][igrp] = clatoms_z[ktemp4]; xo[1][igrp] = clatoms_xold[ktemp1]; yo[1][igrp] = clatoms_yold[ktemp1]; zo[1][igrp] = clatoms_zold[ktemp1]; xo[2][igrp] = clatoms_xold[ktemp2]; yo[2][igrp] = clatoms_yold[ktemp2]; zo[2][igrp] = clatoms_zold[ktemp2]; xo[3][igrp] = clatoms_xold[ktemp3]; yo[3][igrp] = clatoms_yold[ktemp3]; zo[3][igrp] = clatoms_zold[ktemp3]; xo[4][igrp] = clatoms_xold[ktemp4]; yo[4][igrp] = clatoms_yold[ktemp4]; zo[4][igrp] = clatoms_zold[ktemp4]; dx[1][igrp] = dx1 = (xo[1][igrp]-xo[2][igrp]); dx[2][igrp] = dx2 = (xo[1][igrp]-xo[3][igrp]); dx[3][igrp] = dx3 = (xo[1][igrp]-xo[4][igrp]); dx[4][igrp] = dx4 = (xo[2][igrp]-xo[3][igrp]); dx[5][igrp] = dx5 = (xo[2][igrp]-xo[4][igrp]); dx[6][igrp] = dx6 = (xo[3][igrp]-xo[4][igrp]); dy[1][igrp] = dy1 = (yo[1][igrp]-yo[2][igrp]); dy[2][igrp] = dy2 = (yo[1][igrp]-yo[3][igrp]); dy[3][igrp] = dy3 = (yo[1][igrp]-yo[4][igrp]); dy[4][igrp] = dy4 = (yo[2][igrp]-yo[3][igrp]); dy[5][igrp] = dy5 = (yo[2][igrp]-yo[4][igrp]); dy[6][igrp] = dy6 = (yo[3][igrp]-yo[4][igrp]); dz[1][igrp] = dz1 = (zo[1][igrp]-zo[2][igrp]); dz[2][igrp] = dz2 = (zo[1][igrp]-zo[3][igrp]); dz[3][igrp] = dz3 = (zo[1][igrp]-zo[4][igrp]); dz[4][igrp] = dz4 = (zo[2][igrp]-zo[3][igrp]); dz[5][igrp] = dz5 = (zo[2][igrp]-zo[4][igrp]); dz[6][igrp] = dz6 = (zo[3][igrp]-zo[4][igrp]); clatoms_x[ktemp1] -= ( xlam1*dx1 + xlam2*dx2 + xlam3*dx3)*rms1 *baro_roll_scv; clatoms_y[ktemp1] -= ( xlam1*dy1 + xlam2*dy2 + xlam3*dy3)*rms1 *baro_roll_scv; clatoms_z[ktemp1] -= ( xlam1*dz1 + xlam2*dz2 + xlam3*dz3)*rms1 *baro_roll_scv; clatoms_x[ktemp2] -= (-xlam1*dx1 + xlam4*dx4 + xlam5*dx5)*rms2 *baro_roll_scv; clatoms_y[ktemp2] -= (-xlam1*dy1 + xlam4*dy4 + xlam5*dy5)*rms2 *baro_roll_scv; clatoms_z[ktemp2] -= (-xlam1*dz1 + xlam4*dz4 + xlam5*dz5)*rms2 *baro_roll_scv; clatoms_x[ktemp3] -= (-xlam2*dx2 - xlam4*dx4 + xlam6*dx6)*rms3 *baro_roll_scv; clatoms_y[ktemp3] -= (-xlam2*dy2 - xlam4*dy4 + xlam6*dy6)*rms3 *baro_roll_scv; clatoms_z[ktemp3] -= (-xlam2*dz2 - xlam4*dz4 + xlam6*dz6)*rms3 *baro_roll_scv; clatoms_x[ktemp4] -= (-xlam3*dx3 - xlam5*dx5 - xlam6*dx6)*rms4 *baro_roll_scv; clatoms_y[ktemp4] -= (-xlam3*dy3 - xlam5*dy5 - xlam6*dy6)*rms4 *baro_roll_scv; clatoms_z[ktemp4] -= (-xlam3*dz3 - xlam5*dz5 - xlam6*dz6)*rms4 *baro_roll_scv; /* Velocity update */ clatoms_vx[ktemp1] -= ( xlam1*dx1 + xlam2*dx2 + xlam3*dx3) *rms1/dt; clatoms_vy[ktemp1] -= ( xlam1*dy1 + xlam2*dy2 + xlam3*dy3) *rms1/dt; clatoms_vz[ktemp1] -= ( xlam1*dz1 + xlam2*dz2 + xlam3*dz3) *rms1/dt; clatoms_vx[ktemp2] -= (-xlam1*dx1 + xlam4*dx4 + xlam5*dx5) *rms2/dt; clatoms_vy[ktemp2] -= (-xlam1*dy1 + xlam4*dy4 + xlam5*dy5) *rms2/dt; clatoms_vz[ktemp2] -= (-xlam1*dz1 + xlam4*dz4 + xlam5*dz5) *rms2/dt; clatoms_vx[ktemp3] -= (-xlam2*dx2 - xlam4*dx4 + xlam6*dx6) *rms3/dt; clatoms_vy[ktemp3] -= (-xlam2*dy2 - xlam4*dy4 + xlam6*dy6) *rms3/dt; clatoms_vz[ktemp3] -= (-xlam2*dz2 - xlam4*dz4 + xlam6*dz6) *rms3/dt; clatoms_vx[ktemp4] -= (-xlam3*dx3 - xlam5*dx5 - xlam6*dx6) *rms4/dt; clatoms_vy[ktemp4] -= (-xlam3*dy3 - xlam5*dy5 - xlam6*dy6) *rms4/dt; clatoms_vz[ktemp4] -= (-xlam3*dz3 - xlam5*dz5 - xlam6*dz6) *rms4/dt; /* Pressure tensor update */ /* Compute difference vectors: use unscaled old distances */ p11[igrp]= xlam1*dx1*dx1 + xlam2*dx2*dx2 + xlam3*dx3*dx3 + xlam4*dx4*dx4 + xlam5*dx5*dx5 + xlam6*dx6*dx6; p22[igrp]= xlam1*dy1*dy1 + xlam2*dy2*dy2 + xlam3*dy3*dy3 + xlam4*dy4*dy4 + xlam5*dy5*dy5 + xlam6*dy6*dy6; p33[igrp]= xlam1*dz1*dz1 + xlam2*dz2*dz2 + xlam3*dz3*dz3 + xlam4*dz4*dz4 + xlam5*dz5*dz5 + xlam6*dz6*dz6; p12[igrp]= xlam1*dx1*dy1 + xlam2*dx2*dy2 + xlam3*dx3*dy3 + xlam4*dx4*dy4 + xlam5*dx5*dy5 + xlam6*dx6*dy6; p13[igrp]= xlam1*dx1*dz1 + xlam2*dx2*dz2 + xlam3*dx3*dz3 + xlam4*dx4*dz4 + xlam5*dx5*dz5 + xlam6*dx6*dz6; p23[igrp]= xlam1*dy1*dz1 + xlam2*dy2*dz2 + xlam3*dy3*dz3 + xlam4*dy4*dz4 + xlam5*dy5*dz5 + xlam6*dy6*dz6; }/*end for*/ #ifndef NO_PRAGMA #pragma IVDEP #endif for(igrp=1;igrp <= ngrp; igrp++) { ptens_pvten_tmp[1] -= (p11[igrp]*pnorm); ptens_pvten_tmp[2] -= (p12[igrp]*pnorm); ptens_pvten_tmp[3] -= (p13[igrp]*pnorm); ptens_pvten_tmp[4] -= (p12[igrp]*pnorm); ptens_pvten_tmp[5] -= (p22[igrp]*pnorm); ptens_pvten_tmp[6] -= (p23[igrp]*pnorm); ptens_pvten_tmp[7] -= (p13[igrp]*pnorm); ptens_pvten_tmp[8] -= (p23[igrp]*pnorm); ptens_pvten_tmp[9] -= (p33[igrp]*pnorm); } /* end for */ /* Save multiplier */ for(igrp=1;igrp <= ngrp; igrp++) { grp_bond_con_al_46[1][(igrp+igrp_off)] += xlam[1][igrp]; grp_bond_con_al_46[2][(igrp+igrp_off)] += xlam[2][igrp]; grp_bond_con_al_46[3][(igrp+igrp_off)] += xlam[3][igrp]; grp_bond_con_al_46[4][(igrp+igrp_off)] += xlam[4][igrp]; grp_bond_con_al_46[5][(igrp+igrp_off)] += xlam[5][igrp]; grp_bond_con_al_46[6][(igrp+igrp_off)] += xlam[6][igrp]; } /* end for igrp */ /*=======================================================================*/ /* IV)Allreduce pvten_tmp */ if(np_forc > 1 ){ for(i=1;i<=9;i++){ ptens_pvten_tmp2[i] = ptens_pvten_tmp[i]; }/*endfor*/ Allreduce(&(ptens_pvten_tmp2[1]), &(ptens_pvten_tmp[1]),9,MPI_DOUBLE, MPI_SUM,0,comm_forc); }/*endif*/ ptens_pvten_inc[1] += ptens_pvten_tmp[1]; ptens_pvten_inc[2] += ptens_pvten_tmp[2]; ptens_pvten_inc[3] += ptens_pvten_tmp[3]; ptens_pvten_inc[4] += ptens_pvten_tmp[4]; ptens_pvten_inc[5] += ptens_pvten_tmp[5]; ptens_pvten_inc[6] += ptens_pvten_tmp[6]; ptens_pvten_inc[7] += ptens_pvten_tmp[7]; ptens_pvten_inc[8] += ptens_pvten_tmp[8]; ptens_pvten_inc[9] += ptens_pvten_tmp[9]; if(ifirst == 0){ ftemp = (ptens_pvten_tmp[1]+ptens_pvten_tmp[5]+ptens_pvten_tmp[9]); baro->f_lnv_p += ftemp; baro->v_lnv += 0.5*ftemp*(baro->roll_scg)*dt/(baro->mass_lnv); } /* free locally assigned memory */ if(ngrp > 0){ free_dvector(dlmax,1,6); free_dvector(txlam,1,6); free_d3tensor(rmassm,1,6,1,6,1,ngrp); free_dmatrix(amat,1,36,1,ngrp); free_dmatrix(xlam,1,6,1,ngrp); free_dmatrix(avec,1,6,1,ngrp); free_dmatrix(dxl,1,6,1,ngrp); free_dmatrix(dij,1,6,1,ngrp); free_dmatrix(dx,1,6,1,ngrp); free_dmatrix(dy,1,6,1,ngrp); free_dmatrix(dz,1,6,1,ngrp); free_dmatrix(dxt,1,6,1,ngrp); free_dmatrix(dyt,1,6,1,ngrp); free_dmatrix(dzt,1,6,1,ngrp); free_dmatrix(dxn,1,6,1,ngrp); free_dmatrix(dyn,1,6,1,ngrp); free_dmatrix(dzn,1,6,1,ngrp); free_dvector(rmass1,1,ngrp); free_dvector(rmass2,1,ngrp); free_dvector(rmass3,1,ngrp); free_dvector(rmass4,1,ngrp); free_dmatrix(x,1,ngrp,1,36); free_dmatrix(y,1,ngrp,1,36); free_dmatrix(z,1,ngrp,1,36); free_dmatrix(xo,1,ngrp,1,36); free_dmatrix(yo,1,ngrp,1,36); free_dmatrix(zo,1,ngrp,1,36); free_dvector(p11,1,ngrp); free_dvector(p12,1,ngrp); free_dvector(p13,1,ngrp); free_dvector(p22,1,ngrp); free_dvector(p23,1,ngrp); free_dvector(p33,1,ngrp); free_dvector(tamat,1,36); free(ind1); free(ind2); free(ind3); free(ind4); }/*endif*/ /*==========================================================================*/ } /* end routine */
main() { /* Change of variables info */ double *r,*dr; int N; /* Physics variables */ double *V,*Rho,Z; int lmax,*nmax,nmaxmax; double **E,***Psi,**F; /* Working variables */ int n,l,k; double x; /* Value of pi */ const double pi=4.*atan(1.); /* Specifications for carbon */ Z=6.; lmax=1; nmax=ivector(0,lmax); nmax[0]=1; nmax[1]=0; nmaxmax=0; /* Find max of all nmax's */ for (l=0; l<=lmax; l++) if (nmax[l]>nmaxmax) nmaxmax=nmax[l]; F=dmatrix(0,lmax,0,nmaxmax); F[0][0]=2.; /* 2 electrons in 1s */ F[0][1]=2.; /* 2 electrons in 2s */ F[1][0]=2.; /* 2 electrons in 2p */ /* The rest is now general for ANY case */ E=dmatrix(0,lmax,0,nmaxmax); /* Make space for E's and Psi's */ Psi=d3tensor(0,lmax,0,nmaxmax,0,Nmx); Rho=dvector(0,Nmx); /* Grid vectors */ r=dvector(0,Nmx); dr=dvector(0,Nmx); V=dvector(0,Nmx); /* Set up grid */ N=400; for (k=0; k<=N; k++) { x=((double) k)/((double) N); r[k]=1./(1.-x)-1.-x-x*x; dr[k]=1./(1.-x)/(1.-x)-1.-2*x; V[k]=-Z/r[k]; } V[0]=0.; dr[N]=0.; /* Test section */ getallEs(E,lmax,nmax,Z,V,r,dr,N); getallPsis(Psi,E,lmax,nmax,V,r,dr,N); getRho(Rho,Psi,F,lmax,nmax,N); printf("Total charge is: %20.15f\n",simpint(Rho,r,dr,N)); /* Be a good citizen and clean up... */ free_dvector(r,0,Nmx); free_dvector(dr,0,Nmx); free_dvector(V,0,Nmx); free_dmatrix(E,0,lmax,0,nmaxmax); free_dmatrix(F,0,lmax,0,nmaxmax); free_d3tensor(Psi,0,lmax,0,nmaxmax,0,Nmx); free_dvector(Rho,0,Nmx); }