Remove unnecessary config.h includes
[alexxy/gromacs.git] / src / gromacs / mdlib / coupling.c
1 /*
2  * This file is part of the GROMACS molecular simulation package.
3  *
4  * Copyright (c) 1991-2000, University of Groningen, The Netherlands.
5  * Copyright (c) 2001-2004, The GROMACS development team.
6  * Copyright (c) 2013,2014, by the GROMACS development team, led by
7  * Mark Abraham, David van der Spoel, Berk Hess, and Erik Lindahl,
8  * and including many others, as listed in the AUTHORS file in the
9  * top-level source directory and at http://www.gromacs.org.
10  *
11  * GROMACS is free software; you can redistribute it and/or
12  * modify it under the terms of the GNU Lesser General Public License
13  * as published by the Free Software Foundation; either version 2.1
14  * of the License, or (at your option) any later version.
15  *
16  * GROMACS is distributed in the hope that it will be useful,
17  * but WITHOUT ANY WARRANTY; without even the implied warranty of
18  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19  * Lesser General Public License for more details.
20  *
21  * You should have received a copy of the GNU Lesser General Public
22  * License along with GROMACS; if not, see
23  * http://www.gnu.org/licenses, or write to the Free Software Foundation,
24  * Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA.
25  *
26  * If you want to redistribute modifications to GROMACS, please
27  * consider that scientific software is very special. Version
28  * control is crucial - bugs must be traceable. We will be happy to
29  * consider code for inclusion in the official distribution, but
30  * derived work must not be called official GROMACS. Details are found
31  * in the README & COPYING files - if they are missing, get the
32  * official version at http://www.gromacs.org.
33  *
34  * To help us fund GROMACS development, we humbly ask that you cite
35  * the research papers on the package. Check out http://www.gromacs.org.
36  */
37 #include "gmxpre.h"
38
39 #include <assert.h>
40
41 #include "gromacs/legacyheaders/typedefs.h"
42 #include "gromacs/legacyheaders/types/commrec.h"
43 #include "gromacs/utility/smalloc.h"
44 #include "gromacs/legacyheaders/update.h"
45 #include "gromacs/math/vec.h"
46 #include "gromacs/legacyheaders/macros.h"
47 #include "gromacs/math/units.h"
48 #include "gromacs/legacyheaders/names.h"
49 #include "gromacs/utility/fatalerror.h"
50 #include "gromacs/legacyheaders/txtdump.h"
51 #include "gromacs/legacyheaders/nrnb.h"
52 #include "gromacs/random/random.h"
53 #include "gromacs/legacyheaders/update.h"
54 #include "gromacs/legacyheaders/mdrun.h"
55
56 #define NTROTTERPARTS 3
57
58 /* Suzuki-Yoshida Constants, for n=3 and n=5, for symplectic integration  */
59 /* for n=1, w0 = 1 */
60 /* for n=3, w0 = w2 = 1/(2-2^-(1/3)), w1 = 1-2*w0 */
61 /* for n=5, w0 = w1 = w3 = w4 = 1/(4-4^-(1/3)), w1 = 1-4*w0 */
62
63 #define MAX_SUZUKI_YOSHIDA_NUM 5
64 #define SUZUKI_YOSHIDA_NUM  5
65
66 static const double  sy_const_1[] = { 1. };
67 static const double  sy_const_3[] = { 0.828981543588751, -0.657963087177502, 0.828981543588751 };
68 static const double  sy_const_5[] = { 0.2967324292201065, 0.2967324292201065, -0.186929716880426, 0.2967324292201065, 0.2967324292201065 };
69
70 static const double* sy_const[] = {
71     NULL,
72     sy_const_1,
73     NULL,
74     sy_const_3,
75     NULL,
76     sy_const_5
77 };
78
79 /*
80    static const double sy_const[MAX_SUZUKI_YOSHIDA_NUM+1][MAX_SUZUKI_YOSHIDA_NUM+1] = {
81     {},
82     {1},
83     {},
84     {0.828981543588751,-0.657963087177502,0.828981543588751},
85     {},
86     {0.2967324292201065,0.2967324292201065,-0.186929716880426,0.2967324292201065,0.2967324292201065}
87    };*/
88
89 /* these integration routines are only referenced inside this file */
90 static void NHC_trotter(t_grpopts *opts, int nvar, gmx_ekindata_t *ekind, real dtfull,
91                         double xi[], double vxi[], double scalefac[], real *veta, t_extmass *MassQ, gmx_bool bEkinAveVel)
92
93 {
94     /* general routine for both barostat and thermostat nose hoover chains */
95
96     int           i, j, mi, mj, jmax;
97     double        Ekin, Efac, reft, kT, nd;
98     double        dt;
99     t_grp_tcstat *tcstat;
100     double       *ivxi, *ixi;
101     double       *iQinv;
102     double       *GQ;
103     gmx_bool      bBarostat;
104     int           mstepsi, mstepsj;
105     int           ns = SUZUKI_YOSHIDA_NUM; /* set the degree of integration in the types/state.h file */
106     int           nh = opts->nhchainlength;
107
108     snew(GQ, nh);
109     mstepsi = mstepsj = ns;
110
111 /* if scalefac is NULL, we are doing the NHC of the barostat */
112
113     bBarostat = FALSE;
114     if (scalefac == NULL)
115     {
116         bBarostat = TRUE;
117     }
118
119     for (i = 0; i < nvar; i++)
120     {
121
122         /* make it easier to iterate by selecting
123            out the sub-array that corresponds to this T group */
124
125         ivxi = &vxi[i*nh];
126         ixi  = &xi[i*nh];
127         if (bBarostat)
128         {
129             iQinv = &(MassQ->QPinv[i*nh]);
130             nd    = 1.0; /* THIS WILL CHANGE IF NOT ISOTROPIC */
131             reft  = max(0.0, opts->ref_t[0]);
132             Ekin  = sqr(*veta)/MassQ->Winv;
133         }
134         else
135         {
136             iQinv  = &(MassQ->Qinv[i*nh]);
137             tcstat = &ekind->tcstat[i];
138             nd     = opts->nrdf[i];
139             reft   = max(0.0, opts->ref_t[i]);
140             if (bEkinAveVel)
141             {
142                 Ekin = 2*trace(tcstat->ekinf)*tcstat->ekinscalef_nhc;
143             }
144             else
145             {
146                 Ekin = 2*trace(tcstat->ekinh)*tcstat->ekinscaleh_nhc;
147             }
148         }
149         kT = BOLTZ*reft;
150
151         for (mi = 0; mi < mstepsi; mi++)
152         {
153             for (mj = 0; mj < mstepsj; mj++)
154             {
155                 /* weighting for this step using Suzuki-Yoshida integration - fixed at 5 */
156                 dt = sy_const[ns][mj] * dtfull / mstepsi;
157
158                 /* compute the thermal forces */
159                 GQ[0] = iQinv[0]*(Ekin - nd*kT);
160
161                 for (j = 0; j < nh-1; j++)
162                 {
163                     if (iQinv[j+1] > 0)
164                     {
165                         /* we actually don't need to update here if we save the
166                            state of the GQ, but it's easier to just recompute*/
167                         GQ[j+1] = iQinv[j+1]*((sqr(ivxi[j])/iQinv[j])-kT);
168                     }
169                     else
170                     {
171                         GQ[j+1] = 0;
172                     }
173                 }
174
175                 ivxi[nh-1] += 0.25*dt*GQ[nh-1];
176                 for (j = nh-1; j > 0; j--)
177                 {
178                     Efac      = exp(-0.125*dt*ivxi[j]);
179                     ivxi[j-1] = Efac*(ivxi[j-1]*Efac + 0.25*dt*GQ[j-1]);
180                 }
181
182                 Efac = exp(-0.5*dt*ivxi[0]);
183                 if (bBarostat)
184                 {
185                     *veta *= Efac;
186                 }
187                 else
188                 {
189                     scalefac[i] *= Efac;
190                 }
191                 Ekin *= (Efac*Efac);
192
193                 /* Issue - if the KE is an average of the last and the current temperatures, then we might not be
194                    able to scale the kinetic energy directly with this factor.  Might take more bookkeeping -- have to
195                    think about this a bit more . . . */
196
197                 GQ[0] = iQinv[0]*(Ekin - nd*kT);
198
199                 /* update thermostat positions */
200                 for (j = 0; j < nh; j++)
201                 {
202                     ixi[j] += 0.5*dt*ivxi[j];
203                 }
204
205                 for (j = 0; j < nh-1; j++)
206                 {
207                     Efac    = exp(-0.125*dt*ivxi[j+1]);
208                     ivxi[j] = Efac*(ivxi[j]*Efac + 0.25*dt*GQ[j]);
209                     if (iQinv[j+1] > 0)
210                     {
211                         GQ[j+1] = iQinv[j+1]*((sqr(ivxi[j])/iQinv[j])-kT);
212                     }
213                     else
214                     {
215                         GQ[j+1] = 0;
216                     }
217                 }
218                 ivxi[nh-1] += 0.25*dt*GQ[nh-1];
219             }
220         }
221     }
222     sfree(GQ);
223 }
224
225 static void boxv_trotter(t_inputrec *ir, real *veta, real dt, tensor box,
226                          gmx_ekindata_t *ekind, tensor vir, real pcorr, t_extmass *MassQ)
227 {
228
229     real   pscal;
230     double alpha;
231     int    i, j, d, n, nwall;
232     real   T, GW, vol;
233     tensor Winvm, ekinmod, localpres;
234
235     /* The heat bath is coupled to a separate barostat, the last temperature group.  In the
236        2006 Tuckerman et al paper., the order is iL_{T_baro} iL {T_part}
237      */
238
239     if (ir->epct == epctSEMIISOTROPIC)
240     {
241         nwall = 2;
242     }
243     else
244     {
245         nwall = 3;
246     }
247
248     /* eta is in pure units.  veta is in units of ps^-1. GW is in
249        units of ps^-2.  However, eta has a reference of 1 nm^3, so care must be
250        taken to use only RATIOS of eta in updating the volume. */
251
252     /* we take the partial pressure tensors, modify the
253        kinetic energy tensor, and recovert to pressure */
254
255     if (ir->opts.nrdf[0] == 0)
256     {
257         gmx_fatal(FARGS, "Barostat is coupled to a T-group with no degrees of freedom\n");
258     }
259     /* alpha factor for phase space volume, then multiply by the ekin scaling factor.  */
260     alpha  = 1.0 + DIM/((double)ir->opts.nrdf[0]);
261     alpha *= ekind->tcstat[0].ekinscalef_nhc;
262     msmul(ekind->ekin, alpha, ekinmod);
263     /* for now, we use Elr = 0, because if you want to get it right, you
264        really should be using PME. Maybe print a warning? */
265
266     pscal   = calc_pres(ir->ePBC, nwall, box, ekinmod, vir, localpres)+pcorr;
267
268     vol = det(box);
269     GW  = (vol*(MassQ->Winv/PRESFAC))*(DIM*pscal - trace(ir->ref_p));  /* W is in ps^2 * bar * nm^3 */
270
271     *veta += 0.5*dt*GW;
272 }
273
274 /*
275  * This file implements temperature and pressure coupling algorithms:
276  * For now only the Weak coupling and the modified weak coupling.
277  *
278  * Furthermore computation of pressure and temperature is done here
279  *
280  */
281
282 real calc_pres(int ePBC, int nwall, matrix box, tensor ekin, tensor vir,
283                tensor pres)
284 {
285     int  n, m;
286     real fac;
287
288     if (ePBC == epbcNONE || (ePBC == epbcXY && nwall != 2))
289     {
290         clear_mat(pres);
291     }
292     else
293     {
294         /* Uitzoeken welke ekin hier van toepassing is, zie Evans & Morris - E.
295          * Wrs. moet de druktensor gecorrigeerd worden voor de netto stroom in
296          * het systeem...
297          */
298
299         fac = PRESFAC*2.0/det(box);
300         for (n = 0; (n < DIM); n++)
301         {
302             for (m = 0; (m < DIM); m++)
303             {
304                 pres[n][m] = (ekin[n][m] - vir[n][m])*fac;
305             }
306         }
307
308         if (debug)
309         {
310             pr_rvecs(debug, 0, "PC: pres", pres, DIM);
311             pr_rvecs(debug, 0, "PC: ekin", ekin, DIM);
312             pr_rvecs(debug, 0, "PC: vir ", vir, DIM);
313             pr_rvecs(debug, 0, "PC: box ", box, DIM);
314         }
315     }
316     return trace(pres)/DIM;
317 }
318
319 real calc_temp(real ekin, real nrdf)
320 {
321     if (nrdf > 0)
322     {
323         return (2.0*ekin)/(nrdf*BOLTZ);
324     }
325     else
326     {
327         return 0;
328     }
329 }
330
331 void parrinellorahman_pcoupl(FILE *fplog, gmx_int64_t step,
332                              t_inputrec *ir, real dt, tensor pres,
333                              tensor box, tensor box_rel, tensor boxv,
334                              tensor M, matrix mu, gmx_bool bFirstStep)
335 {
336     /* This doesn't do any coordinate updating. It just
337      * integrates the box vector equations from the calculated
338      * acceleration due to pressure difference. We also compute
339      * the tensor M which is used in update to couple the particle
340      * coordinates to the box vectors.
341      *
342      * In Nose and Klein (Mol.Phys 50 (1983) no 5., p 1055) this is
343      * given as
344      *            -1    .           .     -1
345      * M_nk = (h')   * (h' * h + h' h) * h
346      *
347      * with the dots denoting time derivatives and h is the transformation from
348      * the scaled frame to the real frame, i.e. the TRANSPOSE of the box.
349      * This also goes for the pressure and M tensors - they are transposed relative
350      * to ours. Our equation thus becomes:
351      *
352      *                  -1       .    .           -1
353      * M_gmx = M_nk' = b  * (b * b' + b * b') * b'
354      *
355      * where b is the gromacs box matrix.
356      * Our box accelerations are given by
357      *   ..                                    ..
358      *   b = vol/W inv(box') * (P-ref_P)     (=h')
359      */
360
361     int    d, n;
362     tensor winv;
363     real   vol = box[XX][XX]*box[YY][YY]*box[ZZ][ZZ];
364     real   atot, arel, change, maxchange, xy_pressure;
365     tensor invbox, pdiff, t1, t2;
366
367     real   maxl;
368
369     m_inv_ur0(box, invbox);
370
371     if (!bFirstStep)
372     {
373         /* Note that PRESFAC does not occur here.
374          * The pressure and compressibility always occur as a product,
375          * therefore the pressure unit drops out.
376          */
377         maxl = max(box[XX][XX], box[YY][YY]);
378         maxl = max(maxl, box[ZZ][ZZ]);
379         for (d = 0; d < DIM; d++)
380         {
381             for (n = 0; n < DIM; n++)
382             {
383                 winv[d][n] =
384                     (4*M_PI*M_PI*ir->compress[d][n])/(3*ir->tau_p*ir->tau_p*maxl);
385             }
386         }
387
388         m_sub(pres, ir->ref_p, pdiff);
389
390         if (ir->epct == epctSURFACETENSION)
391         {
392             /* Unlike Berendsen coupling it might not be trivial to include a z
393              * pressure correction here? On the other hand we don't scale the
394              * box momentarily, but change accelerations, so it might not be crucial.
395              */
396             xy_pressure = 0.5*(pres[XX][XX]+pres[YY][YY]);
397             for (d = 0; d < ZZ; d++)
398             {
399                 pdiff[d][d] = (xy_pressure-(pres[ZZ][ZZ]-ir->ref_p[d][d]/box[d][d]));
400             }
401         }
402
403         tmmul(invbox, pdiff, t1);
404         /* Move the off-diagonal elements of the 'force' to one side to ensure
405          * that we obey the box constraints.
406          */
407         for (d = 0; d < DIM; d++)
408         {
409             for (n = 0; n < d; n++)
410             {
411                 t1[d][n] += t1[n][d];
412                 t1[n][d]  = 0;
413             }
414         }
415
416         switch (ir->epct)
417         {
418             case epctANISOTROPIC:
419                 for (d = 0; d < DIM; d++)
420                 {
421                     for (n = 0; n <= d; n++)
422                     {
423                         t1[d][n] *= winv[d][n]*vol;
424                     }
425                 }
426                 break;
427             case epctISOTROPIC:
428                 /* calculate total volume acceleration */
429                 atot = box[XX][XX]*box[YY][YY]*t1[ZZ][ZZ]+
430                     box[XX][XX]*t1[YY][YY]*box[ZZ][ZZ]+
431                     t1[XX][XX]*box[YY][YY]*box[ZZ][ZZ];
432                 arel = atot/(3*vol);
433                 /* set all RELATIVE box accelerations equal, and maintain total V
434                  * change speed */
435                 for (d = 0; d < DIM; d++)
436                 {
437                     for (n = 0; n <= d; n++)
438                     {
439                         t1[d][n] = winv[0][0]*vol*arel*box[d][n];
440                     }
441                 }
442                 break;
443             case epctSEMIISOTROPIC:
444             case epctSURFACETENSION:
445                 /* Note the correction to pdiff above for surftens. coupling  */
446
447                 /* calculate total XY volume acceleration */
448                 atot = box[XX][XX]*t1[YY][YY]+t1[XX][XX]*box[YY][YY];
449                 arel = atot/(2*box[XX][XX]*box[YY][YY]);
450                 /* set RELATIVE XY box accelerations equal, and maintain total V
451                  * change speed. Dont change the third box vector accelerations */
452                 for (d = 0; d < ZZ; d++)
453                 {
454                     for (n = 0; n <= d; n++)
455                     {
456                         t1[d][n] = winv[d][n]*vol*arel*box[d][n];
457                     }
458                 }
459                 for (n = 0; n < DIM; n++)
460                 {
461                     t1[ZZ][n] *= winv[d][n]*vol;
462                 }
463                 break;
464             default:
465                 gmx_fatal(FARGS, "Parrinello-Rahman pressure coupling type %s "
466                           "not supported yet\n", EPCOUPLTYPETYPE(ir->epct));
467                 break;
468         }
469
470         maxchange = 0;
471         for (d = 0; d < DIM; d++)
472         {
473             for (n = 0; n <= d; n++)
474             {
475                 boxv[d][n] += dt*t1[d][n];
476
477                 /* We do NOT update the box vectors themselves here, since
478                  * we need them for shifting later. It is instead done last
479                  * in the update() routine.
480                  */
481
482                 /* Calculate the change relative to diagonal elements-
483                    since it's perfectly ok for the off-diagonal ones to
484                    be zero it doesn't make sense to check the change relative
485                    to its current size.
486                  */
487
488                 change = fabs(dt*boxv[d][n]/box[d][d]);
489
490                 if (change > maxchange)
491                 {
492                     maxchange = change;
493                 }
494             }
495         }
496
497         if (maxchange > 0.01 && fplog)
498         {
499             char buf[22];
500             fprintf(fplog,
501                     "\nStep %s  Warning: Pressure scaling more than 1%%. "
502                     "This may mean your system\n is not yet equilibrated. "
503                     "Use of Parrinello-Rahman pressure coupling during\n"
504                     "equilibration can lead to simulation instability, "
505                     "and is discouraged.\n",
506                     gmx_step_str(step, buf));
507         }
508     }
509
510     preserve_box_shape(ir, box_rel, boxv);
511
512     mtmul(boxv, box, t1);   /* t1=boxv * b' */
513     mmul(invbox, t1, t2);
514     mtmul(t2, invbox, M);
515
516     /* Determine the scaling matrix mu for the coordinates */
517     for (d = 0; d < DIM; d++)
518     {
519         for (n = 0; n <= d; n++)
520         {
521             t1[d][n] = box[d][n] + dt*boxv[d][n];
522         }
523     }
524     preserve_box_shape(ir, box_rel, t1);
525     /* t1 is the box at t+dt, determine mu as the relative change */
526     mmul_ur0(invbox, t1, mu);
527 }
528
529 void berendsen_pcoupl(FILE *fplog, gmx_int64_t step,
530                       t_inputrec *ir, real dt, tensor pres, matrix box,
531                       matrix mu)
532 {
533     int     d, n;
534     real    scalar_pressure, xy_pressure, p_corr_z;
535     char   *ptr, buf[STRLEN];
536
537     /*
538      *  Calculate the scaling matrix mu
539      */
540     scalar_pressure = 0;
541     xy_pressure     = 0;
542     for (d = 0; d < DIM; d++)
543     {
544         scalar_pressure += pres[d][d]/DIM;
545         if (d != ZZ)
546         {
547             xy_pressure += pres[d][d]/(DIM-1);
548         }
549     }
550     /* Pressure is now in bar, everywhere. */
551 #define factor(d, m) (ir->compress[d][m]*dt/ir->tau_p)
552
553     /* mu has been changed from pow(1+...,1/3) to 1+.../3, since this is
554      * necessary for triclinic scaling
555      */
556     clear_mat(mu);
557     switch (ir->epct)
558     {
559         case epctISOTROPIC:
560             for (d = 0; d < DIM; d++)
561             {
562                 mu[d][d] = 1.0 - factor(d, d)*(ir->ref_p[d][d] - scalar_pressure) /DIM;
563             }
564             break;
565         case epctSEMIISOTROPIC:
566             for (d = 0; d < ZZ; d++)
567             {
568                 mu[d][d] = 1.0 - factor(d, d)*(ir->ref_p[d][d]-xy_pressure)/DIM;
569             }
570             mu[ZZ][ZZ] =
571                 1.0 - factor(ZZ, ZZ)*(ir->ref_p[ZZ][ZZ] - pres[ZZ][ZZ])/DIM;
572             break;
573         case epctANISOTROPIC:
574             for (d = 0; d < DIM; d++)
575             {
576                 for (n = 0; n < DIM; n++)
577                 {
578                     mu[d][n] = (d == n ? 1.0 : 0.0)
579                         -factor(d, n)*(ir->ref_p[d][n] - pres[d][n])/DIM;
580                 }
581             }
582             break;
583         case epctSURFACETENSION:
584             /* ir->ref_p[0/1] is the reference surface-tension times *
585              * the number of surfaces                                */
586             if (ir->compress[ZZ][ZZ])
587             {
588                 p_corr_z = dt/ir->tau_p*(ir->ref_p[ZZ][ZZ] - pres[ZZ][ZZ]);
589             }
590             else
591             {
592                 /* when the compressibity is zero, set the pressure correction   *
593                  * in the z-direction to zero to get the correct surface tension */
594                 p_corr_z = 0;
595             }
596             mu[ZZ][ZZ] = 1.0 - ir->compress[ZZ][ZZ]*p_corr_z;
597             for (d = 0; d < DIM-1; d++)
598             {
599                 mu[d][d] = 1.0 + factor(d, d)*(ir->ref_p[d][d]/(mu[ZZ][ZZ]*box[ZZ][ZZ])
600                                                - (pres[ZZ][ZZ]+p_corr_z - xy_pressure))/(DIM-1);
601             }
602             break;
603         default:
604             gmx_fatal(FARGS, "Berendsen pressure coupling type %s not supported yet\n",
605                       EPCOUPLTYPETYPE(ir->epct));
606             break;
607     }
608     /* To fullfill the orientation restrictions on triclinic boxes
609      * we will set mu_yx, mu_zx and mu_zy to 0 and correct
610      * the other elements of mu to first order.
611      */
612     mu[YY][XX] += mu[XX][YY];
613     mu[ZZ][XX] += mu[XX][ZZ];
614     mu[ZZ][YY] += mu[YY][ZZ];
615     mu[XX][YY]  = 0;
616     mu[XX][ZZ]  = 0;
617     mu[YY][ZZ]  = 0;
618
619     if (debug)
620     {
621         pr_rvecs(debug, 0, "PC: pres ", pres, 3);
622         pr_rvecs(debug, 0, "PC: mu   ", mu, 3);
623     }
624
625     if (mu[XX][XX] < 0.99 || mu[XX][XX] > 1.01 ||
626         mu[YY][YY] < 0.99 || mu[YY][YY] > 1.01 ||
627         mu[ZZ][ZZ] < 0.99 || mu[ZZ][ZZ] > 1.01)
628     {
629         char buf2[22];
630         sprintf(buf, "\nStep %s  Warning: pressure scaling more than 1%%, "
631                 "mu: %g %g %g\n",
632                 gmx_step_str(step, buf2), mu[XX][XX], mu[YY][YY], mu[ZZ][ZZ]);
633         if (fplog)
634         {
635             fprintf(fplog, "%s", buf);
636         }
637         fprintf(stderr, "%s", buf);
638     }
639 }
640
641 void berendsen_pscale(t_inputrec *ir, matrix mu,
642                       matrix box, matrix box_rel,
643                       int start, int nr_atoms,
644                       rvec x[], unsigned short cFREEZE[],
645                       t_nrnb *nrnb)
646 {
647     ivec   *nFreeze = ir->opts.nFreeze;
648     int     n, d, g = 0;
649
650     /* Scale the positions */
651     for (n = start; n < start+nr_atoms; n++)
652     {
653         if (cFREEZE)
654         {
655             g = cFREEZE[n];
656         }
657
658         if (!nFreeze[g][XX])
659         {
660             x[n][XX] = mu[XX][XX]*x[n][XX]+mu[YY][XX]*x[n][YY]+mu[ZZ][XX]*x[n][ZZ];
661         }
662         if (!nFreeze[g][YY])
663         {
664             x[n][YY] = mu[YY][YY]*x[n][YY]+mu[ZZ][YY]*x[n][ZZ];
665         }
666         if (!nFreeze[g][ZZ])
667         {
668             x[n][ZZ] = mu[ZZ][ZZ]*x[n][ZZ];
669         }
670     }
671     /* compute final boxlengths */
672     for (d = 0; d < DIM; d++)
673     {
674         box[d][XX] = mu[XX][XX]*box[d][XX]+mu[YY][XX]*box[d][YY]+mu[ZZ][XX]*box[d][ZZ];
675         box[d][YY] = mu[YY][YY]*box[d][YY]+mu[ZZ][YY]*box[d][ZZ];
676         box[d][ZZ] = mu[ZZ][ZZ]*box[d][ZZ];
677     }
678
679     preserve_box_shape(ir, box_rel, box);
680
681     /* (un)shifting should NOT be done after this,
682      * since the box vectors might have changed
683      */
684     inc_nrnb(nrnb, eNR_PCOUPL, nr_atoms);
685 }
686
687 void berendsen_tcoupl(t_inputrec *ir, gmx_ekindata_t *ekind, real dt)
688 {
689     t_grpopts *opts;
690     int        i;
691     real       T, reft = 0, lll;
692
693     opts = &ir->opts;
694
695     for (i = 0; (i < opts->ngtc); i++)
696     {
697         if (ir->eI == eiVV)
698         {
699             T = ekind->tcstat[i].T;
700         }
701         else
702         {
703             T = ekind->tcstat[i].Th;
704         }
705
706         if ((opts->tau_t[i] > 0) && (T > 0.0))
707         {
708             reft                    = max(0.0, opts->ref_t[i]);
709             lll                     = sqrt(1.0 + (dt/opts->tau_t[i])*(reft/T-1.0));
710             ekind->tcstat[i].lambda = max(min(lll, 1.25), 0.8);
711         }
712         else
713         {
714             ekind->tcstat[i].lambda = 1.0;
715         }
716
717         if (debug)
718         {
719             fprintf(debug, "TC: group %d: T: %g, Lambda: %g\n",
720                     i, T, ekind->tcstat[i].lambda);
721         }
722     }
723 }
724
725 void andersen_tcoupl(t_inputrec *ir, gmx_int64_t step,
726                      const t_commrec *cr, const t_mdatoms *md, t_state *state, real rate, const gmx_bool *randomize, const real *boltzfac)
727 {
728     const int *gatindex = (DOMAINDECOMP(cr) ? cr->dd->gatindex : NULL);
729     int        i;
730     int        gc = 0;
731
732     /* randomize the velocities of the selected particles */
733
734     for (i = 0; i < md->homenr; i++)  /* now loop over the list of atoms */
735     {
736         int      ng = gatindex ? gatindex[i] : i;
737         gmx_bool bRandomize;
738
739         if (md->cTC)
740         {
741             gc = md->cTC[i];  /* assign the atom to a temperature group if there are more than one */
742         }
743         if (randomize[gc])
744         {
745             if (ir->etc == etcANDERSEN)
746             {
747                 bRandomize = TRUE;
748             }
749             else
750             {
751                 double uniform[2];
752
753                 gmx_rng_cycle_2uniform(step*2, ng, ir->andersen_seed, RND_SEED_ANDERSEN, uniform);
754                 bRandomize = (uniform[0] < rate);
755             }
756             if (bRandomize)
757             {
758                 real scal, gauss[3];
759                 int  d;
760
761                 scal = sqrt(boltzfac[gc]*md->invmass[i]);
762                 gmx_rng_cycle_3gaussian_table(step*2+1, ng, ir->andersen_seed, RND_SEED_ANDERSEN, gauss);
763                 for (d = 0; d < DIM; d++)
764                 {
765                     state->v[i][d] = scal*gauss[d];
766                 }
767             }
768         }
769     }
770 }
771
772
773 void nosehoover_tcoupl(t_grpopts *opts, gmx_ekindata_t *ekind, real dt,
774                        double xi[], double vxi[], t_extmass *MassQ)
775 {
776     int   i;
777     real  reft, oldvxi;
778
779     /* note that this routine does not include Nose-hoover chains yet. Should be easy to add. */
780
781     for (i = 0; (i < opts->ngtc); i++)
782     {
783         reft     = max(0.0, opts->ref_t[i]);
784         oldvxi   = vxi[i];
785         vxi[i]  += dt*MassQ->Qinv[i]*(ekind->tcstat[i].Th - reft);
786         xi[i]   += dt*(oldvxi + vxi[i])*0.5;
787     }
788 }
789
790 t_state *init_bufstate(const t_state *template_state)
791 {
792     t_state *state;
793     int      nc = template_state->nhchainlength;
794     snew(state, 1);
795     snew(state->nosehoover_xi, nc*template_state->ngtc);
796     snew(state->nosehoover_vxi, nc*template_state->ngtc);
797     snew(state->therm_integral, template_state->ngtc);
798     snew(state->nhpres_xi, nc*template_state->nnhpres);
799     snew(state->nhpres_vxi, nc*template_state->nnhpres);
800
801     return state;
802 }
803
804 void destroy_bufstate(t_state *state)
805 {
806     sfree(state->x);
807     sfree(state->v);
808     sfree(state->nosehoover_xi);
809     sfree(state->nosehoover_vxi);
810     sfree(state->therm_integral);
811     sfree(state->nhpres_xi);
812     sfree(state->nhpres_vxi);
813     sfree(state);
814 }
815
816 void trotter_update(t_inputrec *ir, gmx_int64_t step, gmx_ekindata_t *ekind,
817                     gmx_enerdata_t *enerd, t_state *state,
818                     tensor vir, t_mdatoms *md,
819                     t_extmass *MassQ, int **trotter_seqlist, int trotter_seqno)
820 {
821
822     int             n, i, j, d, ntgrp, ngtc, gc = 0;
823     t_grp_tcstat   *tcstat;
824     t_grpopts      *opts;
825     gmx_int64_t     step_eff;
826     real            ecorr, pcorr, dvdlcorr;
827     real            bmass, qmass, reft, kT, dt, nd;
828     tensor          dumpres, dumvir;
829     double         *scalefac, dtc;
830     int            *trotter_seq;
831     rvec            sumv = {0, 0, 0}, consk;
832     gmx_bool        bCouple;
833
834     if (trotter_seqno <= ettTSEQ2)
835     {
836         step_eff = step-1;  /* the velocity verlet calls are actually out of order -- the first half step
837                                is actually the last half step from the previous step.  Thus the first half step
838                                actually corresponds to the n-1 step*/
839
840     }
841     else
842     {
843         step_eff = step;
844     }
845
846     bCouple = (ir->nsttcouple == 1 ||
847                do_per_step(step_eff+ir->nsttcouple, ir->nsttcouple));
848
849     trotter_seq = trotter_seqlist[trotter_seqno];
850
851     if ((trotter_seq[0] == etrtSKIPALL) || (!bCouple))
852     {
853         return;
854     }
855     dtc  = ir->nsttcouple*ir->delta_t; /* This is OK for NPT, because nsttcouple == nstpcouple is enforcesd */
856     opts = &(ir->opts);                /* just for ease of referencing */
857     ngtc = opts->ngtc;
858     assert(ngtc > 0);
859     snew(scalefac, opts->ngtc);
860     for (i = 0; i < ngtc; i++)
861     {
862         scalefac[i] = 1;
863     }
864     /* execute the series of trotter updates specified in the trotterpart array */
865
866     for (i = 0; i < NTROTTERPARTS; i++)
867     {
868         /* allow for doubled intgrators by doubling dt instead of making 2 calls */
869         if ((trotter_seq[i] == etrtBAROV2) || (trotter_seq[i] == etrtBARONHC2) || (trotter_seq[i] == etrtNHC2))
870         {
871             dt = 2 * dtc;
872         }
873         else
874         {
875             dt = dtc;
876         }
877
878         switch (trotter_seq[i])
879         {
880             case etrtBAROV:
881             case etrtBAROV2:
882                 boxv_trotter(ir, &(state->veta), dt, state->box, ekind, vir,
883                              enerd->term[F_PDISPCORR], MassQ);
884                 break;
885             case etrtBARONHC:
886             case etrtBARONHC2:
887                 NHC_trotter(opts, state->nnhpres, ekind, dt, state->nhpres_xi,
888                             state->nhpres_vxi, NULL, &(state->veta), MassQ, FALSE);
889                 break;
890             case etrtNHC:
891             case etrtNHC2:
892                 NHC_trotter(opts, opts->ngtc, ekind, dt, state->nosehoover_xi,
893                             state->nosehoover_vxi, scalefac, NULL, MassQ, (ir->eI == eiVV));
894                 /* need to rescale the kinetic energies and velocities here.  Could
895                    scale the velocities later, but we need them scaled in order to
896                    produce the correct outputs, so we'll scale them here. */
897
898                 for (i = 0; i < ngtc; i++)
899                 {
900                     tcstat                  = &ekind->tcstat[i];
901                     tcstat->vscale_nhc      = scalefac[i];
902                     tcstat->ekinscaleh_nhc *= (scalefac[i]*scalefac[i]);
903                     tcstat->ekinscalef_nhc *= (scalefac[i]*scalefac[i]);
904                 }
905                 /* now that we've scaled the groupwise velocities, we can add them up to get the total */
906                 /* but do we actually need the total? */
907
908                 /* modify the velocities as well */
909                 for (n = 0; n < md->homenr; n++)
910                 {
911                     if (md->cTC) /* does this conditional need to be here? is this always true?*/
912                     {
913                         gc = md->cTC[n];
914                     }
915                     for (d = 0; d < DIM; d++)
916                     {
917                         state->v[n][d] *= scalefac[gc];
918                     }
919
920                     if (debug)
921                     {
922                         for (d = 0; d < DIM; d++)
923                         {
924                             sumv[d] += (state->v[n][d])/md->invmass[n];
925                         }
926                     }
927                 }
928                 break;
929             default:
930                 break;
931         }
932     }
933     /* check for conserved momentum -- worth looking at this again eventually, but not working right now.*/
934 #if 0
935     if (debug)
936     {
937         if (bFirstHalf)
938         {
939             for (d = 0; d < DIM; d++)
940             {
941                 consk[d] = sumv[d]*exp((1 + 1.0/opts->nrdf[0])*((1.0/DIM)*log(det(state->box)/state->vol0)) + state->nosehoover_xi[0]);
942             }
943             fprintf(debug, "Conserved kappa: %15.8f %15.8f %15.8f\n", consk[0], consk[1], consk[2]);
944         }
945     }
946 #endif
947     sfree(scalefac);
948 }
949
950
951 extern void init_npt_masses(t_inputrec *ir, t_state *state, t_extmass *MassQ, gmx_bool bInit)
952 {
953     int           n, i, j, d, ntgrp, ngtc, nnhpres, nh, gc = 0;
954     t_grp_tcstat *tcstat;
955     t_grpopts    *opts;
956     real          ecorr, pcorr, dvdlcorr;
957     real          bmass, qmass, reft, kT, dt, ndj, nd;
958     tensor        dumpres, dumvir;
959
960     opts    = &(ir->opts); /* just for ease of referencing */
961     ngtc    = ir->opts.ngtc;
962     nnhpres = state->nnhpres;
963     nh      = state->nhchainlength;
964
965     if (ir->eI == eiMD)
966     {
967         if (bInit)
968         {
969             snew(MassQ->Qinv, ngtc);
970         }
971         for (i = 0; (i < ngtc); i++)
972         {
973             if ((opts->tau_t[i] > 0) && (opts->ref_t[i] > 0))
974             {
975                 MassQ->Qinv[i] = 1.0/(sqr(opts->tau_t[i]/M_2PI)*opts->ref_t[i]);
976             }
977             else
978             {
979                 MassQ->Qinv[i] = 0.0;
980             }
981         }
982     }
983     else if (EI_VV(ir->eI))
984     {
985         /* Set pressure variables */
986
987         if (bInit)
988         {
989             if (state->vol0 == 0)
990             {
991                 state->vol0 = det(state->box);
992                 /* because we start by defining a fixed
993                    compressibility, we need the volume at this
994                    compressibility to solve the problem. */
995             }
996         }
997
998         /* units are nm^3 * ns^2 / (nm^3 * bar / kJ/mol) = kJ/mol  */
999         /* Consider evaluating eventually if this the right mass to use.  All are correct, some might be more stable  */
1000         MassQ->Winv = (PRESFAC*trace(ir->compress)*BOLTZ*opts->ref_t[0])/(DIM*state->vol0*sqr(ir->tau_p/M_2PI));
1001         /* An alternate mass definition, from Tuckerman et al. */
1002         /* MassQ->Winv = 1.0/(sqr(ir->tau_p/M_2PI)*(opts->nrdf[0]+DIM)*BOLTZ*opts->ref_t[0]); */
1003         for (d = 0; d < DIM; d++)
1004         {
1005             for (n = 0; n < DIM; n++)
1006             {
1007                 MassQ->Winvm[d][n] = PRESFAC*ir->compress[d][n]/(state->vol0*sqr(ir->tau_p/M_2PI));
1008                 /* not clear this is correct yet for the anisotropic case. Will need to reevaluate
1009                    before using MTTK for anisotropic states.*/
1010             }
1011         }
1012         /* Allocate space for thermostat variables */
1013         if (bInit)
1014         {
1015             snew(MassQ->Qinv, ngtc*nh);
1016         }
1017
1018         /* now, set temperature variables */
1019         for (i = 0; i < ngtc; i++)
1020         {
1021             if ((opts->tau_t[i] > 0) && (opts->ref_t[i] > 0))
1022             {
1023                 reft = max(0.0, opts->ref_t[i]);
1024                 nd   = opts->nrdf[i];
1025                 kT   = BOLTZ*reft;
1026                 for (j = 0; j < nh; j++)
1027                 {
1028                     if (j == 0)
1029                     {
1030                         ndj = nd;
1031                     }
1032                     else
1033                     {
1034                         ndj = 1;
1035                     }
1036                     MassQ->Qinv[i*nh+j]   = 1.0/(sqr(opts->tau_t[i]/M_2PI)*ndj*kT);
1037                 }
1038             }
1039             else
1040             {
1041                 reft = 0.0;
1042                 for (j = 0; j < nh; j++)
1043                 {
1044                     MassQ->Qinv[i*nh+j] = 0.0;
1045                 }
1046             }
1047         }
1048     }
1049 }
1050
1051 int **init_npt_vars(t_inputrec *ir, t_state *state, t_extmass *MassQ, gmx_bool bTrotter)
1052 {
1053     int           n, i, j, d, ntgrp, ngtc, nnhpres, nh, gc = 0;
1054     t_grp_tcstat *tcstat;
1055     t_grpopts    *opts;
1056     real          ecorr, pcorr, dvdlcorr;
1057     real          bmass, qmass, reft, kT, dt, ndj, nd;
1058     tensor        dumpres, dumvir;
1059     int         **trotter_seq;
1060
1061     opts    = &(ir->opts); /* just for ease of referencing */
1062     ngtc    = state->ngtc;
1063     nnhpres = state->nnhpres;
1064     nh      = state->nhchainlength;
1065
1066     init_npt_masses(ir, state, MassQ, TRUE);
1067
1068     /* first, initialize clear all the trotter calls */
1069     snew(trotter_seq, ettTSEQMAX);
1070     for (i = 0; i < ettTSEQMAX; i++)
1071     {
1072         snew(trotter_seq[i], NTROTTERPARTS);
1073         for (j = 0; j < NTROTTERPARTS; j++)
1074         {
1075             trotter_seq[i][j] = etrtNONE;
1076         }
1077         trotter_seq[i][0] = etrtSKIPALL;
1078     }
1079
1080     if (!bTrotter)
1081     {
1082         /* no trotter calls, so we never use the values in the array.
1083          * We access them (so we need to define them, but ignore
1084          * then.*/
1085
1086         return trotter_seq;
1087     }
1088
1089     /* compute the kinetic energy by using the half step velocities or
1090      * the kinetic energies, depending on the order of the trotter calls */
1091
1092     if (ir->eI == eiVV)
1093     {
1094         if (IR_NPT_TROTTER(ir))
1095         {
1096             /* This is the complicated version - there are 4 possible calls, depending on ordering.
1097                We start with the initial one. */
1098             /* first, a round that estimates veta. */
1099             trotter_seq[0][0] = etrtBAROV;
1100
1101             /* trotter_seq[1] is etrtNHC for 1/2 step velocities - leave zero */
1102
1103             /* The first half trotter update */
1104             trotter_seq[2][0] = etrtBAROV;
1105             trotter_seq[2][1] = etrtNHC;
1106             trotter_seq[2][2] = etrtBARONHC;
1107
1108             /* The second half trotter update */
1109             trotter_seq[3][0] = etrtBARONHC;
1110             trotter_seq[3][1] = etrtNHC;
1111             trotter_seq[3][2] = etrtBAROV;
1112
1113             /* trotter_seq[4] is etrtNHC for second 1/2 step velocities - leave zero */
1114
1115         }
1116         else if (IR_NVT_TROTTER(ir))
1117         {
1118             /* This is the easy version - there are only two calls, both the same.
1119                Otherwise, even easier -- no calls  */
1120             trotter_seq[2][0] = etrtNHC;
1121             trotter_seq[3][0] = etrtNHC;
1122         }
1123         else if (IR_NPH_TROTTER(ir))
1124         {
1125             /* This is the complicated version - there are 4 possible calls, depending on ordering.
1126                We start with the initial one. */
1127             /* first, a round that estimates veta. */
1128             trotter_seq[0][0] = etrtBAROV;
1129
1130             /* trotter_seq[1] is etrtNHC for 1/2 step velocities - leave zero */
1131
1132             /* The first half trotter update */
1133             trotter_seq[2][0] = etrtBAROV;
1134             trotter_seq[2][1] = etrtBARONHC;
1135
1136             /* The second half trotter update */
1137             trotter_seq[3][0] = etrtBARONHC;
1138             trotter_seq[3][1] = etrtBAROV;
1139
1140             /* trotter_seq[4] is etrtNHC for second 1/2 step velocities - leave zero */
1141         }
1142     }
1143     else if (ir->eI == eiVVAK)
1144     {
1145         if (IR_NPT_TROTTER(ir))
1146         {
1147             /* This is the complicated version - there are 4 possible calls, depending on ordering.
1148                We start with the initial one. */
1149             /* first, a round that estimates veta. */
1150             trotter_seq[0][0] = etrtBAROV;
1151
1152             /* The first half trotter update, part 1 -- double update, because it commutes */
1153             trotter_seq[1][0] = etrtNHC;
1154
1155             /* The first half trotter update, part 2 */
1156             trotter_seq[2][0] = etrtBAROV;
1157             trotter_seq[2][1] = etrtBARONHC;
1158
1159             /* The second half trotter update, part 1 */
1160             trotter_seq[3][0] = etrtBARONHC;
1161             trotter_seq[3][1] = etrtBAROV;
1162
1163             /* The second half trotter update */
1164             trotter_seq[4][0] = etrtNHC;
1165         }
1166         else if (IR_NVT_TROTTER(ir))
1167         {
1168             /* This is the easy version - there is only one call, both the same.
1169                Otherwise, even easier -- no calls  */
1170             trotter_seq[1][0] = etrtNHC;
1171             trotter_seq[4][0] = etrtNHC;
1172         }
1173         else if (IR_NPH_TROTTER(ir))
1174         {
1175             /* This is the complicated version - there are 4 possible calls, depending on ordering.
1176                We start with the initial one. */
1177             /* first, a round that estimates veta. */
1178             trotter_seq[0][0] = etrtBAROV;
1179
1180             /* The first half trotter update, part 1 -- leave zero */
1181             trotter_seq[1][0] = etrtNHC;
1182
1183             /* The first half trotter update, part 2 */
1184             trotter_seq[2][0] = etrtBAROV;
1185             trotter_seq[2][1] = etrtBARONHC;
1186
1187             /* The second half trotter update, part 1 */
1188             trotter_seq[3][0] = etrtBARONHC;
1189             trotter_seq[3][1] = etrtBAROV;
1190
1191             /* The second half trotter update -- blank for now */
1192         }
1193     }
1194
1195     switch (ir->epct)
1196     {
1197         case epctISOTROPIC:
1198         default:
1199             bmass = DIM*DIM; /* recommended mass parameters for isotropic barostat */
1200     }
1201
1202     snew(MassQ->QPinv, nnhpres*opts->nhchainlength);
1203
1204     /* barostat temperature */
1205     if ((ir->tau_p > 0) && (opts->ref_t[0] > 0))
1206     {
1207         reft = max(0.0, opts->ref_t[0]);
1208         kT   = BOLTZ*reft;
1209         for (i = 0; i < nnhpres; i++)
1210         {
1211             for (j = 0; j < nh; j++)
1212             {
1213                 if (j == 0)
1214                 {
1215                     qmass = bmass;
1216                 }
1217                 else
1218                 {
1219                     qmass = 1;
1220                 }
1221                 MassQ->QPinv[i*opts->nhchainlength+j]   = 1.0/(sqr(opts->tau_t[0]/M_2PI)*qmass*kT);
1222             }
1223         }
1224     }
1225     else
1226     {
1227         for (i = 0; i < nnhpres; i++)
1228         {
1229             for (j = 0; j < nh; j++)
1230             {
1231                 MassQ->QPinv[i*nh+j] = 0.0;
1232             }
1233         }
1234     }
1235     return trotter_seq;
1236 }
1237
1238 real NPT_energy(t_inputrec *ir, t_state *state, t_extmass *MassQ)
1239 {
1240     int     i, j, nd, ndj, bmass, qmass, ngtcall;
1241     real    ener_npt, reft, eta, kT, tau;
1242     double *ivxi, *ixi;
1243     double *iQinv;
1244     real    vol, dbaro, W, Q;
1245     int     nh = state->nhchainlength;
1246
1247     ener_npt = 0;
1248
1249     /* now we compute the contribution of the pressure to the conserved quantity*/
1250
1251     if (ir->epc == epcMTTK)
1252     {
1253         /* find the volume, and the kinetic energy of the volume */
1254
1255         switch (ir->epct)
1256         {
1257
1258             case epctISOTROPIC:
1259                 /* contribution from the pressure momenenta */
1260                 ener_npt += 0.5*sqr(state->veta)/MassQ->Winv;
1261
1262                 /* contribution from the PV term */
1263                 vol       = det(state->box);
1264                 ener_npt += vol*trace(ir->ref_p)/(DIM*PRESFAC);
1265
1266                 break;
1267             case epctANISOTROPIC:
1268
1269                 break;
1270
1271             case epctSURFACETENSION:
1272
1273                 break;
1274             case epctSEMIISOTROPIC:
1275
1276                 break;
1277             default:
1278                 break;
1279         }
1280     }
1281
1282     if (IR_NPT_TROTTER(ir) || IR_NPH_TROTTER(ir))
1283     {
1284         /* add the energy from the barostat thermostat chain */
1285         for (i = 0; i < state->nnhpres; i++)
1286         {
1287
1288             /* note -- assumes only one degree of freedom that is thermostatted in barostat */
1289             ivxi  = &state->nhpres_vxi[i*nh];
1290             ixi   = &state->nhpres_xi[i*nh];
1291             iQinv = &(MassQ->QPinv[i*nh]);
1292             reft  = max(ir->opts.ref_t[0], 0); /* using 'System' temperature */
1293             kT    = BOLTZ * reft;
1294
1295             for (j = 0; j < nh; j++)
1296             {
1297                 if (iQinv[j] > 0)
1298                 {
1299                     ener_npt += 0.5*sqr(ivxi[j])/iQinv[j];
1300                     /* contribution from the thermal variable of the NH chain */
1301                     ener_npt += ixi[j]*kT;
1302                 }
1303                 if (debug)
1304                 {
1305                     fprintf(debug, "P-T-group: %10d Chain %4d ThermV: %15.8f ThermX: %15.8f", i, j, ivxi[j], ixi[j]);
1306                 }
1307             }
1308         }
1309     }
1310
1311     if (ir->etc)
1312     {
1313         for (i = 0; i < ir->opts.ngtc; i++)
1314         {
1315             ixi   = &state->nosehoover_xi[i*nh];
1316             ivxi  = &state->nosehoover_vxi[i*nh];
1317             iQinv = &(MassQ->Qinv[i*nh]);
1318
1319             nd   = ir->opts.nrdf[i];
1320             reft = max(ir->opts.ref_t[i], 0);
1321             kT   = BOLTZ * reft;
1322
1323             if (nd > 0)
1324             {
1325                 if (IR_NVT_TROTTER(ir))
1326                 {
1327                     /* contribution from the thermal momenta of the NH chain */
1328                     for (j = 0; j < nh; j++)
1329                     {
1330                         if (iQinv[j] > 0)
1331                         {
1332                             ener_npt += 0.5*sqr(ivxi[j])/iQinv[j];
1333                             /* contribution from the thermal variable of the NH chain */
1334                             if (j == 0)
1335                             {
1336                                 ndj = nd;
1337                             }
1338                             else
1339                             {
1340                                 ndj = 1;
1341                             }
1342                             ener_npt += ndj*ixi[j]*kT;
1343                         }
1344                     }
1345                 }
1346                 else  /* Other non Trotter temperature NH control  -- no chains yet. */
1347                 {
1348                     ener_npt += 0.5*BOLTZ*nd*sqr(ivxi[0])/iQinv[0];
1349                     ener_npt += nd*ixi[0]*kT;
1350                 }
1351             }
1352         }
1353     }
1354     return ener_npt;
1355 }
1356
1357 static real vrescale_gamdev(real ia,
1358                             gmx_int64_t step, gmx_int64_t *count,
1359                             gmx_int64_t seed1, gmx_int64_t seed2)
1360 /* Gamma distribution, adapted from numerical recipes */
1361 {
1362     real   am, e, s, v1, v2, x, y;
1363     double rnd[2];
1364
1365     assert(ia > 1);
1366
1367     do
1368     {
1369         do
1370         {
1371             do
1372             {
1373                 gmx_rng_cycle_2uniform(step, (*count)++, seed1, seed2, rnd);
1374                 v1 = rnd[0];
1375                 v2 = 2.0*rnd[1] - 1.0;
1376             }
1377             while (v1*v1 + v2*v2 > 1.0 ||
1378                    v1*v1*GMX_REAL_MAX < 3.0*ia);
1379             /* The last check above ensures that both x (3.0 > 2.0 in s)
1380              * and the pre-factor for e do not go out of range.
1381              */
1382             y  = v2/v1;
1383             am = ia - 1;
1384             s  = sqrt(2.0*am + 1.0);
1385             x  = s*y + am;
1386         }
1387         while (x <= 0.0);
1388
1389         e = (1.0 + y*y)*exp(am*log(x/am) - s*y);
1390
1391         gmx_rng_cycle_2uniform(step, (*count)++, seed1, seed2, rnd);
1392     }
1393     while (rnd[0] > e);
1394
1395     return x;
1396 }
1397
1398 static real gaussian_count(gmx_int64_t step, gmx_int64_t *count,
1399                            gmx_int64_t seed1, gmx_int64_t seed2)
1400 {
1401     double rnd[2], x, y, r;
1402
1403     do
1404     {
1405         gmx_rng_cycle_2uniform(step, (*count)++, seed1, seed2, rnd);
1406         x = 2.0*rnd[0] - 1.0;
1407         y = 2.0*rnd[1] - 1.0;
1408         r = x*x + y*y;
1409     }
1410     while (r > 1.0 || r == 0.0);
1411
1412     r = sqrt(-2.0*log(r)/r);
1413
1414     return x*r;
1415 }
1416
1417 static real vrescale_sumnoises(real nn,
1418                                gmx_int64_t step, gmx_int64_t *count,
1419                                gmx_int64_t seed1, gmx_int64_t seed2)
1420 {
1421 /*
1422  * Returns the sum of nn independent gaussian noises squared
1423  * (i.e. equivalent to summing the square of the return values
1424  * of nn calls to gmx_rng_gaussian_real).
1425  */
1426     const real ndeg_tol = 0.0001;
1427     real       r;
1428
1429     if (nn < 2 + ndeg_tol)
1430     {
1431         int  nn_int, i;
1432         real gauss;
1433
1434         nn_int = (int)(nn + 0.5);
1435
1436         if (nn - nn_int < -ndeg_tol || nn - nn_int > ndeg_tol)
1437         {
1438             gmx_fatal(FARGS, "The v-rescale thermostat was called with a group with #DOF=%f, but for #DOF<3 only integer #DOF are supported", nn + 1);
1439         }
1440
1441         r = 0;
1442         for (i = 0; i < nn_int; i++)
1443         {
1444             gauss = gaussian_count(step, count, seed1, seed2);
1445
1446             r += gauss*gauss;
1447         }
1448     }
1449     else
1450     {
1451         /* Use a gamma distribution for any real nn > 2 */
1452         r = 2.0*vrescale_gamdev(0.5*nn, step, count, seed1, seed2);
1453     }
1454
1455     return r;
1456 }
1457
1458 static real vrescale_resamplekin(real kk, real sigma, real ndeg, real taut,
1459                                  gmx_int64_t step, gmx_int64_t seed)
1460 {
1461 /*
1462  * Generates a new value for the kinetic energy,
1463  * according to Bussi et al JCP (2007), Eq. (A7)
1464  * kk:    present value of the kinetic energy of the atoms to be thermalized (in arbitrary units)
1465  * sigma: target average value of the kinetic energy (ndeg k_b T/2)  (in the same units as kk)
1466  * ndeg:  number of degrees of freedom of the atoms to be thermalized
1467  * taut:  relaxation time of the thermostat, in units of 'how often this routine is called'
1468  */
1469     /* rnd_count tracks the step-local state for the cycle random
1470      * number generator.
1471      */
1472     gmx_int64_t rnd_count = 0;
1473     real        factor, rr, ekin_new;
1474
1475     if (taut > 0.1)
1476     {
1477         factor = exp(-1.0/taut);
1478     }
1479     else
1480     {
1481         factor = 0.0;
1482     }
1483
1484     rr = gaussian_count(step, &rnd_count, seed, RND_SEED_VRESCALE);
1485
1486     ekin_new =
1487         kk +
1488         (1.0 - factor)*(sigma*(vrescale_sumnoises(ndeg-1, step, &rnd_count, seed, RND_SEED_VRESCALE) + rr*rr)/ndeg - kk) +
1489         2.0*rr*sqrt(kk*sigma/ndeg*(1.0 - factor)*factor);
1490
1491     return ekin_new;
1492 }
1493
1494 void vrescale_tcoupl(t_inputrec *ir, gmx_int64_t step,
1495                      gmx_ekindata_t *ekind, real dt,
1496                      double therm_integral[])
1497 {
1498     t_grpopts *opts;
1499     int        i;
1500     real       Ek, Ek_ref1, Ek_ref, Ek_new;
1501
1502     opts = &ir->opts;
1503
1504     for (i = 0; (i < opts->ngtc); i++)
1505     {
1506         if (ir->eI == eiVV)
1507         {
1508             Ek = trace(ekind->tcstat[i].ekinf);
1509         }
1510         else
1511         {
1512             Ek = trace(ekind->tcstat[i].ekinh);
1513         }
1514
1515         if (opts->tau_t[i] >= 0 && opts->nrdf[i] > 0 && Ek > 0)
1516         {
1517             Ek_ref1 = 0.5*opts->ref_t[i]*BOLTZ;
1518             Ek_ref  = Ek_ref1*opts->nrdf[i];
1519
1520             Ek_new  = vrescale_resamplekin(Ek, Ek_ref, opts->nrdf[i],
1521                                            opts->tau_t[i]/dt,
1522                                            step, ir->ld_seed);
1523
1524             /* Analytically Ek_new>=0, but we check for rounding errors */
1525             if (Ek_new <= 0)
1526             {
1527                 ekind->tcstat[i].lambda = 0.0;
1528             }
1529             else
1530             {
1531                 ekind->tcstat[i].lambda = sqrt(Ek_new/Ek);
1532             }
1533
1534             therm_integral[i] -= Ek_new - Ek;
1535
1536             if (debug)
1537             {
1538                 fprintf(debug, "TC: group %d: Ekr %g, Ek %g, Ek_new %g, Lambda: %g\n",
1539                         i, Ek_ref, Ek, Ek_new, ekind->tcstat[i].lambda);
1540             }
1541         }
1542         else
1543         {
1544             ekind->tcstat[i].lambda = 1.0;
1545         }
1546     }
1547 }
1548
1549 real vrescale_energy(t_grpopts *opts, double therm_integral[])
1550 {
1551     int  i;
1552     real ener;
1553
1554     ener = 0;
1555     for (i = 0; i < opts->ngtc; i++)
1556     {
1557         ener += therm_integral[i];
1558     }
1559
1560     return ener;
1561 }
1562
1563 void rescale_velocities(gmx_ekindata_t *ekind, t_mdatoms *mdatoms,
1564                         int start, int end, rvec v[])
1565 {
1566     t_grp_acc      *gstat;
1567     t_grp_tcstat   *tcstat;
1568     unsigned short *cACC, *cTC;
1569     int             ga, gt, n, d;
1570     real            lg;
1571     rvec            vrel;
1572
1573     tcstat = ekind->tcstat;
1574     cTC    = mdatoms->cTC;
1575
1576     if (ekind->bNEMD)
1577     {
1578         gstat  = ekind->grpstat;
1579         cACC   = mdatoms->cACC;
1580
1581         ga = 0;
1582         gt = 0;
1583         for (n = start; n < end; n++)
1584         {
1585             if (cACC)
1586             {
1587                 ga   = cACC[n];
1588             }
1589             if (cTC)
1590             {
1591                 gt   = cTC[n];
1592             }
1593             /* Only scale the velocity component relative to the COM velocity */
1594             rvec_sub(v[n], gstat[ga].u, vrel);
1595             lg = tcstat[gt].lambda;
1596             for (d = 0; d < DIM; d++)
1597             {
1598                 v[n][d] = gstat[ga].u[d] + lg*vrel[d];
1599             }
1600         }
1601     }
1602     else
1603     {
1604         gt = 0;
1605         for (n = start; n < end; n++)
1606         {
1607             if (cTC)
1608             {
1609                 gt   = cTC[n];
1610             }
1611             lg = tcstat[gt].lambda;
1612             for (d = 0; d < DIM; d++)
1613             {
1614                 v[n][d] *= lg;
1615             }
1616         }
1617     }
1618 }
1619
1620
1621 /* set target temperatures if we are annealing */
1622 void update_annealing_target_temp(t_grpopts *opts, real t)
1623 {
1624     int  i, j, n, npoints;
1625     real pert, thist = 0, x;
1626
1627     for (i = 0; i < opts->ngtc; i++)
1628     {
1629         npoints = opts->anneal_npoints[i];
1630         switch (opts->annealing[i])
1631         {
1632             case eannNO:
1633                 continue;
1634             case  eannPERIODIC:
1635                 /* calculate time modulo the period */
1636                 pert  = opts->anneal_time[i][npoints-1];
1637                 n     = t / pert;
1638                 thist = t - n*pert; /* modulo time */
1639                 /* Make sure rounding didn't get us outside the interval */
1640                 if (fabs(thist-pert) < GMX_REAL_EPS*100)
1641                 {
1642                     thist = 0;
1643                 }
1644                 break;
1645             case eannSINGLE:
1646                 thist = t;
1647                 break;
1648             default:
1649                 gmx_fatal(FARGS, "Death horror in update_annealing_target_temp (i=%d/%d npoints=%d)", i, opts->ngtc, npoints);
1650         }
1651         /* We are doing annealing for this group if we got here,
1652          * and we have the (relative) time as thist.
1653          * calculate target temp */
1654         j = 0;
1655         while ((j < npoints-1) && (thist > (opts->anneal_time[i][j+1])))
1656         {
1657             j++;
1658         }
1659         if (j < npoints-1)
1660         {
1661             /* Found our position between points j and j+1.
1662              * Interpolate: x is the amount from j+1, (1-x) from point j
1663              * First treat possible jumps in temperature as a special case.
1664              */
1665             if ((opts->anneal_time[i][j+1]-opts->anneal_time[i][j]) < GMX_REAL_EPS*100)
1666             {
1667                 opts->ref_t[i] = opts->anneal_temp[i][j+1];
1668             }
1669             else
1670             {
1671                 x = ((thist-opts->anneal_time[i][j])/
1672                      (opts->anneal_time[i][j+1]-opts->anneal_time[i][j]));
1673                 opts->ref_t[i] = x*opts->anneal_temp[i][j+1]+(1-x)*opts->anneal_temp[i][j];
1674             }
1675         }
1676         else
1677         {
1678             opts->ref_t[i] = opts->anneal_temp[i][npoints-1];
1679         }
1680     }
1681 }