bool constrain(FILE *fplog,bool bLog,bool bEner,
struct gmx_constr *constr,
t_idef *idef,t_inputrec *ir,
t_commrec *cr,
gmx_step_t step,int delta_step,
t_mdatoms *md,
rvec *x,rvec *xprime,rvec *min_proj,matrix box,
real lambda,real *dvdlambda,
rvec *v,tensor *vir,
t_nrnb *nrnb,int econq)
{
bool bOK;
int start,homenr;
int i,j;
int ncons,error;
tensor rmdr;
real invdt,vir_fac,t;
t_ilist *settle;
int nsettle;
t_pbc pbc;
char buf[22];
if (econq == econqForceDispl && !EI_ENERGY_MINIMIZATION(ir->eI))
{
gmx_incons("constrain called for forces displacements while not doing energy minimization, can not do this while the LINCS and SETTLE constraint connection matrices are mass weighted");
}
bOK = TRUE;
start = md->start;
homenr = md->homenr;
if (ir->delta_t == 0)
{
invdt = 0;
}
else
{
invdt = 1/ir->delta_t;
}
if (ir->efep != efepNO && EI_DYNAMICS(ir->eI))
{
/* Set the constraint lengths for the step at which this configuration
* is meant to be. The invmasses should not be changed.
*/
lambda += delta_step*ir->delta_lambda;
}
if (vir != NULL)
{
clear_mat(rmdr);
}
where();
if (constr->lincsd)
{
bOK = constrain_lincs(fplog,bLog,bEner,ir,step,constr->lincsd,md,cr,
x,xprime,min_proj,box,lambda,dvdlambda,
invdt,v,vir!=NULL,rmdr,
econq,nrnb,
constr->maxwarn,&constr->warncount_lincs);
if (!bOK && constr->maxwarn >= 0 && fplog)
{
fprintf(fplog,"Constraint error in algorithm %s at step %s\n",
econstr_names[econtLINCS],gmx_step_str(step,buf));
}
}
if (constr->nblocks > 0)
{
if (econq != econqCoord)
{
gmx_fatal(FARGS,"Internal error, SHAKE called for constraining something else than coordinates");
}
bOK = bshakef(fplog,constr->shaked,
homenr,md->invmass,constr->nblocks,constr->sblock,
idef,ir,box,x,xprime,nrnb,
constr->lagr,lambda,dvdlambda,
invdt,v,vir!=NULL,rmdr,constr->maxwarn>=0);
if (!bOK && constr->maxwarn >= 0 && fplog)
{
fprintf(fplog,"Constraint error in algorithm %s at step %s\n",
econstr_names[econtSHAKE],gmx_step_str(step,buf));
}
}
settle = &idef->il[F_SETTLE];
if (settle->nr > 0)
{
nsettle = settle->nr/2;
switch (econq)
{
case econqCoord:
csettle(constr->settled,
nsettle,settle->iatoms,x[0],xprime[0],
invdt,v[0],vir!=NULL,rmdr,&error);
inc_nrnb(nrnb,eNR_SETTLE,nsettle);
if (v != NULL)
{
inc_nrnb(nrnb,eNR_CONSTR_V,nsettle*3);
}
if (vir != NULL)
{
inc_nrnb(nrnb,eNR_CONSTR_VIR,nsettle*3);
}
bOK = (error < 0);
if (!bOK && constr->maxwarn >= 0)
{
char buf[256];
sprintf(buf,
"\nt = %.3f ps: Water molecule starting at atom %d can not be "
"settled.\nCheck for bad contacts and/or reduce the timestep.\n",
ir->init_t+step*ir->delta_t,
ddglatnr(cr->dd,settle->iatoms[error*2+1]));
if (fplog)
{
fprintf(fplog,"%s",buf);
}
fprintf(stderr,"%s",buf);
constr->warncount_settle++;
if (constr->warncount_settle > constr->maxwarn)
{
too_many_constraint_warnings(-1,constr->warncount_settle);
}
break;
case econqVeloc:
case econqDeriv:
case econqForce:
case econqForceDispl:
settle_proj(fplog,constr->settled,econq,
nsettle,settle->iatoms,x,
xprime,min_proj,vir!=NULL,rmdr);
/* This is an overestimate */
inc_nrnb(nrnb,eNR_SETTLE,nsettle);
break;
case econqDeriv_FlexCon:
/* Nothing to do, since the are no flexible constraints in settles */
break;
default:
gmx_incons("Unknown constraint quantity for settle");
}
}
}
if (vir != NULL)
{
switch (econq)
{
case econqCoord:
vir_fac = 0.5/(ir->delta_t*ir->delta_t);
break;
case econqVeloc:
/* Assume that these are velocities */
vir_fac = 0.5/ir->delta_t;
break;
case econqForce:
case econqForceDispl:
vir_fac = 0.5;
break;
default:
vir_fac = 0;
gmx_incons("Unsupported constraint quantity for virial");
}
for(i=0; i<DIM; i++)
{
for(j=0; j<DIM; j++)
{
(*vir)[i][j] = vir_fac*rmdr[i][j];
}
}
}
if (!bOK && constr->maxwarn >= 0)
{
dump_confs(fplog,step,constr->warn_mtop,start,homenr,cr,x,xprime,box);
}
if (econq == econqCoord)
{
if (ir->ePull == epullCONSTRAINT)
{
if (EI_DYNAMICS(ir->eI))
{
t = ir->init_t + (step + delta_step)*ir->delta_t;
}
else
{
t = ir->init_t;
}
set_pbc(&pbc,ir->ePBC,box);
pull_constraint(ir->pull,md,&pbc,cr,ir->delta_t,t,x,xprime,v,*vir);
}
if (constr->ed && delta_step > 0)
{
/* apply the essential dynamcs constraints here */
do_edsam(ir,step,md,cr,xprime,v,box,constr->ed);
}
}
return bOK;
}
gmx_bool constrain(FILE *fplog, gmx_bool bLog, gmx_bool bEner,
struct gmx_constr *constr,
t_idef *idef, t_inputrec *ir, gmx_ekindata_t *ekind,
t_commrec *cr,
gmx_int64_t step, int delta_step,
t_mdatoms *md,
rvec *x, rvec *xprime, rvec *min_proj,
gmx_bool bMolPBC, matrix box,
real lambda, real *dvdlambda,
rvec *v, tensor *vir,
t_nrnb *nrnb, int econq, gmx_bool bPscal,
real veta, real vetanew)
{
gmx_bool bOK, bDump;
int start, homenr, nrend;
int i, j, d;
int ncons, settle_error;
tensor vir_r_m_dr;
rvec *vstor;
real invdt, vir_fac, t;
t_ilist *settle;
int nsettle;
t_pbc pbc, *pbc_null;
char buf[22];
t_vetavars vetavar;
int nth, th;
if (econq == econqForceDispl && !EI_ENERGY_MINIMIZATION(ir->eI))
{
gmx_incons("constrain called for forces displacements while not doing energy minimization, can not do this while the LINCS and SETTLE constraint connection matrices are mass weighted");
}
bOK = TRUE;
bDump = FALSE;
start = 0;
homenr = md->homenr;
nrend = start+homenr;
/* set constants for pressure control integration */
init_vetavars(&vetavar, econq != econqCoord,
veta, vetanew, ir, ekind, bPscal);
if (ir->delta_t == 0)
{
invdt = 0;
}
else
{
invdt = 1/ir->delta_t;
}
if (ir->efep != efepNO && EI_DYNAMICS(ir->eI))
{
/* Set the constraint lengths for the step at which this configuration
* is meant to be. The invmasses should not be changed.
*/
lambda += delta_step*ir->fepvals->delta_lambda;
}
if (vir != NULL)
{
clear_mat(vir_r_m_dr);
}
where();
settle = &idef->il[F_SETTLE];
nsettle = settle->nr/(1+NRAL(F_SETTLE));
if (nsettle > 0)
{
nth = gmx_omp_nthreads_get(emntSETTLE);
}
else
{
nth = 1;
}
if (nth > 1 && constr->vir_r_m_dr_th == NULL)
{
snew(constr->vir_r_m_dr_th, nth);
snew(constr->settle_error, nth);
}
settle_error = -1;
/* We do not need full pbc when constraints do not cross charge groups,
* i.e. when dd->constraint_comm==NULL.
* Note that PBC for constraints is different from PBC for bondeds.
* For constraints there is both forward and backward communication.
*/
if (ir->ePBC != epbcNONE &&
(cr->dd || bMolPBC) && !(cr->dd && cr->dd->constraint_comm == NULL))
{
/* With pbc=screw the screw has been changed to a shift
* by the constraint coordinate communication routine,
* so that here we can use normal pbc.
*/
pbc_null = set_pbc_dd(&pbc, ir->ePBC, cr->dd, FALSE, box);
}
else
{
pbc_null = NULL;
}
/* Communicate the coordinates required for the non-local constraints
* for LINCS and/or SETTLE.
*/
if (cr->dd)
{
dd_move_x_constraints(cr->dd, box, x, xprime, econq == econqCoord);
}
if (constr->lincsd != NULL)
{
bOK = constrain_lincs(fplog, bLog, bEner, ir, step, constr->lincsd, md, cr,
x, xprime, min_proj,
box, pbc_null, lambda, dvdlambda,
invdt, v, vir != NULL, vir_r_m_dr,
econq, nrnb,
constr->maxwarn, &constr->warncount_lincs);
if (!bOK && constr->maxwarn >= 0)
{
if (fplog != NULL)
{
fprintf(fplog, "Constraint error in algorithm %s at step %s\n",
econstr_names[econtLINCS], gmx_step_str(step, buf));
}
bDump = TRUE;
}
}
if (constr->nblocks > 0)
{
switch (econq)
{
case (econqCoord):
bOK = bshakef(fplog, constr->shaked,
md->invmass, constr->nblocks, constr->sblock,
idef, ir, x, xprime, nrnb,
constr->lagr, lambda, dvdlambda,
invdt, v, vir != NULL, vir_r_m_dr,
constr->maxwarn >= 0, econq, &vetavar);
break;
case (econqVeloc):
bOK = bshakef(fplog, constr->shaked,
md->invmass, constr->nblocks, constr->sblock,
idef, ir, x, min_proj, nrnb,
constr->lagr, lambda, dvdlambda,
invdt, NULL, vir != NULL, vir_r_m_dr,
constr->maxwarn >= 0, econq, &vetavar);
break;
default:
gmx_fatal(FARGS, "Internal error, SHAKE called for constraining something else than coordinates");
break;
}
if (!bOK && constr->maxwarn >= 0)
{
if (fplog != NULL)
{
fprintf(fplog, "Constraint error in algorithm %s at step %s\n",
econstr_names[econtSHAKE], gmx_step_str(step, buf));
}
bDump = TRUE;
}
}
if (nsettle > 0)
{
int calcvir_atom_end;
if (vir == NULL)
{
calcvir_atom_end = 0;
}
else
{
calcvir_atom_end = md->homenr;
}
switch (econq)
{
case econqCoord:
#pragma omp parallel for num_threads(nth) schedule(static)
for (th = 0; th < nth; th++)
{
int start_th, end_th;
if (th > 0)
{
clear_mat(constr->vir_r_m_dr_th[th]);
}
start_th = (nsettle* th )/nth;
end_th = (nsettle*(th+1))/nth;
if (start_th >= 0 && end_th - start_th > 0)
{
csettle(constr->settled,
end_th-start_th,
settle->iatoms+start_th*(1+NRAL(F_SETTLE)),
pbc_null,
x[0], xprime[0],
invdt, v ? v[0] : NULL, calcvir_atom_end,
th == 0 ? vir_r_m_dr : constr->vir_r_m_dr_th[th],
th == 0 ? &settle_error : &constr->settle_error[th],
&vetavar);
}
}
inc_nrnb(nrnb, eNR_SETTLE, nsettle);
if (v != NULL)
{
inc_nrnb(nrnb, eNR_CONSTR_V, nsettle*3);
}
if (vir != NULL)
{
inc_nrnb(nrnb, eNR_CONSTR_VIR, nsettle*3);
}
break;
case econqVeloc:
case econqDeriv:
case econqForce:
case econqForceDispl:
#pragma omp parallel for num_threads(nth) schedule(static)
for (th = 0; th < nth; th++)
{
int start_th, end_th;
if (th > 0)
{
clear_mat(constr->vir_r_m_dr_th[th]);
}
start_th = (nsettle* th )/nth;
end_th = (nsettle*(th+1))/nth;
if (start_th >= 0 && end_th - start_th > 0)
{
settle_proj(constr->settled, econq,
end_th-start_th,
settle->iatoms+start_th*(1+NRAL(F_SETTLE)),
pbc_null,
x,
xprime, min_proj, calcvir_atom_end,
th == 0 ? vir_r_m_dr : constr->vir_r_m_dr_th[th],
&vetavar);
}
}
/* This is an overestimate */
inc_nrnb(nrnb, eNR_SETTLE, nsettle);
break;
case econqDeriv_FlexCon:
/* Nothing to do, since the are no flexible constraints in settles */
break;
default:
gmx_incons("Unknown constraint quantity for settle");
}
}
if (settle->nr > 0)
{
/* Combine virial and error info of the other threads */
for (i = 1; i < nth; i++)
{
m_add(vir_r_m_dr, constr->vir_r_m_dr_th[i], vir_r_m_dr);
settle_error = constr->settle_error[i];
}
if (econq == econqCoord && settle_error >= 0)
{
bOK = FALSE;
if (constr->maxwarn >= 0)
{
char buf[256];
sprintf(buf,
"\nstep " "%"GMX_PRId64 ": Water molecule starting at atom %d can not be "
"settled.\nCheck for bad contacts and/or reduce the timestep if appropriate.\n",
step, ddglatnr(cr->dd, settle->iatoms[settle_error*(1+NRAL(F_SETTLE))+1]));
if (fplog)
{
fprintf(fplog, "%s", buf);
}
fprintf(stderr, "%s", buf);
constr->warncount_settle++;
if (constr->warncount_settle > constr->maxwarn)
{
too_many_constraint_warnings(-1, constr->warncount_settle);
}
bDump = TRUE;
}
}
}
free_vetavars(&vetavar);
if (vir != NULL)
{
switch (econq)
{
case econqCoord:
vir_fac = 0.5/(ir->delta_t*ir->delta_t);
break;
case econqVeloc:
vir_fac = 0.5/ir->delta_t;
break;
case econqForce:
case econqForceDispl:
vir_fac = 0.5;
break;
default:
vir_fac = 0;
gmx_incons("Unsupported constraint quantity for virial");
}
if (EI_VV(ir->eI))
{
vir_fac *= 2; /* only constraining over half the distance here */
}
for (i = 0; i < DIM; i++)
{
for (j = 0; j < DIM; j++)
{
(*vir)[i][j] = vir_fac*vir_r_m_dr[i][j];
}
}
}
if (bDump)
{
dump_confs(fplog, step, constr->warn_mtop, start, homenr, cr, x, xprime, box);
}
if (econq == econqCoord)
{
if (ir->ePull == epullCONSTRAINT)
{
if (EI_DYNAMICS(ir->eI))
{
t = ir->init_t + (step + delta_step)*ir->delta_t;
}
else
{
t = ir->init_t;
}
set_pbc(&pbc, ir->ePBC, box);
pull_constraint(ir->pull, md, &pbc, cr, ir->delta_t, t, x, xprime, v, *vir);
}
if (constr->ed && delta_step > 0)
{
/* apply the essential dynamcs constraints here */
do_edsam(ir, step, cr, xprime, v, box, constr->ed);
}
}
return bOK;
}
static bool low_constrain(FILE *log,t_topology *top,t_inputrec *ir,
int step,t_mdatoms *md,int start,int homenr,
rvec *x,rvec *xprime,rvec *min_proj,matrix box,
real lambda,real *dvdlambda,t_nrnb *nrnb,
bool bCoordinates,bool bInit)
{
static int nblocks=0;
static int *sblock=NULL;
static int nsettle,settle_type;
static int *owptr;
static bool bDumpOnError = TRUE;
char buf[STRLEN];
bool bOK;
t_sortblock *sb;
t_block *blocks=&(top->blocks[ebSBLOCKS]);
t_idef *idef=&(top->idef);
t_iatom *iatom;
atom_id *inv_sblock;
int i,j,m,bnr;
int ncons,bstart,error;
bOK = TRUE;
if (bInit) {
/* Output variables, initiate them right away */
if ((ir->etc==etcBERENDSEN) || (ir->epc==epcBERENDSEN))
please_cite(log,"Berendsen84a");
#ifdef SPEC_CPU
bDumpOnError = TRUE;
#else
bDumpOnError = (getenv("NO_SHAKE_ERROR") == NULL);
#endif
/* Put the oxygen atoms in the owptr array */
nsettle=idef->il[F_SETTLE].nr/2;
if (nsettle > 0) {
snew(owptr,nsettle);
settle_type=idef->il[F_SETTLE].iatoms[0];
for (j=0; (j<idef->il[F_SETTLE].nr); j+=2) {
if (idef->il[F_SETTLE].iatoms[j] != settle_type)
fatal_error(0,"More than one settle type (%d and %d)",
settle_type,idef->il[F_SETTLE].iatoms[j]);
owptr[j/2]=idef->il[F_SETTLE].iatoms[j+1];
#ifdef DEBUG
fprintf(log,"owptr[%d]=%d\n",j/2,owptr[j/2]);
#endif
}
/* We used to free this memory, but ED sampling needs it later on
* sfree(idef->il[F_SETTLE].iatoms);
*/
please_cite(log,"Miyamoto92a");
}
ncons=idef->il[F_SHAKE].nr/3;
if (ncons > 0)
{
bstart=(idef->nodeid > 0) ? blocks->multinr[idef->nodeid-1] : 0;
nblocks=blocks->multinr[idef->nodeid] - bstart;
if (debug)
fprintf(debug,"ncons: %d, bstart: %d, nblocks: %d\n",
ncons,bstart,nblocks);
/* Calculate block number for each atom */
inv_sblock=make_invblock(blocks,md->nr);
/* Store the block number in temp array and
* sort the constraints in order of the sblock number
* and the atom numbers, really sorting a segment of the array!
*/
#ifdef DEBUGIDEF
pr_idef(stdlog,0,"Before Sort",idef);
#endif
iatom=idef->il[F_SHAKE].iatoms;
snew(sb,ncons);
for(i=0; (i<ncons); i++,iatom+=3) {
for(m=0; (m<3); m++)
sb[i].iatom[m]=iatom[m];
sb[i].blocknr=inv_sblock[iatom[1]];
}
/* Now sort the blocks */
if (debug) {
pr_sortblock(debug,"Before sorting",ncons,sb);
fprintf(debug,"Going to sort constraints\n");
}
qsort(sb,ncons,(size_t)sizeof(*sb),pcomp);
if (debug) {
fprintf(debug,"I used %d calls to pcomp\n",pcount);
pr_sortblock(debug,"After sorting",ncons,sb);
}
iatom=idef->il[F_SHAKE].iatoms;
for(i=0; (i<ncons); i++,iatom+=3)
for(m=0; (m<DIM); m++)
iatom[m]=sb[i].iatom[m];
#ifdef DEBUGIDEF
pr_idef(stdlog,0,"After Sort",idef);
#endif
j=0;
snew(sblock,nblocks+1);
bnr=-2;
for(i=0; (i<ncons); i++) {
if (sb[i].blocknr != bnr) {
bnr=sb[i].blocknr;
sblock[j++]=3*i;
}
}
/* Last block... */
sblock[j++]=3*ncons;
if (j != (nblocks+1) && log) {
fprintf(log,"bstart: %d\n",bstart);
fprintf(log,"j: %d, nblocks: %d, ncons: %d\n",
j,nblocks,ncons);
for(i=0; (i<ncons); i++)
fprintf(log,"i: %5d sb[i].blocknr: %5u\n",i,sb[i].blocknr);
for(j=0; (j<=nblocks); j++)
fprintf(log,"sblock[%3d]=%5d\n",j,(int) sblock[j]);
fatal_error(0,"DEATH HORROR: "
"top->blocks[ebSBLOCKS] does not match idef->il[F_SHAKE]");
}
sfree(sb);
sfree(inv_sblock);
}
if (idef->il[F_SHAKE].nr) {
if (ir->eConstrAlg == estLINCS || !bCoordinates) {
please_cite(stdlog,"Hess97a");
bOK = constrain_lincs(stdlog,top,ir,0,md,start,homenr,&nblocks,&sblock,
NULL,NULL,NULL,NULL,0,NULL,bCoordinates,TRUE,nrnb,
bDumpOnError);
}
else
please_cite(stdlog,"Ryckaert77a");
}
}
else {
/* !bInit */
if (nblocks > 0) {
where();
if (ir->eConstrAlg == estSHAKE)
bOK = bshakef(stdlog,homenr,md->invmass,nblocks,sblock,idef,
ir,box,x,xprime,nrnb,lambda,dvdlambda,bDumpOnError);
else if (ir->eConstrAlg == estLINCS)
bOK = constrain_lincs(stdlog,top,ir,step,md,
start,homenr,&nblocks,&sblock,
x,xprime,min_proj,box,lambda,dvdlambda,
bCoordinates,FALSE,nrnb,bDumpOnError);
if (!bOK && bDumpOnError && stdlog)
fprintf(stdlog,"Constraint error in algorithm %s at step %d\n",
eshake_names[ir->eConstrAlg],step);
}
if (nsettle > 0) {
int ow1;
real mO,mH,dOH,dHH;
ow1 = owptr[0];
mO = md->massA[ow1];
mH = md->massA[ow1+1];
dOH = top->idef.iparams[settle_type].settle.doh;
dHH = top->idef.iparams[settle_type].settle.dhh;
#ifdef USE_FORTRAN
#ifdef DOUBLE
F77_FUNC(fsettled,FSETTLED)(&nsettle,owptr,x[0],xprime[0],
&dOH,&dHH,&mO,&mH,&error);
#else
F77_FUNC(fsettle,FSETTLE)(&nsettle,owptr,x[0],xprime[0],
&dOH,&dHH,&mO,&mH,&error);
#endif
#else
csettle(stdlog,nsettle,owptr,x[0],xprime[0],dOH,dHH,mO,mH,&error);
#endif
inc_nrnb(nrnb,eNR_SETTLE,nsettle);
bOK = (error < 0);
if (!bOK && bDumpOnError && stdlog)
fprintf(stdlog,"\nt = %.3f ps: Water molecule starting at atom %d can not be "
"settled.\nCheck for bad contacts and/or reduce the timestep.",
ir->init_t+step*ir->delta_t,owptr[error]+1);
}
if (!bOK && bDumpOnError)
dump_confs(step,&(top->atoms),x,xprime,box);
}
return bOK;
}