void communicate_test_energy_pimd(double *vgen,double *vgen2,double *vgen3,
double *cpu, MPI_Comm world)
/*==========================================================================*/
/* Begin Routine */
{/*begin routine*/
/*==========================================================================*/
#include "../typ_defs/typ_mask.h"
int iii;
double vgen_temp,vgen2_temp,vgen3_temp,cpu_temp;
cpu_temp = *cpu;
vgen_temp = *vgen;
vgen2_temp = *vgen2;
vgen3_temp = *vgen3;
Reduce(&cpu_temp,cpu, 1, MPI_DOUBLE, MPI_MAX, 0,world);
Allreduce(&vgen_temp,vgen, 1, MPI_DOUBLE, MPI_SUM,0, world);
Allreduce(&vgen2_temp,vgen2, 1, MPI_DOUBLE, MPI_SUM,0, world);
Allreduce(&vgen3_temp,vgen3, 1, MPI_DOUBLE, MPI_SUM,0, world);
Barrier(world);
}/*end routine*/
//! Allreduce on one type
void mpi:: Allreduce1(void *output,
const void *input,
MPI_Datatype datatype,
MPI_Op op,
MPI_Comm comm
) const
{
assert(output);
assert(input);
Allreduce(input, output, 1, datatype, op, comm);
}
void communicate_utils_pimd(double *kinet, COMMUNICATE *communicate)
/*==========================================================================*/
/* Begin Routine */
{/*begin routine*/
/*==========================================================================*/
#include "../typ_defs/typ_mask.h"
double kinet_temp;
MPI_Comm comm_beads;
comm_beads = communicate->comm_beads;
kinet_temp = *kinet;
Allreduce(&kinet_temp,kinet, 1, MPI_DOUBLE, MPI_SUM,0, comm_beads);
}/*end routine*/
void apply_c_nhc(CPTHERM_INFO *cptherm_info,CPTHERM_POS *cptherm_pos,
CPCOEFFS_INFO *cpcoeffs_info,CPCOEFFS_POS *cpcoeffs_pos,
CPSCR *cpscr,int cp_lsda,COMMUNICATE *communicate)
/*==========================================================================*/
/* Begin Routine */
{/*begin routine*/
/*========================================================================*/
/* Local variable declarations */
#include "../typ_defs/typ_mask.h"
int icoef,inhc,ichain; /* Num: for loop counters */
int iresn,iyosh; /* Num: for loop counters */
int len_c_nhc,len_c_nhcm1,len_c_nhcp1; /* Num: length of chains */
int len_c_nhcm2;
double arg,aa; /* Num: scalar temps */
int iii;
int nstate_up,nstate_dn;
int ncoef;
int ncoef_up_tot,ncoef_dn_tot;
int num_c_nhc;
int is, i,ichain1,itemp,jtemp;
/* Define local pointers */
double *cpscr_coef_kin = cpscr->cpscr_therm.coef_kin;
double *cpscr_sc = cpscr->cpscr_therm.sc_cp;
double *vc_nhc_tmp = cpscr->cpscr_therm.coef_kin;
double *c_nhc_tmp = cpscr->cpscr_therm.sc_cp;
int *icmapup_nhc = cptherm_info->icmapup_nhc;
int *icmapdn_nhc = cptherm_info->icmapdn_nhc;
double *cpcoeffs_cmass = cpcoeffs_info->cmass;
double *cpcoeffs_vcre_up = cpcoeffs_pos->vcre_up;
double *cpcoeffs_vcim_up = cpcoeffs_pos->vcim_up;
double *cpcoeffs_vcre_dn = cpcoeffs_pos->vcre_dn;
double *cpcoeffs_vcim_dn = cpcoeffs_pos->vcim_dn;
double **fc_nhc = cptherm_pos->fc_nhc;
double **vc_nhc = cptherm_pos->vc_nhc;
double **c_nhc = cptherm_pos->c_nhc;
double **c_gkt = cptherm_info->c_gkt;
double **cmass_nhc = cptherm_info->cmass_nhc;
double *wdti2 = cptherm_info->wdti2;
double *wdti4 = cptherm_info->wdti4;
double *wdti8 = cptherm_info->wdti8;
int *cpcoeffs_ioff_up = cpcoeffs_info->ioff_upt;
int *cpcoeffs_ioff_dn = cpcoeffs_info->ioff_dnt;
int myid_state = communicate->myid_state;
MPI_Comm comm_states = communicate->comm_states;
int icmoff_up = cpcoeffs_info->icoef_start_up-1;
int icmoff_dn = cpcoeffs_info->icoef_start_dn-1;
int np_states = communicate->np_states;
int ncoef_up,ncoef_dn;
int ivcoef_form_up = cpcoeffs_pos->ivcoef_form_up;
int ivcoef_form_dn = cpcoeffs_pos->ivcoef_form_dn;
/*==========================================================================*/
/* 0) Checks */
if(np_states>1){
if(ivcoef_form_up!=1){
printf("@@@@@@@@@@@@@@@@@@@@_ERROR_@@@@@@@@@@@@@@@@@@@@\n");
printf("Up CP velocities are not in transposed form \n");
printf("on state processor %d in apply_c_nhc \n",myid_state);
printf("@@@@@@@@@@@@@@@@@@@@_ERROR_@@@@@@@@@@@@@@@@@@@@\n");
fflush(stdout);
exit(1);
}/*endif*/
if(cp_lsda==1){
if(ivcoef_form_dn!=1){
printf("@@@@@@@@@@@@@@@@@@@@_ERROR_@@@@@@@@@@@@@@@@@@@@\n");
printf("Dn CP velocities are not in transposed form \n");
printf("on state processor %d in int_NVE_cp \n",myid_state);
printf("@@@@@@@@@@@@@@@@@@@@_ERROR_@@@@@@@@@@@@@@@@@@@@\n");
fflush(stdout);
exit(1);
}/*endif*/
}/*endif*/
}/*endif*/
/*==========================================================================*/
/* 0) Simple definitions */
nstate_up = cpcoeffs_info->nstate_up;
nstate_dn = cpcoeffs_info->nstate_dn;
if(np_states==1){
ncoef_up = cpcoeffs_info->ncoef;
ncoef_dn = cpcoeffs_info->ncoef;
}else{
ncoef_up = cpcoeffs_info->nstate_ncoef_proc_up;
ncoef_dn = cpcoeffs_info->nstate_ncoef_proc_dn;
}/*endif*/
num_c_nhc = cptherm_info->num_c_nhc_proc;
/*==========================================================================*/
/* I) Map the ke of each particle to the appropriate nose-hoover chain */
/* and assemble the total particle ke associated */
/* with each chain. The num_c_nhc+1 cpthermo is the null cptherm */
for(inhc=1;inhc<=num_c_nhc+1;inhc++){
cpscr_coef_kin[inhc] = 0.0;
/*endfor*/}
for(is=1;is<=nstate_up;is++) {
for(i=1;i<=ncoef_up;i++) {
icoef = i+cpcoeffs_ioff_up[is];
cpscr_coef_kin[icmapup_nhc[is]] +=
cpcoeffs_cmass[(i+icmoff_up)]
*cpcoeffs_vcre_up[icoef]*cpcoeffs_vcre_up[icoef];
}/*endfor*/
for(i=1;i<=ncoef_up;i++) {
icoef = i+cpcoeffs_ioff_up[is];
cpscr_coef_kin[icmapup_nhc[is]] +=
cpcoeffs_cmass[(i+icmoff_up)]
*cpcoeffs_vcim_up[icoef]*cpcoeffs_vcim_up[icoef];
}/*endfor*/
}/* endfor */
if( (cp_lsda == 1) && (nstate_dn != 0) ){
for(is=1;is<=nstate_dn;is++) {
for(i=1;i<=ncoef_dn;i++) {
icoef = i+cpcoeffs_ioff_dn[is];
cpscr_coef_kin[icmapdn_nhc[is]] +=
cpcoeffs_cmass[(i+icmoff_dn)]
*cpcoeffs_vcre_dn[icoef]*cpcoeffs_vcre_dn[icoef];
}/*endfor*/
for(i=1;i<=ncoef_dn;i++) {
icoef = i+cpcoeffs_ioff_dn[is];
cpscr_coef_kin[icmapdn_nhc[is]] +=
cpcoeffs_cmass[(i+icmoff_dn)]
*cpcoeffs_vcim_dn[icoef]*cpcoeffs_vcim_dn[icoef];
}/*endfor*/
}/* endfor */
}/* endif cp_lsda */
if(np_states>1){
Allreduce(&(cpscr_coef_kin[1]), &(cpscr_sc[1]),num_c_nhc,
MPI_DOUBLE,MPI_SUM,0,comm_states);
for(inhc=1;inhc<=num_c_nhc;inhc++){
cpscr_coef_kin[inhc] = cpscr_sc[inhc];
}/*endfor*/
}/*endif*/
/*==========================================================================*/
/* III) Get the force on the first NHC in each chain */
for(inhc=1;inhc<=num_c_nhc;inhc++){
fc_nhc[1][inhc] = (cpscr_coef_kin[inhc]-c_gkt[1][inhc])
/cmass_nhc[1][inhc];
}/*endfor*/
/*==========================================================================*/
/* IV) Apply the nhc evolution operator using RESPA */
len_c_nhc = (cptherm_info->len_c_nhc);
len_c_nhcm1 = (cptherm_info->len_c_nhc)-1;
len_c_nhcm2 = (cptherm_info->len_c_nhc)-2;
len_c_nhcp1 = (cptherm_info->len_c_nhc)+1;
for(inhc=1;inhc<=num_c_nhc+1;inhc++){
cpscr_sc[inhc] = 1.0;
}/*endfor*/
for(iresn=1;iresn<=cptherm_info->nres_c_nhc;iresn++){
for(iyosh=1;iyosh<=cptherm_info->nyosh_c_nhc;iyosh++){
/*--------------------------------------------------------------------------*/
/* 1) Evolve the last cptherm velocity in each chain */
if(len_c_nhc>2){
for(inhc=1;inhc<=num_c_nhc;inhc++){
arg = -wdti8[iyosh]*vc_nhc[len_c_nhcm1][inhc];
aa = exp(arg);
vc_nhc[len_c_nhc][inhc] = vc_nhc[len_c_nhc][inhc]*aa*aa
+ wdti4[iyosh]*fc_nhc[len_c_nhc][inhc]*aa;
}/*endfor*/
for(inhc=1;inhc<=num_c_nhc;inhc++){
fc_nhc[len_c_nhcm1][inhc] =
(cmass_nhc[len_c_nhc][inhc]*
vc_nhc[len_c_nhc][inhc]*vc_nhc[len_c_nhc][inhc]
+cmass_nhc[len_c_nhcm2][inhc]*
vc_nhc[len_c_nhcm2][inhc]*vc_nhc[len_c_nhcm2][inhc]
-c_gkt[len_c_nhcm1][inhc])/cmass_nhc[len_c_nhcm1][inhc];
}/*endfor*/
}else{
for(inhc=1;inhc<=num_c_nhc;inhc++){
vc_nhc[len_c_nhc][inhc] = vc_nhc[len_c_nhc][inhc]
+ wdti4[iyosh]*fc_nhc[len_c_nhc][inhc];
}/*endfor*/
}/*endif*/
/*--------------------------------------------------------------------------*/
/* 2) Evolve the last-1 to the first cpthermo velocitiy in each chain */
for(ichain=1;ichain<=len_c_nhcm1;ichain++){
itemp = (len_c_nhc-ichain);
jtemp = (len_c_nhcp1-ichain);
for(inhc=1;inhc<=num_c_nhc;inhc++){
arg = -wdti8[iyosh]*vc_nhc[jtemp][inhc];
aa = exp(arg);
vc_nhc[itemp][inhc] = vc_nhc[itemp][inhc]*aa*aa
+ wdti4[iyosh]*fc_nhc[itemp][inhc]*aa;
}/*endfor*/
}/*endfor*/
/*--------------------------------------------------------------------------*/
/* 3) Evolve the particle velocities (by adding to the scaling factor) */
for(inhc=1;inhc<=num_c_nhc;inhc++){
arg = -wdti2[iyosh]*vc_nhc[1][inhc];
aa = exp(arg);
cpscr_sc[inhc] *= aa;
cpscr_coef_kin[inhc] *= (aa*aa);
}/*endfor*/
/*--------------------------------------------------------------------------*/
/* 4) Evolve the cptherm positions */
for(ichain=1;ichain<=len_c_nhc;ichain++){
for(inhc=1;inhc<=num_c_nhc;inhc++){
c_nhc[ichain][inhc] +=
vc_nhc[ichain][inhc]*wdti2[iyosh];
}/*endfor*/
}/*endfor*/
/*--------------------------------------------------------------------------*/
/* 5) Evolve the 1 to last-1 cptherm velocity in each chain */
/* calculting cptherm forces as you go along */
/* careful with the len-1st puppy. */
for(inhc=1;inhc<=num_c_nhc;inhc++){
fc_nhc[1][inhc] = (cpscr_coef_kin[inhc]-c_gkt[1][inhc])
/cmass_nhc[1][inhc];
}/*endfor*/
for(ichain=1;ichain<=len_c_nhcm1;ichain++){
ichain1 = ichain+1;
for(inhc=1;inhc<=num_c_nhc;inhc++){
arg = -wdti8[iyosh]*vc_nhc[ichain1][inhc];
aa = exp(arg);
vc_nhc[ichain][inhc] = vc_nhc[ichain][inhc]*aa*aa
+ wdti4[iyosh]*fc_nhc[ichain][inhc]*aa;
}/*endfor*/
if(ichain1!=len_c_nhcm1 || len_c_nhc<=2){
for(inhc=1;inhc<=num_c_nhc;inhc++){
fc_nhc[ichain1][inhc] =
(cmass_nhc[ichain][inhc]*
vc_nhc[ichain][inhc]*vc_nhc[ichain][inhc]
-c_gkt[ichain1][inhc])/cmass_nhc[ichain1][inhc];
}/*endfor*/
}else{
for(inhc=1;inhc<=num_c_nhc;inhc++){
fc_nhc[len_c_nhcm1][inhc] =
(cmass_nhc[len_c_nhc][inhc]*
vc_nhc[len_c_nhc][inhc]*vc_nhc[len_c_nhc][inhc]
+cmass_nhc[len_c_nhcm2][inhc]*
vc_nhc[len_c_nhcm2][inhc]*vc_nhc[len_c_nhcm2][inhc]
-c_gkt[len_c_nhcm1][inhc])/cmass_nhc[len_c_nhcm1][inhc];
}/*endfor*/
}/*endif*/
}/*endfor*/
/*--------------------------------------------------------------------------*/
/* 6) Evolve the last cptherm velocotiy in each chain */
if(len_c_nhc>2){
for(inhc=1;inhc<=num_c_nhc;inhc++){
arg = -wdti8[iyosh]*vc_nhc[len_c_nhcm1][inhc];
aa = exp(arg);
vc_nhc[len_c_nhc][inhc] = vc_nhc[len_c_nhc][inhc]*aa*aa
+ wdti4[iyosh]*fc_nhc[len_c_nhc][inhc]*aa;
}/*endfor*/
}else{
for(inhc=1;inhc<=num_c_nhc;inhc++){
arg = -wdti8[iyosh]*vc_nhc[len_c_nhcm1][inhc];
aa = exp(arg);
vc_nhc[len_c_nhc][inhc] = vc_nhc[len_c_nhc][inhc]*aa*aa
+ wdti4[iyosh]*fc_nhc[len_c_nhc][inhc]*aa;
}/*endfor*/
}/*endif*/
/*--------------------------------------------------------------------------*/
/* 7) End Respa */
/*endfor: iyosh */}
/*endfor: iresn*/}
/*==========================================================================*/
/* V) Apply the accumulated scaling factor to the velocities */
for(is=1;is<=nstate_up;is++) {
for(i=1;i<=ncoef_up;i++) {
icoef = i+cpcoeffs_ioff_up[is];
cpcoeffs_vcre_up[icoef] *= cpscr_sc[icmapup_nhc[is]];
}/*endfor*/
for(i=1;i<=ncoef_up;i++) {
icoef = i+cpcoeffs_ioff_up[is];
cpcoeffs_vcim_up[icoef] *= cpscr_sc[icmapup_nhc[is]];
} /*endfor*/
} /*endfor*/
if( (cp_lsda == 1) && (nstate_dn != 0)){
for(is=1;is<=nstate_dn;is++) {
for(i=1;i<=ncoef_dn;i++) {
icoef = i+cpcoeffs_ioff_dn[is];
cpcoeffs_vcre_dn[icoef] *= cpscr_sc[icmapdn_nhc[is]];
}/*endfor*/
for(i=1;i<=ncoef_dn;i++) {
cpcoeffs_vcim_dn[icoef] *= cpscr_sc[icmapdn_nhc[is]];
}/*endfor*/
}/*endfor*/
}/* endif cp_lsda */
/*==========================================================================*/
/* V) Broadcast the results to keep consistency */
if(np_states>1){
for(ichain=1;ichain<=len_c_nhc;ichain++){
if(myid_state==0){
for(inhc=1;inhc<=num_c_nhc;inhc++){
vc_nhc_tmp[inhc] = vc_nhc[ichain][inhc];
c_nhc_tmp[inhc] = c_nhc[ichain][inhc];
}/*endfor : inhc*/
}/*endif*/
Bcast(&vc_nhc_tmp[1],num_c_nhc,MPI_DOUBLE,0,comm_states);
Bcast(&c_nhc_tmp[1],num_c_nhc,MPI_DOUBLE,0,comm_states);
for(inhc=1;inhc<=num_c_nhc;inhc++){
vc_nhc[ichain][inhc] = vc_nhc_tmp[inhc];
c_nhc[ichain][inhc] = c_nhc_tmp[inhc];
}/*endfor : inhc*/
}/*endfor : ichain*/
}/*endif*/
/*--------------------------------------------------------------------------*/
}/*end routine*/
void init_cp_NHC(CPTHERM_INFO *cptherm_info,CPTHERM_POS *cptherm_pos,
CPCOEFFS_INFO *cpcoeffs_info,CPCOEFFS_POS *cpcoeffs_pos,
CPSCR *cpscr,int cp_lsda,MPI_Comm comm_states,int np_states,
int myid_state)
/*========================================================================*/
{/*begin routine*/
/*========================================================================*/
/* Local variable declarations */
#include "../typ_defs/typ_mask.h"
int icoef,inhc,ichain; /* Num: for loop counters */
int len_c_nhc,len_c_nhcm1,len_c_nhcp1; /* Num: length of chains */
int len_c_nhcm2;
int iii;
int is, i,ichain1;
int myid=myid_state;
/* Define local pointers */
double *cpscr_coef_kin = cpscr->cpscr_therm.coef_kin;
double *cpscr_coef_kin_temp= cpscr->cpscr_therm.sc_cp;
int *icmapup_nhc = cptherm_info->icmapup_nhc;
int *icmapdn_nhc = cptherm_info->icmapdn_nhc;
double *cpcoeffs_cmass = cpcoeffs_info->cmass;
double *cpcoeffs_vcre_up = cpcoeffs_pos->vcre_up;
double *cpcoeffs_vcim_up = cpcoeffs_pos->vcim_up;
double *cpcoeffs_vcre_dn = cpcoeffs_pos->vcre_dn;
double *cpcoeffs_vcim_dn = cpcoeffs_pos->vcim_dn;
int ivcoef_form_up = cpcoeffs_pos->ivcoef_form_up;
int ivcoef_form_dn = cpcoeffs_pos->ivcoef_form_dn;
double **fc_nhc = cptherm_pos->fc_nhc;
double **vc_nhc = cptherm_pos->vc_nhc;
double **c_gkt = cptherm_info->c_gkt;
double **cmass_nhc = cptherm_info->cmass_nhc;
int *cpcoeffs_ioff_up = cpcoeffs_info->ioff_upt;
int *cpcoeffs_ioff_dn = cpcoeffs_info->ioff_dnt;
int nstate_up = cpcoeffs_info->nstate_up;
int nstate_dn = cpcoeffs_info->nstate_dn;
int ncoef = cpcoeffs_info->ncoef;
int num_c_nhc = cptherm_info->num_c_nhc_proc;
int icmoff_up = cpcoeffs_info->icoef_start_up-1;
int icmoff_dn = cpcoeffs_info->icoef_start_dn-1;
int ncoef_up,ncoef_dn;
/*========================================================================*/
/* 0) Checks and Assigns */
if(np_states>1){
if((ivcoef_form_up)!=1){
printf("@@@@@@@@@@@@@@@@@@@@_ERROR_@@@@@@@@@@@@@@@@@@@@\n");
printf("Up CP vectors are not in transposed form \n");
printf("in int_cp_NHC \n");
printf("@@@@@@@@@@@@@@@@@@@@_ERROR_@@@@@@@@@@@@@@@@@@@@\n");
fflush(stdout);
exit(1);
}/*endif*/
if(cp_lsda==1){
if((ivcoef_form_dn)!=1){
printf("@@@@@@@@@@@@@@@@@@@@_ERROR_@@@@@@@@@@@@@@@@@@@@\n");
printf("Up CP vectors are not in transposed form \n");
printf("in int_NVE_cp \n");
printf("@@@@@@@@@@@@@@@@@@@@_ERROR_@@@@@@@@@@@@@@@@@@@@\n");
fflush(stdout);
exit(1);
}/*endif*/
}/*endif*/
}/*endif*/
if(np_states==1){
ncoef_up = cpcoeffs_info->ncoef;
ncoef_dn = cpcoeffs_info->ncoef;
}else{
ncoef_up = cpcoeffs_info->nstate_ncoef_proc_up;
ncoef_dn = cpcoeffs_info->nstate_ncoef_proc_dn;
}/*endif*/
/*==========================================================================*/
/* I) Map the ke of each particle to the appropriate nose-hoover chain */
/* and assemble the total particle ke associated */
/* with each chain. The num_c_nhc+1 cpthermo is the null cptherm */
for(inhc=1;inhc<=num_c_nhc+1;inhc++){
cpscr_coef_kin[inhc] = 0.0;
/*endfor*/}
for(is=1;is<=nstate_up;is++) {
for(i=1;i<=ncoef_up;i++) {
icoef = i+cpcoeffs_ioff_up[is];
cpscr_coef_kin[icmapup_nhc[is]] +=
cpcoeffs_cmass[(i+icmoff_up)]
*cpcoeffs_vcre_up[icoef]*cpcoeffs_vcre_up[icoef];
}/*endfor*/
for(i=1;i<=ncoef_up;i++) {
icoef = i+cpcoeffs_ioff_up[is];
cpscr_coef_kin[icmapup_nhc[is]] +=
cpcoeffs_cmass[(i+icmoff_up)]
*cpcoeffs_vcim_up[icoef]*cpcoeffs_vcim_up[icoef];
}/*endfor*/
}/* endfor */
if( (cp_lsda == 1) && (nstate_dn != 0) ){
for(is=1;is<=nstate_dn;is++) {
for(i=1;i<=ncoef_dn;i++) {
icoef = i+cpcoeffs_ioff_dn[is];
cpscr_coef_kin[icmapdn_nhc[is]] +=
cpcoeffs_cmass[(i+icmoff_dn)]
*cpcoeffs_vcre_dn[icoef]*cpcoeffs_vcre_dn[icoef];
}/*endfor*/
for(i=1;i<=ncoef_dn;i++) {
icoef = i+cpcoeffs_ioff_dn[is];
cpscr_coef_kin[icmapdn_nhc[is]] +=
cpcoeffs_cmass[(i+icmoff_dn)]
*cpcoeffs_vcim_dn[icoef]*cpcoeffs_vcim_dn[icoef];
}/*endfor*/
}/* endfor */
}/* endif cp_lsda */
printf("in init_nhc %d 0\n",myid);
if(np_states>1){
Allreduce(&(cpscr_coef_kin[1]), &(cpscr_coef_kin_temp[1]),num_c_nhc,
MPI_DOUBLE,MPI_SUM,0,comm_states);
for(inhc=1;inhc<=num_c_nhc;inhc++){
cpscr_coef_kin[inhc] = cpscr_coef_kin_temp[inhc];
}/*endfor*/
}/*endif*/
printf("in init_nhc %d 1\n",myid);
/*==========================================================================*/
len_c_nhc = (cptherm_info->len_c_nhc);
len_c_nhcm1 = (cptherm_info->len_c_nhc)-1;
len_c_nhcm2 = (cptherm_info->len_c_nhc)-2;
len_c_nhcp1 = (cptherm_info->len_c_nhc)+1;
for(inhc=1;inhc<=num_c_nhc;inhc++){
fc_nhc[1][inhc] = (cpscr_coef_kin[inhc]-c_gkt[1][inhc])
/cmass_nhc[1][inhc];
}/*endfor*/
for(ichain=1;ichain<=len_c_nhcm1;ichain++){
ichain1 = ichain+1;
if(ichain1!=len_c_nhcm1){
for(inhc=1;inhc<=num_c_nhc;inhc++){
fc_nhc[ichain1][inhc] = (cmass_nhc[ichain][inhc]*
vc_nhc[ichain][inhc]*vc_nhc[ichain][inhc]
-c_gkt[ichain1][inhc])
/cmass_nhc[ichain1][inhc];
}/*endfor*/
}else{
for(inhc=1;inhc<=num_c_nhc;inhc++){
fc_nhc[len_c_nhcm1][inhc] = (cmass_nhc[len_c_nhc][inhc]*
vc_nhc[len_c_nhc][inhc]*vc_nhc[len_c_nhc][inhc]
+cmass_nhc[len_c_nhcm2][inhc]*
vc_nhc[len_c_nhcm2][inhc]*vc_nhc[len_c_nhcm2][inhc]
- c_gkt[len_c_nhcm1][inhc])/cmass_nhc[len_c_nhcm1][inhc];
}/*endfor*/
}/*endif*/
}/*endfor*/
printf("in init_nhc %d 2\n",myid);
/*--------------------------------------------------------------------------*/
/*end routine*/}
/*==========================================================================*/
void build_cp_comm_pkg_dvr(CP *cp,MPI_Comm world)
/*==========================================================================*/
{/* begin routine */
/*==========================================================================*/
/* Local variable declarations */
#include "../typ_defs/typ_mask.h"
int irem,idiv,iii;
int nstate_ncoef_proc_max,nstate_ncoef_proc_min;
int num_coef,*num_coef_v,ncoef_proc,ncoef_proc_yz;
/*==========================================================================*/
/* I) Up states */
/*------------------------------------*/
/* i) states per processor stuff */
idiv = cp->cpcoeffs_info.nstate_up/cp->communicate.np_states;
irem = (cp->cpcoeffs_info.nstate_up % cp->communicate.np_states);
cp->cpcoeffs_info.nstate_up_proc = idiv;
if(cp->communicate.myid_state < irem) {
cp->cpcoeffs_info.nstate_up_proc = idiv+1;
}/*endif*/
if(cp->communicate.myid_state <= irem) {
cp->cpcoeffs_info.istate_up_st = cp->communicate.myid_state*(idiv+1)+1;
} else {
cp->cpcoeffs_info.istate_up_st = irem*(idiv+1)
+ (cp->communicate.myid_state-irem)*idiv+1;
}/*endif*/
cp->cpcoeffs_info.istate_up_end = cp->cpcoeffs_info.istate_up_st +
cp->cpcoeffs_info.nstate_up_proc-1;
/*------------------------------------*/
/* ii) coefs per processor stuff */
cp->cp_comm_state_pkg_dvr_up.num_proc = cp->communicate.np_states;
cp->cp_comm_state_pkg_dvr_up.myid = cp->communicate.myid_state;
cp->cp_comm_state_pkg_dvr_up.nstate = cp->cpcoeffs_info.nstate_up;
cp->cp_comm_state_pkg_dvr_up.ncoef = cp->cpcoeffs_info.ncoef;
cp->cp_comm_state_pkg_dvr_up.nstate_proc= cp->cpcoeffs_info.nstate_up_proc;
cp->cp_comm_state_pkg_dvr_up.world = world;
if(cp->communicate.np_states > 1){
Comm_dup(cp->communicate.comm_states,&(cp->cp_comm_state_pkg_dvr_up.comm));
} else {
cp->cp_comm_state_pkg_dvr_up.comm = cp->communicate.comm_states;
}/* endif */
irem = (cp->cp_comm_state_pkg_dvr_up.nstate %
cp->cp_comm_state_pkg_dvr_up.num_proc);
cp->cp_comm_state_pkg_dvr_up.nstate_proc_max = (irem > 0 ? idiv+1 : idiv);
cp->cp_comm_state_pkg_dvr_up.nstate_max = (irem > 0 ?
((idiv+1)*cp->communicate.np_states) :
(idiv*cp->communicate.np_states)) ;
/* different from PW code*/
cp->cp_comm_state_pkg_dvr_up.nstate_proc_min = idiv;
idiv = (cp->cpcoeffs_info.grid_ny)*(cp->cpcoeffs_info.grid_nz)/
(cp->cp_comm_state_pkg_dvr_up.num_proc);
irem = (cp->cpcoeffs_info.grid_ny * cp->cpcoeffs_info.grid_nz) %
cp->cp_comm_state_pkg_dvr_up.num_proc;
ncoef_proc_yz = (cp->communicate.myid_state < irem ? idiv+1 : idiv);
ncoef_proc = ncoef_proc_yz * (cp->cpcoeffs_info.grid_nx);
cp->cpcoeffs_info.nstate_ncoef_proc_up = ncoef_proc;
cp->cp_comm_state_pkg_dvr_up.nstate_ncoef_proc =
cp->cpcoeffs_info.nstate_ncoef_proc_up;
if(cp->communicate.np_states > 1){
Allreduce(&(cp->cpcoeffs_info.nstate_ncoef_proc_up),
&nstate_ncoef_proc_max,
1,MPI_INT,MPI_MAX,0,world);
/* Not defined anymore
Allreduce(&(cp->cpcoeffs_info.nstate_ncoef_proc_up),
&nstate_ncoef_proc_min,
1,MPI_INT,MPI_MIN,0,world); */
}else{
nstate_ncoef_proc_max = cp->cpcoeffs_info.nstate_ncoef_proc_up;
/* nstate_ncoef_proc_min = cp->cpcoeffs_info.nstate_ncoef_proc_up; */
}
cp->cpcoeffs_info.nstate_ncoef_proc_max_up = nstate_ncoef_proc_max;
cp->cp_comm_state_pkg_dvr_up.nstate_ncoef_proc_max = nstate_ncoef_proc_max;
/*cp->cp_comm_state_pkg_dvr_up.nstate_ncoef_proc_min = nstate_ncoef_proc_min; */
if(cp->communicate.np_states > 1){
num_coef = cp->cp_comm_state_pkg_dvr_up.nstate_ncoef_proc;
num_coef_v = (int *) malloc((cp->communicate.np_states)*sizeof(int))-1;
Allgather(&num_coef,1,MPI_INT,&num_coef_v[1],1,MPI_INT,0,world);
cp->cpcoeffs_info.icoef_start_up = 1;
for(iii=1; iii <= cp->communicate.myid; iii++){
cp->cpcoeffs_info.icoef_start_up += num_coef_v[iii];
}
cp->cp_comm_state_pkg_dvr_up.icoef_start =
cp->cpcoeffs_info.icoef_start_up;
}else{
cp->cpcoeffs_info.icoef_start_up = 1;
cp->cp_comm_state_pkg_dvr_up.icoef_start = 1;
}
/*==========================================================================*/
/* II) Down states */
/*------------------------------------*/
/* i) states per processor stuff */
idiv = cp->cpcoeffs_info.nstate_dn/cp->communicate.np_states;
irem = (cp->cpcoeffs_info.nstate_dn % cp->communicate.np_states);
cp->cpcoeffs_info.nstate_dn_proc = idiv;
if(cp->communicate.myid_state < irem) {
cp->cpcoeffs_info.nstate_dn_proc = idiv+1;
}/*endif*/
if(cp->communicate.myid_state <= irem) {
cp->cpcoeffs_info.istate_dn_st = cp->communicate.myid_state*(idiv+1)+1;
} else {
cp->cpcoeffs_info.istate_dn_st = irem*(idiv+1)
+ (cp->communicate.myid_state-irem)*idiv+1;
}/*endif*/
cp->cpcoeffs_info.istate_dn_end = cp->cpcoeffs_info.istate_dn_st +
cp->cpcoeffs_info.nstate_dn_proc-1;
/*------------------------------------*/
/* ii) coefs per processor stuff */
cp->cp_comm_state_pkg_dvr_dn.num_proc = cp->communicate.np_states;
cp->cp_comm_state_pkg_dvr_dn.myid = cp->communicate.myid_state;
cp->cp_comm_state_pkg_dvr_dn.nstate = cp->cpcoeffs_info.nstate_dn;
cp->cp_comm_state_pkg_dvr_dn.ncoef = cp->cpcoeffs_info.ncoef;
cp->cp_comm_state_pkg_dvr_dn.nstate_proc= cp->cpcoeffs_info.nstate_dn_proc;
cp->cp_comm_state_pkg_dvr_dn.world = world;
if(cp->communicate.np_states > 1){
Comm_dup(cp->communicate.comm_states,&(cp->cp_comm_state_pkg_dvr_dn.comm));
} else {
cp->cp_comm_state_pkg_dvr_dn.comm = cp->communicate.comm_states;
}/* endif */
irem = (cp->cp_comm_state_pkg_dvr_dn.nstate %
cp->cp_comm_state_pkg_dvr_dn.num_proc);
cp->cp_comm_state_pkg_dvr_dn.nstate_proc_max = (irem > 0 ? idiv+1 : idiv);
cp->cp_comm_state_pkg_dvr_dn.nstate_max = (irem > 0 ?
((idiv+1)*cp->communicate.np_states) :
(idiv*cp->communicate.np_states)) ;
cp->cp_comm_state_pkg_dvr_dn.nstate_proc_min = idiv;
cp->cpcoeffs_info.nstate_ncoef_proc_dn = ncoef_proc;
cp->cp_comm_state_pkg_dvr_dn.nstate_ncoef_proc =
cp->cpcoeffs_info.nstate_ncoef_proc_dn;
if(cp->communicate.np_states > 1){
Allreduce(&(cp->cpcoeffs_info.nstate_ncoef_proc_dn),
&nstate_ncoef_proc_max,
1,MPI_INT,MPI_MAX,0,world);
/* Allreduce(&(cp->cpcoeffs_info.nstate_ncoef_proc_dn),
&nstate_ncoef_proc_min,
1,MPI_INT,MPI_MIN,0,world); */
}else{
nstate_ncoef_proc_max = cp->cpcoeffs_info.nstate_ncoef_proc_dn;
/* nstate_ncoef_proc_min = cp->cpcoeffs_info.nstate_ncoef_proc_dn; */
}
cp->cpcoeffs_info.nstate_ncoef_proc_max_dn = nstate_ncoef_proc_max;
cp->cp_comm_state_pkg_dvr_dn.nstate_ncoef_proc_max =
cp->cpcoeffs_info.nstate_ncoef_proc_max_dn;
/* cp->cp_comm_state_pkg_dvr_dn.nstate_ncoef_proc_min = nstate_ncoef_proc_min; */
if(cp->communicate.np_states > 1){
for(iii=1; iii <= cp->communicate.np_states; iii++){
num_coef_v[iii] = 0;
}
num_coef = cp->cp_comm_state_pkg_dvr_dn.nstate_ncoef_proc;
Allgather(&num_coef,1,MPI_INT,&num_coef_v[1],1,MPI_INT,0,world);
cp->cpcoeffs_info.icoef_start_dn = 1;
for(iii=1; iii <= cp->communicate.myid; iii++){
cp->cpcoeffs_info.icoef_start_dn += num_coef_v[iii];
}
cp->cp_comm_state_pkg_dvr_dn.icoef_start =
cp->cpcoeffs_info.icoef_start_dn;
}else{
cp->cpcoeffs_info.icoef_start_dn = 1;
cp->cp_comm_state_pkg_dvr_dn.icoef_start = 1;
}
if(cp->communicate.np_states > 1){
free(&num_coef_v[1]);
}
/*==========================================================================*/
}/* end routine */
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 */
/*
**************************************************************************
* Specialized Allreduce for doubles.
**************************************************************************
*/
int
SAMRAI_MPI::AllReduce(
float* x,
int count,
Op op,
int* ranks_of_extrema) const
{
#ifndef HAVE_MPI
NULL_USE(x);
NULL_USE(count);
NULL_USE(op);
NULL_USE(ranks_of_extrema);
#endif
if ((op == MPI_MINLOC || op == MPI_MAXLOC) &&
ranks_of_extrema == 0) {
TBOX_ERROR("SAMRAI_MPI::AllReduce: If you specify reduce\n"
<< "operation MPI_MINLOC or MPI_MAXLOC, you must\n"
<< "provide space for the ranks in the 'ranks_of_extrema'\n"
<< "argument.");
}
if (!s_mpi_is_initialized) {
TBOX_ERROR("SAMRAI_MPI::AllReduce is a no-op without run-time MPI!");
}
int rval = MPI_SUCCESS;
/*
* Get ranks of extrema if user operation specified it or user
* specified min/max operation and provides space for rank.
*/
bool get_ranks_of_extrema =
op == MPI_MINLOC ? true :
op == MPI_MAXLOC ? true :
ranks_of_extrema != 0 && (op == MPI_MIN || op == MPI_MAX);
if (!get_ranks_of_extrema) {
std::vector<float> recv_buf(count);
rval = Allreduce(x, &recv_buf[0], count, MPI_FLOAT, op);
for (int c = 0; c < count; ++c) {
x[c] = recv_buf[c];
}
} else {
Op locop =
op == MPI_MIN ? MPI_MINLOC :
op == MPI_MAX ? MPI_MAXLOC :
op;
FloatIntStruct* send_buf = new FloatIntStruct[count];
FloatIntStruct* recv_buf = new FloatIntStruct[count];
for (int c = 0; c < count; ++c) {
send_buf[c].f = x[c];
send_buf[c].i = d_rank;
}
rval = Allreduce(send_buf, recv_buf, count, MPI_FLOAT_INT, locop);
for (int c = 0; c < count; ++c) {
x[c] = recv_buf[c].f;
ranks_of_extrema[c] = recv_buf[c].i;
}
delete[] send_buf;
delete[] recv_buf;
}
return rval;
}
/*==========================================================================*/
void rattle_23_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 avec[NCON_23+1];
double amat[NCON_23+1][NCON_23+1],ainv[NCON_23+1][NCON_23+1];
double dvx12,dvy12,dvz12,dvx13,dvy13,dvz13;
double r12s,r13s,dot23,dot2t2,dot3t3;
double rdet_a;
double roll_sci,dlam1,dlam2;
double f_lnv_inc;
int i,igrp,*ind1,*ind2,*ind3,jtyp;
int ktemp,ktemp1,ktemp2,ktemp3;
double *p11,*p22,*p33,*p12,*p13,*p23;
double **x,**y,**z;
double **vx,**vy,**vz;
double *xlam1,*xlam2;
double *rmassu1,*rmassu2;
double *rmass1,*rmass2,*rmass3;
double *dx12,*dy12,*dz12,*dx13,*dy13,*dz13;
/* 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_23 = grp_bond_con->j1_23;
int *grp_bond_con_j2_23 = grp_bond_con->j2_23;
int *grp_bond_con_j3_23 = grp_bond_con->j3_23;
int *grp_bond_con_jtyp_23 = grp_bond_con->jtyp_23;
double **grp_bond_con_al_23 = grp_bond_con->al_23;
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 pnorm;
double baro_v_lnv_g = baro->v_lnv_g;
int ngrp,irem,igrp_off;
int ngrp_tot = grp_bond_con->num_23;
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){
p11= dvector(1,ngrp);
p12= dvector(1,ngrp);
p13= dvector(1,ngrp);
p22= dvector(1,ngrp);
p23= dvector(1,ngrp);
p33= dvector(1,ngrp);
xlam1= dvector(1,ngrp);
xlam2= dvector(1,ngrp);
x= dmatrix(1,3,1,ngrp);
y= dmatrix(1,3,1,ngrp);
z= dmatrix(1,3,1,ngrp);
dx12= dvector(1,ngrp);
dy12= dvector(1,ngrp);
dz12= dvector(1,ngrp);
dx13= dvector(1,ngrp);
dy13= dvector(1,ngrp);
dz13= dvector(1,ngrp);
rmassu1= dvector(1,ngrp);
rmassu2= dvector(1,ngrp);
rmass1= dvector(1,ngrp);
rmass2= dvector(1,ngrp);
rmass3= dvector(1,ngrp);
vx= dmatrix(1,3,1,ngrp);
vy= dmatrix(1,3,1,ngrp);
vz= dmatrix(1,3,1,ngrp);
ind1= (int *)calloc((1+ngrp),sizeof(int));
ind2= (int *)calloc((1+ngrp),sizeof(int));
ind3= (int *)calloc((1+ngrp),sizeof(int));
}/*endif*/
/*=======================================================================*/
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;
/* Collect masses, positions,and velocities */
for(igrp=1;igrp <= ngrp; igrp++) {
ind1[igrp] = grp_bond_con_j1_23[(igrp+igrp_off)];
ind2[igrp] = grp_bond_con_j2_23[(igrp+igrp_off)];
ind3[igrp] = grp_bond_con_j3_23[(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= 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;
}
/* ==================================================================================== */
/* Define useful constants */
for(igrp=1;igrp <= ngrp; igrp++) {
dx12[igrp] = (x[1][igrp]-x[2][igrp]);
dy12[igrp] = (y[1][igrp]-y[2][igrp]);
dz12[igrp] = (z[1][igrp]-z[2][igrp]);
r12s = dx12[igrp]*dx12[igrp] + dy12[igrp]*dy12[igrp] + dz12[igrp]*dz12[igrp];
dx13[igrp] = (x[1][igrp]-x[3][igrp]);
dy13[igrp] = (y[1][igrp]-y[3][igrp]);
dz13[igrp] = (z[1][igrp]-z[3][igrp]);
r13s = dx13[igrp]*dx13[igrp] + dy13[igrp]*dy13[igrp] + dz13[igrp]*dz13[igrp];
dvx12 = (vx[1][igrp]-vx[2][igrp]);
dvy12 = (vy[1][igrp]-vy[2][igrp]);
dvz12 = (vz[1][igrp]-vz[2][igrp]);
dvx13 = (vx[1][igrp]-vx[3][igrp]);
dvy13 = (vy[1][igrp]-vy[3][igrp]);
dvz13 = (vz[1][igrp]-vz[3][igrp]);
rmassu1[igrp] = rmass1[igrp] + rmass2[igrp];
rmassu2[igrp] = rmass1[igrp] + rmass3[igrp];
/* Get elements of vector */
dot2t2 = dx12[igrp]*dvx12 + dy12[igrp]*dvy12 + dz12[igrp]*dvz12;
dot3t3 = dx13[igrp]*dvx13 + dy13[igrp]*dvy13 + dz13[igrp]*dvz13;
dot23 = dx12[igrp]*dx13[igrp] + dy12[igrp]*dy13[igrp] + dz12[igrp]*dz13[igrp];
avec[1] = dot2t2;
avec[2] = dot3t3;
/* Get elements of matrix */
amat[1][1] = rmassu1[igrp]*r12s;
amat[1][2] = rmass1[igrp]*dot23;
amat[2][1] = amat[1][2];
amat[2][2] = rmassu2[igrp]*r13s;
rdet_a = 1.0/(amat[1][1]*amat[2][2] - amat[1][2]*amat[2][1]);
ainv[1][1] = amat[2][2]*rdet_a;
ainv[1][2] = -amat[1][2]*rdet_a;
ainv[2][1] = -amat[2][1]*rdet_a;
ainv[2][2] = amat[1][1]*rdet_a;
xlam1[igrp] = ainv[1][1]*avec[1] + ainv[1][2]*avec[2];
xlam2[igrp] = ainv[2][1]*avec[1] + ainv[2][2]*avec[2];
}/*end for*/
#ifndef NO_PRAGMA
#pragma IVDEP
#endif
for(igrp=1;igrp <= ngrp; igrp++) {
double dx_12,dy_12,dz_12;
double dx_13,dy_13,dz_13;
double xlam_1,xlam_2;
double rms1,rms2,rms3;
ktemp1 = ind1[igrp];
ktemp2 = ind2[igrp];
ktemp3 = ind3[igrp];
dx_12= dx12[igrp]; dy_12= dy12[igrp]; dz_12= dz12[igrp];
dx_13= dx13[igrp]; dy_13= dy13[igrp]; dz_13= dz13[igrp];
rms1= rmass1[igrp]; rms2= rmass2[igrp]; rms3= rmass3[igrp];
xlam_1= xlam1[igrp];
xlam_2= xlam2[igrp];
clatoms_vx[ktemp1] -= (xlam_1*dx_12 + xlam_2*dx_13)*rms1;
clatoms_vy[ktemp1] -= (xlam_1*dy_12 + xlam_2*dy_13)*rms1;
clatoms_vz[ktemp1] -= (xlam_1*dz_12 + xlam_2*dz_13)*rms1;
clatoms_vx[ktemp2] += xlam_1*dx_12*rms2;
clatoms_vy[ktemp2] += xlam_1*dy_12*rms2;
clatoms_vz[ktemp2] += xlam_1*dz_12*rms2;
clatoms_vx[ktemp3] += xlam_2*dx_13*rms3;
clatoms_vy[ktemp3] += xlam_2*dy_13*rms3;
clatoms_vz[ktemp3] += xlam_2*dz_13*rms3;
/* Pressure Tensor update */
p11[igrp] = xlam_1*dx_12*dx_12 + xlam_2*dx_13*dx_13;
p22[igrp] = xlam_1*dy_12*dy_12 + xlam_2*dy_13*dy_13;
p33[igrp] = xlam_1*dz_12*dz_12 + xlam_2*dz_13*dz_13;
p12[igrp] = xlam_1*dx_12*dy_12 + xlam_2*dx_13*dy_13;
p13[igrp] = xlam_1*dx_12*dz_12 + xlam_2*dx_13*dz_13;
p23[igrp] = xlam_1*dy_12*dz_12 + xlam_2*dy_13*dz_13;
}/*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_23[1][(igrp+igrp_off)] = xlam1[igrp];
grp_bond_con_al_23[2][(igrp+igrp_off)] = xlam2[igrp];
}/* end for */
/*=======================================================================*/
/* 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(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(xlam1,1,ngrp);
free_dvector(xlam2,1,ngrp);
free_dmatrix(x,1,3,1,ngrp);
free_dmatrix(y,1,3,1,ngrp);
free_dmatrix(z,1,3,1,ngrp);
free_dvector(dx12,1,ngrp);
free_dvector(dy12,1,ngrp);
free_dvector(dz12,1,ngrp);
free_dvector(dx13,1,ngrp);
free_dvector(dy13,1,ngrp);
free_dvector(dz13,1,ngrp);
free_dvector(rmassu1,1,ngrp);
free_dvector(rmassu2,1,ngrp);
free_dvector(rmass1,1,ngrp);
free_dvector(rmass2,1,ngrp);
free_dvector(rmass3,1,ngrp);
free_dmatrix(vx,1,3,1,ngrp);
free_dmatrix(vy,1,3,1,ngrp);
free_dmatrix(vz,1,3,1,ngrp);
free(ind1); free(ind2); free(ind3);
}/*endif*/
/*=======================================================================*/
} /* end routine */
/*==========================================================================*/
void shake_23_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 ftemp;
double xl0[NCON_23+1];
double rmu[NCON_23+1];
double amat[NCON_23+1][NCON_23+1],ainv[NCON_23+1][NCON_23+1];
double r12s,r13s;
double dxn12,dyn12,dzn12,dxn13,dyn13,dzn13;
double dlmax,dlmax1,dlmax2,rdet_a;
double rmu12,rmu22,rm12;
double dts;
int iter,igrp,*ind1,*ind2,*ind3,jtyp;
int iii,i,ktemp,ktemp1,ktemp2,ktemp3;
double *xlam1,*xlam2;
double *avec1,*avec2;
double *rm1,*rm2,*rm3;
double *rmm11,*rmm12,*rmm21,*rmm22;
double *dxl1,*dxl2;
double *dx12,*dy12,*dz12,*dx13,*dy13,*dz13;
double *dxo12,*dyo12,*dzo12,*dxo13,*dyo13,*dzo13;
double **x,**y,**z,**xo,**yo,**zo;
double *dij1,*dij2;
double *p11,*p12,*p13,*p23,*p33,*p22;
/* 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_23 = grp_bond_con->j1_23;
int *grp_bond_con_j2_23 = grp_bond_con->j2_23;
int *grp_bond_con_j3_23 = grp_bond_con->j3_23;
int *grp_bond_con_jtyp_23 = grp_bond_con->jtyp_23;
double **grp_bond_con_eq_23 = grp_bond_con->eq_23;
double **grp_bond_con_al_23 = grp_bond_con->al_23;
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_23;
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;
/*=======================================================================*/
/* assign local memory */
if(ngrp > 0){
xlam1 = dvector(1,ngrp);
xlam2 = dvector(1,ngrp);
avec1 = dvector(1,ngrp);
avec2 = dvector(1,ngrp);
rm1 = dvector(1,ngrp);
rm2 = dvector(1,ngrp);
rm3 = dvector(1,ngrp);
rmm11 = dvector(1,ngrp);
rmm12 = dvector(1,ngrp);
rmm21 = dvector(1,ngrp);
rmm22 = dvector(1,ngrp);
dxl1 = dvector(1,ngrp);
dxl2 = dvector(1,ngrp);
dx12 = dvector(1,ngrp);
dy12 = dvector(1,ngrp);
dz12 = dvector(1,ngrp);
dx13 = dvector(1,ngrp);
dy13 = dvector(1,ngrp);
dz13 = dvector(1,ngrp);
dxo12 = dvector(1,ngrp);
dyo12 = dvector(1,ngrp);
dzo12 = dvector(1,ngrp);
dxo13 = dvector(1,ngrp);
dyo13 = dvector(1,ngrp);
dzo13 = dvector(1,ngrp);
dij1= dvector(1,ngrp);
dij2= dvector(1,ngrp);
x= dmatrix(1,3,1,ngrp);
y= dmatrix(1,3,1,ngrp);
z= dmatrix(1,3,1,ngrp);
xo= dmatrix(1,3,1,ngrp);
yo= dmatrix(1,3,1,ngrp);
zo= dmatrix(1,3,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);
ind1 = (int *) cmalloc(ngrp*sizeof(int))-1;
ind2 = (int *) cmalloc(ngrp*sizeof(int))-1;
ind3 = (int *) cmalloc(ngrp*sizeof(int))-1;
}/*endif*/
/*=======================================================================*/
/* CC */
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_23[1][(igrp+igrp_off)] = 0.0;
grp_bond_con_al_23[2][(igrp+igrp_off)] = 0.0;
}
}
for(igrp=1;igrp <= ngrp; igrp++) {
ind1[igrp] = grp_bond_con_j1_23[(igrp+igrp_off)];
ind2[igrp] = grp_bond_con_j2_23[(igrp+igrp_off)];
ind3[igrp] = grp_bond_con_j3_23[(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];
rm1[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];
rm2[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];
rm3[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++) {
jtyp = grp_bond_con_jtyp_23[(igrp+igrp_off)];
dij1[igrp] = grp_bond_con_eq_23[1][jtyp];
dij2[igrp] = grp_bond_con_eq_23[2][jtyp];
}/*end for*/
/* Initial Guess for multipliers */
for(igrp=1;igrp <= ngrp; igrp++) {
rmm11[igrp] = -(rm1[igrp]+rm2[igrp]);
rmm12[igrp] = -rm1[igrp];
rmm21[igrp] = -rm1[igrp];
rmm22[igrp] = -(rm1[igrp]+rm3[igrp]);
}
for(igrp=1;igrp <= ngrp; igrp++) {
dx12[igrp] = x[1][igrp]-x[2][igrp];
dy12[igrp] = y[1][igrp]-y[2][igrp];
dz12[igrp] = z[1][igrp]-z[2][igrp];
}
for(igrp=1;igrp <= ngrp; igrp++) {
dx13[igrp] = x[1][igrp]-x[3][igrp];
dy13[igrp] = y[1][igrp]-y[3][igrp];
dz13[igrp] = z[1][igrp]-z[3][igrp];
}
for(igrp=1;igrp <= ngrp; igrp++) {
dxo12[igrp] = (xo[1][igrp]-xo[2][igrp])*baro_roll_scv;
dyo12[igrp] = (yo[1][igrp]-yo[2][igrp])*baro_roll_scv;
dzo12[igrp] = (zo[1][igrp]-zo[2][igrp])*baro_roll_scv;
}
for(igrp=1;igrp <= ngrp; igrp++) {
dxo13[igrp] = (xo[1][igrp]-xo[3][igrp])*baro_roll_scv;
dyo13[igrp] = (yo[1][igrp]-yo[3][igrp])*baro_roll_scv;
dzo13[igrp] = (zo[1][igrp]-zo[3][igrp])*baro_roll_scv;
}
for(igrp=1;igrp <= ngrp; igrp++) {
r12s = dx12[igrp]*dx12[igrp] + dy12[igrp]*dy12[igrp]
+ dz12[igrp]*dz12[igrp];
r13s = dx13[igrp]*dx13[igrp] + dy13[igrp]*dy13[igrp]
+ dz13[igrp]*dz13[igrp];
avec1[igrp] = dij1[igrp]*dij1[igrp] - r12s;
avec2[igrp] = dij2[igrp]*dij2[igrp] - r13s;
}
if(ifirst==2||ifirst==0){
for(igrp=1;igrp <= ngrp; igrp++) {
amat[1][1] = 2.0*rmm11[igrp]*(dx12[igrp]*dxo12[igrp]
+ dy12[igrp]*dyo12[igrp]
+ dz12[igrp]*dzo12[igrp]);
amat[1][2] = 2.0*rmm12[igrp]*(dx12[igrp]*dxo13[igrp]
+ dy12[igrp]*dyo13[igrp]
+ dz12[igrp]*dzo13[igrp]);
amat[2][1] = 2.0*rmm21[igrp]*(dx13[igrp]*dxo12[igrp]
+ dy13[igrp]*dyo12[igrp]
+ dz13[igrp]*dzo12[igrp]);
amat[2][2] = 2.0*rmm22[igrp]*(dx13[igrp]*dxo13[igrp]
+ dy13[igrp]*dyo13[igrp]
+ dz13[igrp]*dzo13[igrp]);
rdet_a = 1.0/(amat[1][1]*amat[2][2] - amat[1][2]*amat[2][1]);
ainv[1][1] = amat[2][2]*rdet_a;
ainv[1][2] = -amat[1][2]*rdet_a;
ainv[2][1] = -amat[2][1]*rdet_a;
ainv[2][2] = amat[1][1]*rdet_a;
xlam1[igrp] = ainv[1][1]*avec1[igrp] + ainv[1][2]*avec2[igrp];
xlam2[igrp] = ainv[2][1]*avec1[igrp] + ainv[2][2]*avec2[igrp];
}/*end for*/
}else{
for(igrp=1;igrp <= ngrp; igrp++) {
xlam1[igrp] = grp_bond_con_al_23[1][(igrp+igrp_off)];
xlam2[igrp] = grp_bond_con_al_23[2][(igrp+igrp_off)];
grp_bond_con_al_23[1][(igrp+igrp_off)] = 0.0;
grp_bond_con_al_23[2][(igrp+igrp_off)] = 0.0;
}/* end for */
}/*endif*/
/* Iterative do loop for multiplier */
if(ngrp > 0){
iter = 0;
do {
++iter;
if(iter > grp_bond_con->max_iter) {
printf("$$$$$$$$$$$$$$$$$$$$_WARNING_$$$$$$$$$$$$$$$$$$$$\n");
printf("Shake not converged after %d iterations.\n",
grp_bond_con->max_iter);
printf("The present tolerance is %g \n",dlmax);
printf("The desired tolerance is %g \n",grp_bond_con->tol);
printf("$$$$$$$$$$$$$$$$$$$$_WARNING_$$$$$$$$$$$$$$$$$$$$\n");
fflush(stdout);
break;
}/*endif*/
/* Get elements of matrix */
for(igrp=1;igrp <= ngrp; igrp++) {
dxn12 = 2.0*dx12[igrp]
+ rmm11[igrp]*xlam1[igrp]*dxo12[igrp]
+ rmm12[igrp]*xlam2[igrp]*dxo13[igrp];
dyn12 = 2.0*dy12[igrp]
+ rmm11[igrp]*xlam1[igrp]*dyo12[igrp]
+ rmm12[igrp]*xlam2[igrp]*dyo13[igrp];
dzn12 = 2.0*dz12[igrp]
+ rmm11[igrp]*xlam1[igrp]*dzo12[igrp]
+ rmm12[igrp]*xlam2[igrp]*dzo13[igrp];
dxn13 = 2.0*dx13[igrp]
+ rmm21[igrp]*xlam1[igrp]*dxo12[igrp]
+ rmm22[igrp]*xlam2[igrp]*dxo13[igrp];
dyn13 = 2.0*dy13[igrp]
+ rmm21[igrp]*xlam1[igrp]*dyo12[igrp]
+ rmm22[igrp]*xlam2[igrp]*dyo13[igrp];
dzn13 = 2.0*dz13[igrp]
+ rmm21[igrp]*xlam1[igrp]*dzo12[igrp]
+ rmm22[igrp]*xlam2[igrp]*dzo13[igrp];
amat[1][1] = rmm11[igrp]*(dxn12*dxo12[igrp]
+ dyn12*dyo12[igrp]
+ dzn12*dzo12[igrp]);
amat[1][2] = rmm12[igrp]*(dxn12*dxo13[igrp]
+ dyn12*dyo13[igrp]
+ dzn12*dzo13[igrp]);
amat[2][1] = rmm21[igrp]*(dxn13*dxo12[igrp]
+ dyn13*dyo12[igrp]
+ dzn13*dzo12[igrp]);
amat[2][2] = rmm22[igrp]*(dxn13*dxo13[igrp]
+ dyn13*dyo13[igrp]
+ dzn13*dzo13[igrp]);
rdet_a = 1.0/(amat[1][1]*amat[2][2] - amat[1][2]*amat[2][1]);
ainv[1][1] = amat[2][2]*rdet_a;
ainv[1][2] = -amat[1][2]*rdet_a;
ainv[2][1] = -amat[2][1]*rdet_a;
ainv[2][2] = amat[1][1]*rdet_a;
xl0[1] = xlam1[igrp];
xl0[2] = xlam2[igrp];
xlam1[igrp] = ainv[1][1]*avec1[igrp] + ainv[1][2]*avec2[igrp];
xlam2[igrp] = ainv[2][1]*avec1[igrp] + ainv[2][2]*avec2[igrp];
dxl1[igrp] = fabs(xlam1[igrp]-xl0[1]);
dxl2[igrp] = fabs(xlam2[igrp]-xl0[2]);
} /* end loop over groups */
/* test for convergence */
dlmax1 = dxl1[1];
dlmax2 = dxl2[1];
for(igrp=2;igrp <= ngrp; igrp++) {
dlmax1= (dlmax1 > dxl1[igrp] ? dlmax1 : dxl1[igrp]);
dlmax2= (dlmax2 > dxl2[igrp] ? dlmax2 : dxl1[igrp]);
}
dlmax = (dlmax1 > dlmax2 ? dlmax1:dlmax2);
} while(dlmax > 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 xlam_1,xlam_2;
double rms1,rms2,rms3;
double dxo120,dyo120,dzo120;
double dxo130,dyo130,dzo130;
ktemp1 = ind1[igrp];
ktemp2 = ind2[igrp];
ktemp3 = ind3[igrp];
xlam_1 = xlam1[igrp]; xlam_2 = xlam2[igrp];
rms1= rm1[igrp];
rms2= rm2[igrp];
rms3= rm3[igrp];
dxo120 = (xo[1][igrp]-xo[2][igrp]);
dyo120 = (yo[1][igrp]-yo[2][igrp]);
dzo120 = (zo[1][igrp]-zo[2][igrp]);
dxo130 = (xo[1][igrp]-xo[3][igrp]);
dyo130 = (yo[1][igrp]-yo[3][igrp]);
dzo130 = (zo[1][igrp]-zo[3][igrp]);
clatoms_x[ktemp1] -= (xlam_1*dxo120 + xlam_2*dxo130)*rms1 *baro_roll_scv;
clatoms_y[ktemp1] -= (xlam_1*dyo120 + xlam_2*dyo130)*rms1 *baro_roll_scv;
clatoms_z[ktemp1] -= (xlam_1*dzo120 + xlam_2*dzo130)*rms1 *baro_roll_scv;
clatoms_x[ktemp2] += xlam_1*dxo120*rms2*baro_roll_scv;
clatoms_y[ktemp2] += xlam_1*dyo120*rms2*baro_roll_scv;
clatoms_z[ktemp2] += xlam_1*dzo120*rms2*baro_roll_scv;
clatoms_x[ktemp3] += xlam_2*dxo130*rms3*baro_roll_scv;
clatoms_y[ktemp3] += xlam_2*dyo130*rms3*baro_roll_scv;
clatoms_z[ktemp3] += xlam_2*dzo130*rms3*baro_roll_scv;
/* Velocity update */
clatoms_vx[ktemp1] -= (xlam_1*dxo120 + xlam_2*dxo130)*rms1/dt;
clatoms_vy[ktemp1] -= (xlam_1*dyo120 + xlam_2*dyo130)*rms1/dt;
clatoms_vz[ktemp1] -= (xlam_1*dzo120 + xlam_2*dzo130)*rms1/dt;
clatoms_vx[ktemp2] += xlam_1*dxo120*rms2/dt;
clatoms_vy[ktemp2] += xlam_1*dyo120*rms2/dt;
clatoms_vz[ktemp2] += xlam_1*dzo120*rms2/dt;
clatoms_vx[ktemp3] += xlam_2*dxo130*rms3/dt;
clatoms_vy[ktemp3] += xlam_2*dyo130*rms3/dt;
clatoms_vz[ktemp3] += xlam_2*dzo130*rms3/dt;
/* Pressure tensor update */
/* Compute difference vectors: unscaled old distances !!!*/
p11[igrp] = xlam_1*dxo120*dxo120 + xlam_2*dxo130*dxo130;
p22[igrp] = xlam_1*dyo120*dyo120 + xlam_2*dyo130*dyo130;
p33[igrp] = xlam_1*dzo120*dzo120 + xlam_2*dzo130*dzo130;
p12[igrp] = xlam_1*dxo120*dyo120 + xlam_2*dxo130*dyo130;
p13[igrp] = xlam_1*dxo120*dzo120 + xlam_2*dxo130*dzo130;
p23[igrp] = xlam_1*dyo120*dzo120 + xlam_2*dyo130*dzo130;
}/*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_23[1][(igrp+igrp_off)] += xlam1[igrp];
grp_bond_con_al_23[2][(igrp+igrp_off)] += xlam2[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(xlam1,1,ngrp);
free_dvector(xlam2,1,ngrp);
free_dvector(avec1,1,ngrp);
free_dvector(avec2,1,ngrp);
free_dvector(rm1,1,ngrp);
free_dvector(rm2,1,ngrp);
free_dvector(rm3,1,ngrp);
free_dvector(rmm11,1,ngrp);
free_dvector(rmm12,1,ngrp);
free_dvector(rmm21,1,ngrp);
free_dvector(rmm22,1,ngrp);
free_dvector(dxl1,1,ngrp);
free_dvector(dxl2,1,ngrp);
free_dvector(dx12,1,ngrp);
free_dvector(dy12,1,ngrp);
free_dvector(dz12,1,ngrp);
free_dvector(dx13,1,ngrp);
free_dvector(dy13,1,ngrp);
free_dvector(dz13,1,ngrp);
free_dvector(dxo12,1,ngrp);
free_dvector(dyo12,1,ngrp);
free_dvector(dzo12,1,ngrp);
free_dvector(dxo13,1,ngrp);
free_dvector(dyo13,1,ngrp);
free_dvector(dzo13,1,ngrp);
free_dvector(dij1,1,ngrp);
free_dvector(dij2,1,ngrp);
free_dmatrix(x,1,3,1,ngrp);
free_dmatrix(y,1,3,1,ngrp);
free_dmatrix(z,1,3,1,ngrp);
free_dmatrix(xo,1,3,1,ngrp);
free_dmatrix(yo,1,3,1,ngrp);
free_dmatrix(zo,1,3,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);
cfree(&(ind1[1]));
cfree(&(ind2[1]));
cfree(&(ind3[1]));
}/*endif*/
/*=======================================================================*/
} /* end routine */
/*==========================================================================*/
void check_coef_grad_mag_dvr(CP *cp,SIMOPTS *simopts,
double *fc_mag_up_ret,double *fc_mag_dn_ret,
int *ireset_ret,int *idone_ret, double tol_coef,
int ip_start,int ip_end,STAT_AVG *stat_avg)
/*=======================================================================*/
/* Begin subprogram: */
{/*begin routine*/
/*=======================================================================*/
/* Local variable declarations */
#include "../typ_defs/typ_mask.h"
int iii;
double fc_mag_up_old = *fc_mag_up_ret;
double fc_mag_dn_old = *fc_mag_dn_ret;
double fc_mag_up,fc_mag_dn;
double fc_max_up,fc_max_dn;
double fc_mag_up_tmp,fc_mag_dn_tmp;
double fc_max_up_tmp,fc_max_dn_tmp;
int pi_beads = cp->cpcoeffs_info.pi_beads;
int pi_beads_proc = cp->cpcoeffs_info.pi_beads_proc;
int ip;
int i,idone,ireset;
int ncoef_tot;
double *dvrfc_up,*dvrfc_dn;
double *dvrc_up, *dvrc_dn;
double *ksmat_up,*ksmat_dn;
double *occ_up = cp->cpopts.occ_up;
double *occ_dn = cp->cpopts.occ_dn;
double *ksmat_scr = cp->cpscr.cpscr_ovmat.ovlap1;
int *ioff_upt = cp->cpcoeffs_info.ioff_upt;
int *ioff_dnt = cp->cpcoeffs_info.ioff_dnt;
int cp_norb = cp->cpopts.cp_norb;
int cp_min;
int ncoef_up = cp->cp_comm_state_pkg_dvr_up.nstate_ncoef_proc;
int ncoef_dn = cp->cp_comm_state_pkg_dvr_dn.nstate_ncoef_proc;
int nstate_up = cp->cpcoeffs_info.nstate_up;
int nstate_dn = cp->cpcoeffs_info.nstate_dn;
int cp_lsda = cp->cpopts.cp_lsda;
int myid_state = cp->communicate.myid_state;
int myid_bead = cp->communicate.myid_bead;
int np_states = cp->communicate.np_states;
int np_beads = cp->communicate.np_beads;
int icoef_orth_up,icoef_orth_dn;
int icoef_form_up,icoef_form_dn;
int ifcoef_orth_up,ifcoef_orth_dn;
int ifcoef_form_up,ifcoef_form_dn;
MPI_Comm comm_states = cp->communicate.comm_states;
MPI_Comm comm_beads = cp->communicate.comm_beads;
/*=======================================================================*/
/* 0) Parallel checks */
if(np_states>1){
for(ip=ip_start;ip<=ip_end;ip++){
ifcoef_form_up = cp->cpcoeffs_pos_dvr[ip].ifcoef_form_up;
ifcoef_form_dn = cp->cpcoeffs_pos_dvr[ip].ifcoef_form_dn;
if(ifcoef_form_up!=1){
printf("@@@@@@@@@@@@@@@@@@@@_ERROR_@@@@@@@@@@@@@@@@@@@@\n");
printf("Up Coef forces are not in transposed form \n");
printf("on state processor %d in check_coef_grad \n",myid_state);
printf("@@@@@@@@@@@@@@@@@@@@_ERROR_@@@@@@@@@@@@@@@@@@@@\n");
fflush(stdout);
exit(1);
}/*endif*/
if(cp_lsda==1){
if(ifcoef_form_dn!=1){
printf("@@@@@@@@@@@@@@@@@@@@_ERROR_@@@@@@@@@@@@@@@@@@@@\n");
printf("Dn Coef forces are not in transposed form \n");
printf("on state processor %d in check_coef_grad \n",myid_state);
printf("@@@@@@@@@@@@@@@@@@@@_ERROR_@@@@@@@@@@@@@@@@@@@@\n");
fflush(stdout);
exit(1);
}/*endif*/
}/*endif*/
}/* endfor */
}/*endif*/
/*=======================================================================*/
/* 0.1) Initialize and calculate some useful quantities */
ncoef_tot = ncoef_up*nstate_up;
cp_min = simopts->cp_min + simopts->cp_wave_min + simopts->cp_wave_min_pimd;
fc_mag_up = 0.0;
fc_max_up = 0.0;
fc_mag_dn = 0.0;
fc_max_dn = 0.0;
/*=======================================================================*/
/* Begin for loop over beads */
for(ip=ip_start;ip<=ip_end;ip++){
/*-----------------------------------------------------------------------*/
/* Assign and project forces if necessary */
dvrc_up = cp->cpcoeffs_pos_dvr[ip].dvrc_up;
dvrc_dn = cp->cpcoeffs_pos_dvr[ip].dvrc_dn;
icoef_orth_up = cp->cpcoeffs_pos_dvr[ip].icoef_orth_up;
icoef_orth_dn = cp->cpcoeffs_pos_dvr[ip].icoef_orth_dn;
icoef_form_up = cp->cpcoeffs_pos_dvr[ip].icoef_form_up;
icoef_form_dn = cp->cpcoeffs_pos_dvr[ip].icoef_form_dn;
ifcoef_orth_up = cp->cpcoeffs_pos_dvr[ip].ifcoef_orth_up;
ifcoef_orth_dn = cp->cpcoeffs_pos_dvr[ip].ifcoef_orth_dn;
ifcoef_form_up = cp->cpcoeffs_pos_dvr[ip].ifcoef_form_up;
ifcoef_form_dn = cp->cpcoeffs_pos_dvr[ip].ifcoef_form_dn;
ksmat_up = cp->cpcoeffs_pos_dvr[ip].ksmat_up;
ksmat_dn = cp->cpcoeffs_pos_dvr[ip].ksmat_dn;
if(cp_min == 1 || cp_norb >= 1) {
dvrfc_up = cp->cpcoeffs_pos_dvr[ip].dvrfc_up;
dvrfc_dn = cp->cpcoeffs_pos_dvr[ip].dvrfc_dn;
}else { /* CHECK PARALLEL */
dvrfc_up = cp->cpscr.cpscr_wave.cre_up;
dvrfc_dn = cp->cpscr.cpscr_wave.cre_dn;
for(i=1;i<=ncoef_tot; i++){
dvrfc_up[i] = cp->cpcoeffs_pos_dvr[ip].dvrfc_up[i];
}
if(cp->cpopts.cp_lsda == 1 && nstate_dn != 0){
for(i=1;i<=ncoef_tot; i++){
dvrfc_dn[i] = cp->cpcoeffs_pos_dvr[ip].dvrfc_dn[i];
}
}/* endif */
cp_add_ksmat_force_dvr(dvrc_up,icoef_form_up,icoef_orth_up,
dvrfc_up,ifcoef_form_up,ifcoef_orth_up,
ksmat_up,ksmat_scr,ioff_upt,cp_lsda,cp_min,occ_up,
cp->cpcoeffs_info.scale_fact,
&(cp->cp_comm_state_pkg_dvr_up));
if( (cp_lsda==1) && (nstate_dn!=0) ){
cp_add_ksmat_force_dvr(dvrc_dn,icoef_form_dn,icoef_orth_dn,
dvrfc_dn,ifcoef_form_dn,ifcoef_orth_dn,
ksmat_dn,ksmat_scr,ioff_dnt,cp_lsda,cp_min,occ_dn,
cp->cpcoeffs_info.scale_fact,
&(cp->cp_comm_state_pkg_dvr_dn));
}/*endif*/
}/* endif */
/*-----------------------------------------------------------------------*/
/* I) Up tolerence */
for(i=1;i <= ncoef_tot; i++) {
fc_mag_up += (dvrfc_up[i]*dvrfc_up[i]);
fc_max_up = MAX(fabs(dvrfc_up[i]),fc_max_up);
}/*endfor*/
/*-----------------------------------------------------------------------*/
/* II) Dn tolerence */
if(cp_lsda == 1){
ncoef_tot = ncoef_dn*nstate_dn;
for(i=1;i <= ncoef_tot; i++) {
fc_mag_dn += dvrfc_dn[i] * dvrfc_dn[i];
fc_max_dn = MAX(fabs(dvrfc_dn[i]),fc_max_dn);
}/*endfor*/
}/*endif*/
}/* endfor ip */
/*=======================================================================*/
/* II.V) Parallel reductions */
/*------------------------------------------------------------------------*/
/* i) First state level */
if(np_states > 1){
fc_mag_up_tmp = fc_mag_up;
fc_mag_dn_tmp = fc_mag_dn;
Allreduce(&(fc_mag_up_tmp),&(fc_mag_up),1,MPI_DOUBLE,MPI_SUM,0,comm_states);
Allreduce(&(fc_mag_dn_tmp),&(fc_mag_dn),1,MPI_DOUBLE,MPI_SUM,0,comm_states);
fc_max_up_tmp = fc_max_up;
fc_max_dn_tmp = fc_max_dn;
Allreduce(&(fc_max_up_tmp),&(fc_max_up),1,MPI_DOUBLE,MPI_MAX,0,comm_states);
Allreduce(&(fc_max_dn_tmp),&(fc_max_dn),1,MPI_DOUBLE,MPI_MAX,0,comm_states);
}/*endif*/
/*------------------------------------------------------------------------*/
/* ii) Next, bead level */
if(np_beads > 1 && cp_min == 0){
fc_mag_up_tmp = fc_mag_up;
fc_mag_dn_tmp = fc_mag_dn;
Allreduce(&(fc_mag_up_tmp),&(fc_mag_up),1,MPI_DOUBLE,MPI_SUM,0,comm_beads);
Allreduce(&(fc_mag_dn_tmp),&(fc_mag_dn),1,MPI_DOUBLE,MPI_SUM,0,comm_beads);
fc_max_up_tmp = fc_max_up;
fc_max_dn_tmp = fc_max_dn;
Allreduce(&(fc_max_up_tmp),&(fc_max_up),1,MPI_DOUBLE,MPI_MAX,0,comm_beads);
Allreduce(&(fc_max_dn_tmp),&(fc_max_dn),1,MPI_DOUBLE,MPI_MAX,0,comm_beads);
}/*endif*/
/*=======================================================================*/
/* II.VI) Calculate the magnitude */
fc_mag_up = sqrt(fc_mag_up/((double)pi_beads));
fc_mag_dn = sqrt(fc_mag_dn/((double)pi_beads));
/*=======================================================================*/
/* III) Set the flags (used for minimization) */
if(myid_state==0){
idone = 1;
if(fc_mag_up > tol_coef){idone=0;}
if((fc_mag_dn > tol_coef)&&(cp_lsda==1)){idone=0;}
ireset = 0;
if(fc_mag_up > fc_mag_up_old){ireset=1;}
if((fc_mag_dn > fc_mag_dn_old)&&(cp_lsda==1)){ireset=1;}
}/*endif*/
if(np_states>1){
Bcast(&idone,1,MPI_INT,0,comm_states);
Bcast(&ireset,1,MPI_INT,0,comm_states);
}/*endif*/
/*=======================================================================*/
/* IV) Set return values and put things in structures */
*fc_mag_up_ret = fc_mag_up;
*fc_mag_dn_ret = fc_mag_dn;
*idone_ret = idone;
*ireset_ret = ireset;
(stat_avg->fc_mag_up) = fc_mag_up;
(stat_avg->fc_mag_dn) = fc_mag_dn;
(stat_avg->fc_max_up) = fc_max_up;
(stat_avg->fc_max_dn) = fc_max_dn;
/*-----------------------------------------------------------------------*/
}/*end routine*/
void rattle_23_rollf(GRP_BOND_CON *grp_bond_con,
CLATOMS_INFO *clatoms_info,CLATOMS_POS *clatoms_pos,
PTENS *ptens,double dt,
PAR_RAHMAN *par_rahman,int ifirst,CELL *cell,
CLASS_COMM_FORC_PKG *class_comm_forc_pkg)
/*==========================================================================*/
/* Begin Routine */
{/* Begin routine */
/*==========================================================================*/
/* Local Variable declarations */
#include "../typ_defs/typ_mask.h"
int i,igrp,*ind1,*ind2,*ind3,jtyp,n;
int ktemp,ktemp1,ktemp2,ktemp3;
double avec[NCON_23+1];
double amat[NCON_23+1][NCON_23+1],ainv[NCON_23+1][NCON_23+1];
double rmu1,rmu2;
double dvx12,dvy12,dvz12,dvx13,dvy13,dvz13;
double r12s,r13s,dot23,dot2t2,dot3t3;
double rdet_a;
double roll_sci,dlam1,dlam2;
double f_lnv_inc;
double *p11,*p12,*p13,*p22,*p23,*p33;
double **x,**y,**z,**vx,**vy,**vz;
double *rm1,*rm2,*rm3;
double *dx12,*dy12,*dz12,*dx13,*dy13,*dz13;
double **xlam;
double pnorm;
double roll_mtvvi[10],rolli_by_vg[10];
double det_roll_mtvv;
/*=======================================================================*/
/* 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_roll_sc = clatoms_info->roll_sc;
int ngrp = grp_bond_con->num_23;
int *grp_bond_con_j1_23 = grp_bond_con->j1_23;
int *grp_bond_con_j2_23 = grp_bond_con->j2_23;
int *grp_bond_con_j3_23 = grp_bond_con->j3_23;
int *grp_bond_con_jtyp_23 = grp_bond_con->jtyp_23;
double **grp_bond_con_al_23 = grp_bond_con->al_23;
double *pvten_inc = ptens->pvten_inc;
double *pvten_tmp = ptens->pvten_tmp;
double *pvten_tmp2 = ptens->pvten_tmp_res;
double *roll_mtvv = par_rahman->roll_mtvv;
double *vgmat_g = par_rahman->vgmat_g;
double *fgmat_p = par_rahman->fgmat_p;
double roll_scg = par_rahman->roll_scg;
double mass_hm = par_rahman->mass_hm;
int iperd = cell->iperd;
int hmat_cons_typ = cell->hmat_cons_typ;
int hmat_int_typ = cell->hmat_int_typ;
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;
/*=======================================================================*/
/* assign local memory */
if(ngrp > 0){
p11= dvector(1,ngrp); p12= dvector(1,ngrp);
p13= dvector(1,ngrp); p22= dvector(1,ngrp);
p23= dvector(1,ngrp); p33= dvector(1,ngrp);
ind1 = (int *)calloc((ngrp+1),sizeof(int));
ind2 = (int *)calloc((ngrp+1),sizeof(int));
ind3 = (int *)calloc((ngrp+1),sizeof(int));
x = dmatrix(1,3,1,ngrp);
y = dmatrix(1,3,1,ngrp);
z = dmatrix(1,3,1,ngrp);
vx = dmatrix(1,3,1,ngrp);
vy = dmatrix(1,3,1,ngrp);
vz = dmatrix(1,3,1,ngrp);
rm1 = dvector(1,ngrp);
rm2 = dvector(1,ngrp);
rm3 = dvector(1,ngrp);
dx12= dvector(1,ngrp);
dy12= dvector(1,ngrp);
dz12= dvector(1,ngrp);
dx13= dvector(1,ngrp);
dy13= dvector(1,ngrp);
dz13= dvector(1,ngrp);
xlam= dmatrix(1,2,1,ngrp);
}/*endif*/
/*=======================================================================*/
pnorm = 2.0/dt;
n=3;
gethinv(roll_mtvv,roll_mtvvi,&det_roll_mtvv,n);
matmul_tt(roll_mtvvi,vgmat_g,rolli_by_vg,n);
pvten_tmp[1] = 0.0;
pvten_tmp[2] = 0.0;
pvten_tmp[3] = 0.0;
pvten_tmp[4] = 0.0;
pvten_tmp[5] = 0.0;
pvten_tmp[6] = 0.0;
pvten_tmp[7] = 0.0;
pvten_tmp[8] = 0.0;
pvten_tmp[9] = 0.0;
for(igrp=1;igrp <= ngrp; igrp++) {
ind1[igrp] = grp_bond_con_j1_23[igrp];
ind2[igrp] = grp_bond_con_j2_23[igrp];
ind3[igrp] = grp_bond_con_j3_23[igrp];
}/*end for*/
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];
rm1[igrp] = 1.0/clatoms_mass[ktemp];
}/*end for*/
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];
rm2[igrp] = 1.0/clatoms_mass[ktemp];
}/*end for*/
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];
rm3[igrp] = 1.0/clatoms_mass[ktemp];
}/*end for*/
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]*rolli_by_vg[1] +y[1][igrp]*rolli_by_vg[2]
+ z[1][igrp]*rolli_by_vg[3]) *roll_sci;
vy[1][igrp] = clatoms_vy[ktemp]
+ (x[1][igrp]*rolli_by_vg[4] +y[1][igrp]*rolli_by_vg[5]
+ z[1][igrp]*rolli_by_vg[6]) *roll_sci;
vz[1][igrp] = clatoms_vz[ktemp]
+ (x[1][igrp]*rolli_by_vg[7] +y[1][igrp]*rolli_by_vg[8]
+ z[1][igrp]*rolli_by_vg[9]) *roll_sci;
}/*end for*/
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]*rolli_by_vg[1] +y[2][igrp]*rolli_by_vg[2]
+ z[2][igrp]*rolli_by_vg[3]) *roll_sci;
vy[2][igrp] = clatoms_vy[ktemp]
+ (x[2][igrp]*rolli_by_vg[4] +y[2][igrp]*rolli_by_vg[5]
+ z[2][igrp]*rolli_by_vg[6]) *roll_sci;
vz[2][igrp] = clatoms_vz[ktemp]
+ (x[2][igrp]*rolli_by_vg[7] +y[2][igrp]*rolli_by_vg[8]
+ z[2][igrp]*rolli_by_vg[9]) *roll_sci;
}/*end for*/
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]*rolli_by_vg[1] +y[3][igrp]*rolli_by_vg[2]
+ z[3][igrp]*rolli_by_vg[3]) *roll_sci;
vy[3][igrp] = clatoms_vy[ktemp]
+ (x[3][igrp]*rolli_by_vg[4] +y[3][igrp]*rolli_by_vg[5]
+ z[3][igrp]*rolli_by_vg[6]) *roll_sci;
vz[3][igrp] = clatoms_vz[ktemp]
+ (x[3][igrp]*rolli_by_vg[7] +y[3][igrp]*rolli_by_vg[8]
+ z[3][igrp]*rolli_by_vg[9]) *roll_sci;
}/*end for*/
/* Define useful constants */
for(igrp=1;igrp <= ngrp; igrp++) {
rmu1= rm1[igrp] + rm2[igrp];
rmu2= rm1[igrp] + rm3[igrp];
dx12[igrp] = (x[1][igrp]-x[2][igrp]);
dy12[igrp] = (y[1][igrp]-y[2][igrp]);
dz12[igrp] = (z[1][igrp]-z[2][igrp]);
r12s = dx12[igrp]*dx12[igrp] + dy12[igrp]*dy12[igrp] + dz12[igrp]*dz12[igrp];
dx13[igrp] = (x[1][igrp]-x[3][igrp]);
dy13[igrp] = (y[1][igrp]-y[3][igrp]);
dz13[igrp] = (z[1][igrp]-z[3][igrp]);
r13s = dx13[igrp]*dx13[igrp] + dy13[igrp]*dy13[igrp] + dz13[igrp]*dz13[igrp];
dvx12 = (vx[1][igrp]-vx[2][igrp]);
dvy12 = (vy[1][igrp]-vy[2][igrp]);
dvz12 = (vz[1][igrp]-vz[2][igrp]);
dvx13 = (vx[1][igrp]-vx[3][igrp]);
dvy13 = (vy[1][igrp]-vy[3][igrp]);
dvz13 = (vz[1][igrp]-vz[3][igrp]);
/* Get elements of vector */
dot2t2 = dx12[igrp]*dvx12 + dy12[igrp]*dvy12 + dz12[igrp]*dvz12;
dot3t3 = dx13[igrp]*dvx13 + dy13[igrp]*dvy13 + dz13[igrp]*dvz13;
dot23 = dx12[igrp]*dx13[igrp] + dy12[igrp]*dy13[igrp] + dz12[igrp]*dz13[igrp];
avec[1] = dot2t2;
avec[2] = dot3t3;
/* Get elements of matrix */
amat[1][1] = rmu1*r12s;
amat[1][2] = rm1[igrp]*dot23;
amat[2][1] = amat[1][2];
amat[2][2] = rmu2*r12s;
rdet_a = 1.0/(amat[1][1]*amat[2][2] - amat[1][2]*amat[2][1]);
ainv[1][1] = amat[2][2]*rdet_a;
ainv[1][2] = -amat[1][2]*rdet_a;
ainv[2][1] = -amat[2][1]*rdet_a;
ainv[2][2] = amat[1][1]*rdet_a;
xlam[1][igrp] = ainv[1][1]*avec[1] + ainv[1][2]*avec[2];
xlam[2][igrp] = ainv[2][1]*avec[1] + ainv[2][2]*avec[2];
}/*end for*/
#ifndef NO_PRAGMA
#pragma IVDEP
#endif
for(igrp=1;igrp <= ngrp; igrp++) {
double xlam1,xlam2;
double dx_12,dx_13;
double dy_12,dy_13;
double dz_12,dz_13;
int ktemp1,ktemp2,ktemp3;
xlam1= xlam[1][igrp];
xlam2= xlam[2][igrp];
dx_12= dx12[igrp]; dx_13= dx13[igrp];
dy_12= dy12[igrp]; dy_13= dy13[igrp];
dz_12= dz12[igrp]; dz_13= dz13[igrp];
ktemp1=ind1[igrp]; ktemp2=ind2[igrp]; ktemp3=ind3[igrp];
clatoms_vx[ktemp1] -= (xlam1*dx_12 + xlam2*dx_13)*rm1[igrp];
clatoms_vy[ktemp1] -= (xlam1*dy_12 + xlam2*dy_13)*rm1[igrp];
clatoms_vz[ktemp1] -= (xlam1*dz_12 + xlam2*dz_13)*rm1[igrp];
clatoms_vx[ktemp2] += xlam1*dx_12*rm2[igrp];
clatoms_vy[ktemp2] += xlam1*dy_12*rm2[igrp];
clatoms_vz[ktemp2] += xlam1*dz_12*rm2[igrp];
clatoms_vx[ktemp3] += xlam2*dx_13*rm3[igrp];
clatoms_vy[ktemp3] += xlam2*dy_13*rm3[igrp];
clatoms_vz[ktemp3] += xlam2*dz_13*rm3[igrp];
/* Pressure Tensor update */
p11[igrp] = xlam1*dx_12*dx_12 + xlam2*dx_13*dx_13;
p22[igrp] = xlam1*dy_12*dy_12 + xlam2*dy_13*dy_13;
p33[igrp] = xlam1*dz_12*dz_12 + xlam2*dz_13*dz_13;
p12[igrp] = xlam1*dx_12*dy_12 + xlam2*dx_13*dy_13;
p13[igrp] = xlam1*dx_12*dz_12 + xlam2*dx_13*dz_13;
p23[igrp] = xlam1*dy_12*dz_12 + xlam2*dy_13*dz_13;
}/*end for*/
#ifndef NO_PRAGMA
#pragma IVDEP
#endif
for(igrp=1;igrp <= ngrp; igrp++) {
pvten_tmp[1] -= (p11[igrp]*pnorm);
pvten_tmp[2] -= (p12[igrp]*pnorm);
pvten_tmp[3] -= (p13[igrp]*pnorm);
pvten_tmp[4] -= (p12[igrp]*pnorm);
pvten_tmp[5] -= (p22[igrp]*pnorm);
pvten_tmp[6] -= (p23[igrp]*pnorm);
pvten_tmp[7] -= (p13[igrp]*pnorm);
pvten_tmp[8] -= (p23[igrp]*pnorm);
pvten_tmp[9] -= (p33[igrp]*pnorm);
}/*end for*/
/* Save multiplier */
for(igrp=1;igrp <= ngrp; igrp++) {
grp_bond_con_al_23[1][igrp] = xlam[1][igrp];
grp_bond_con_al_23[2][igrp] = xlam[2][igrp];
}/* end for igrp */
/*=======================================================================*/
/* IV)Allreduce pvten_tmp */
if(np_forc > 1 ){
for(i=1;i<=9;i++){
pvten_tmp2[i] = pvten_tmp[i];
}/*endfor*/
Allreduce(&(pvten_tmp2[1]), &(pvten_tmp[1]),9,MPI_DOUBLE,
MPI_SUM,0,comm_forc);
}/*endif*/
pvten_inc[1] += pvten_tmp[1];
pvten_inc[2] += pvten_tmp[2];
pvten_inc[3] += pvten_tmp[3];
pvten_inc[4] += pvten_tmp[4];
pvten_inc[5] += pvten_tmp[5];
pvten_inc[6] += pvten_tmp[6];
pvten_inc[7] += pvten_tmp[7];
pvten_inc[8] += pvten_tmp[8];
pvten_inc[9] += pvten_tmp[9];
if(ifirst == 0){
constr_cell_mat(iperd,hmat_cons_typ,hmat_int_typ,pvten_tmp);
for(i=1;i<=9;i++){
fgmat_p[i] += pvten_tmp[i];
vgmat_g[i] += (pvten_tmp[i]*roll_scg*0.5*dt/mass_hm);
}/*endfor*/
}/*endif*/
/* free locally assigned memory */
if(ngrp > 0){
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(ind1); free(ind2); free(ind3);
free_dmatrix(x,1,3,1,ngrp);
free_dmatrix(y,1,3,1,ngrp);
free_dmatrix(z,1,3,1,ngrp);
free_dmatrix(vx,1,3,1,ngrp);
free_dmatrix(vy,1,3,1,ngrp);
free_dmatrix(vz,1,3,1,ngrp);
free_dvector(rm1,1,ngrp);
free_dvector(rm2,1,ngrp);
free_dvector(rm3,1,ngrp);
free_dvector(dx12,1,ngrp);
free_dvector(dy12,1,ngrp);
free_dvector(dz12,1,ngrp);
free_dvector(dx13,1,ngrp);
free_dvector(dy13,1,ngrp);
free_dvector(dz13,1,ngrp);
free_dmatrix(xlam,1,2,1,ngrp);
}/*endif*/
/*=======================================================================*/
} /* end routine */
void shake_23_rollf(GRP_BOND_CON *grp_bond_con,
CLATOMS_INFO *clatoms_info,CLATOMS_POS *clatoms_pos,
PTENS *ptens,double dt,double *aiter,
PAR_RAHMAN *par_rahman,int ifirst,CELL *cell,
CLASS_COMM_FORC_PKG *class_comm_forc_pkg)
/*==========================================================================*/
/* Begin Routine */
{/*Begin Routine*/
/*=======================================================================*/
/* Local Variable declarations */
#include "../typ_defs/typ_mask.h"
double xl0[NCON_23+1];
double amat[NCON_23+1][NCON_23+1],ainv[NCON_23+1][NCON_23+1];
double r12s,r13s;
double dxn12,dyn12,dzn12,dxn13,dyn13,dzn13;
double dlmax,dlmax1,dlmax2,rdet_a;
double dts;
double dlam1,dlam2;
double ftemp;
double pnorm;
int i,iii;
int iter,igrp,*ind1,*ind2,*ind3,jtyp;
int ktemp,ktemp1,ktemp2,ktemp3;
/* TOP */
double *xlam1,*xlam2;
double *avec1,*avec2;
double *rm1,*rm2,*rm3;
double *rmm11,*rmm12,*rmm21,*rmm22;
double *dxl1,*dxl2;
double *dx12,*dy12,*dz12,*dx13,*dy13,*dz13;
double *dxo12,*dyo12,*dzo12,*dxo13,*dyo13,*dzo13;
double *dxo120,*dyo120,*dzo120,*dxo130,*dyo130,*dzo130;
double **x,**y,**z,**xo,**yo,**zo;
double *dij1,*dij2;
double *p11,*p12,*p13,*p23,*p33,*p22;
/* Local pointers */
double *clatoms_mass = clatoms_info->mass;
double *clatoms_xold = clatoms_info->xold;
double *clatoms_yold = clatoms_info->yold;
double *clatoms_zold = clatoms_info->zold;
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 tol = grp_bond_con->tol;
int max_iter = grp_bond_con->max_iter;
int ngrp = grp_bond_con->num_23;
int *grp_bond_con_j1_23 = grp_bond_con->j1_23;
int *grp_bond_con_j2_23 = grp_bond_con->j2_23;
int *grp_bond_con_j3_23 = grp_bond_con->j3_23;
int *grp_bond_con_jtyp_23 = grp_bond_con->jtyp_23;
double **grp_bond_con_eq_23 = grp_bond_con->eq_23;
double **grp_bond_con_al_23 = grp_bond_con->al_23;
double *pvten_inc = ptens->pvten_inc;
double *pvten_tmp = ptens->pvten_tmp;
double *pvten_tmp2 = ptens->pvten_tmp_res;
int iperd = cell->iperd;
int hmat_cons_typ = cell->hmat_cons_typ;
int hmat_int_typ = cell->hmat_int_typ;
double *roll_mtv = par_rahman->roll_mtv;
double *fgmat_p = par_rahman->fgmat_p;
double *vgmat = par_rahman->vgmat;
double roll_scg = par_rahman->roll_scg;
double mass_hm = par_rahman->mass_hm;
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;
/*=======================================================================*/
if(ngrp > 0){
rm1= dvector(1,ngrp);
rm2= dvector(1,ngrp);
rm3= dvector(1,ngrp);
xlam1= dvector(1,ngrp); xlam2= dvector(1,ngrp);
dxl1= dvector(1,ngrp); dxl2= dvector(1,ngrp);
avec1= dvector(1,ngrp); avec2= dvector(1,ngrp);
dxo12= dvector(1,ngrp); dyo12= dvector(1,ngrp); dzo12= dvector(1,ngrp);
dxo13= dvector(1,ngrp); dyo13= dvector(1,ngrp); dzo13= dvector(1,ngrp);
dx12= dvector(1,ngrp); dy12= dvector(1,ngrp); dz12= dvector(1,ngrp);
dx13= dvector(1,ngrp); dy13= dvector(1,ngrp); dz13= dvector(1,ngrp);
x= dmatrix(1,3,1,ngrp);
y= dmatrix(1,3,1,ngrp);
z= dmatrix(1,3,1,ngrp);
xo= dmatrix(1,3,1,ngrp);
yo= dmatrix(1,3,1,ngrp);
zo= dmatrix(1,3,1,ngrp);
dij1= dvector(1,ngrp);
dij2= dvector(1,ngrp);
ind1= (int *)calloc((ngrp+1),sizeof(int));
ind2= (int *)calloc((ngrp+1),sizeof(int));
ind3= (int *)calloc((ngrp+1),sizeof(int));
rmm11= dvector(1,ngrp);
rmm12= dvector(1,ngrp);
rmm21= dvector(1,ngrp);
rmm22= dvector(1,ngrp);
dxo120= dvector(1,ngrp); dyo120= dvector(1,ngrp); dzo120= dvector(1,ngrp);
dxo130= dvector(1,ngrp); dyo130= dvector(1,ngrp); dzo130= dvector(1,ngrp);
p11= dvector(1,ngrp);
p12= dvector(1,ngrp);
p13= dvector(1,ngrp);
p22= dvector(1,ngrp);
p33= dvector(1,ngrp);
p23= dvector(1,ngrp);
}/*endif*/
/*=======================================================================*/
dts = dt*dt;
pnorm = 2.0/dts;
*aiter = 0.0;
for(i=1; i <= 9; i++){pvten_tmp[i] = 0.0;}
if(ifirst == 2){
for(igrp=1;igrp <= ngrp; igrp++) {
grp_bond_con_al_23[1][igrp] = 0.0;
grp_bond_con_al_23[2][igrp] = 0.0;
}
}
for(igrp=1;igrp <= ngrp; igrp++) {
ind1[igrp] = grp_bond_con_j1_23[igrp];
ind2[igrp] = grp_bond_con_j2_23[igrp];
ind3[igrp] = grp_bond_con_j3_23[igrp];
}/*end for*/
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];
rm1[igrp] = 1.0/clatoms_mass[ktemp];
}/*end for*/
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];
rm2[igrp] = 1.0/clatoms_mass[ktemp];
}/*end for*/
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];
rm3[igrp] = 1.0/clatoms_mass[ktemp];
}/*end for*/
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];
}/*end for*/
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];
}/*end for*/
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];
}/*end for*/
for(igrp=1;igrp <= ngrp; igrp++) {
jtyp = grp_bond_con_jtyp_23[igrp];
dij1[igrp] = grp_bond_con_eq_23[1][jtyp];
dij2[igrp] = grp_bond_con_eq_23[2][jtyp];
}/*end for*/
/* Initial Guess for multipliers */
for(igrp=1;igrp <= ngrp; igrp++) {
rmm11[igrp] = -(rm1[igrp]+rm2[igrp]);
rmm12[igrp] = -rm1[igrp];
rmm21[igrp] = -rm1[igrp];
rmm22[igrp] = -(rm1[igrp]+rm3[igrp]);
}
for(igrp=1;igrp <= ngrp; igrp++) {
dx12[igrp] = x[1][igrp]-x[2][igrp];
dy12[igrp] = y[1][igrp]-y[2][igrp];
dz12[igrp] = z[1][igrp]-z[2][igrp];
}
for(igrp=1;igrp <= ngrp; igrp++) {
dx13[igrp] = x[1][igrp]-x[3][igrp];
dy13[igrp] = y[1][igrp]-y[3][igrp];
dz13[igrp] = z[1][igrp]-z[3][igrp];
}
for(igrp=1;igrp <= ngrp; igrp++) {
dxo120[igrp] = xo[1][igrp]-xo[2][igrp];
dyo120[igrp] = yo[1][igrp]-yo[2][igrp];
dzo120[igrp] = zo[1][igrp]-zo[2][igrp];
}
for(igrp=1;igrp <= ngrp; igrp++) {
dxo130[igrp] = xo[1][igrp]-xo[3][igrp];
dyo130[igrp] = yo[1][igrp]-yo[3][igrp];
dzo130[igrp] = zo[1][igrp]-zo[3][igrp];
}
/* dxo120[igrp] = (xo[1]-xo[2]);
dyo120[igrp] = (yo[1]-yo[2]);
dzo120[igrp] = (zo[1]-zo[2]);
dxo130[igrp] = (xo[1]-xo[3]);
dyo130[igrp] = (yo[1]-yo[3]);
dzo130[igrp] = (zo[1]-zo[3]); */
for(igrp=1;igrp <= ngrp; igrp++) {
dxo12[igrp] = (dxo120[igrp])*roll_mtv[1]
+ (dyo120[igrp])*roll_mtv[2]
+ (dzo120[igrp])*roll_mtv[3];
dyo12[igrp] = (dxo120[igrp])*roll_mtv[4]
+ (dyo120[igrp])*roll_mtv[5]
+ (dzo120[igrp])*roll_mtv[6];
dzo12[igrp] = (dxo120[igrp])*roll_mtv[7]
+ (dyo120[igrp])*roll_mtv[8]
+ (dzo120[igrp])*roll_mtv[9];
}/*end for*/
for(igrp=1;igrp <= ngrp; igrp++) {
dxo13[igrp] = (dxo130[igrp])*roll_mtv[1]
+ (dyo130[igrp])*roll_mtv[2]
+ (dzo130[igrp])*roll_mtv[3];
dyo13[igrp] = (dxo130[igrp])*roll_mtv[4]
+ (dyo130[igrp])*roll_mtv[5]
+ (dzo130[igrp])*roll_mtv[6];
dzo13[igrp] = (dxo130[igrp])*roll_mtv[7]
+ (dyo130[igrp])*roll_mtv[8]
+ (dzo130[igrp])*roll_mtv[9];
}/*end for*/
for(igrp=1;igrp <= ngrp; igrp++) {
r12s = dx12[igrp]*dx12[igrp] + dy12[igrp]*dy12[igrp]
+ dz12[igrp]*dz12[igrp];
r13s = dx13[igrp]*dx13[igrp] + dy13[igrp]*dy13[igrp]
+ dz13[igrp]*dz13[igrp];
avec1[igrp] = dij1[igrp]*dij1[igrp] - r12s;
avec2[igrp] = dij2[igrp]*dij2[igrp] - r13s;
}/*end for*/
/* Initial Guess for multipliers */
if(ifirst==2||ifirst==0){
for(igrp=1;igrp <= ngrp; igrp++) {
amat[1][1] = 2.0*rmm11[igrp]*(dx12[igrp]*dxo12[igrp]
+ dy12[igrp]*dyo12[igrp]
+ dz12[igrp]*dzo12[igrp]);
amat[1][2] = 2.0*rmm12[igrp]*(dx12[igrp]*dxo13[igrp]
+ dy12[igrp]*dyo13[igrp]
+ dz12[igrp]*dzo13[igrp]);
amat[2][1] = 2.0*rmm21[igrp]*(dx13[igrp]*dxo12[igrp]
+ dy13[igrp]*dyo12[igrp]
+ dz13[igrp]*dzo12[igrp]);
amat[2][2] = 2.0*rmm22[igrp]*(dx13[igrp]*dxo13[igrp]
+ dy13[igrp]*dyo13[igrp]
+ dz13[igrp]*dzo13[igrp]);
rdet_a = 1.0/(amat[1][1]*amat[2][2] - amat[1][2]*amat[2][1]);
ainv[1][1] = amat[2][2]*rdet_a;
ainv[1][2] = -amat[1][2]*rdet_a;
ainv[2][1] = -amat[2][1]*rdet_a;
ainv[2][2] = amat[1][1]*rdet_a;
xlam1[igrp] = ainv[1][1]*avec1[igrp] + ainv[1][2]*avec2[igrp];
xlam2[igrp] = ainv[2][1]*avec1[igrp] + ainv[2][2]*avec2[igrp];
} /*end for*/
}else{
for(igrp=1;igrp <= ngrp; igrp++) {
xlam1[igrp] = grp_bond_con_al_23[1][igrp];
xlam2[igrp] = grp_bond_con_al_23[2][igrp];
grp_bond_con_al_23[1][igrp] = 0.0;
grp_bond_con_al_23[2][igrp] = 0.0;
} /*end for*/
}/*endif*/
/* Iterative do loop for multiplier */
if(ngrp > 0){
iter = 0;
do {
++iter;
if(iter > max_iter) {
printf("$$$$$$$$$$$$$$$$$$$$_WARNING_$$$$$$$$$$$$$$$$$$$$\n");
printf("Group Shake 23 not converged after %d iterations.\n",max_iter);
printf("The present tolerance is %g \n",dlmax);
printf("The desired tolerance is %g \n",tol);
printf("$$$$$$$$$$$$$$$$$$$$_WARNING_$$$$$$$$$$$$$$$$$$$$\n");
fflush(stdout);
break;
}/*endif*/
/* Get elements of matrix */
for(igrp=1;igrp <= ngrp; igrp++) {
dxn12 = 2.0*dx12[igrp]
+ rmm11[igrp]*xlam1[igrp]*dxo12[igrp]
+ rmm12[igrp]*xlam2[igrp]*dxo13[igrp];
dyn12 = 2.0*dy12[igrp]
+ rmm11[igrp]*xlam1[igrp]*dyo12[igrp]
+ rmm12[igrp]*xlam2[igrp]*dyo13[igrp];
dzn12 = 2.0*dz12[igrp]
+ rmm11[igrp]*xlam1[igrp]*dzo12[igrp]
+ rmm12[igrp]*xlam2[igrp]*dzo13[igrp];
dxn13 = 2.0*dx13[igrp]
+ rmm21[igrp]*xlam1[igrp]*dxo12[igrp]
+ rmm22[igrp]*xlam2[igrp]*dxo13[igrp];
dyn13 = 2.0*dy13[igrp]
+ rmm21[igrp]*xlam1[igrp]*dyo12[igrp]
+ rmm22[igrp]*xlam2[igrp]*dyo13[igrp];
dzn13 = 2.0*dz13[igrp]
+ rmm21[igrp]*xlam1[igrp]*dzo12[igrp]
+ rmm22[igrp]*xlam2[igrp]*dzo13[igrp];
amat[1][1] = rmm11[igrp]*(dxn12*dxo12[igrp]
+ dyn12*dyo12[igrp]
+ dzn12*dzo12[igrp]);
amat[1][2] = rmm12[igrp]*(dxn12*dxo13[igrp]
+ dyn12*dyo13[igrp]
+ dzn12*dzo13[igrp]);
amat[2][1] = rmm21[igrp]*(dxn13*dxo12[igrp]
+ dyn13*dyo12[igrp]
+ dzn13*dzo12[igrp]);
amat[2][2] = rmm22[igrp]*(dxn13*dxo13[igrp]
+ dyn13*dyo13[igrp]
+ dzn13*dzo13[igrp]);
rdet_a = 1.0/(amat[1][1]*amat[2][2] - amat[1][2]*amat[2][1]);
ainv[1][1] = amat[2][2]*rdet_a;
ainv[1][2] = -amat[1][2]*rdet_a;
ainv[2][1] = -amat[2][1]*rdet_a;
ainv[2][2] = amat[1][1]*rdet_a;
xl0[1] = xlam1[igrp];
xl0[2] = xlam2[igrp];
xlam1[igrp] = ainv[1][1]*avec1[igrp] + ainv[1][2]*avec2[igrp];
xlam2[igrp] = ainv[2][1]*avec1[igrp] + ainv[2][2]*avec2[igrp];
dxl1[igrp] = fabs(xlam1[igrp]-xl0[1]);
dxl2[igrp] = fabs(xlam2[igrp]-xl0[2]);
} /* end loop over groups */
/* test for convergence */
dlmax1= dxl1[1];
dlmax2= dxl2[1];
for(igrp=2;igrp <= ngrp; igrp++) {
dlmax1= (dlmax1> dxl1[igrp] ? dlmax1 : dxl1[igrp]);
dlmax2= (dlmax2> dxl2[igrp] ? dlmax2 : dxl2[igrp]);
}/* end loop over groups */
dlmax = (dlmax1 > dlmax2 ? dlmax1:dlmax2);
} while(dlmax > tol);
*aiter += (double) iter;
}/*endif ngrp > 0*/
/* position update */
#ifndef NO_PRAGMA
#pragma IVDEP
#endif
for(igrp=1;igrp <= ngrp; igrp++) {
ktemp= ind1[igrp];
clatoms_x[ktemp] -= (xlam1[igrp]*dxo12[igrp]
+ xlam2[igrp]*dxo13[igrp])*rm1[igrp];
clatoms_y[ktemp] -= (xlam1[igrp]*dyo12[igrp]
+ xlam2[igrp]*dyo13[igrp])*rm1[igrp];
clatoms_z[ktemp] -= (xlam1[igrp]*dzo12[igrp]
+ xlam2[igrp]*dzo13[igrp])*rm1[igrp];
}/*end for*/
#ifndef NO_PRAGMA
#pragma IVDEP
#endif
for(igrp=1;igrp <= ngrp; igrp++) {
ktemp= ind2[igrp];
clatoms_x[ktemp] += xlam1[igrp]*dxo12[igrp]*rm2[igrp];
clatoms_y[ktemp] += xlam1[igrp]*dyo12[igrp]*rm2[igrp];
clatoms_z[ktemp] += xlam1[igrp]*dzo12[igrp]*rm2[igrp];
}/*end for*/
#ifndef NO_PRAGMA
#pragma IVDEP
#endif
for(igrp=1;igrp <= ngrp; igrp++) {
ktemp= ind3[igrp];
clatoms_x[ktemp] += xlam2[igrp]*dxo13[igrp]*rm3[igrp];
clatoms_y[ktemp] += xlam2[igrp]*dyo13[igrp]*rm3[igrp];
clatoms_z[ktemp] += xlam2[igrp]*dzo13[igrp]*rm3[igrp];
}/*end for*/
/* Velocity update */
#ifndef NO_PRAGMA
#pragma IVDEP
#endif
for(igrp=1;igrp <= ngrp; igrp++) {
ktemp= ind1[igrp];
clatoms_vx[ktemp]-=(xlam1[igrp]*dxo12[igrp]+xlam2[igrp]*dxo13[igrp])*rm1[igrp]/dt;
clatoms_vy[ktemp]-=(xlam1[igrp]*dyo12[igrp]+xlam2[igrp]*dyo13[igrp])*rm1[igrp]/dt;
clatoms_vz[ktemp]-=(xlam1[igrp]*dzo12[igrp]+xlam2[igrp]*dzo13[igrp])*rm1[igrp]/dt;
}/*end for*/
#ifndef NO_PRAGMA
#pragma IVDEP
#endif
for(igrp=1;igrp <= ngrp; igrp++) {
ktemp= ind2[igrp];
clatoms_vx[ktemp] += xlam1[igrp]*dxo120[igrp]*rm2[igrp]/dt;
clatoms_vy[ktemp] += xlam1[igrp]*dyo120[igrp]*rm2[igrp]/dt;
clatoms_vz[ktemp] += xlam1[igrp]*dzo120[igrp]*rm2[igrp]/dt;
}/*end for*/
#ifndef NO_PRAGMA
#pragma IVDEP
#endif
for(igrp=1;igrp <= ngrp; igrp++) {
ktemp= ind3[igrp];
clatoms_vx[ktemp] += xlam2[igrp]*dxo130[igrp]*rm3[igrp]/dt;
clatoms_vy[ktemp] += xlam2[igrp]*dyo130[igrp]*rm3[igrp]/dt;
clatoms_vz[ktemp] += xlam2[igrp]*dzo130[igrp]*rm3[igrp]/dt;
}/*end for*/
/* Pressure tensor update */
/* Compute difference vectors: unscaled old distances !!!*/
for(igrp=1;igrp <= ngrp; igrp++) {
p11[igrp] = xlam1[igrp]*dxo120[igrp]*dxo120[igrp]
+ xlam2[igrp]*dxo130[igrp]*dxo130[igrp];
p22[igrp] = xlam1[igrp]*dyo120[igrp]*dyo120[igrp]
+ xlam2[igrp]*dyo130[igrp]*dyo130[igrp];
p33[igrp] = xlam1[igrp]*dzo120[igrp]*dzo120[igrp]
+ xlam2[igrp]*dzo130[igrp]*dzo130[igrp];
p12[igrp] = xlam1[igrp]*dxo120[igrp]*dyo120[igrp]
+ xlam2[igrp]*dxo130[igrp]*dyo130[igrp];
p13[igrp] = xlam1[igrp]*dxo120[igrp]*dzo120[igrp]
+ xlam2[igrp]*dxo130[igrp]*dzo130[igrp];
p23[igrp] = xlam1[igrp]*dyo120[igrp]*dzo120[igrp]
+ xlam2[igrp]*dyo130[igrp]*dzo130[igrp];
}/*end for*/
#ifndef NO_PRAGMA
#pragma IVDEP
#endif
for(igrp=1;igrp <= ngrp; igrp++) {
pvten_tmp[1] -= (p11[igrp]*pnorm);
pvten_tmp[2] -= (p12[igrp]*pnorm);
pvten_tmp[3] -= (p13[igrp]*pnorm);
pvten_tmp[4] -= (p12[igrp]*pnorm);
pvten_tmp[5] -= (p22[igrp]*pnorm);
pvten_tmp[6] -= (p23[igrp]*pnorm);
pvten_tmp[7] -= (p13[igrp]*pnorm);
pvten_tmp[8] -= (p23[igrp]*pnorm);
pvten_tmp[9] -= (p33[igrp]*pnorm);
}/*end for*/
/* Save multiplier */
for(igrp=1;igrp <= ngrp; igrp++) {
grp_bond_con_al_23[1][igrp] += xlam1[igrp];
} /* end for */
/*=======================================================================*/
/* IV)Allreduce pvten_tmp */
if(np_forc > 1 ){
for(i=1;i<=9;i++){
pvten_tmp2[i] = pvten_tmp[i];
}/*endfor*/
Allreduce(&(pvten_tmp2[1]), &(pvten_tmp[1]),9,MPI_DOUBLE,
MPI_SUM,0,comm_forc);
}/*endif*/
pvten_inc[1] += pvten_tmp[1];
pvten_inc[2] += pvten_tmp[2];
pvten_inc[3] += pvten_tmp[3];
pvten_inc[4] += pvten_tmp[4];
pvten_inc[5] += pvten_tmp[5];
pvten_inc[6] += pvten_tmp[6];
pvten_inc[7] += pvten_tmp[7];
pvten_inc[8] += pvten_tmp[8];
pvten_inc[9] += pvten_tmp[9];
if(ifirst == 0){
constr_cell_mat(iperd,hmat_cons_typ,hmat_int_typ,pvten_tmp);
for(i=1;i<=9;i++){
fgmat_p[i]+=pvten_tmp[i];
vgmat[i] +=pvten_tmp[i]*(roll_scg)
*0.5*dt/(mass_hm);
}/*endfor*/
}/*endif*/
/* free locally assigned memory */
if(ngrp > 0){
free_dvector(rm1,1,ngrp);
free_dvector(rm2,1,ngrp);
free_dvector(rm3,1,ngrp);
free_dvector(xlam1,1,ngrp); free_dvector(xlam2,1,ngrp);
free_dvector(dxl1,1,ngrp); free_dvector(dxl2,1,ngrp);
free_dvector(avec1,1,ngrp); free_dvector(avec2,1,ngrp);
free_dvector(dxo12,1,ngrp);
free_dvector(dyo12,1,ngrp);
free_dvector(dzo12,1,ngrp);
free_dvector(dxo13,1,ngrp);
free_dvector(dyo13,1,ngrp);
free_dvector(dzo13,1,ngrp);
free_dvector(dx12,1,ngrp);
free_dvector(dy12,1,ngrp);
free_dvector(dz12,1,ngrp);
free_dvector(dx13,1,ngrp);
free_dvector(dy13,1,ngrp);
free_dvector(dz13,1,ngrp);
free_dmatrix(x,1,3,1,ngrp);
free_dmatrix(y,1,3,1,ngrp);
free_dmatrix(z,1,3,1,ngrp);
free_dmatrix(xo,1,3,1,ngrp);
free_dmatrix(yo,1,3,1,ngrp);
free_dmatrix(zo,1,3,1,ngrp);
free_dvector(dij1,1,ngrp);
free_dvector(dij2,1,ngrp);
free(ind1);
free(ind2);
free(ind3);
free_dvector(rmm11,1,ngrp);
free_dvector(rmm12,1,ngrp);
free_dvector(rmm21,1,ngrp);
free_dvector(rmm22,1,ngrp);
free_dvector(dxo120,1,ngrp);
free_dvector(dyo120,1,ngrp);
free_dvector(dzo120,1,ngrp);
free_dvector(dxo130,1,ngrp);
free_dvector(dyo130,1,ngrp);
free_dvector(dzo130,1,ngrp);
free_dvector(p11,1,ngrp);
free_dvector(p12,1,ngrp);
free_dvector(p13,1,ngrp);
free_dvector(p22,1,ngrp);
free_dvector(p33,1,ngrp);
free_dvector(p23,1,ngrp);
}/*endif*/
/*=======================================================================*/
}/* end routine */
