--- /dev/null
- Files: include/molfile_plugin.h
- include/vmddlopen.h
- include/vmdplugin.h
- src/gmxlib/vmddlopen.c
- src/gmxlib/vmdio.c
+ GROMACS is free software, distributed under the GNU General Public License.
+ See COPING for details. It however includes optional code covered by several
+ different licences as described below.
+
+
+ 1. Trajectory file reading using VMD plugins
- Files: src/mdlib/fftpack.c
++ Files: src/external/vmd_molfile/*
++ src/gromacs/gmxlib/vmdio.c
+
+ (C) Copyright 1995-2009 The Board of Trustees of the
+ University of Illinois
+ All Rights Reserved
+
+ Developed by: Theoretical and Computational Biophysics Group
+ University of Illinois at Urbana-Champaign
+ http://www.ks.uiuc.edu/
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the Software), to deal with
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to
+ do so, subject to the following conditions:
+
+ Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimers.
+
+ Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimers in the documentation
+ and/or other materials provided with the distribution.
+
+ Neither the names of Theoretical and Computational Biophysics Group,
+ University of Illinois at Urbana-Champaign, nor the names of its contributors
+ may be used to endorse or promote products derived from this Software without
+ specific prior written permission.
+
+ THE SOFTWARE IS PROVIDED AS IS, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
+ THE CONTRIBUTORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
+ OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
+ ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+ OTHER DEALINGS WITH THE SOFTWARE.
+
+ 2. Internal FFT
++ Files: src/external/fftpack/fftpack.c
+
+ Copyright (c) 2005-2011, NumPy Developers.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are
+ met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of the NumPy Developers nor the names of any
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+ fftpack.c : A set of FFT routines in C.
+ Algorithmically based on Fortran-77 FFTPACK by Paul N. Swarztrauber (Version 4, 1985).
++
++3. Subset of Boost C++ library
++ Files: src/external/boost/boost/*
++
++Boost Software License - Version 1.0 - August 17th, 2003
++
++Permission is hereby granted, free of charge, to any person or organization
++obtaining a copy of the software and accompanying documentation covered by
++this license (the "Software") to use, reproduce, display, distribute,
++execute, and transmit the Software, and to prepare derivative works of the
++Software, and to permit third-parties to whom the Software is furnished to
++do so, all subject to the following:
++
++The copyright notices in the Software and this entire statement, including
++the above license grant, this restriction and the following disclaimer,
++must be included in all copies of the Software, in whole or in part, and
++all derivative works of the Software, unless such copies or derivative
++works are solely in the form of machine-executable object code generated by
++a source language processor.
++
++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
++IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
++FITNESS FOR A PARTICULAR PURPOSE, TITLE AND NON-INFRINGEMENT. IN NO EVENT
++SHALL THE COPYRIGHT HOLDERS OR ANYONE DISTRIBUTING THE SOFTWARE BE LIABLE
++FOR ANY DAMAGES OR OTHER LIABILITY, WHETHER IN CONTRACT, TORT OR OTHERWISE,
++ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
++DEALINGS IN THE SOFTWARE.
++
++4. Google Test and Google Mock
++ Files: src/external/gmock-1.6.0/*
++
++Copyright 2008, Google Inc.
++All rights reserved.
++
++Redistribution and use in source and binary forms, with or without
++modification, are permitted provided that the following conditions are
++met:
++
++ * Redistributions of source code must retain the above copyright
++notice, this list of conditions and the following disclaimer.
++ * Redistributions in binary form must reproduce the above
++copyright notice, this list of conditions and the following disclaimer
++in the documentation and/or other materials provided with the
++distribution.
++ * Neither the name of Google Inc. nor the names of its
++contributors may be used to endorse or promote products derived from
++this software without specific prior written permission.
++
++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
++"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
++LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
++A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
++OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
++SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
++LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
++DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
++THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
++(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
++OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--- /dev/null
--- /dev/null
++ * This source code is part of
++ *
++ * G R O M A C S
++ *
++ * GROningen MAchine for Chemical Simulations
++ *
++ * Written by David van der Spoel, Erik Lindahl, Berk Hess, and others.
++ * Copyright (c) 1991-2000, University of Groningen, The Netherlands.
++ * Copyright (c) 2001-2012, The GROMACS development team,
++ * check out http://www.gromacs.org for more information.
++
++ * This program is free software; you can redistribute it and/or
++ * modify it under the terms of the GNU General Public License
++ * as published by the Free Software Foundation; either version 2
++ * of the License, or (at your option) any later version.
++ *
++ * If you want to redistribute modifications, please consider that
++ * scientific software is very special. Version control is crucial -
++ * bugs must be traceable. We will be happy to consider code for
++ * inclusion in the official distribution, but derived work must not
++ * be called official GROMACS. Details are found in the README & COPYING
++ * files - if they are missing, get the official version at www.gromacs.org.
++ *
++ * To help us fund GROMACS development, we humbly ask that you cite
++ * the papers on the package - you can find them in the top README file.
++ *
++ * For more info, check our website at http://www.gromacs.org
++ *
++ * And Hey:
++ * Groningen Machine for Chemical Simulation
++
++************************************************************
++
++fftpack.c is copy of fftpack from Numpy with very minor modifications:
++ - usage of fftpack.h (replacement for Treal define)
++ - [cr]fft[ifb]1 non-static
++ - Added Copyright headers
++ - Added fftpack_ prefix
++
++fftpack.h is GROMACS specific
++
++Original version is from Numpy 1.6
++
++************************************************************
++
++Copyright (c) 2005-2011, NumPy Developers.
++All rights reserved.
++
++Redistribution and use in source and binary forms, with or without
++modification, are permitted provided that the following conditions are
++met:
++
++ * Redistributions of source code must retain the above copyright
++ notice, this list of conditions and the following disclaimer.
++
++ * Redistributions in binary form must reproduce the above
++ copyright notice, this list of conditions and the following
++ disclaimer in the documentation and/or other materials provided
++ with the distribution.
++
++ * Neither the name of the NumPy Developers nor the names of any
++ contributors may be used to endorse or promote products derived
++ from this software without specific prior written permission.
++
++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
++"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
++LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
++A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
++OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
++SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
++LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
++DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
++THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
++(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
++OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--- /dev/null
--- /dev/null
++/*
++fftpack.c : A set of FFT routines in C.
++Algorithmically based on Fortran-77 FFTPACK by Paul N. Swarztrauber (Version 4, 1985).
++
++*/
++
++/* isign is +1 for backward and -1 for forward transforms */
++
++#include <math.h>
++#include <stdio.h>
++
++#include "fftpack.h"
++
++#define ref(u,a) u[a]
++
++#define MAXFAC 13 /* maximum number of factors in factorization of n */
++#define NSPECIAL 4 /* number of factors for which we have special-case routines */
++
++#ifdef __cplusplus
++extern "C" {
++#endif
++
++
++/* ----------------------------------------------------------------------
++ passf2, passf3, passf4, passf5, passf. Complex FFT passes fwd and bwd.
++---------------------------------------------------------------------- */
++
++static void passf2(int ido, int l1, const Treal cc[], Treal ch[], const Treal wa1[], int isign)
++ /* isign==+1 for backward transform */
++ {
++ int i, k, ah, ac;
++ Treal ti2, tr2;
++ if (ido <= 2) {
++ for (k=0; k<l1; k++) {
++ ah = k*ido;
++ ac = 2*k*ido;
++ ch[ah] = ref(cc,ac) + ref(cc,ac + ido);
++ ch[ah + ido*l1] = ref(cc,ac) - ref(cc,ac + ido);
++ ch[ah+1] = ref(cc,ac+1) + ref(cc,ac + ido + 1);
++ ch[ah + ido*l1 + 1] = ref(cc,ac+1) - ref(cc,ac + ido + 1);
++ }
++ } else {
++ for (k=0; k<l1; k++) {
++ for (i=0; i<ido-1; i+=2) {
++ ah = i + k*ido;
++ ac = i + 2*k*ido;
++ ch[ah] = ref(cc,ac) + ref(cc,ac + ido);
++ tr2 = ref(cc,ac) - ref(cc,ac + ido);
++ ch[ah+1] = ref(cc,ac+1) + ref(cc,ac + 1 + ido);
++ ti2 = ref(cc,ac+1) - ref(cc,ac + 1 + ido);
++ ch[ah+l1*ido+1] = wa1[i]*ti2 + isign*wa1[i+1]*tr2;
++ ch[ah+l1*ido] = wa1[i]*tr2 - isign*wa1[i+1]*ti2;
++ }
++ }
++ }
++ } /* passf2 */
++
++
++static void passf3(int ido, int l1, const Treal cc[], Treal ch[],
++ const Treal wa1[], const Treal wa2[], int isign)
++ /* isign==+1 for backward transform */
++ {
++ static const Treal taur = -0.5;
++ static const Treal taui = 0.866025403784439;
++ int i, k, ac, ah;
++ Treal ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
++ if (ido == 2) {
++ for (k=1; k<=l1; k++) {
++ ac = (3*k - 2)*ido;
++ tr2 = ref(cc,ac) + ref(cc,ac + ido);
++ cr2 = ref(cc,ac - ido) + taur*tr2;
++ ah = (k - 1)*ido;
++ ch[ah] = ref(cc,ac - ido) + tr2;
++
++ ti2 = ref(cc,ac + 1) + ref(cc,ac + ido + 1);
++ ci2 = ref(cc,ac - ido + 1) + taur*ti2;
++ ch[ah + 1] = ref(cc,ac - ido + 1) + ti2;
++
++ cr3 = isign*taui*(ref(cc,ac) - ref(cc,ac + ido));
++ ci3 = isign*taui*(ref(cc,ac + 1) - ref(cc,ac + ido + 1));
++ ch[ah + l1*ido] = cr2 - ci3;
++ ch[ah + 2*l1*ido] = cr2 + ci3;
++ ch[ah + l1*ido + 1] = ci2 + cr3;
++ ch[ah + 2*l1*ido + 1] = ci2 - cr3;
++ }
++ } else {
++ for (k=1; k<=l1; k++) {
++ for (i=0; i<ido-1; i+=2) {
++ ac = i + (3*k - 2)*ido;
++ tr2 = ref(cc,ac) + ref(cc,ac + ido);
++ cr2 = ref(cc,ac - ido) + taur*tr2;
++ ah = i + (k-1)*ido;
++ ch[ah] = ref(cc,ac - ido) + tr2;
++ ti2 = ref(cc,ac + 1) + ref(cc,ac + ido + 1);
++ ci2 = ref(cc,ac - ido + 1) + taur*ti2;
++ ch[ah + 1] = ref(cc,ac - ido + 1) + ti2;
++ cr3 = isign*taui*(ref(cc,ac) - ref(cc,ac + ido));
++ ci3 = isign*taui*(ref(cc,ac + 1) - ref(cc,ac + ido + 1));
++ dr2 = cr2 - ci3;
++ dr3 = cr2 + ci3;
++ di2 = ci2 + cr3;
++ di3 = ci2 - cr3;
++ ch[ah + l1*ido + 1] = wa1[i]*di2 + isign*wa1[i+1]*dr2;
++ ch[ah + l1*ido] = wa1[i]*dr2 - isign*wa1[i+1]*di2;
++ ch[ah + 2*l1*ido + 1] = wa2[i]*di3 + isign*wa2[i+1]*dr3;
++ ch[ah + 2*l1*ido] = wa2[i]*dr3 - isign*wa2[i+1]*di3;
++ }
++ }
++ }
++ } /* passf3 */
++
++
++static void passf4(int ido, int l1, const Treal cc[], Treal ch[],
++ const Treal wa1[], const Treal wa2[], const Treal wa3[], int isign)
++ /* isign == -1 for forward transform and +1 for backward transform */
++ {
++ int i, k, ac, ah;
++ Treal ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;
++ if (ido == 2) {
++ for (k=0; k<l1; k++) {
++ ac = 4*k*ido + 1;
++ ti1 = ref(cc,ac) - ref(cc,ac + 2*ido);
++ ti2 = ref(cc,ac) + ref(cc,ac + 2*ido);
++ tr4 = ref(cc,ac + 3*ido) - ref(cc,ac + ido);
++ ti3 = ref(cc,ac + ido) + ref(cc,ac + 3*ido);
++ tr1 = ref(cc,ac - 1) - ref(cc,ac + 2*ido - 1);
++ tr2 = ref(cc,ac - 1) + ref(cc,ac + 2*ido - 1);
++ ti4 = ref(cc,ac + ido - 1) - ref(cc,ac + 3*ido - 1);
++ tr3 = ref(cc,ac + ido - 1) + ref(cc,ac + 3*ido - 1);
++ ah = k*ido;
++ ch[ah] = tr2 + tr3;
++ ch[ah + 2*l1*ido] = tr2 - tr3;
++ ch[ah + 1] = ti2 + ti3;
++ ch[ah + 2*l1*ido + 1] = ti2 - ti3;
++ ch[ah + l1*ido] = tr1 + isign*tr4;
++ ch[ah + 3*l1*ido] = tr1 - isign*tr4;
++ ch[ah + l1*ido + 1] = ti1 + isign*ti4;
++ ch[ah + 3*l1*ido + 1] = ti1 - isign*ti4;
++ }
++ } else {
++ for (k=0; k<l1; k++) {
++ for (i=0; i<ido-1; i+=2) {
++ ac = i + 1 + 4*k*ido;
++ ti1 = ref(cc,ac) - ref(cc,ac + 2*ido);
++ ti2 = ref(cc,ac) + ref(cc,ac + 2*ido);
++ ti3 = ref(cc,ac + ido) + ref(cc,ac + 3*ido);
++ tr4 = ref(cc,ac + 3*ido) - ref(cc,ac + ido);
++ tr1 = ref(cc,ac - 1) - ref(cc,ac + 2*ido - 1);
++ tr2 = ref(cc,ac - 1) + ref(cc,ac + 2*ido - 1);
++ ti4 = ref(cc,ac + ido - 1) - ref(cc,ac + 3*ido - 1);
++ tr3 = ref(cc,ac + ido - 1) + ref(cc,ac + 3*ido - 1);
++ ah = i + k*ido;
++ ch[ah] = tr2 + tr3;
++ cr3 = tr2 - tr3;
++ ch[ah + 1] = ti2 + ti3;
++ ci3 = ti2 - ti3;
++ cr2 = tr1 + isign*tr4;
++ cr4 = tr1 - isign*tr4;
++ ci2 = ti1 + isign*ti4;
++ ci4 = ti1 - isign*ti4;
++ ch[ah + l1*ido] = wa1[i]*cr2 - isign*wa1[i + 1]*ci2;
++ ch[ah + l1*ido + 1] = wa1[i]*ci2 + isign*wa1[i + 1]*cr2;
++ ch[ah + 2*l1*ido] = wa2[i]*cr3 - isign*wa2[i + 1]*ci3;
++ ch[ah + 2*l1*ido + 1] = wa2[i]*ci3 + isign*wa2[i + 1]*cr3;
++ ch[ah + 3*l1*ido] = wa3[i]*cr4 -isign*wa3[i + 1]*ci4;
++ ch[ah + 3*l1*ido + 1] = wa3[i]*ci4 + isign*wa3[i + 1]*cr4;
++ }
++ }
++ }
++ } /* passf4 */
++
++
++static void passf5(int ido, int l1, const Treal cc[], Treal ch[],
++ const Treal wa1[], const Treal wa2[], const Treal wa3[], const Treal wa4[], int isign)
++ /* isign == -1 for forward transform and +1 for backward transform */
++ {
++ static const Treal tr11 = 0.309016994374947;
++ static const Treal ti11 = 0.951056516295154;
++ static const Treal tr12 = -0.809016994374947;
++ static const Treal ti12 = 0.587785252292473;
++ int i, k, ac, ah;
++ Treal ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, ti2, ti3,
++ ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
++ if (ido == 2) {
++ for (k = 1; k <= l1; ++k) {
++ ac = (5*k - 4)*ido + 1;
++ ti5 = ref(cc,ac) - ref(cc,ac + 3*ido);
++ ti2 = ref(cc,ac) + ref(cc,ac + 3*ido);
++ ti4 = ref(cc,ac + ido) - ref(cc,ac + 2*ido);
++ ti3 = ref(cc,ac + ido) + ref(cc,ac + 2*ido);
++ tr5 = ref(cc,ac - 1) - ref(cc,ac + 3*ido - 1);
++ tr2 = ref(cc,ac - 1) + ref(cc,ac + 3*ido - 1);
++ tr4 = ref(cc,ac + ido - 1) - ref(cc,ac + 2*ido - 1);
++ tr3 = ref(cc,ac + ido - 1) + ref(cc,ac + 2*ido - 1);
++ ah = (k - 1)*ido;
++ ch[ah] = ref(cc,ac - ido - 1) + tr2 + tr3;
++ ch[ah + 1] = ref(cc,ac - ido) + ti2 + ti3;
++ cr2 = ref(cc,ac - ido - 1) + tr11*tr2 + tr12*tr3;
++ ci2 = ref(cc,ac - ido) + tr11*ti2 + tr12*ti3;
++ cr3 = ref(cc,ac - ido - 1) + tr12*tr2 + tr11*tr3;
++ ci3 = ref(cc,ac - ido) + tr12*ti2 + tr11*ti3;
++ cr5 = isign*(ti11*tr5 + ti12*tr4);
++ ci5 = isign*(ti11*ti5 + ti12*ti4);
++ cr4 = isign*(ti12*tr5 - ti11*tr4);
++ ci4 = isign*(ti12*ti5 - ti11*ti4);
++ ch[ah + l1*ido] = cr2 - ci5;
++ ch[ah + 4*l1*ido] = cr2 + ci5;
++ ch[ah + l1*ido + 1] = ci2 + cr5;
++ ch[ah + 2*l1*ido + 1] = ci3 + cr4;
++ ch[ah + 2*l1*ido] = cr3 - ci4;
++ ch[ah + 3*l1*ido] = cr3 + ci4;
++ ch[ah + 3*l1*ido + 1] = ci3 - cr4;
++ ch[ah + 4*l1*ido + 1] = ci2 - cr5;
++ }
++ } else {
++ for (k=1; k<=l1; k++) {
++ for (i=0; i<ido-1; i+=2) {
++ ac = i + 1 + (k*5 - 4)*ido;
++ ti5 = ref(cc,ac) - ref(cc,ac + 3*ido);
++ ti2 = ref(cc,ac) + ref(cc,ac + 3*ido);
++ ti4 = ref(cc,ac + ido) - ref(cc,ac + 2*ido);
++ ti3 = ref(cc,ac + ido) + ref(cc,ac + 2*ido);
++ tr5 = ref(cc,ac - 1) - ref(cc,ac + 3*ido - 1);
++ tr2 = ref(cc,ac - 1) + ref(cc,ac + 3*ido - 1);
++ tr4 = ref(cc,ac + ido - 1) - ref(cc,ac + 2*ido - 1);
++ tr3 = ref(cc,ac + ido - 1) + ref(cc,ac + 2*ido - 1);
++ ah = i + (k - 1)*ido;
++ ch[ah] = ref(cc,ac - ido - 1) + tr2 + tr3;
++ ch[ah + 1] = ref(cc,ac - ido) + ti2 + ti3;
++ cr2 = ref(cc,ac - ido - 1) + tr11*tr2 + tr12*tr3;
++
++ ci2 = ref(cc,ac - ido) + tr11*ti2 + tr12*ti3;
++ cr3 = ref(cc,ac - ido - 1) + tr12*tr2 + tr11*tr3;
++
++ ci3 = ref(cc,ac - ido) + tr12*ti2 + tr11*ti3;
++ cr5 = isign*(ti11*tr5 + ti12*tr4);
++ ci5 = isign*(ti11*ti5 + ti12*ti4);
++ cr4 = isign*(ti12*tr5 - ti11*tr4);
++ ci4 = isign*(ti12*ti5 - ti11*ti4);
++ dr3 = cr3 - ci4;
++ dr4 = cr3 + ci4;
++ di3 = ci3 + cr4;
++ di4 = ci3 - cr4;
++ dr5 = cr2 + ci5;
++ dr2 = cr2 - ci5;
++ di5 = ci2 - cr5;
++ di2 = ci2 + cr5;
++ ch[ah + l1*ido] = wa1[i]*dr2 - isign*wa1[i+1]*di2;
++ ch[ah + l1*ido + 1] = wa1[i]*di2 + isign*wa1[i+1]*dr2;
++ ch[ah + 2*l1*ido] = wa2[i]*dr3 - isign*wa2[i+1]*di3;
++ ch[ah + 2*l1*ido + 1] = wa2[i]*di3 + isign*wa2[i+1]*dr3;
++ ch[ah + 3*l1*ido] = wa3[i]*dr4 - isign*wa3[i+1]*di4;
++ ch[ah + 3*l1*ido + 1] = wa3[i]*di4 + isign*wa3[i+1]*dr4;
++ ch[ah + 4*l1*ido] = wa4[i]*dr5 - isign*wa4[i+1]*di5;
++ ch[ah + 4*l1*ido + 1] = wa4[i]*di5 + isign*wa4[i+1]*dr5;
++ }
++ }
++ }
++ } /* passf5 */
++
++
++static void passf(int *nac, int ido, int ip, int l1, int idl1,
++ Treal cc[], Treal ch[],
++ const Treal wa[], int isign)
++ /* isign is -1 for forward transform and +1 for backward transform */
++ {
++ int idij, idlj, idot, ipph, i, j, k, l, jc, lc, ik, idj, idl, inc,idp;
++ Treal wai, war;
++
++ idot = ido / 2;
++ /* nt = ip*idl1;*/
++ ipph = (ip + 1) / 2;
++ idp = ip*ido;
++ if (ido >= l1) {
++ for (j=1; j<ipph; j++) {
++ jc = ip - j;
++ for (k=0; k<l1; k++) {
++ for (i=0; i<ido; i++) {
++ ch[i + (k + j*l1)*ido] =
++ ref(cc,i + (j + k*ip)*ido) + ref(cc,i + (jc + k*ip)*ido);
++ ch[i + (k + jc*l1)*ido] =
++ ref(cc,i + (j + k*ip)*ido) - ref(cc,i + (jc + k*ip)*ido);
++ }
++ }
++ }
++ for (k=0; k<l1; k++)
++ for (i=0; i<ido; i++)
++ ch[i + k*ido] = ref(cc,i + k*ip*ido);
++ } else {
++ for (j=1; j<ipph; j++) {
++ jc = ip - j;
++ for (i=0; i<ido; i++) {
++ for (k=0; k<l1; k++) {
++ ch[i + (k + j*l1)*ido] = ref(cc,i + (j + k*ip)*ido) + ref(cc,i + (jc + k*
++ ip)*ido);
++ ch[i + (k + jc*l1)*ido] = ref(cc,i + (j + k*ip)*ido) - ref(cc,i + (jc + k*
++ ip)*ido);
++ }
++ }
++ }
++ for (i=0; i<ido; i++)
++ for (k=0; k<l1; k++)
++ ch[i + k*ido] = ref(cc,i + k*ip*ido);
++ }
++
++ idl = 2 - ido;
++ inc = 0;
++ for (l=1; l<ipph; l++) {
++ lc = ip - l;
++ idl += ido;
++ for (ik=0; ik<idl1; ik++) {
++ cc[ik + l*idl1] = ch[ik] + wa[idl - 2]*ch[ik + idl1];
++ cc[ik + lc*idl1] = isign*wa[idl-1]*ch[ik + (ip-1)*idl1];
++ }
++ idlj = idl;
++ inc += ido;
++ for (j=2; j<ipph; j++) {
++ jc = ip - j;
++ idlj += inc;
++ if (idlj > idp) idlj -= idp;
++ war = wa[idlj - 2];
++ wai = wa[idlj-1];
++ for (ik=0; ik<idl1; ik++) {
++ cc[ik + l*idl1] += war*ch[ik + j*idl1];
++ cc[ik + lc*idl1] += isign*wai*ch[ik + jc*idl1];
++ }
++ }
++ }
++ for (j=1; j<ipph; j++)
++ for (ik=0; ik<idl1; ik++)
++ ch[ik] += ch[ik + j*idl1];
++ for (j=1; j<ipph; j++) {
++ jc = ip - j;
++ for (ik=1; ik<idl1; ik+=2) {
++ ch[ik - 1 + j*idl1] = cc[ik - 1 + j*idl1] - cc[ik + jc*idl1];
++ ch[ik - 1 + jc*idl1] = cc[ik - 1 + j*idl1] + cc[ik + jc*idl1];
++ ch[ik + j*idl1] = cc[ik + j*idl1] + cc[ik - 1 + jc*idl1];
++ ch[ik + jc*idl1] = cc[ik + j*idl1] - cc[ik - 1 + jc*idl1];
++ }
++ }
++ *nac = 1;
++ if (ido == 2) return;
++ *nac = 0;
++ for (ik=0; ik<idl1; ik++)
++ cc[ik] = ch[ik];
++ for (j=1; j<ip; j++) {
++ for (k=0; k<l1; k++) {
++ cc[(k + j*l1)*ido + 0] = ch[(k + j*l1)*ido + 0];
++ cc[(k + j*l1)*ido + 1] = ch[(k + j*l1)*ido + 1];
++ }
++ }
++ if (idot <= l1) {
++ idij = 0;
++ for (j=1; j<ip; j++) {
++ idij += 2;
++ for (i=3; i<ido; i+=2) {
++ idij += 2;
++ for (k=0; k<l1; k++) {
++ cc[i - 1 + (k + j*l1)*ido] =
++ wa[idij - 2]*ch[i - 1 + (k + j*l1)*ido] -
++ isign*wa[idij-1]*ch[i + (k + j*l1)*ido];
++ cc[i + (k + j*l1)*ido] =
++ wa[idij - 2]*ch[i + (k + j*l1)*ido] +
++ isign*wa[idij-1]*ch[i - 1 + (k + j*l1)*ido];
++ }
++ }
++ }
++ } else {
++ idj = 2 - ido;
++ for (j=1; j<ip; j++) {
++ idj += ido;
++ for (k = 0; k < l1; k++) {
++ idij = idj;
++ for (i=3; i<ido; i+=2) {
++ idij += 2;
++ cc[i - 1 + (k + j*l1)*ido] =
++ wa[idij - 2]*ch[i - 1 + (k + j*l1)*ido] -
++ isign*wa[idij-1]*ch[i + (k + j*l1)*ido];
++ cc[i + (k + j*l1)*ido] =
++ wa[idij - 2]*ch[i + (k + j*l1)*ido] +
++ isign*wa[idij-1]*ch[i - 1 + (k + j*l1)*ido];
++ }
++ }
++ }
++ }
++ } /* passf */
++
++
++ /* ----------------------------------------------------------------------
++radf2,radb2, radf3,radb3, radf4,radb4, radf5,radb5, radfg,radbg.
++Treal FFT passes fwd and bwd.
++---------------------------------------------------------------------- */
++
++static void radf2(int ido, int l1, const Treal cc[], Treal ch[], const Treal wa1[])
++ {
++ int i, k, ic;
++ Treal ti2, tr2;
++ for (k=0; k<l1; k++) {
++ ch[2*k*ido] =
++ ref(cc,k*ido) + ref(cc,(k + l1)*ido);
++ ch[(2*k+1)*ido + ido-1] =
++ ref(cc,k*ido) - ref(cc,(k + l1)*ido);
++ }
++ if (ido < 2) return;
++ if (ido != 2) {
++ for (k=0; k<l1; k++) {
++ for (i=2; i<ido; i+=2) {
++ ic = ido - i;
++ tr2 = wa1[i - 2]*ref(cc, i-1 + (k + l1)*ido) + wa1[i - 1]*ref(cc, i + (k + l1)*ido);
++ ti2 = wa1[i - 2]*ref(cc, i + (k + l1)*ido) - wa1[i - 1]*ref(cc, i-1 + (k + l1)*ido);
++ ch[i + 2*k*ido] = ref(cc,i + k*ido) + ti2;
++ ch[ic + (2*k+1)*ido] = ti2 - ref(cc,i + k*ido);
++ ch[i - 1 + 2*k*ido] = ref(cc,i - 1 + k*ido) + tr2;
++ ch[ic - 1 + (2*k+1)*ido] = ref(cc,i - 1 + k*ido) - tr2;
++ }
++ }
++ if (ido % 2 == 1) return;
++ }
++ for (k=0; k<l1; k++) {
++ ch[(2*k+1)*ido] = -ref(cc,ido-1 + (k + l1)*ido);
++ ch[ido-1 + 2*k*ido] = ref(cc,ido-1 + k*ido);
++ }
++ } /* radf2 */
++
++
++static void radb2(int ido, int l1, const Treal cc[], Treal ch[], const Treal wa1[])
++ {
++ int i, k, ic;
++ Treal ti2, tr2;
++ for (k=0; k<l1; k++) {
++ ch[k*ido] =
++ ref(cc,2*k*ido) + ref(cc,ido-1 + (2*k+1)*ido);
++ ch[(k + l1)*ido] =
++ ref(cc,2*k*ido) - ref(cc,ido-1 + (2*k+1)*ido);
++ }
++ if (ido < 2) return;
++ if (ido != 2) {
++ for (k = 0; k < l1; ++k) {
++ for (i = 2; i < ido; i += 2) {
++ ic = ido - i;
++ ch[i-1 + k*ido] =
++ ref(cc,i-1 + 2*k*ido) + ref(cc,ic-1 + (2*k+1)*ido);
++ tr2 = ref(cc,i-1 + 2*k*ido) - ref(cc,ic-1 + (2*k+1)*ido);
++ ch[i + k*ido] =
++ ref(cc,i + 2*k*ido) - ref(cc,ic + (2*k+1)*ido);
++ ti2 = ref(cc,i + (2*k)*ido) + ref(cc,ic + (2*k+1)*ido);
++ ch[i-1 + (k + l1)*ido] =
++ wa1[i - 2]*tr2 - wa1[i - 1]*ti2;
++ ch[i + (k + l1)*ido] =
++ wa1[i - 2]*ti2 + wa1[i - 1]*tr2;
++ }
++ }
++ if (ido % 2 == 1) return;
++ }
++ for (k = 0; k < l1; k++) {
++ ch[ido-1 + k*ido] = 2*ref(cc,ido-1 + 2*k*ido);
++ ch[ido-1 + (k + l1)*ido] = -2*ref(cc,(2*k+1)*ido);
++ }
++ } /* radb2 */
++
++
++static void radf3(int ido, int l1, const Treal cc[], Treal ch[],
++ const Treal wa1[], const Treal wa2[])
++ {
++ static const Treal taur = -0.5;
++ static const Treal taui = 0.866025403784439;
++ int i, k, ic;
++ Treal ci2, di2, di3, cr2, dr2, dr3, ti2, ti3, tr2, tr3;
++ for (k=0; k<l1; k++) {
++ cr2 = ref(cc,(k + l1)*ido) + ref(cc,(k + 2*l1)*ido);
++ ch[3*k*ido] = ref(cc,k*ido) + cr2;
++ ch[(3*k+2)*ido] = taui*(ref(cc,(k + l1*2)*ido) - ref(cc,(k + l1)*ido));
++ ch[ido-1 + (3*k + 1)*ido] = ref(cc,k*ido) + taur*cr2;
++ }
++ if (ido == 1) return;
++ for (k=0; k<l1; k++) {
++ for (i=2; i<ido; i+=2) {
++ ic = ido - i;
++ dr2 = wa1[i - 2]*ref(cc,i - 1 + (k + l1)*ido) +
++ wa1[i - 1]*ref(cc,i + (k + l1)*ido);
++ di2 = wa1[i - 2]*ref(cc,i + (k + l1)*ido) - wa1[i - 1]*ref(cc,i - 1 + (k + l1)*ido);
++ dr3 = wa2[i - 2]*ref(cc,i - 1 + (k + l1*2)*ido) + wa2[i - 1]*ref(cc,i + (k + l1*2)*ido);
++ di3 = wa2[i - 2]*ref(cc,i + (k + l1*2)*ido) - wa2[i - 1]*ref(cc,i - 1 + (k + l1*2)*ido);
++ cr2 = dr2 + dr3;
++ ci2 = di2 + di3;
++ ch[i - 1 + 3*k*ido] = ref(cc,i - 1 + k*ido) + cr2;
++ ch[i + 3*k*ido] = ref(cc,i + k*ido) + ci2;
++ tr2 = ref(cc,i - 1 + k*ido) + taur*cr2;
++ ti2 = ref(cc,i + k*ido) + taur*ci2;
++ tr3 = taui*(di2 - di3);
++ ti3 = taui*(dr3 - dr2);
++ ch[i - 1 + (3*k + 2)*ido] = tr2 + tr3;
++ ch[ic - 1 + (3*k + 1)*ido] = tr2 - tr3;
++ ch[i + (3*k + 2)*ido] = ti2 + ti3;
++ ch[ic + (3*k + 1)*ido] = ti3 - ti2;
++ }
++ }
++ } /* radf3 */
++
++
++static void radb3(int ido, int l1, const Treal cc[], Treal ch[],
++ const Treal wa1[], const Treal wa2[])
++ {
++ static const Treal taur = -0.5;
++ static const Treal taui = 0.866025403784439;
++ int i, k, ic;
++ Treal ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
++ for (k=0; k<l1; k++) {
++ tr2 = 2*ref(cc,ido-1 + (3*k + 1)*ido);
++ cr2 = ref(cc,3*k*ido) + taur*tr2;
++ ch[k*ido] = ref(cc,3*k*ido) + tr2;
++ ci3 = 2*taui*ref(cc,(3*k + 2)*ido);
++ ch[(k + l1)*ido] = cr2 - ci3;
++ ch[(k + 2*l1)*ido] = cr2 + ci3;
++ }
++ if (ido == 1) return;
++ for (k=0; k<l1; k++) {
++ for (i=2; i<ido; i+=2) {
++ ic = ido - i;
++ tr2 = ref(cc,i - 1 + (3*k + 2)*ido) + ref(cc,ic - 1 + (3*k + 1)*ido);
++ cr2 = ref(cc,i - 1 + 3*k*ido) + taur*tr2;
++ ch[i - 1 + k*ido] = ref(cc,i - 1 + 3*k*ido) + tr2;
++ ti2 = ref(cc,i + (3*k + 2)*ido) - ref(cc,ic + (3*k + 1)*ido);
++ ci2 = ref(cc,i + 3*k*ido) + taur*ti2;
++ ch[i + k*ido] = ref(cc,i + 3*k*ido) + ti2;
++ cr3 = taui*(ref(cc,i - 1 + (3*k + 2)*ido) - ref(cc,ic - 1 + (3*k + 1)*ido));
++ ci3 = taui*(ref(cc,i + (3*k + 2)*ido) + ref(cc,ic + (3*k + 1)*ido));
++ dr2 = cr2 - ci3;
++ dr3 = cr2 + ci3;
++ di2 = ci2 + cr3;
++ di3 = ci2 - cr3;
++ ch[i - 1 + (k + l1)*ido] = wa1[i - 2]*dr2 - wa1[i - 1]*di2;
++ ch[i + (k + l1)*ido] = wa1[i - 2]*di2 + wa1[i - 1]*dr2;
++ ch[i - 1 + (k + 2*l1)*ido] = wa2[i - 2]*dr3 - wa2[i - 1]*di3;
++ ch[i + (k + 2*l1)*ido] = wa2[i - 2]*di3 + wa2[i - 1]*dr3;
++ }
++ }
++ } /* radb3 */
++
++
++static void radf4(int ido, int l1, const Treal cc[], Treal ch[],
++ const Treal wa1[], const Treal wa2[], const Treal wa3[])
++ {
++ static const Treal hsqt2 = 0.7071067811865475;
++ int i, k, ic;
++ Treal ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;
++ for (k=0; k<l1; k++) {
++ tr1 = ref(cc,(k + l1)*ido) + ref(cc,(k + 3*l1)*ido);
++ tr2 = ref(cc,k*ido) + ref(cc,(k + 2*l1)*ido);
++ ch[4*k*ido] = tr1 + tr2;
++ ch[ido-1 + (4*k + 3)*ido] = tr2 - tr1;
++ ch[ido-1 + (4*k + 1)*ido] = ref(cc,k*ido) - ref(cc,(k + 2*l1)*ido);
++ ch[(4*k + 2)*ido] = ref(cc,(k + 3*l1)*ido) - ref(cc,(k + l1)*ido);
++ }
++ if (ido < 2) return;
++ if (ido != 2) {
++ for (k=0; k<l1; k++) {
++ for (i=2; i<ido; i += 2) {
++ ic = ido - i;
++ cr2 = wa1[i - 2]*ref(cc,i - 1 + (k + l1)*ido) + wa1[i - 1]*ref(cc,i + (k + l1)*ido);
++ ci2 = wa1[i - 2]*ref(cc,i + (k + l1)*ido) - wa1[i - 1]*ref(cc,i - 1 + (k + l1)*ido);
++ cr3 = wa2[i - 2]*ref(cc,i - 1 + (k + 2*l1)*ido) + wa2[i - 1]*ref(cc,i + (k + 2*l1)*
++ ido);
++ ci3 = wa2[i - 2]*ref(cc,i + (k + 2*l1)*ido) - wa2[i - 1]*ref(cc,i - 1 + (k + 2*l1)*
++ ido);
++ cr4 = wa3[i - 2]*ref(cc,i - 1 + (k + 3*l1)*ido) + wa3[i - 1]*ref(cc,i + (k + 3*l1)*
++ ido);
++ ci4 = wa3[i - 2]*ref(cc,i + (k + 3*l1)*ido) - wa3[i - 1]*ref(cc,i - 1 + (k + 3*l1)*
++ ido);
++ tr1 = cr2 + cr4;
++ tr4 = cr4 - cr2;
++ ti1 = ci2 + ci4;
++ ti4 = ci2 - ci4;
++ ti2 = ref(cc,i + k*ido) + ci3;
++ ti3 = ref(cc,i + k*ido) - ci3;
++ tr2 = ref(cc,i - 1 + k*ido) + cr3;
++ tr3 = ref(cc,i - 1 + k*ido) - cr3;
++ ch[i - 1 + 4*k*ido] = tr1 + tr2;
++ ch[ic - 1 + (4*k + 3)*ido] = tr2 - tr1;
++ ch[i + 4*k*ido] = ti1 + ti2;
++ ch[ic + (4*k + 3)*ido] = ti1 - ti2;
++ ch[i - 1 + (4*k + 2)*ido] = ti4 + tr3;
++ ch[ic - 1 + (4*k + 1)*ido] = tr3 - ti4;
++ ch[i + (4*k + 2)*ido] = tr4 + ti3;
++ ch[ic + (4*k + 1)*ido] = tr4 - ti3;
++ }
++ }
++ if (ido % 2 == 1) return;
++ }
++ for (k=0; k<l1; k++) {
++ ti1 = -hsqt2*(ref(cc,ido-1 + (k + l1)*ido) + ref(cc,ido-1 + (k + 3*l1)*ido));
++ tr1 = hsqt2*(ref(cc,ido-1 + (k + l1)*ido) - ref(cc,ido-1 + (k + 3*l1)*ido));
++ ch[ido-1 + 4*k*ido] = tr1 + ref(cc,ido-1 + k*ido);
++ ch[ido-1 + (4*k + 2)*ido] = ref(cc,ido-1 + k*ido) - tr1;
++ ch[(4*k + 1)*ido] = ti1 - ref(cc,ido-1 + (k + 2*l1)*ido);
++ ch[(4*k + 3)*ido] = ti1 + ref(cc,ido-1 + (k + 2*l1)*ido);
++ }
++ } /* radf4 */
++
++
++static void radb4(int ido, int l1, const Treal cc[], Treal ch[],
++ const Treal wa1[], const Treal wa2[], const Treal wa3[])
++ {
++ static const Treal sqrt2 = 1.414213562373095;
++ int i, k, ic;
++ Treal ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;
++ for (k = 0; k < l1; k++) {
++ tr1 = ref(cc,4*k*ido) - ref(cc,ido-1 + (4*k + 3)*ido);
++ tr2 = ref(cc,4*k*ido) + ref(cc,ido-1 + (4*k + 3)*ido);
++ tr3 = ref(cc,ido-1 + (4*k + 1)*ido) + ref(cc,ido-1 + (4*k + 1)*ido);
++ tr4 = ref(cc,(4*k + 2)*ido) + ref(cc,(4*k + 2)*ido);
++ ch[k*ido] = tr2 + tr3;
++ ch[(k + l1)*ido] = tr1 - tr4;
++ ch[(k + 2*l1)*ido] = tr2 - tr3;
++ ch[(k + 3*l1)*ido] = tr1 + tr4;
++ }
++ if (ido < 2) return;
++ if (ido != 2) {
++ for (k = 0; k < l1; ++k) {
++ for (i = 2; i < ido; i += 2) {
++ ic = ido - i;
++ ti1 = ref(cc,i + 4*k*ido) + ref(cc,ic + (4*k + 3)*ido);
++ ti2 = ref(cc,i + 4*k*ido) - ref(cc,ic + (4*k + 3)*ido);
++ ti3 = ref(cc,i + (4*k + 2)*ido) - ref(cc,ic + (4*k + 1)*ido);
++ tr4 = ref(cc,i + (4*k + 2)*ido) + ref(cc,ic + (4*k + 1)*ido);
++ tr1 = ref(cc,i - 1 + 4*k*ido) - ref(cc,ic - 1 + (4*k + 3)*ido);
++ tr2 = ref(cc,i - 1 + 4*k*ido) + ref(cc,ic - 1 + (4*k + 3)*ido);
++ ti4 = ref(cc,i - 1 + (4*k + 2)*ido) - ref(cc,ic - 1 + (4*k + 1)*ido);
++ tr3 = ref(cc,i - 1 + (4*k + 2)*ido) + ref(cc,ic - 1 + (4*k + 1)*ido);
++ ch[i - 1 + k*ido] = tr2 + tr3;
++ cr3 = tr2 - tr3;
++ ch[i + k*ido] = ti2 + ti3;
++ ci3 = ti2 - ti3;
++ cr2 = tr1 - tr4;
++ cr4 = tr1 + tr4;
++ ci2 = ti1 + ti4;
++ ci4 = ti1 - ti4;
++ ch[i - 1 + (k + l1)*ido] = wa1[i - 2]*cr2 - wa1[i - 1]*ci2;
++ ch[i + (k + l1)*ido] = wa1[i - 2]*ci2 + wa1[i - 1]*cr2;
++ ch[i - 1 + (k + 2*l1)*ido] = wa2[i - 2]*cr3 - wa2[i - 1]*ci3;
++ ch[i + (k + 2*l1)*ido] = wa2[i - 2]*ci3 + wa2[i - 1]*cr3;
++ ch[i - 1 + (k + 3*l1)*ido] = wa3[i - 2]*cr4 - wa3[i - 1]*ci4;
++ ch[i + (k + 3*l1)*ido] = wa3[i - 2]*ci4 + wa3[i - 1]*cr4;
++ }
++ }
++ if (ido % 2 == 1) return;
++ }
++ for (k = 0; k < l1; k++) {
++ ti1 = ref(cc,(4*k + 1)*ido) + ref(cc,(4*k + 3)*ido);
++ ti2 = ref(cc,(4*k + 3)*ido) - ref(cc,(4*k + 1)*ido);
++ tr1 = ref(cc,ido-1 + 4*k*ido) - ref(cc,ido-1 + (4*k + 2)*ido);
++ tr2 = ref(cc,ido-1 + 4*k*ido) + ref(cc,ido-1 + (4*k + 2)*ido);
++ ch[ido-1 + k*ido] = tr2 + tr2;
++ ch[ido-1 + (k + l1)*ido] = sqrt2*(tr1 - ti1);
++ ch[ido-1 + (k + 2*l1)*ido] = ti2 + ti2;
++ ch[ido-1 + (k + 3*l1)*ido] = -sqrt2*(tr1 + ti1);
++ }
++ } /* radb4 */
++
++
++static void radf5(int ido, int l1, const Treal cc[], Treal ch[],
++ const Treal wa1[], const Treal wa2[], const Treal wa3[], const Treal wa4[])
++ {
++ static const Treal tr11 = 0.309016994374947;
++ static const Treal ti11 = 0.951056516295154;
++ static const Treal tr12 = -0.809016994374947;
++ static const Treal ti12 = 0.587785252292473;
++ int i, k, ic;
++ Treal ci2, di2, ci4, ci5, di3, di4, di5, ci3, cr2, cr3, dr2, dr3, dr4, dr5,
++ cr5, cr4, ti2, ti3, ti5, ti4, tr2, tr3, tr4, tr5;
++ for (k = 0; k < l1; k++) {
++ cr2 = ref(cc,(k + 4*l1)*ido) + ref(cc,(k + l1)*ido);
++ ci5 = ref(cc,(k + 4*l1)*ido) - ref(cc,(k + l1)*ido);
++ cr3 = ref(cc,(k + 3*l1)*ido) + ref(cc,(k + 2*l1)*ido);
++ ci4 = ref(cc,(k + 3*l1)*ido) - ref(cc,(k + 2*l1)*ido);
++ ch[5*k*ido] = ref(cc,k*ido) + cr2 + cr3;
++ ch[ido-1 + (5*k + 1)*ido] = ref(cc,k*ido) + tr11*cr2 + tr12*cr3;
++ ch[(5*k + 2)*ido] = ti11*ci5 + ti12*ci4;
++ ch[ido-1 + (5*k + 3)*ido] = ref(cc,k*ido) + tr12*cr2 + tr11*cr3;
++ ch[(5*k + 4)*ido] = ti12*ci5 - ti11*ci4;
++ }
++ if (ido == 1) return;
++ for (k = 0; k < l1; ++k) {
++ for (i = 2; i < ido; i += 2) {
++ ic = ido - i;
++ dr2 = wa1[i - 2]*ref(cc,i - 1 + (k + l1)*ido) + wa1[i - 1]*ref(cc,i + (k + l1)*ido);
++ di2 = wa1[i - 2]*ref(cc,i + (k + l1)*ido) - wa1[i - 1]*ref(cc,i - 1 + (k + l1)*ido);
++ dr3 = wa2[i - 2]*ref(cc,i - 1 + (k + 2*l1)*ido) + wa2[i - 1]*ref(cc,i + (k + 2*l1)*ido);
++ di3 = wa2[i - 2]*ref(cc,i + (k + 2*l1)*ido) - wa2[i - 1]*ref(cc,i - 1 + (k + 2*l1)*ido);
++ dr4 = wa3[i - 2]*ref(cc,i - 1 + (k + 3*l1)*ido) + wa3[i - 1]*ref(cc,i + (k + 3*l1)*ido);
++ di4 = wa3[i - 2]*ref(cc,i + (k + 3*l1)*ido) - wa3[i - 1]*ref(cc,i - 1 + (k + 3*l1)*ido);
++ dr5 = wa4[i - 2]*ref(cc,i - 1 + (k + 4*l1)*ido) + wa4[i - 1]*ref(cc,i + (k + 4*l1)*ido);
++ di5 = wa4[i - 2]*ref(cc,i + (k + 4*l1)*ido) - wa4[i - 1]*ref(cc,i - 1 + (k + 4*l1)*ido);
++ cr2 = dr2 + dr5;
++ ci5 = dr5 - dr2;
++ cr5 = di2 - di5;
++ ci2 = di2 + di5;
++ cr3 = dr3 + dr4;
++ ci4 = dr4 - dr3;
++ cr4 = di3 - di4;
++ ci3 = di3 + di4;
++ ch[i - 1 + 5*k*ido] = ref(cc,i - 1 + k*ido) + cr2 + cr3;
++ ch[i + 5*k*ido] = ref(cc,i + k*ido) + ci2 + ci3;
++ tr2 = ref(cc,i - 1 + k*ido) + tr11*cr2 + tr12*cr3;
++ ti2 = ref(cc,i + k*ido) + tr11*ci2 + tr12*ci3;
++ tr3 = ref(cc,i - 1 + k*ido) + tr12*cr2 + tr11*cr3;
++ ti3 = ref(cc,i + k*ido) + tr12*ci2 + tr11*ci3;
++ tr5 = ti11*cr5 + ti12*cr4;
++ ti5 = ti11*ci5 + ti12*ci4;
++ tr4 = ti12*cr5 - ti11*cr4;
++ ti4 = ti12*ci5 - ti11*ci4;
++ ch[i - 1 + (5*k + 2)*ido] = tr2 + tr5;
++ ch[ic - 1 + (5*k + 1)*ido] = tr2 - tr5;
++ ch[i + (5*k + 2)*ido] = ti2 + ti5;
++ ch[ic + (5*k + 1)*ido] = ti5 - ti2;
++ ch[i - 1 + (5*k + 4)*ido] = tr3 + tr4;
++ ch[ic - 1 + (5*k + 3)*ido] = tr3 - tr4;
++ ch[i + (5*k + 4)*ido] = ti3 + ti4;
++ ch[ic + (5*k + 3)*ido] = ti4 - ti3;
++ }
++ }
++ } /* radf5 */
++
++
++static void radb5(int ido, int l1, const Treal cc[], Treal ch[],
++ const Treal wa1[], const Treal wa2[], const Treal wa3[], const Treal wa4[])
++ {
++ static const Treal tr11 = 0.309016994374947;
++ static const Treal ti11 = 0.951056516295154;
++ static const Treal tr12 = -0.809016994374947;
++ static const Treal ti12 = 0.587785252292473;
++ int i, k, ic;
++ Treal ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, ti2, ti3,
++ ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
++ for (k = 0; k < l1; k++) {
++ ti5 = 2*ref(cc,(5*k + 2)*ido);
++ ti4 = 2*ref(cc,(5*k + 4)*ido);
++ tr2 = 2*ref(cc,ido-1 + (5*k + 1)*ido);
++ tr3 = 2*ref(cc,ido-1 + (5*k + 3)*ido);
++ ch[k*ido] = ref(cc,5*k*ido) + tr2 + tr3;
++ cr2 = ref(cc,5*k*ido) + tr11*tr2 + tr12*tr3;
++ cr3 = ref(cc,5*k*ido) + tr12*tr2 + tr11*tr3;
++ ci5 = ti11*ti5 + ti12*ti4;
++ ci4 = ti12*ti5 - ti11*ti4;
++ ch[(k + l1)*ido] = cr2 - ci5;
++ ch[(k + 2*l1)*ido] = cr3 - ci4;
++ ch[(k + 3*l1)*ido] = cr3 + ci4;
++ ch[(k + 4*l1)*ido] = cr2 + ci5;
++ }
++ if (ido == 1) return;
++ for (k = 0; k < l1; ++k) {
++ for (i = 2; i < ido; i += 2) {
++ ic = ido - i;
++ ti5 = ref(cc,i + (5*k + 2)*ido) + ref(cc,ic + (5*k + 1)*ido);
++ ti2 = ref(cc,i + (5*k + 2)*ido) - ref(cc,ic + (5*k + 1)*ido);
++ ti4 = ref(cc,i + (5*k + 4)*ido) + ref(cc,ic + (5*k + 3)*ido);
++ ti3 = ref(cc,i + (5*k + 4)*ido) - ref(cc,ic + (5*k + 3)*ido);
++ tr5 = ref(cc,i - 1 + (5*k + 2)*ido) - ref(cc,ic - 1 + (5*k + 1)*ido);
++ tr2 = ref(cc,i - 1 + (5*k + 2)*ido) + ref(cc,ic - 1 + (5*k + 1)*ido);
++ tr4 = ref(cc,i - 1 + (5*k + 4)*ido) - ref(cc,ic - 1 + (5*k + 3)*ido);
++ tr3 = ref(cc,i - 1 + (5*k + 4)*ido) + ref(cc,ic - 1 + (5*k + 3)*ido);
++ ch[i - 1 + k*ido] = ref(cc,i - 1 + 5*k*ido) + tr2 + tr3;
++ ch[i + k*ido] = ref(cc,i + 5*k*ido) + ti2 + ti3;
++ cr2 = ref(cc,i - 1 + 5*k*ido) + tr11*tr2 + tr12*tr3;
++
++ ci2 = ref(cc,i + 5*k*ido) + tr11*ti2 + tr12*ti3;
++ cr3 = ref(cc,i - 1 + 5*k*ido) + tr12*tr2 + tr11*tr3;
++
++ ci3 = ref(cc,i + 5*k*ido) + tr12*ti2 + tr11*ti3;
++ cr5 = ti11*tr5 + ti12*tr4;
++ ci5 = ti11*ti5 + ti12*ti4;
++ cr4 = ti12*tr5 - ti11*tr4;
++ ci4 = ti12*ti5 - ti11*ti4;
++ dr3 = cr3 - ci4;
++ dr4 = cr3 + ci4;
++ di3 = ci3 + cr4;
++ di4 = ci3 - cr4;
++ dr5 = cr2 + ci5;
++ dr2 = cr2 - ci5;
++ di5 = ci2 - cr5;
++ di2 = ci2 + cr5;
++ ch[i - 1 + (k + l1)*ido] = wa1[i - 2]*dr2 - wa1[i - 1]*di2;
++ ch[i + (k + l1)*ido] = wa1[i - 2]*di2 + wa1[i - 1]*dr2;
++ ch[i - 1 + (k + 2*l1)*ido] = wa2[i - 2]*dr3 - wa2[i - 1]*di3;
++ ch[i + (k + 2*l1)*ido] = wa2[i - 2]*di3 + wa2[i - 1]*dr3;
++ ch[i - 1 + (k + 3*l1)*ido] = wa3[i - 2]*dr4 - wa3[i - 1]*di4;
++ ch[i + (k + 3*l1)*ido] = wa3[i - 2]*di4 + wa3[i - 1]*dr4;
++ ch[i - 1 + (k + 4*l1)*ido] = wa4[i - 2]*dr5 - wa4[i - 1]*di5;
++ ch[i + (k + 4*l1)*ido] = wa4[i - 2]*di5 + wa4[i - 1]*dr5;
++ }
++ }
++ } /* radb5 */
++
++
++static void radfg(int ido, int ip, int l1, int idl1,
++ Treal cc[], Treal ch[], const Treal wa[])
++ {
++ static const Treal twopi = 6.28318530717959;
++ int idij, ipph, i, j, k, l, j2, ic, jc, lc, ik, is, nbd;
++ Treal dc2, ai1, ai2, ar1, ar2, ds2, dcp, arg, dsp, ar1h, ar2h;
++ arg = twopi / ip;
++ dcp = cos(arg);
++ dsp = sin(arg);
++ ipph = (ip + 1) / 2;
++ nbd = (ido - 1) / 2;
++ if (ido != 1) {
++ for (ik=0; ik<idl1; ik++) ch[ik] = cc[ik];
++ for (j=1; j<ip; j++)
++ for (k=0; k<l1; k++)
++ ch[(k + j*l1)*ido] = cc[(k + j*l1)*ido];
++ if (nbd <= l1) {
++ is = -ido;
++ for (j=1; j<ip; j++) {
++ is += ido;
++ idij = is-1;
++ for (i=2; i<ido; i+=2) {
++ idij += 2;
++ for (k=0; k<l1; k++) {
++ ch[i - 1 + (k + j*l1)*ido] =
++ wa[idij - 1]*cc[i - 1 + (k + j*l1)*ido] + wa[idij]*cc[i + (k + j*l1)*ido];
++ ch[i + (k + j*l1)*ido] =
++ wa[idij - 1]*cc[i + (k + j*l1)*ido] - wa[idij]*cc[i - 1 + (k + j*l1)*ido];
++ }
++ }
++ }
++ } else {
++ is = -ido;
++ for (j=1; j<ip; j++) {
++ is += ido;
++ for (k=0; k<l1; k++) {
++ idij = is-1;
++ for (i=2; i<ido; i+=2) {
++ idij += 2;
++ ch[i - 1 + (k + j*l1)*ido] =
++ wa[idij - 1]*cc[i - 1 + (k + j*l1)*ido] + wa[idij]*cc[i + (k + j*l1)*ido];
++ ch[i + (k + j*l1)*ido] =
++ wa[idij - 1]*cc[i + (k + j*l1)*ido] - wa[idij]*cc[i - 1 + (k + j*l1)*ido];
++ }
++ }
++ }
++ }
++ if (nbd >= l1) {
++ for (j=1; j<ipph; j++) {
++ jc = ip - j;
++ for (k=0; k<l1; k++) {
++ for (i=2; i<ido; i+=2) {
++ cc[i - 1 + (k + j*l1)*ido] = ch[i - 1 + (k + j*l1)*ido] + ch[i - 1 + (k + jc*l1)*ido];
++ cc[i - 1 + (k + jc*l1)*ido] = ch[i + (k + j*l1)*ido] - ch[i + (k + jc*l1)*ido];
++ cc[i + (k + j*l1)*ido] = ch[i + (k + j*l1)*ido] + ch[i + (k + jc*l1)*ido];
++ cc[i + (k + jc*l1)*ido] = ch[i - 1 + (k + jc*l1)*ido] - ch[i - 1 + (k + j*l1)*ido];
++ }
++ }
++ }
++ } else {
++ for (j=1; j<ipph; j++) {
++ jc = ip - j;
++ for (i=2; i<ido; i+=2) {
++ for (k=0; k<l1; k++) {
++ cc[i - 1 + (k + j*l1)*ido] =
++ ch[i - 1 + (k + j*l1)*ido] + ch[i - 1 + (k + jc*l1)*ido];
++ cc[i - 1 + (k + jc*l1)*ido] = ch[i + (k + j*l1)*ido] - ch[i + (k + jc*l1)*ido];
++ cc[i + (k + j*l1)*ido] = ch[i + (k + j*l1)*ido] + ch[i + (k + jc*l1)*ido];
++ cc[i + (k + jc*l1)*ido] = ch[i - 1 + (k + jc*l1)*ido] - ch[i - 1 + (k + j*l1)*ido];
++ }
++ }
++ }
++ }
++ } else { /* now ido == 1 */
++ for (ik=0; ik<idl1; ik++) cc[ik] = ch[ik];
++ }
++ for (j=1; j<ipph; j++) {
++ jc = ip - j;
++ for (k=0; k<l1; k++) {
++ cc[(k + j*l1)*ido] = ch[(k + j*l1)*ido] + ch[(k + jc*l1)*ido];
++ cc[(k + jc*l1)*ido] = ch[(k + jc*l1)*ido] - ch[(k + j*l1)*ido];
++ }
++ }
++
++ ar1 = 1;
++ ai1 = 0;
++ for (l=1; l<ipph; l++) {
++ lc = ip - l;
++ ar1h = dcp*ar1 - dsp*ai1;
++ ai1 = dcp*ai1 + dsp*ar1;
++ ar1 = ar1h;
++ for (ik=0; ik<idl1; ik++) {
++ ch[ik + l*idl1] = cc[ik] + ar1*cc[ik + idl1];
++ ch[ik + lc*idl1] = ai1*cc[ik + (ip-1)*idl1];
++ }
++ dc2 = ar1;
++ ds2 = ai1;
++ ar2 = ar1;
++ ai2 = ai1;
++ for (j=2; j<ipph; j++) {
++ jc = ip - j;
++ ar2h = dc2*ar2 - ds2*ai2;
++ ai2 = dc2*ai2 + ds2*ar2;
++ ar2 = ar2h;
++ for (ik=0; ik<idl1; ik++) {
++ ch[ik + l*idl1] += ar2*cc[ik + j*idl1];
++ ch[ik + lc*idl1] += ai2*cc[ik + jc*idl1];
++ }
++ }
++ }
++ for (j=1; j<ipph; j++)
++ for (ik=0; ik<idl1; ik++)
++ ch[ik] += cc[ik + j*idl1];
++
++ if (ido >= l1) {
++ for (k=0; k<l1; k++) {
++ for (i=0; i<ido; i++) {
++ ref(cc,i + k*ip*ido) = ch[i + k*ido];
++ }
++ }
++ } else {
++ for (i=0; i<ido; i++) {
++ for (k=0; k<l1; k++) {
++ ref(cc,i + k*ip*ido) = ch[i + k*ido];
++ }
++ }
++ }
++ for (j=1; j<ipph; j++) {
++ jc = ip - j;
++ j2 = 2*j;
++ for (k=0; k<l1; k++) {
++ ref(cc,ido-1 + (j2 - 1 + k*ip)*ido) =
++ ch[(k + j*l1)*ido];
++ ref(cc,(j2 + k*ip)*ido) =
++ ch[(k + jc*l1)*ido];
++ }
++ }
++ if (ido == 1) return;
++ if (nbd >= l1) {
++ for (j=1; j<ipph; j++) {
++ jc = ip - j;
++ j2 = 2*j;
++ for (k=0; k<l1; k++) {
++ for (i=2; i<ido; i+=2) {
++ ic = ido - i;
++ ref(cc,i - 1 + (j2 + k*ip)*ido) = ch[i - 1 + (k + j*l1)*ido] + ch[i - 1 + (k + jc*l1)*ido];
++ ref(cc,ic - 1 + (j2 - 1 + k*ip)*ido) = ch[i - 1 + (k + j*l1)*ido] - ch[i - 1 + (k + jc*l1)*ido];
++ ref(cc,i + (j2 + k*ip)*ido) = ch[i + (k + j*l1)*ido] + ch[i + (k + jc*l1)*ido];
++ ref(cc,ic + (j2 - 1 + k*ip)*ido) = ch[i + (k + jc*l1)*ido] - ch[i + (k + j*l1)*ido];
++ }
++ }
++ }
++ } else {
++ for (j=1; j<ipph; j++) {
++ jc = ip - j;
++ j2 = 2*j;
++ for (i=2; i<ido; i+=2) {
++ ic = ido - i;
++ for (k=0; k<l1; k++) {
++ ref(cc,i - 1 + (j2 + k*ip)*ido) = ch[i - 1 + (k + j*l1)*ido] + ch[i - 1 + (k + jc*l1)*ido];
++ ref(cc,ic - 1 + (j2 - 1 + k*ip)*ido) = ch[i - 1 + (k + j*l1)*ido] - ch[i - 1 + (k + jc*l1)*ido];
++ ref(cc,i + (j2 + k*ip)*ido) = ch[i + (k + j*l1)*ido] + ch[i + (k + jc*l1)*ido];
++ ref(cc,ic + (j2 - 1 + k*ip)*ido) = ch[i + (k + jc*l1)*ido] - ch[i + (k + j*l1)*ido];
++ }
++ }
++ }
++ }
++ } /* radfg */
++
++
++static void radbg(int ido, int ip, int l1, int idl1,
++ Treal cc[], Treal ch[], const Treal wa[])
++ {
++ static const Treal twopi = 6.28318530717959;
++ int idij, ipph, i, j, k, l, j2, ic, jc, lc, ik, is;
++ Treal dc2, ai1, ai2, ar1, ar2, ds2;
++ int nbd;
++ Treal dcp, arg, dsp, ar1h, ar2h;
++ arg = twopi / ip;
++ dcp = cos(arg);
++ dsp = sin(arg);
++ nbd = (ido - 1) / 2;
++ ipph = (ip + 1) / 2;
++ if (ido >= l1) {
++ for (k=0; k<l1; k++) {
++ for (i=0; i<ido; i++) {
++ ch[i + k*ido] = ref(cc,i + k*ip*ido);
++ }
++ }
++ } else {
++ for (i=0; i<ido; i++) {
++ for (k=0; k<l1; k++) {
++ ch[i + k*ido] = ref(cc,i + k*ip*ido);
++ }
++ }
++ }
++ for (j=1; j<ipph; j++) {
++ jc = ip - j;
++ j2 = 2*j;
++ for (k=0; k<l1; k++) {
++ ch[(k + j*l1)*ido] = ref(cc,ido-1 + (j2 - 1 + k*ip)*ido) + ref(cc,ido-1 + (j2 - 1 + k*ip)*
++ ido);
++ ch[(k + jc*l1)*ido] = ref(cc,(j2 + k*ip)*ido) + ref(cc,(j2 + k*ip)*ido);
++ }
++ }
++
++ if (ido != 1) {
++ if (nbd >= l1) {
++ for (j=1; j<ipph; j++) {
++ jc = ip - j;
++ for (k=0; k<l1; k++) {
++ for (i=2; i<ido; i+=2) {
++ ic = ido - i;
++ ch[i - 1 + (k + j*l1)*ido] = ref(cc,i - 1 + (2*j + k*ip)*ido) + ref(cc,
++ ic - 1 + (2*j - 1 + k*ip)*ido);
++ ch[i - 1 + (k + jc*l1)*ido] = ref(cc,i - 1 + (2*j + k*ip)*ido) -
++ ref(cc,ic - 1 + (2*j - 1 + k*ip)*ido);
++ ch[i + (k + j*l1)*ido] = ref(cc,i + (2*j + k*ip)*ido) - ref(cc,ic
++ + (2*j - 1 + k*ip)*ido);
++ ch[i + (k + jc*l1)*ido] = ref(cc,i + (2*j + k*ip)*ido) + ref(cc,ic
++ + (2*j - 1 + k*ip)*ido);
++ }
++ }
++ }
++ } else {
++ for (j=1; j<ipph; j++) {
++ jc = ip - j;
++ for (i=2; i<ido; i+=2) {
++ ic = ido - i;
++ for (k=0; k<l1; k++) {
++ ch[i - 1 + (k + j*l1)*ido] = ref(cc,i - 1 + (2*j + k*ip)*ido) + ref(cc,
++ ic - 1 + (2*j - 1 + k*ip)*ido);
++ ch[i - 1 + (k + jc*l1)*ido] = ref(cc,i - 1 + (2*j + k*ip)*ido) -
++ ref(cc,ic - 1 + (2*j - 1 + k*ip)*ido);
++ ch[i + (k + j*l1)*ido] = ref(cc,i + (2*j + k*ip)*ido) - ref(cc,ic
++ + (2*j - 1 + k*ip)*ido);
++ ch[i + (k + jc*l1)*ido] = ref(cc,i + (2*j + k*ip)*ido) + ref(cc,ic
++ + (2*j - 1 + k*ip)*ido);
++ }
++ }
++ }
++ }
++ }
++
++ ar1 = 1;
++ ai1 = 0;
++ for (l=1; l<ipph; l++) {
++ lc = ip - l;
++ ar1h = dcp*ar1 - dsp*ai1;
++ ai1 = dcp*ai1 + dsp*ar1;
++ ar1 = ar1h;
++ for (ik=0; ik<idl1; ik++) {
++ cc[ik + l*idl1] = ch[ik] + ar1*ch[ik + idl1];
++ cc[ik + lc*idl1] = ai1*ch[ik + (ip-1)*idl1];
++ }
++ dc2 = ar1;
++ ds2 = ai1;
++ ar2 = ar1;
++ ai2 = ai1;
++ for (j=2; j<ipph; j++) {
++ jc = ip - j;
++ ar2h = dc2*ar2 - ds2*ai2;
++ ai2 = dc2*ai2 + ds2*ar2;
++ ar2 = ar2h;
++ for (ik=0; ik<idl1; ik++) {
++ cc[ik + l*idl1] += ar2*ch[ik + j*idl1];
++ cc[ik + lc*idl1] += ai2*ch[ik + jc*idl1];
++ }
++ }
++ }
++ for (j=1; j<ipph; j++) {
++ for (ik=0; ik<idl1; ik++) {
++ ch[ik] += ch[ik + j*idl1];
++ }
++ }
++ for (j=1; j<ipph; j++) {
++ jc = ip - j;
++ for (k=0; k<l1; k++) {
++ ch[(k + j*l1)*ido] = cc[(k + j*l1)*ido] - cc[(k + jc*l1)*ido];
++ ch[(k + jc*l1)*ido] = cc[(k + j*l1)*ido] + cc[(k + jc*l1)*ido];
++ }
++ }
++
++ if (ido == 1) return;
++ if (nbd >= l1) {
++ for (j=1; j<ipph; j++) {
++ jc = ip - j;
++ for (k=0; k<l1; k++) {
++ for (i=2; i<ido; i+=2) {
++ ch[i - 1 + (k + j*l1)*ido] = cc[i - 1 + (k + j*l1)*ido] - cc[i + (k + jc*l1)*ido];
++ ch[i - 1 + (k + jc*l1)*ido] = cc[i - 1 + (k + j*l1)*ido] + cc[i + (k + jc*l1)*ido];
++ ch[i + (k + j*l1)*ido] = cc[i + (k + j*l1)*ido] + cc[i - 1 + (k + jc*l1)*ido];
++ ch[i + (k + jc*l1)*ido] = cc[i + (k + j*l1)*ido] - cc[i - 1 + (k + jc*l1)*ido];
++ }
++ }
++ }
++ } else {
++ for (j=1; j<ipph; j++) {
++ jc = ip - j;
++ for (i=2; i<ido; i+=2) {
++ for (k=0; k<l1; k++) {
++ ch[i - 1 + (k + j*l1)*ido] = cc[i - 1 + (k + j*l1)*ido] - cc[i + (k + jc*l1)*ido];
++ ch[i - 1 + (k + jc*l1)*ido] = cc[i - 1 + (k + j *l1)*ido] + cc[i + (k + jc*l1)*ido];
++ ch[i + (k + j*l1)*ido] = cc[i + (k + j*l1)*ido] + cc[i - 1 + (k + jc*l1)*ido];
++ ch[i + (k + jc*l1)*ido] = cc[i + (k + j*l1)*ido] - cc[i - 1 + (k + jc*l1)*ido];
++ }
++ }
++ }
++ }
++ for (ik=0; ik<idl1; ik++) cc[ik] = ch[ik];
++ for (j=1; j<ip; j++)
++ for (k=0; k<l1; k++)
++ cc[(k + j*l1)*ido] = ch[(k + j*l1)*ido];
++ if (nbd <= l1) {
++ is = -ido;
++ for (j=1; j<ip; j++) {
++ is += ido;
++ idij = is-1;
++ for (i=2; i<ido; i+=2) {
++ idij += 2;
++ for (k=0; k<l1; k++) {
++ cc[i - 1 + (k + j*l1)*ido] = wa[idij - 1]*ch[i - 1 + (k + j*l1)*ido] - wa[idij]*
++ ch[i + (k + j*l1)*ido];
++ cc[i + (k + j*l1)*ido] = wa[idij - 1]*ch[i + (k + j*l1)*ido] + wa[idij]*ch[i - 1 + (k + j*l1)*ido];
++ }
++ }
++ }
++ } else {
++ is = -ido;
++ for (j=1; j<ip; j++) {
++ is += ido;
++ for (k=0; k<l1; k++) {
++ idij = is - 1;
++ for (i=2; i<ido; i+=2) {
++ idij += 2;
++ cc[i - 1 + (k + j*l1)*ido] = wa[idij-1]*ch[i - 1 + (k + j*l1)*ido] - wa[idij]*
++ ch[i + (k + j*l1)*ido];
++ cc[i + (k + j*l1)*ido] = wa[idij-1]*ch[i + (k + j*l1)*ido] + wa[idij]*ch[i - 1 + (k + j*l1)*ido];
++ }
++ }
++ }
++ }
++ } /* radbg */
++
++ /* ----------------------------------------------------------------------
++cfftf1, cfftf, cfftb, cffti1, cffti. Complex FFTs.
++---------------------------------------------------------------------- */
++
++void fftpack_cfftf1(int n, Treal c[], Treal ch[], const Treal wa[], const int ifac[MAXFAC+2], int isign)
++ {
++ int idot, i;
++ int k1, l1, l2;
++ int na, nf, ip, iw, ix2, ix3, ix4, nac, ido, idl1;
++ Treal *cinput, *coutput;
++ nf = ifac[1];
++ na = 0;
++ l1 = 1;
++ iw = 0;
++ for (k1=2; k1<=nf+1; k1++) {
++ ip = ifac[k1];
++ l2 = ip*l1;
++ ido = n / l2;
++ idot = ido + ido;
++ idl1 = idot*l1;
++ if (na) {
++ cinput = ch;
++ coutput = c;
++ } else {
++ cinput = c;
++ coutput = ch;
++ }
++ switch (ip) {
++ case 4:
++ ix2 = iw + idot;
++ ix3 = ix2 + idot;
++ passf4(idot, l1, cinput, coutput, &wa[iw], &wa[ix2], &wa[ix3], isign);
++ na = !na;
++ break;
++ case 2:
++ passf2(idot, l1, cinput, coutput, &wa[iw], isign);
++ na = !na;
++ break;
++ case 3:
++ ix2 = iw + idot;
++ passf3(idot, l1, cinput, coutput, &wa[iw], &wa[ix2], isign);
++ na = !na;
++ break;
++ case 5:
++ ix2 = iw + idot;
++ ix3 = ix2 + idot;
++ ix4 = ix3 + idot;
++ passf5(idot, l1, cinput, coutput, &wa[iw], &wa[ix2], &wa[ix3], &wa[ix4], isign);
++ na = !na;
++ break;
++ default:
++ passf(&nac, idot, ip, l1, idl1, cinput, coutput, &wa[iw], isign);
++ if (nac != 0) na = !na;
++ }
++ l1 = l2;
++ iw += (ip - 1)*idot;
++ }
++ if (na == 0) return;
++ for (i=0; i<2*n; i++) c[i] = ch[i];
++ } /* cfftf1 */
++
++
++void fftpack_cfftf(int n, Treal c[], Treal wsave[])
++ {
++ int iw1, iw2;
++ if (n == 1) return;
++ iw1 = 2*n;
++ iw2 = iw1 + 2*n;
++ fftpack_cfftf1(n, c, wsave, wsave+iw1, (int*)(wsave+iw2), -1);
++ } /* cfftf */
++
++
++void fftpack_cfftb(int n, Treal c[], Treal wsave[])
++ {
++ int iw1, iw2;
++ if (n == 1) return;
++ iw1 = 2*n;
++ iw2 = iw1 + 2*n;
++ fftpack_cfftf1(n, c, wsave, wsave+iw1, (int*)(wsave+iw2), +1);
++ } /* cfftb */
++
++
++static void factorize(int n, int ifac[MAXFAC+2], const int ntryh[NSPECIAL])
++ /* Factorize n in factors in ntryh and rest. On exit,
++ifac[0] contains n and ifac[1] contains number of factors,
++the factors start from ifac[2]. */
++ {
++ int ntry=3, i, j=0, ib, nf=0, nl=n, nq, nr;
++startloop:
++ if (j < NSPECIAL)
++ ntry = ntryh[j];
++ else
++ ntry+= 2;
++ j++;
++ do {
++ nq = nl / ntry;
++ nr = nl - ntry*nq;
++ if (nr != 0) goto startloop;
++ nf++;
++ ifac[nf + 1] = ntry;
++ nl = nq;
++ if (ntry == 2 && nf != 1) {
++ for (i=2; i<=nf; i++) {
++ ib = nf - i + 2;
++ ifac[ib + 1] = ifac[ib];
++ }
++ ifac[2] = 2;
++ }
++ } while (nl != 1);
++ ifac[0] = n;
++ ifac[1] = nf;
++ }
++
++
++void fftpack_cffti1(int n, Treal wa[], int ifac[MAXFAC+2])
++ {
++ static const Treal twopi = 6.28318530717959;
++ Treal arg, argh, argld, fi;
++ int idot, i, j;
++ int i1, k1, l1, l2;
++ int ld, ii, nf, ip;
++ int ido, ipm;
++
++ static const int ntryh[NSPECIAL] = {
++ 3,4,2,5 }; /* Do not change the order of these. */
++
++ factorize(n,ifac,ntryh);
++ nf = ifac[1];
++ argh = twopi/(Treal)n;
++ i = 1;
++ l1 = 1;
++ for (k1=1; k1<=nf; k1++) {
++ ip = ifac[k1+1];
++ ld = 0;
++ l2 = l1*ip;
++ ido = n / l2;
++ idot = ido + ido + 2;
++ ipm = ip - 1;
++ for (j=1; j<=ipm; j++) {
++ i1 = i;
++ wa[i-1] = 1;
++ wa[i] = 0;
++ ld += l1;
++ fi = 0;
++ argld = ld*argh;
++ for (ii=4; ii<=idot; ii+=2) {
++ i+= 2;
++ fi+= 1;
++ arg = fi*argld;
++ wa[i-1] = cos(arg);
++ wa[i] = sin(arg);
++ }
++ if (ip > 5) {
++ wa[i1-1] = wa[i-1];
++ wa[i1] = wa[i];
++ }
++ }
++ l1 = l2;
++ }
++ } /* cffti1 */
++
++
++void fftpack_cffti(int n, Treal wsave[])
++ {
++ int iw1, iw2;
++ if (n == 1) return;
++ iw1 = 2*n;
++ iw2 = iw1 + 2*n;
++ fftpack_cffti1(n, wsave+iw1, (int*)(wsave+iw2));
++ } /* cffti */
++
++ /* ----------------------------------------------------------------------
++rfftf1, rfftb1, rfftf, rfftb, rffti1, rffti. Treal FFTs.
++---------------------------------------------------------------------- */
++
++void fftpack_rfftf1(int n, Treal c[], Treal ch[], const Treal wa[], const int ifac[MAXFAC+2])
++ {
++ int i;
++ int k1, l1, l2, na, kh, nf, ip, iw, ix2, ix3, ix4, ido, idl1;
++ Treal *cinput, *coutput;
++ nf = ifac[1];
++ na = 1;
++ l2 = n;
++ iw = n-1;
++ for (k1 = 1; k1 <= nf; ++k1) {
++ kh = nf - k1;
++ ip = ifac[kh + 2];
++ l1 = l2 / ip;
++ ido = n / l2;
++ idl1 = ido*l1;
++ iw -= (ip - 1)*ido;
++ na = !na;
++ if (na) {
++ cinput = ch;
++ coutput = c;
++ } else {
++ cinput = c;
++ coutput = ch;
++ }
++ switch (ip) {
++ case 4:
++ ix2 = iw + ido;
++ ix3 = ix2 + ido;
++ radf4(ido, l1, cinput, coutput, &wa[iw], &wa[ix2], &wa[ix3]);
++ break;
++ case 2:
++ radf2(ido, l1, cinput, coutput, &wa[iw]);
++ break;
++ case 3:
++ ix2 = iw + ido;
++ radf3(ido, l1, cinput, coutput, &wa[iw], &wa[ix2]);
++ break;
++ case 5:
++ ix2 = iw + ido;
++ ix3 = ix2 + ido;
++ ix4 = ix3 + ido;
++ radf5(ido, l1, cinput, coutput, &wa[iw], &wa[ix2], &wa[ix3], &wa[ix4]);
++ break;
++ default:
++ if (ido == 1)
++ na = !na;
++ if (na == 0) {
++ radfg(ido, ip, l1, idl1, c, ch, &wa[iw]);
++ na = 1;
++ } else {
++ radfg(ido, ip, l1, idl1, ch, c, &wa[iw]);
++ na = 0;
++ }
++ }
++ l2 = l1;
++ }
++ if (na == 1) return;
++ for (i = 0; i < n; i++) c[i] = ch[i];
++ } /* rfftf1 */
++
++
++void fftpack_rfftb1(int n, Treal c[], Treal ch[], const Treal wa[], const int ifac[MAXFAC+2])
++ {
++ int i;
++ int k1, l1, l2, na, nf, ip, iw, ix2, ix3, ix4, ido, idl1;
++ Treal *cinput, *coutput;
++ nf = ifac[1];
++ na = 0;
++ l1 = 1;
++ iw = 0;
++ for (k1=1; k1<=nf; k1++) {
++ ip = ifac[k1 + 1];
++ l2 = ip*l1;
++ ido = n / l2;
++ idl1 = ido*l1;
++ if (na) {
++ cinput = ch;
++ coutput = c;
++ } else {
++ cinput = c;
++ coutput = ch;
++ }
++ switch (ip) {
++ case 4:
++ ix2 = iw + ido;
++ ix3 = ix2 + ido;
++ radb4(ido, l1, cinput, coutput, &wa[iw], &wa[ix2], &wa[ix3]);
++ na = !na;
++ break;
++ case 2:
++ radb2(ido, l1, cinput, coutput, &wa[iw]);
++ na = !na;
++ break;
++ case 3:
++ ix2 = iw + ido;
++ radb3(ido, l1, cinput, coutput, &wa[iw], &wa[ix2]);
++ na = !na;
++ break;
++ case 5:
++ ix2 = iw + ido;
++ ix3 = ix2 + ido;
++ ix4 = ix3 + ido;
++ radb5(ido, l1, cinput, coutput, &wa[iw], &wa[ix2], &wa[ix3], &wa[ix4]);
++ na = !na;
++ break;
++ default:
++ radbg(ido, ip, l1, idl1, cinput, coutput, &wa[iw]);
++ if (ido == 1) na = !na;
++ }
++ l1 = l2;
++ iw += (ip - 1)*ido;
++ }
++ if (na == 0) return;
++ for (i=0; i<n; i++) c[i] = ch[i];
++ } /* rfftb1 */
++
++
++void fftpack_rfftf(int n, Treal r[], Treal wsave[])
++ {
++ if (n == 1) return;
++ fftpack_rfftf1(n, r, wsave, wsave+n, (int*)(wsave+2*n));
++ } /* rfftf */
++
++
++void fftpack_rfftb(int n, Treal r[], Treal wsave[])
++ {
++ if (n == 1) return;
++ fftpack_rfftb1(n, r, wsave, wsave+n, (int*)(wsave+2*n));
++ } /* rfftb */
++
++
++void fftpack_rffti1(int n, Treal wa[], int ifac[MAXFAC+2])
++ {
++ static const Treal twopi = 6.28318530717959;
++ Treal arg, argh, argld, fi;
++ int i, j;
++ int k1, l1, l2;
++ int ld, ii, nf, ip, is;
++ int ido, ipm, nfm1;
++ static const int ntryh[NSPECIAL] = {
++ 4,2,3,5 }; /* Do not change the order of these. */
++ factorize(n,ifac,ntryh);
++ nf = ifac[1];
++ argh = twopi / n;
++ is = 0;
++ nfm1 = nf - 1;
++ l1 = 1;
++ if (nfm1 == 0) return;
++ for (k1 = 1; k1 <= nfm1; k1++) {
++ ip = ifac[k1 + 1];
++ ld = 0;
++ l2 = l1*ip;
++ ido = n / l2;
++ ipm = ip - 1;
++ for (j = 1; j <= ipm; ++j) {
++ ld += l1;
++ i = is;
++ argld = (Treal) ld*argh;
++ fi = 0;
++ for (ii = 3; ii <= ido; ii += 2) {
++ i += 2;
++ fi += 1;
++ arg = fi*argld;
++ wa[i - 2] = cos(arg);
++ wa[i - 1] = sin(arg);
++ }
++ is += ido;
++ }
++ l1 = l2;
++ }
++ } /* rffti1 */
++
++
++void fftpack_rffti(int n, Treal wsave[])
++ {
++ if (n == 1) return;
++ fftpack_rffti1(n, wsave+n, (int*)(wsave+2*n));
++ } /* rffti */
++
++#ifdef __cplusplus
++}
++#endif
--- /dev/null
- int load_vmd_library(const char *fn, t_gmxvmdplugin *vmdplugin)
+/* -*- mode: c; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4; c-file-style: "stroustrup"; -*-
+ *
+ *
+ * This file is part of Gromacs Copyright (c) 1991-2008
+ * David van der Spoel, Erik Lindahl, Berk Hess, University of Groningen.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * To help us fund GROMACS development, we humbly ask that you cite
+ * the research papers on the package. Check out http://www.gromacs.org
+ *
+ * And Hey:
+ * Gnomes, ROck Monsters And Chili Sauce
+ */
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+#include "gromacs/utility/gmx_header_config.h"
+
+
+
+/* Derived from PluginMgr.C and catdcd.c */
+
+/* PluginMgr.C: Copyright: */
+/***************************************************************************
+ *cr
+ *cr (C) Copyright 1995-2009 The Board of Trustees of the
+ *cr University of Illinois
+ *cr All Rights Reserved
+ *cr
+Developed by: Theoretical and Computational Biophysics Group
+ University of Illinois at Urbana-Champaign
+ http://www.ks.uiuc.edu/
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the Software), to deal with
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+of the Software, and to permit persons to whom the Software is furnished to
+do so, subject to the following conditions:
+
+Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimers.
+
+Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimers in the documentation
+and/or other materials provided with the distribution.
+
+Neither the names of Theoretical and Computational Biophysics Group,
+University of Illinois at Urbana-Champaign, nor the names of its contributors
+may be used to endorse or promote products derived from this Software without
+specific prior written permission.
+
+THE SOFTWARE IS PROVIDED AS IS, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
+THE CONTRIBUTORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS WITH THE SOFTWARE.
+ ***************************************************************************/
+
+/* catdcd.c: Copyright: */
+/*****************************************************************************/
+/* */
+/* (C) Copyright 2001-2005 Justin Gullingsrud and the University of Illinois.*/
+/* */
+/*****************************************************************************/
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <assert.h>
+
+/*
+ * Plugin header files; get plugin source from www.ks.uiuc.edu/Research/vmd"
+ */
+#include "external/vmd_molfile/molfile_plugin.h"
+#include "external/vmd_molfile/vmddlopen.h"
+#ifndef GMX_NATIVE_WINDOWS
+#include <glob.h>
+#else
+#include <windows.h>
+#include <shlobj.h>
+#endif
+#include "smalloc.h"
+#include "futil.h"
+#include "vmdio.h"
+
+
+#include "types/simple.h"
+#include "vec.h"
+#include "gmxfio.h"
+
+
+typedef int (*initfunc)(void);
+typedef int (*regfunc)(void *, vmdplugin_register_cb);
+typedef int (*finifunc)(void);
+
+
+
+static int register_cb(void *v, vmdplugin_t *p) {
+ const char *key = p->name;
+ t_gmxvmdplugin *vmdplugin = (t_gmxvmdplugin*)v;
+
+ if (strcmp(key,vmdplugin->filetype)==0)
+ {
+ vmdplugin->api = (molfile_plugin_t *)p;
+ }
+ return VMDPLUGIN_SUCCESS;
+}
+
+static int load_sharedlibrary_plugins(const char *fullpath,t_gmxvmdplugin* vmdplugin) {
+ /* Open the dll; try to execute the init function. */
+ void *handle, *ifunc, *registerfunc;
+ handle = vmddlopen(fullpath);
+ if (!handle) {
+ if (debug) fprintf(debug, "\nUnable to open dynamic library %s.\n%s\n", fullpath, vmddlerror()); /*only to debug because of stdc++ erros */
+ return 0;
+ }
+
+ ifunc = vmddlsym(handle, "vmdplugin_init");
+ if (ifunc && ((initfunc)(ifunc))()) {
+ printf("\nvmdplugin_init() for %s returned an error; plugin(s) not loaded.\n", fullpath);
+ vmddlclose(handle);
+ return 0;
+ }
+
+ registerfunc = vmddlsym(handle, "vmdplugin_register");
+ if (!registerfunc) {
+ printf("\nDidn't find the register function in %s; plugin(s) not loaded.\n", fullpath);
+ vmddlclose(handle);
+ return 0;
+ } else {
+ /* Load plugins from the library.*/
+ ((regfunc)registerfunc)(vmdplugin, register_cb);
+ }
+
+ /* in case this library does not support the filetype, close it */
+ if (vmdplugin->api == NULL)
+ {
+ vmddlclose(handle);
+ }
+
+ return 1;
+}
+
+/*return: 1: success, 0: last frame, -1: error*/
+gmx_bool read_next_vmd_frame(int status,t_trxframe *fr)
+{
+ int rc,i;
+ rvec vec, angle;
+ molfile_timestep_t ts;
+
+
+ fr->bV = fr->vmdplugin->bV;
+
+#ifdef GMX_DOUBLE
+ snew(ts.coords, fr->natoms*3);
+ if (fr->bV)
+ {
+ snew(ts.velocities, fr->natoms*3);
+ }
+#else
+ ts.coords = (float*)fr->x;
+ if (fr->bV)
+ {
+ ts.velocities = (float*)fr->v;
+ }
+#endif
+
+ rc = fr->vmdplugin->api->read_next_timestep(fr->vmdplugin->handle, fr->natoms, &ts);
+
+ if (rc < -1) {
+ fprintf(stderr, "\nError reading input file (error code %d)\n", rc);
+ }
+ if (rc < 0)
+ {
+ fr->vmdplugin->api->close_file_read(fr->vmdplugin->handle);
+ return 0;
+ }
+
+#ifdef GMX_DOUBLE
+ for (i=0;i<fr->natoms;i++)
+ {
+ fr->x[i][0] = .1*ts.coords[i*3];
+ fr->x[i][1] = .1*ts.coords[i*3+1];
+ fr->x[i][2] = .1*ts.coords[i*3+2];
+ if (fr->bV)
+ {
+ fr->v[i][0] = .1*ts.velocities[i*3];
+ fr->v[i][1] = .1*ts.velocities[i*3+1];
+ fr->v[i][2] = .1*ts.velocities[i*3+2];
+ }
+ }
+ sfree(ts.coords);
+ if (fr->bV)
+ {
+ sfree(ts.velocities);
+ }
+#else
+ for (i=0;i<fr->natoms;i++)
+ {
+ svmul(.1,fr->x[i],fr->x[i]);
+ if (fr->bV)
+ {
+ svmul(.1,fr->v[i],fr->v[i]);
+ }
+ }
+#endif
+
+ fr->bX = 1;
+ fr->bBox = 1;
+ vec[0] = .1*ts.A; vec[1] = .1*ts.B; vec[2] = .1*ts.C;
+ angle[0] = ts.alpha; angle[1] = ts.beta; angle[2] = ts.gamma;
+ matrix_convert(fr->box,vec,angle);
+ if (fr->vmdplugin->api->abiversion>10)
+ {
+ fr->bTime = TRUE;
+ fr->time = ts.physical_time;
+ }
+ else
+ {
+ fr->bTime = FALSE;
+ }
+
+
+ return 1;
+}
+
++static int load_vmd_library(const char *fn, t_gmxvmdplugin *vmdplugin)
+{
+ char pathname[GMX_PATH_MAX],filename[GMX_PATH_MAX];
+ const char *pathenv;
+ const char *err;
+ int i;
+ int ret=0;
+ char pathenv_buffer[GMX_PATH_MAX];
+#ifndef GMX_NATIVE_WINDOWS
+ glob_t globbuf;
+ const char *defpath_suffix = "/plugins/*/molfile";
+ const char *defpathenv = GMX_VMD_PLUGIN_PATH;
+#else
+ WIN32_FIND_DATA ffd;
+ HANDLE hFind = INVALID_HANDLE_VALUE;
+ char progfolder[GMX_PATH_MAX];
+ char defpathenv[GMX_PATH_MAX];
+ const char *defpath_suffix = "\\plugins\\WIN32\\molfile";
+ SHGetFolderPath(NULL,CSIDL_PROGRAM_FILES,NULL,SHGFP_TYPE_CURRENT,progfolder);
+ sprintf(defpathenv,"%s\\University of Illinois\\VMD\\plugins\\WIN32\\molfile",progfolder);
+#endif
+
+ vmdplugin->api = NULL;
+ vmdplugin->filetype = strrchr(fn,'.');
+ if (!vmdplugin->filetype)
+ {
+ return 0;
+ }
+ vmdplugin->filetype++;
+
+ /* First look for an explicit path given at run time for the
+ * plugins, then an implicit run-time path, and finally for one
+ * given at configure time. This last might be hard-coded to the
+ * default for VMD installs. */
+ pathenv = getenv("VMD_PLUGIN_PATH");
+ if (pathenv==NULL)
+ {
+ pathenv = getenv("VMDDIR");
+ if (NULL == pathenv)
+ {
+ printf("\nNeither VMD_PLUGIN_PATH or VMDDIR set. ");
+ printf("Using default location:\n%s\n",defpathenv);
+ pathenv=defpathenv;
+ }
+ else
+ {
+ printf("\nVMD_PLUGIN_PATH no set, but VMDDIR is set. ");
+#ifdef _MSC_VER
+ _snprintf_s(pathenv_buffer, sizeof(pathenv_buffer), _TRUNCATE, "%s%s", pathenv, defpath_suffix);
+#else
+ snprintf(pathenv_buffer, sizeof(pathenv_buffer), "%s%s", pathenv, defpath_suffix);
+#endif
+ printf("Using semi-default location:\n%s\n",pathenv_buffer);
+ pathenv = pathenv_buffer;
+ }
+ }
+ strncpy(pathname,pathenv,sizeof(pathname));
+#ifndef GMX_NATIVE_WINDOWS
+ strcat(pathname,"/*.so");
+ glob(pathname, 0, NULL, &globbuf);
+ if (globbuf.gl_pathc == 0)
+ {
+ printf("\nNo VMD Plugins found\n"
+ "Set the environment variable VMD_PLUGIN_PATH to the molfile folder within the\n"
+ "VMD installation.\n"
+ "The architecture (e.g. 32bit versus 64bit) of Gromacs and VMD has to match.\n");
+ return 0;
+ }
+ for (i=0; i<globbuf.gl_pathc && vmdplugin->api == NULL; i++)
+ {
+ /* FIXME: Undefined which plugin is chosen if more than one plugin
+ can read a certain file ending. Requires some additional command
+ line option or enviroment variable to specify which plugin should
+ be picked.
+ */
+ ret|=load_sharedlibrary_plugins(globbuf.gl_pathv[i],vmdplugin);
+ }
+ globfree(&globbuf);
+#else
+ strcat(pathname,"\\*.so");
+ hFind = FindFirstFile(pathname, &ffd);
+ if (INVALID_HANDLE_VALUE == hFind)
+ {
+ printf("\nNo VMD Plugins found\n");
+ return 0;
+ }
+ do
+ {
+ sprintf(filename,"%s\\%s",pathenv,ffd.cFileName);
+ ret|=load_sharedlibrary_plugins(filename,vmdplugin);
+ }
+ while (FindNextFile(hFind, &ffd ) != 0 && vmdplugin->api == NULL );
+ FindClose(hFind);
+#endif
+
+ if (!ret)
+ {
+ printf("\nCould not open any VMD library.\n");
+ err = vmddlerror();
+ if (!err)
+ {
+ printf("Compiled with dlopen?\n");
+ }
+ else
+ {
+ printf("Last error:\n%s\n",err);
+ }
+ return 0;
+ }
+
+ if (vmdplugin->api == NULL)
+ {
+ printf("\nNo plugin for %s found\n",vmdplugin->filetype);
+ return 0;
+ }
+
+ if (vmdplugin->api->abiversion < 10)
+ {
+ printf("\nPlugin and/or VMD is too old. At least VMD 1.8.6 is required.\n");
+ return 0;
+ }
+
+ printf("\nUsing VMD plugin: %s (%s)\n",vmdplugin->api->name,vmdplugin->api->prettyname);
+
+ return 1;
+
+}
+
+int read_first_vmd_frame(int *status,const char *fn,t_trxframe *fr,int flags)
+{
+ molfile_timestep_metadata_t *metadata=NULL;
+
+ snew(fr->vmdplugin,1);
+ if (!load_vmd_library(fn,fr->vmdplugin))
+ {
+ return 0;
+ }
+
+ fr->vmdplugin->handle = fr->vmdplugin->api->open_file_read(fn, fr->vmdplugin->filetype, &fr->natoms);
+
+ if (!fr->vmdplugin->handle) {
+ fprintf(stderr, "\nError: could not open file '%s' for reading.\n",
+ fn);
+ return 0;
+ }
+
+ if (fr->natoms == MOLFILE_NUMATOMS_UNKNOWN) {
+ fprintf(stderr, "\nFormat of file %s does not record number of atoms.\n", fn);
+ return 0;
+ } else if (fr->natoms == MOLFILE_NUMATOMS_NONE) {
+ fprintf(stderr, "\nNo atoms found by VMD plugin in file %s.\n", fn );
+ return 0;
+ } else if (fr->natoms < 1) { /*should not be reached*/
+ fprintf(stderr, "\nUnknown number of atoms %d for VMD plugin opening file %s.\n",
+ fr->natoms, fn );
+ return 0;
+ }
+
+ snew(fr->x,fr->natoms);
+
+ fr->vmdplugin->bV = 0;
+ if (fr->vmdplugin->api->abiversion > 10 && fr->vmdplugin->api->read_timestep_metadata)
+ {
+ fr->vmdplugin->api->read_timestep_metadata(fr->vmdplugin->handle, metadata);
+ assert(metadata);
+ fr->vmdplugin->bV = metadata->has_velocities;
+ if (fr->vmdplugin->bV)
+ {
+ snew(fr->v,fr->natoms);
+ }
+ }
+ else
+ {
+ fprintf(stderr,
+ "\nThis trajectory is being read with a VMD plug-in from before VMD"
+ "\nversion 1.8, or from a trajectory that lacks time step metadata."
+ "\nEither way, GROMACS cannot tell whether the trajectory has velocities.\n");
+ }
+ return 1;
+
+}
--- /dev/null
- int load_vmd_library(const char *fn, t_gmxvmdplugin *vmdplugin);
+/* -*- mode: c; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4; c-file-style: "stroustrup"; -*-
+ *
+ *
+ * This file is part of Gromacs Copyright (c) 1991-2008
+ * David van der Spoel, Erik Lindahl, Berk Hess, University of Groningen.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * To help us fund GROMACS development, we humbly ask that you cite
+ * the research papers on the package. Check out http://www.gromacs.org
+ *
+ * And Hey:
+ * Gnomes, ROck Monsters And Chili Sauce
+ */
+
+#ifndef VMDIO_H_
+#define VMDIO_H_
+
+#include "external/vmd_molfile/molfile_plugin.h"
+#include "types/trx.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+struct gmxvmdplugin
+{
+ molfile_plugin_t *api;
+ const char* filetype;
+ void* handle;
+ gmx_bool bV;
+};
+
+int read_first_vmd_frame(int *status,const char *fn, struct trxframe *fr,int flags);
+gmx_bool read_next_vmd_frame(int status,struct trxframe *fr);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* VMDIO_H_ */
--- /dev/null
- return (real)sqrt(a[XX]*a[XX]+a[YY]*a[YY]+a[ZZ]*a[ZZ]);
+/*
+ *
+ * This source code is part of
+ *
+ * G R O M A C S
+ *
+ * GROningen MAchine for Chemical Simulations
+ *
+ * VERSION 3.2.0
+ * Written by David van der Spoel, Erik Lindahl, Berk Hess, and others.
+ * Copyright (c) 1991-2000, University of Groningen, The Netherlands.
+ * Copyright (c) 2001-2004, The GROMACS development team,
+ * check out http://www.gromacs.org for more information.
+
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * If you want to redistribute modifications, please consider that
+ * scientific software is very special. Version control is crucial -
+ * bugs must be traceable. We will be happy to consider code for
+ * inclusion in the official distribution, but derived work must not
+ * be called official GROMACS. Details are found in the README & COPYING
+ * files - if they are missing, get the official version at www.gromacs.org.
+ *
+ * To help us fund GROMACS development, we humbly ask that you cite
+ * the papers on the package - you can find them in the top README file.
+ *
+ * For more info, check our website at http://www.gromacs.org
+ *
+ * And Hey:
+ * Gromacs Runs On Most of All Computer Systems
+ */
+#ifndef _vec_h
+#define _vec_h
+
+/*
+ collection of in-line ready operations:
+
+ lookup-table optimized scalar operations:
+ real gmx_invsqrt(real x)
+ void vecinvsqrt(real in[],real out[],int n)
+ void vecrecip(real in[],real out[],int n)
+ real sqr(real x)
+ double dsqr(double x)
+
+ vector operations:
+ void rvec_add(const rvec a,const rvec b,rvec c) c = a + b
+ void dvec_add(const dvec a,const dvec b,dvec c) c = a + b
+ void ivec_add(const ivec a,const ivec b,ivec c) c = a + b
+ void rvec_inc(rvec a,const rvec b) a += b
+ void dvec_inc(dvec a,const dvec b) a += b
+ void ivec_inc(ivec a,const ivec b) a += b
+ void rvec_sub(const rvec a,const rvec b,rvec c) c = a - b
+ void dvec_sub(const dvec a,const dvec b,dvec c) c = a - b
+ void rvec_dec(rvec a,rvec b) a -= b
+ void copy_rvec(const rvec a,rvec b) b = a (reals)
+ void copy_dvec(const dvec a,dvec b) b = a (reals)
+ void copy_ivec(const ivec a,ivec b) b = a (integers)
+ void ivec_sub(const ivec a,const ivec b,ivec c) c = a - b
+ void svmul(real a,rvec v1,rvec v2) v2 = a * v1
+ void dsvmul(double a,dvec v1,dvec v2) v2 = a * v1
+ void clear_rvec(rvec a) a = 0
+ void clear_dvec(dvec a) a = 0
+ void clear_ivec(rvec a) a = 0
+ void clear_rvecs(int n,rvec v[])
+ real iprod(rvec a,rvec b) = a . b (inner product)
+ double diprod(dvec a,dvec b) = a . b (inner product)
+ real iiprod(ivec a,ivec b) = a . b (integers)
+ real norm2(rvec a) = | a |^2 ( = x*y*z )
+ double dnorm2(dvec a) = | a |^2 ( = x*y*z )
+ real norm(rvec a) = | a |
+ double dnorm(dvec a) = | a |
+ void cprod(rvec a,rvec b,rvec c) c = a x b (cross product)
+ void dprod(rvec a,rvec b,rvec c) c = a x b (cross product)
+ void dprod(rvec a,rvec b,rvec c) c = a * b (direct product)
+ real cos_angle(rvec a,rvec b)
+ real cos_angle_no_table(rvec a,rvec b)
+ real distance2(rvec v1, rvec v2) = | v2 - v1 |^2
+ void unitv(rvec src,rvec dest) dest = src / |src|
+ void unitv_no_table(rvec src,rvec dest) dest = src / |src|
+
+ matrix (3x3) operations:
+ ! indicates that dest should not be the same as a, b or src
+ the _ur0 varieties work on matrices that have only zeros
+ in the upper right part, such as box matrices, these varieties
+ could produce less rounding errors, not due to the operations themselves,
+ but because the compiler can easier recombine the operations
+ void copy_mat(matrix a,matrix b) b = a
+ void clear_mat(matrix a) a = 0
+ void mmul(matrix a,matrix b,matrix dest) ! dest = a . b
+ void mmul_ur0(matrix a,matrix b,matrix dest) dest = a . b
+ void transpose(matrix src,matrix dest) ! dest = src*
+ void tmmul(matrix a,matrix b,matrix dest) ! dest = a* . b
+ void mtmul(matrix a,matrix b,matrix dest) ! dest = a . b*
+ real det(matrix a) = det(a)
+ void m_add(matrix a,matrix b,matrix dest) dest = a + b
+ void m_sub(matrix a,matrix b,matrix dest) dest = a - b
+ void msmul(matrix m1,real r1,matrix dest) dest = r1 * m1
+ void m_inv_ur0(matrix src,matrix dest) dest = src^-1
+ void m_inv(matrix src,matrix dest) ! dest = src^-1
+ void mvmul(matrix a,rvec src,rvec dest) ! dest = a . src
+ void mvmul_ur0(matrix a,rvec src,rvec dest) dest = a . src
+ void tmvmul_ur0(matrix a,rvec src,rvec dest) dest = a* . src
+ real trace(matrix m) = trace(m)
+*/
+
+#include "types/simple.h"
+#include "maths.h"
+#include "typedefs.h"
+#include "sysstuff.h"
+#include "gmx_fatal.h"
+#include "physics.h"
+
+#ifdef __cplusplus
+extern "C" {
+#elif 0
+} /* avoid screwing up indentation */
+#endif
+
+
+#define EXP_LSB 0x00800000
+#define EXP_MASK 0x7f800000
+#define EXP_SHIFT 23
+#define FRACT_MASK 0x007fffff
+#define FRACT_SIZE 11 /* significant part of fraction */
+#define FRACT_SHIFT (EXP_SHIFT-FRACT_SIZE)
+#define EXP_ADDR(val) (((val)&EXP_MASK)>>EXP_SHIFT)
+#define FRACT_ADDR(val) (((val)&(FRACT_MASK|EXP_LSB))>>FRACT_SHIFT)
+
+#define PR_VEC(a) a[XX],a[YY],a[ZZ]
+
+#ifdef GMX_SOFTWARE_INVSQRT
+extern const unsigned int * gmx_invsqrt_exptab;
+extern const unsigned int * gmx_invsqrt_fracttab;
+#endif
+
+
+typedef union
+{
+ unsigned int bval;
+ float fval;
+} t_convert;
+
+
+#ifdef GMX_SOFTWARE_INVSQRT
+static real gmx_invsqrt(real x)
+{
+ const real half=0.5;
+ const real three=3.0;
+ t_convert result,bit_pattern;
+ unsigned int exp,fract;
+ real lu;
+ real y;
+#ifdef GMX_DOUBLE
+ real y2;
+#endif
+
+ bit_pattern.fval=x;
+ exp = EXP_ADDR(bit_pattern.bval);
+ fract = FRACT_ADDR(bit_pattern.bval);
+ result.bval=gmx_invsqrt_exptab[exp] | gmx_invsqrt_fracttab[fract];
+ lu = result.fval;
+
+ y=(half*lu*(three-((x*lu)*lu)));
+#ifdef GMX_DOUBLE
+ y2=(half*y*(three-((x*y)*y)));
+
+ return y2; /* 10 Flops */
+#else
+ return y; /* 5 Flops */
+#endif
+}
+#define INVSQRT_DONE
+#endif /* gmx_invsqrt */
+
+#ifdef GMX_POWERPC_SQRT
+static real gmx_invsqrt(real x)
+{
+ const real half=0.5;
+ const real three=3.0;
+ t_convert result,bit_pattern;
+ unsigned int exp,fract;
+ real lu;
+ real y;
+#ifdef GMX_DOUBLE
+ real y2;
+#endif
+
+ lu = __frsqrte((double)x);
+
+ y=(half*lu*(three-((x*lu)*lu)));
+
+#if (GMX_POWERPC_SQRT==2)
+ /* Extra iteration required */
+ y=(half*y*(three-((x*y)*y)));
+#endif
+
+#ifdef GMX_DOUBLE
+ y2=(half*y*(three-((x*y)*y)));
+
+ return y2; /* 10 Flops */
+#else
+ return y; /* 5 Flops */
+#endif
+}
+#define INVSQRT_DONE
+#endif /* powerpc_invsqrt */
+
+
+#ifndef INVSQRT_DONE
+#define gmx_invsqrt(x) (1.0f/sqrt(x))
+#endif
+
+
+
+
+
+static real sqr(real x)
+{
+ return (x*x);
+}
+
+static gmx_inline double dsqr(double x)
+{
+ return (x*x);
+}
+
+/* Maclaurin series for sinh(x)/x, useful for NH chains and MTTK pressure control
+ Here, we compute it to 10th order, which might be overkill, 8th is probably enough,
+ but it's not very much more expensive. */
+
+static gmx_inline real series_sinhx(real x)
+{
+ real x2 = x*x;
+ return (1 + (x2/6.0)*(1 + (x2/20.0)*(1 + (x2/42.0)*(1 + (x2/72.0)*(1 + (x2/110.0))))));
+}
+
+void vecinvsqrt(real in[],real out[],int n);
+/* Perform out[i]=1.0/sqrt(in[i]) for n elements */
+
+
+void vecrecip(real in[],real out[],int n);
+/* Perform out[i]=1.0/(in[i]) for n elements */
+
+/* Note: If you need a fast version of vecinvsqrt
+ * and/or vecrecip, call detectcpu() and run the SSE/3DNow/SSE2/Altivec
+ * versions if your hardware supports it.
+ *
+ * To use those routines, your memory HAS TO BE CACHE-ALIGNED.
+ * Use snew_aligned(ptr,size,32) to allocate and sfree_aligned to free.
+ */
+
+
+static gmx_inline void rvec_add(const rvec a,const rvec b,rvec c)
+{
+ real x,y,z;
+
+ x=a[XX]+b[XX];
+ y=a[YY]+b[YY];
+ z=a[ZZ]+b[ZZ];
+
+ c[XX]=x;
+ c[YY]=y;
+ c[ZZ]=z;
+}
+
+static gmx_inline void dvec_add(const dvec a,const dvec b,dvec c)
+{
+ double x,y,z;
+
+ x=a[XX]+b[XX];
+ y=a[YY]+b[YY];
+ z=a[ZZ]+b[ZZ];
+
+ c[XX]=x;
+ c[YY]=y;
+ c[ZZ]=z;
+}
+
+static gmx_inline void ivec_add(const ivec a,const ivec b,ivec c)
+{
+ int x,y,z;
+
+ x=a[XX]+b[XX];
+ y=a[YY]+b[YY];
+ z=a[ZZ]+b[ZZ];
+
+ c[XX]=x;
+ c[YY]=y;
+ c[ZZ]=z;
+}
+
+static gmx_inline void rvec_inc(rvec a,const rvec b)
+{
+ real x,y,z;
+
+ x=a[XX]+b[XX];
+ y=a[YY]+b[YY];
+ z=a[ZZ]+b[ZZ];
+
+ a[XX]=x;
+ a[YY]=y;
+ a[ZZ]=z;
+}
+
+static gmx_inline void dvec_inc(dvec a,const dvec b)
+{
+ double x,y,z;
+
+ x=a[XX]+b[XX];
+ y=a[YY]+b[YY];
+ z=a[ZZ]+b[ZZ];
+
+ a[XX]=x;
+ a[YY]=y;
+ a[ZZ]=z;
+}
+
+static gmx_inline void rvec_sub(const rvec a,const rvec b,rvec c)
+{
+ real x,y,z;
+
+ x=a[XX]-b[XX];
+ y=a[YY]-b[YY];
+ z=a[ZZ]-b[ZZ];
+
+ c[XX]=x;
+ c[YY]=y;
+ c[ZZ]=z;
+}
+
+static gmx_inline void dvec_sub(const dvec a,const dvec b,dvec c)
+{
+ double x,y,z;
+
+ x=a[XX]-b[XX];
+ y=a[YY]-b[YY];
+ z=a[ZZ]-b[ZZ];
+
+ c[XX]=x;
+ c[YY]=y;
+ c[ZZ]=z;
+}
+
+static gmx_inline void rvec_dec(rvec a,const rvec b)
+{
+ real x,y,z;
+
+ x=a[XX]-b[XX];
+ y=a[YY]-b[YY];
+ z=a[ZZ]-b[ZZ];
+
+ a[XX]=x;
+ a[YY]=y;
+ a[ZZ]=z;
+}
+
+static gmx_inline void copy_rvec(const rvec a,rvec b)
+{
+ b[XX]=a[XX];
+ b[YY]=a[YY];
+ b[ZZ]=a[ZZ];
+}
+
+static gmx_inline void copy_rvecn(rvec *a,rvec *b,int startn, int endn)
+{
+ int i;
+ for (i=startn;i<endn;i++) {
+ b[i][XX]=a[i][XX];
+ b[i][YY]=a[i][YY];
+ b[i][ZZ]=a[i][ZZ];
+ }
+}
+
+static gmx_inline void copy_dvec(const dvec a,dvec b)
+{
+ b[XX]=a[XX];
+ b[YY]=a[YY];
+ b[ZZ]=a[ZZ];
+}
+
+static gmx_inline void copy_ivec(const ivec a,ivec b)
+{
+ b[XX]=a[XX];
+ b[YY]=a[YY];
+ b[ZZ]=a[ZZ];
+}
+
+static gmx_inline void ivec_sub(const ivec a,const ivec b,ivec c)
+{
+ int x,y,z;
+
+ x=a[XX]-b[XX];
+ y=a[YY]-b[YY];
+ z=a[ZZ]-b[ZZ];
+
+ c[XX]=x;
+ c[YY]=y;
+ c[ZZ]=z;
+}
+
+static gmx_inline void copy_mat(matrix a,matrix b)
+{
+ copy_rvec(a[XX],b[XX]);
+ copy_rvec(a[YY],b[YY]);
+ copy_rvec(a[ZZ],b[ZZ]);
+}
+
+static gmx_inline void svmul(real a,const rvec v1,rvec v2)
+{
+ v2[XX]=a*v1[XX];
+ v2[YY]=a*v1[YY];
+ v2[ZZ]=a*v1[ZZ];
+}
+
+static gmx_inline void dsvmul(double a,const dvec v1,dvec v2)
+{
+ v2[XX]=a*v1[XX];
+ v2[YY]=a*v1[YY];
+ v2[ZZ]=a*v1[ZZ];
+}
+
+static gmx_inline real distance2(const rvec v1,const rvec v2)
+{
+ return sqr(v2[XX]-v1[XX]) + sqr(v2[YY]-v1[YY]) + sqr(v2[ZZ]-v1[ZZ]);
+}
+
+static gmx_inline void clear_rvec(rvec a)
+{
+ /* The ibm compiler has problems with inlining this
+ * when we use a const real variable
+ */
+ a[XX]=0.0;
+ a[YY]=0.0;
+ a[ZZ]=0.0;
+}
+
+static gmx_inline void clear_dvec(dvec a)
+{
+ /* The ibm compiler has problems with inlining this
+ * when we use a const real variable
+ */
+ a[XX]=0.0;
+ a[YY]=0.0;
+ a[ZZ]=0.0;
+}
+
+static gmx_inline void clear_ivec(ivec a)
+{
+ a[XX]=0;
+ a[YY]=0;
+ a[ZZ]=0;
+}
+
+static gmx_inline void clear_rvecs(int n,rvec v[])
+{
+/* memset(v[0],0,DIM*n*sizeof(v[0][0])); */
+ int i;
+
+ for(i=0; (i<n); i++)
+ clear_rvec(v[i]);
+}
+
+static gmx_inline void clear_mat(matrix a)
+{
+/* memset(a[0],0,DIM*DIM*sizeof(a[0][0])); */
+
+ const real nul=0.0;
+
+ a[XX][XX]=a[XX][YY]=a[XX][ZZ]=nul;
+ a[YY][XX]=a[YY][YY]=a[YY][ZZ]=nul;
+ a[ZZ][XX]=a[ZZ][YY]=a[ZZ][ZZ]=nul;
+}
+
+static gmx_inline real iprod(const rvec a,const rvec b)
+{
+ return (a[XX]*b[XX]+a[YY]*b[YY]+a[ZZ]*b[ZZ]);
+}
+
+static gmx_inline double diprod(const dvec a,const dvec b)
+{
+ return (a[XX]*b[XX]+a[YY]*b[YY]+a[ZZ]*b[ZZ]);
+}
+
+static gmx_inline int iiprod(const ivec a,const ivec b)
+{
+ return (a[XX]*b[XX]+a[YY]*b[YY]+a[ZZ]*b[ZZ]);
+}
+
+static gmx_inline real norm2(const rvec a)
+{
+ return a[XX]*a[XX]+a[YY]*a[YY]+a[ZZ]*a[ZZ];
+}
+
+static gmx_inline double dnorm2(const dvec a)
+{
+ return a[XX]*a[XX]+a[YY]*a[YY]+a[ZZ]*a[ZZ];
+}
+
++/* WARNING:
++ * As dnorm() uses sqrt() (which is slow) _only_ use it if you are sure you
++ * don't need 1/dnorm(), otherwise use dnorm2()*dinvnorm(). */
++static gmx_inline double dnorm(const dvec a)
++{
++ return sqrt(diprod(a, a));
++}
++
++/* WARNING:
++ * As norm() uses sqrtf() (which is slow) _only_ use it if you are sure you
++ * don't need 1/norm(), otherwise use norm2()*invnorm(). */
+static gmx_inline real norm(const rvec a)
+{
- static gmx_inline double dnorm(const dvec a)
++ /* This is ugly, but we deliberately do not define gmx_sqrt() and handle the
++ * float/double case here instead to avoid gmx_sqrt() being accidentally used. */
++#ifdef GMX_DOUBLE
++ return dnorm(a);
++#else
++ return sqrtf(iprod(a, a));
++#endif
+}
+
- return sqrt(a[XX]*a[XX]+a[YY]*a[YY]+a[ZZ]*a[ZZ]);
++static gmx_inline real invnorm(const rvec a)
++{
++ return gmx_invsqrt(norm2(a));
++}
++
++static gmx_inline real dinvnorm(const dvec a)
+{
++ return gmx_invsqrt(dnorm2(a));
+}
+
+/* WARNING:
+ * Do _not_ use these routines to calculate the angle between two vectors
+ * as acos(cos_angle(u,v)). While it might seem obvious, the acos function
+ * is very flat close to -1 and 1, which will lead to accuracy-loss.
+ * Instead, use the new gmx_angle() function directly.
+ */
+static gmx_inline real
+cos_angle(const rvec a,const rvec b)
+{
+ /*
+ * ax*bx + ay*by + az*bz
+ * cos-vec (a,b) = ---------------------
+ * ||a|| * ||b||
+ */
+ real cosval;
+ int m;
+ double aa,bb,ip,ipa,ipb,ipab; /* For accuracy these must be double! */
+
+ ip=ipa=ipb=0.0;
+ for(m=0; (m<DIM); m++) { /* 18 */
+ aa = a[m];
+ bb = b[m];
+ ip += aa*bb;
+ ipa += aa*aa;
+ ipb += bb*bb;
+ }
+ ipab = ipa*ipb;
+ if (ipab > 0)
+ cosval = ip*gmx_invsqrt(ipab); /* 7 */
+ else
+ cosval = 1;
+ /* 25 TOTAL */
+ if (cosval > 1.0)
+ return 1.0;
+ if (cosval <-1.0)
+ return -1.0;
+
+ return cosval;
+}
+
+/* WARNING:
+ * Do _not_ use these routines to calculate the angle between two vectors
+ * as acos(cos_angle(u,v)). While it might seem obvious, the acos function
+ * is very flat close to -1 and 1, which will lead to accuracy-loss.
+ * Instead, use the new gmx_angle() function directly.
+ */
+static gmx_inline real
+cos_angle_no_table(const rvec a,const rvec b)
+{
+ /* This version does not need the invsqrt lookup table */
+ real cosval;
+ int m;
+ double aa,bb,ip,ipa,ipb; /* For accuracy these must be double! */
+
+ ip=ipa=ipb=0.0;
+ for(m=0; (m<DIM); m++) { /* 18 */
+ aa = a[m];
+ bb = b[m];
+ ip += aa*bb;
+ ipa += aa*aa;
+ ipb += bb*bb;
+ }
+ cosval=ip/sqrt(ipa*ipb); /* 12 */
+ /* 30 TOTAL */
+ if (cosval > 1.0)
+ return 1.0;
+ if (cosval <-1.0)
+ return -1.0;
+
+ return cosval;
+}
+
+
+static gmx_inline void cprod(const rvec a,const rvec b,rvec c)
+{
+ c[XX]=a[YY]*b[ZZ]-a[ZZ]*b[YY];
+ c[YY]=a[ZZ]*b[XX]-a[XX]*b[ZZ];
+ c[ZZ]=a[XX]*b[YY]-a[YY]*b[XX];
+}
+
+static gmx_inline void dcprod(const dvec a,const dvec b,dvec c)
+{
+ c[XX]=a[YY]*b[ZZ]-a[ZZ]*b[YY];
+ c[YY]=a[ZZ]*b[XX]-a[XX]*b[ZZ];
+ c[ZZ]=a[XX]*b[YY]-a[YY]*b[XX];
+}
+
+/* This routine calculates the angle between a & b without any loss of accuracy close to 0/PI.
+ * If you only need cos(theta), use the cos_angle() routines to save a few cycles.
+ * This routine is faster than it might appear, since atan2 is accelerated on many CPUs (e.g. x86).
+ */
+static gmx_inline real
+gmx_angle(const rvec a, const rvec b)
+{
+ rvec w;
+ real wlen,s;
+
+ cprod(a,b,w);
+
+ wlen = norm(w);
+ s = iprod(a,b);
+
+ return atan2(wlen,s);
+}
+
+static gmx_inline void mmul_ur0(matrix a,matrix b,matrix dest)
+{
+ dest[XX][XX]=a[XX][XX]*b[XX][XX];
+ dest[XX][YY]=0.0;
+ dest[XX][ZZ]=0.0;
+ dest[YY][XX]=a[YY][XX]*b[XX][XX]+a[YY][YY]*b[YY][XX];
+ dest[YY][YY]= a[YY][YY]*b[YY][YY];
+ dest[YY][ZZ]=0.0;
+ dest[ZZ][XX]=a[ZZ][XX]*b[XX][XX]+a[ZZ][YY]*b[YY][XX]+a[ZZ][ZZ]*b[ZZ][XX];
+ dest[ZZ][YY]= a[ZZ][YY]*b[YY][YY]+a[ZZ][ZZ]*b[ZZ][YY];
+ dest[ZZ][ZZ]= a[ZZ][ZZ]*b[ZZ][ZZ];
+}
+
+static gmx_inline void mmul(matrix a,matrix b,matrix dest)
+{
+ dest[XX][XX]=a[XX][XX]*b[XX][XX]+a[XX][YY]*b[YY][XX]+a[XX][ZZ]*b[ZZ][XX];
+ dest[YY][XX]=a[YY][XX]*b[XX][XX]+a[YY][YY]*b[YY][XX]+a[YY][ZZ]*b[ZZ][XX];
+ dest[ZZ][XX]=a[ZZ][XX]*b[XX][XX]+a[ZZ][YY]*b[YY][XX]+a[ZZ][ZZ]*b[ZZ][XX];
+ dest[XX][YY]=a[XX][XX]*b[XX][YY]+a[XX][YY]*b[YY][YY]+a[XX][ZZ]*b[ZZ][YY];
+ dest[YY][YY]=a[YY][XX]*b[XX][YY]+a[YY][YY]*b[YY][YY]+a[YY][ZZ]*b[ZZ][YY];
+ dest[ZZ][YY]=a[ZZ][XX]*b[XX][YY]+a[ZZ][YY]*b[YY][YY]+a[ZZ][ZZ]*b[ZZ][YY];
+ dest[XX][ZZ]=a[XX][XX]*b[XX][ZZ]+a[XX][YY]*b[YY][ZZ]+a[XX][ZZ]*b[ZZ][ZZ];
+ dest[YY][ZZ]=a[YY][XX]*b[XX][ZZ]+a[YY][YY]*b[YY][ZZ]+a[YY][ZZ]*b[ZZ][ZZ];
+ dest[ZZ][ZZ]=a[ZZ][XX]*b[XX][ZZ]+a[ZZ][YY]*b[YY][ZZ]+a[ZZ][ZZ]*b[ZZ][ZZ];
+}
+
+static gmx_inline void transpose(matrix src,matrix dest)
+{
+ dest[XX][XX]=src[XX][XX];
+ dest[YY][XX]=src[XX][YY];
+ dest[ZZ][XX]=src[XX][ZZ];
+ dest[XX][YY]=src[YY][XX];
+ dest[YY][YY]=src[YY][YY];
+ dest[ZZ][YY]=src[YY][ZZ];
+ dest[XX][ZZ]=src[ZZ][XX];
+ dest[YY][ZZ]=src[ZZ][YY];
+ dest[ZZ][ZZ]=src[ZZ][ZZ];
+}
+
+static gmx_inline void tmmul(matrix a,matrix b,matrix dest)
+{
+ /* Computes dest=mmul(transpose(a),b,dest) - used in do_pr_pcoupl */
+ dest[XX][XX]=a[XX][XX]*b[XX][XX]+a[YY][XX]*b[YY][XX]+a[ZZ][XX]*b[ZZ][XX];
+ dest[XX][YY]=a[XX][XX]*b[XX][YY]+a[YY][XX]*b[YY][YY]+a[ZZ][XX]*b[ZZ][YY];
+ dest[XX][ZZ]=a[XX][XX]*b[XX][ZZ]+a[YY][XX]*b[YY][ZZ]+a[ZZ][XX]*b[ZZ][ZZ];
+ dest[YY][XX]=a[XX][YY]*b[XX][XX]+a[YY][YY]*b[YY][XX]+a[ZZ][YY]*b[ZZ][XX];
+ dest[YY][YY]=a[XX][YY]*b[XX][YY]+a[YY][YY]*b[YY][YY]+a[ZZ][YY]*b[ZZ][YY];
+ dest[YY][ZZ]=a[XX][YY]*b[XX][ZZ]+a[YY][YY]*b[YY][ZZ]+a[ZZ][YY]*b[ZZ][ZZ];
+ dest[ZZ][XX]=a[XX][ZZ]*b[XX][XX]+a[YY][ZZ]*b[YY][XX]+a[ZZ][ZZ]*b[ZZ][XX];
+ dest[ZZ][YY]=a[XX][ZZ]*b[XX][YY]+a[YY][ZZ]*b[YY][YY]+a[ZZ][ZZ]*b[ZZ][YY];
+ dest[ZZ][ZZ]=a[XX][ZZ]*b[XX][ZZ]+a[YY][ZZ]*b[YY][ZZ]+a[ZZ][ZZ]*b[ZZ][ZZ];
+}
+
+static gmx_inline void mtmul(matrix a,matrix b,matrix dest)
+{
+ /* Computes dest=mmul(a,transpose(b),dest) - used in do_pr_pcoupl */
+ dest[XX][XX]=a[XX][XX]*b[XX][XX]+a[XX][YY]*b[XX][YY]+a[XX][ZZ]*b[XX][ZZ];
+ dest[XX][YY]=a[XX][XX]*b[YY][XX]+a[XX][YY]*b[YY][YY]+a[XX][ZZ]*b[YY][ZZ];
+ dest[XX][ZZ]=a[XX][XX]*b[ZZ][XX]+a[XX][YY]*b[ZZ][YY]+a[XX][ZZ]*b[ZZ][ZZ];
+ dest[YY][XX]=a[YY][XX]*b[XX][XX]+a[YY][YY]*b[XX][YY]+a[YY][ZZ]*b[XX][ZZ];
+ dest[YY][YY]=a[YY][XX]*b[YY][XX]+a[YY][YY]*b[YY][YY]+a[YY][ZZ]*b[YY][ZZ];
+ dest[YY][ZZ]=a[YY][XX]*b[ZZ][XX]+a[YY][YY]*b[ZZ][YY]+a[YY][ZZ]*b[ZZ][ZZ];
+ dest[ZZ][XX]=a[ZZ][XX]*b[XX][XX]+a[ZZ][YY]*b[XX][YY]+a[ZZ][ZZ]*b[XX][ZZ];
+ dest[ZZ][YY]=a[ZZ][XX]*b[YY][XX]+a[ZZ][YY]*b[YY][YY]+a[ZZ][ZZ]*b[YY][ZZ];
+ dest[ZZ][ZZ]=a[ZZ][XX]*b[ZZ][XX]+a[ZZ][YY]*b[ZZ][YY]+a[ZZ][ZZ]*b[ZZ][ZZ];
+}
+
+static gmx_inline real det(matrix a)
+{
+ return ( a[XX][XX]*(a[YY][YY]*a[ZZ][ZZ]-a[ZZ][YY]*a[YY][ZZ])
+ -a[YY][XX]*(a[XX][YY]*a[ZZ][ZZ]-a[ZZ][YY]*a[XX][ZZ])
+ +a[ZZ][XX]*(a[XX][YY]*a[YY][ZZ]-a[YY][YY]*a[XX][ZZ]));
+}
+
+static gmx_inline void m_add(matrix a,matrix b,matrix dest)
+{
+ dest[XX][XX]=a[XX][XX]+b[XX][XX];
+ dest[XX][YY]=a[XX][YY]+b[XX][YY];
+ dest[XX][ZZ]=a[XX][ZZ]+b[XX][ZZ];
+ dest[YY][XX]=a[YY][XX]+b[YY][XX];
+ dest[YY][YY]=a[YY][YY]+b[YY][YY];
+ dest[YY][ZZ]=a[YY][ZZ]+b[YY][ZZ];
+ dest[ZZ][XX]=a[ZZ][XX]+b[ZZ][XX];
+ dest[ZZ][YY]=a[ZZ][YY]+b[ZZ][YY];
+ dest[ZZ][ZZ]=a[ZZ][ZZ]+b[ZZ][ZZ];
+}
+
+static gmx_inline void m_sub(matrix a,matrix b,matrix dest)
+{
+ dest[XX][XX]=a[XX][XX]-b[XX][XX];
+ dest[XX][YY]=a[XX][YY]-b[XX][YY];
+ dest[XX][ZZ]=a[XX][ZZ]-b[XX][ZZ];
+ dest[YY][XX]=a[YY][XX]-b[YY][XX];
+ dest[YY][YY]=a[YY][YY]-b[YY][YY];
+ dest[YY][ZZ]=a[YY][ZZ]-b[YY][ZZ];
+ dest[ZZ][XX]=a[ZZ][XX]-b[ZZ][XX];
+ dest[ZZ][YY]=a[ZZ][YY]-b[ZZ][YY];
+ dest[ZZ][ZZ]=a[ZZ][ZZ]-b[ZZ][ZZ];
+}
+
+static gmx_inline void msmul(matrix m1,real r1,matrix dest)
+{
+ dest[XX][XX]=r1*m1[XX][XX];
+ dest[XX][YY]=r1*m1[XX][YY];
+ dest[XX][ZZ]=r1*m1[XX][ZZ];
+ dest[YY][XX]=r1*m1[YY][XX];
+ dest[YY][YY]=r1*m1[YY][YY];
+ dest[YY][ZZ]=r1*m1[YY][ZZ];
+ dest[ZZ][XX]=r1*m1[ZZ][XX];
+ dest[ZZ][YY]=r1*m1[ZZ][YY];
+ dest[ZZ][ZZ]=r1*m1[ZZ][ZZ];
+}
+
+static gmx_inline void m_inv_ur0(matrix src,matrix dest)
+{
+ double tmp = src[XX][XX]*src[YY][YY]*src[ZZ][ZZ];
+ if (fabs(tmp) <= 100*GMX_REAL_MIN)
+ gmx_fatal(FARGS,"Can not invert matrix, determinant is zero");
+
+ dest[XX][XX] = 1/src[XX][XX];
+ dest[YY][YY] = 1/src[YY][YY];
+ dest[ZZ][ZZ] = 1/src[ZZ][ZZ];
+ dest[ZZ][XX] = (src[YY][XX]*src[ZZ][YY]*dest[YY][YY]
+ - src[ZZ][XX])*dest[XX][XX]*dest[ZZ][ZZ];
+ dest[YY][XX] = -src[YY][XX]*dest[XX][XX]*dest[YY][YY];
+ dest[ZZ][YY] = -src[ZZ][YY]*dest[YY][YY]*dest[ZZ][ZZ];
+ dest[XX][YY] = 0.0;
+ dest[XX][ZZ] = 0.0;
+ dest[YY][ZZ] = 0.0;
+}
+
+static gmx_inline void m_inv(matrix src,matrix dest)
+{
+ const real smallreal = (real)1.0e-24;
+ const real largereal = (real)1.0e24;
+ real deter,c,fc;
+
+ deter = det(src);
+ c = (real)1.0/deter;
+ fc = (real)fabs(c);
+
+ if ((fc <= smallreal) || (fc >= largereal))
+ gmx_fatal(FARGS,"Can not invert matrix, determinant = %e",deter);
+
+ dest[XX][XX]= c*(src[YY][YY]*src[ZZ][ZZ]-src[ZZ][YY]*src[YY][ZZ]);
+ dest[XX][YY]=-c*(src[XX][YY]*src[ZZ][ZZ]-src[ZZ][YY]*src[XX][ZZ]);
+ dest[XX][ZZ]= c*(src[XX][YY]*src[YY][ZZ]-src[YY][YY]*src[XX][ZZ]);
+ dest[YY][XX]=-c*(src[YY][XX]*src[ZZ][ZZ]-src[ZZ][XX]*src[YY][ZZ]);
+ dest[YY][YY]= c*(src[XX][XX]*src[ZZ][ZZ]-src[ZZ][XX]*src[XX][ZZ]);
+ dest[YY][ZZ]=-c*(src[XX][XX]*src[YY][ZZ]-src[YY][XX]*src[XX][ZZ]);
+ dest[ZZ][XX]= c*(src[YY][XX]*src[ZZ][YY]-src[ZZ][XX]*src[YY][YY]);
+ dest[ZZ][YY]=-c*(src[XX][XX]*src[ZZ][YY]-src[ZZ][XX]*src[XX][YY]);
+ dest[ZZ][ZZ]= c*(src[XX][XX]*src[YY][YY]-src[YY][XX]*src[XX][YY]);
+}
+
+static gmx_inline void mvmul(matrix a,const rvec src,rvec dest)
+{
+ dest[XX]=a[XX][XX]*src[XX]+a[XX][YY]*src[YY]+a[XX][ZZ]*src[ZZ];
+ dest[YY]=a[YY][XX]*src[XX]+a[YY][YY]*src[YY]+a[YY][ZZ]*src[ZZ];
+ dest[ZZ]=a[ZZ][XX]*src[XX]+a[ZZ][YY]*src[YY]+a[ZZ][ZZ]*src[ZZ];
+}
+
+static gmx_inline void mvmul_ur0(matrix a,const rvec src,rvec dest)
+{
+ dest[ZZ]=a[ZZ][XX]*src[XX]+a[ZZ][YY]*src[YY]+a[ZZ][ZZ]*src[ZZ];
+ dest[YY]=a[YY][XX]*src[XX]+a[YY][YY]*src[YY];
+ dest[XX]=a[XX][XX]*src[XX];
+}
+
+static gmx_inline void tmvmul_ur0(matrix a,const rvec src,rvec dest)
+{
+ dest[XX]=a[XX][XX]*src[XX]+a[YY][XX]*src[YY]+a[ZZ][XX]*src[ZZ];
+ dest[YY]= a[YY][YY]*src[YY]+a[ZZ][YY]*src[ZZ];
+ dest[ZZ]= a[ZZ][ZZ]*src[ZZ];
+}
+
+static gmx_inline void unitv(const rvec src,rvec dest)
+{
+ real linv;
+
+ linv=gmx_invsqrt(norm2(src));
+ dest[XX]=linv*src[XX];
+ dest[YY]=linv*src[YY];
+ dest[ZZ]=linv*src[ZZ];
+}
+
+static gmx_inline void unitv_no_table(const rvec src,rvec dest)
+{
+ real linv;
+
+ linv=1.0/sqrt(norm2(src));
+ dest[XX]=linv*src[XX];
+ dest[YY]=linv*src[YY];
+ dest[ZZ]=linv*src[ZZ];
+}
+
+static void calc_lll(rvec box,rvec lll)
+{
+ lll[XX] = 2.0*M_PI/box[XX];
+ lll[YY] = 2.0*M_PI/box[YY];
+ lll[ZZ] = 2.0*M_PI/box[ZZ];
+}
+
+static gmx_inline real trace(matrix m)
+{
+ return (m[XX][XX]+m[YY][YY]+m[ZZ][ZZ]);
+}
+
+static gmx_inline real _divide_err(real a,real b,const char *file,int line)
+{
+ if (fabs(b) <= GMX_REAL_MIN)
+ gmx_fatal(FARGS,"Dividing by zero, file %s, line %d",file,line);
+ return a/b;
+}
+
+static gmx_inline int _mod(int a,int b,char *file,int line)
+{
+ if(b==0)
+ gmx_fatal(FARGS,"Modulo zero, file %s, line %d",file,line);
+ return a % b;
+}
+
+/* Operations on multidimensional rvecs, used e.g. in edsam.c */
+static void m_rveccopy(int dim, rvec *a, rvec *b)
+{
+ /* b = a */
+ int i;
+
+ for (i=0; i<dim; i++)
+ copy_rvec(a[i],b[i]);
+}
+
+/*computer matrix vectors from base vectors and angles */
+static void matrix_convert(matrix box, rvec vec, rvec angle)
+{
+ svmul(DEG2RAD,angle,angle);
+ box[XX][XX] = vec[XX];
+ box[YY][XX] = vec[YY]*cos(angle[ZZ]);
+ box[YY][YY] = vec[YY]*sin(angle[ZZ]);
+ box[ZZ][XX] = vec[ZZ]*cos(angle[YY]);
+ box[ZZ][YY] = vec[ZZ]
+ *(cos(angle[XX])-cos(angle[YY])*cos(angle[ZZ]))/sin(angle[ZZ]);
+ box[ZZ][ZZ] = sqrt(sqr(vec[ZZ])
+ -box[ZZ][XX]*box[ZZ][XX]-box[ZZ][YY]*box[ZZ][YY]);
+}
+
+#define divide_err(a,b) _divide_err((a),(b),__FILE__,__LINE__)
+#define mod(a,b) _mod((a),(b),__FILE__,__LINE__)
+
+#ifdef __cplusplus
+}
+#endif
+
+
+#endif /* _vec_h */
--- /dev/null
+file(GLOB MDLIB_SOURCES *.c)
++if(GMX_FFT_FFTPACK)
++list(APPEND MDLIB_SOURCES ${CMAKE_SOURCE_DIR}/src/external/fftpack/fftpack.c)
++endif()
+set(MDLIB_SOURCES ${MDLIB_SOURCES} PARENT_SCOPE)
--- /dev/null
-
+/* -*- mode: c; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4; c-file-style: "stroustrup"; -*-
+ *
+ *
+ * Gromacs 4.0 Copyright (c) 1991-2003
+ * David van der Spoel, Erik Lindahl, University of Groningen.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * To help us fund GROMACS development, we humbly ask that you cite
+ * the research papers on the package. Check out http://www.gromacs.org
+ *
+ * And Hey:
+ * Gnomes, ROck Monsters And Chili Sauce
+ */
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+
+#ifdef GMX_FFT_FFTPACK
+
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+#include <errno.h>
+
+
+#include "gmx_fft.h"
+#include "gmx_fatal.h"
-
- static void
- fftpack_passf2(int ido,
- int l1,
- real cc[],
- real ch[],
- real wa1[],
- int isign)
- {
- int i, k, ah, ac;
- real ti2, tr2;
-
- if (ido <= 2)
- {
- for (k=0; k<l1; k++)
- {
- ah = k*ido;
- ac = 2*k*ido;
- ch[ah] = cc[ac] + cc[ac + ido];
- ch[ah + ido*l1] = cc[ac] - cc[ac + ido];
- ch[ah+1] = cc[ac+1] + cc[ac + ido + 1];
- ch[ah + ido*l1 + 1] = cc[ac+1] - cc[ac + ido + 1];
- }
- }
- else
- {
- for (k=0; k<l1; k++)
- {
- for (i=0; i<ido-1; i+=2)
- {
- ah = i + k*ido;
- ac = i + 2*k*ido;
- ch[ah] = cc[ac] + cc[ac + ido];
- tr2 = cc[ac] - cc[ac + ido];
- ch[ah+1] = cc[ac+1] + cc[ac + 1 + ido];
- ti2 = cc[ac+1] - cc[ac + 1 + ido];
- ch[ah+l1*ido+1] = wa1[i]*ti2 + isign*wa1[i+1]*tr2;
- ch[ah+l1*ido] = wa1[i]*tr2 - isign*wa1[i+1]*ti2;
- }
- }
- }
- }
-
-
-
- static void
- fftpack_passf3(int ido,
- int l1,
- real cc[],
- real ch[],
- real wa1[],
- real wa2[],
- int isign)
- {
- const real taur = -0.5;
- const real taui = 0.866025403784439;
-
- int i, k, ac, ah;
- real ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
-
- if (ido == 2)
- {
- for (k=1; k<=l1; k++)
- {
- ac = (3*k - 2)*ido;
- tr2 = cc[ac] + cc[ac + ido];
- cr2 = cc[ac - ido] + taur*tr2;
- ah = (k - 1)*ido;
- ch[ah] = cc[ac - ido] + tr2;
-
- ti2 = cc[ac + 1] + cc[ac + ido + 1];
- ci2 = cc[ac - ido + 1] + taur*ti2;
- ch[ah + 1] = cc[ac - ido + 1] + ti2;
-
- cr3 = isign*taui*(cc[ac] - cc[ac + ido]);
- ci3 = isign*taui*(cc[ac + 1] - cc[ac + ido + 1]);
- ch[ah + l1*ido] = cr2 - ci3;
- ch[ah + 2*l1*ido] = cr2 + ci3;
- ch[ah + l1*ido + 1] = ci2 + cr3;
- ch[ah + 2*l1*ido + 1] = ci2 - cr3;
- }
- }
- else
- {
- for (k=1; k<=l1; k++)
- {
- for (i=0; i<ido-1; i+=2)
- {
- ac = i + (3*k - 2)*ido;
- tr2 = cc[ac] + cc[ac + ido];
- cr2 = cc[ac - ido] + taur*tr2;
- ah = i + (k-1)*ido;
- ch[ah] = cc[ac - ido] + tr2;
- ti2 = cc[ac + 1] + cc[ac + ido + 1];
- ci2 = cc[ac - ido + 1] + taur*ti2;
- ch[ah + 1] = cc[ac - ido + 1] + ti2;
- cr3 = isign*taui*(cc[ac] - cc[ac + ido]);
- ci3 = isign*taui*(cc[ac + 1] - cc[ac + ido + 1]);
- dr2 = cr2 - ci3;
- dr3 = cr2 + ci3;
- di2 = ci2 + cr3;
- di3 = ci2 - cr3;
- ch[ah + l1*ido + 1] = wa1[i]*di2 + isign*wa1[i+1]*dr2;
- ch[ah + l1*ido] = wa1[i]*dr2 - isign*wa1[i+1]*di2;
- ch[ah + 2*l1*ido + 1] = wa2[i]*di3 + isign*wa2[i+1]*dr3;
- ch[ah + 2*l1*ido] = wa2[i]*dr3 - isign*wa2[i+1]*di3;
- }
- }
- }
- }
-
-
- static void
- fftpack_passf4(int ido,
- int l1,
- real cc[],
- real ch[],
- real wa1[],
- real wa2[],
- real wa3[],
- int isign)
- {
- int i, k, ac, ah;
- real ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;
-
- if (ido == 2)
- {
- for (k=0; k<l1; k++)
- {
- ac = 4*k*ido + 1;
- ti1 = cc[ac] - cc[ac + 2*ido];
- ti2 = cc[ac] + cc[ac + 2*ido];
- tr4 = cc[ac + 3*ido] - cc[ac + ido];
- ti3 = cc[ac + ido] + cc[ac + 3*ido];
- tr1 = cc[ac - 1] - cc[ac + 2*ido - 1];
- tr2 = cc[ac - 1] + cc[ac + 2*ido - 1];
- ti4 = cc[ac + ido - 1] - cc[ac + 3*ido - 1];
- tr3 = cc[ac + ido - 1] + cc[ac + 3*ido - 1];
- ah = k*ido;
- ch[ah] = tr2 + tr3;
- ch[ah + 2*l1*ido] = tr2 - tr3;
- ch[ah + 1] = ti2 + ti3;
- ch[ah + 2*l1*ido + 1] = ti2 - ti3;
- ch[ah + l1*ido] = tr1 + isign*tr4;
- ch[ah + 3*l1*ido] = tr1 - isign*tr4;
- ch[ah + l1*ido + 1] = ti1 + isign*ti4;
- ch[ah + 3*l1*ido + 1] = ti1 - isign*ti4;
- }
- }
- else
- {
- for (k=0; k<l1; k++)
- {
- for (i=0; i<ido-1; i+=2)
- {
- ac = i + 1 + 4*k*ido;
- ti1 = cc[ac] - cc[ac + 2*ido];
- ti2 = cc[ac] + cc[ac + 2*ido];
- ti3 = cc[ac + ido] + cc[ac + 3*ido];
- tr4 = cc[ac + 3*ido] - cc[ac + ido];
- tr1 = cc[ac - 1] - cc[ac + 2*ido - 1];
- tr2 = cc[ac - 1] + cc[ac + 2*ido - 1];
- ti4 = cc[ac + ido - 1] - cc[ac + 3*ido - 1];
- tr3 = cc[ac + ido - 1] + cc[ac + 3*ido - 1];
- ah = i + k*ido;
- ch[ah] = tr2 + tr3;
- cr3 = tr2 - tr3;
- ch[ah + 1] = ti2 + ti3;
- ci3 = ti2 - ti3;
- cr2 = tr1 + isign*tr4;
- cr4 = tr1 - isign*tr4;
- ci2 = ti1 + isign*ti4;
- ci4 = ti1 - isign*ti4;
- ch[ah + l1*ido] = wa1[i]*cr2 - isign*wa1[i + 1]*ci2;
- ch[ah + l1*ido + 1] = wa1[i]*ci2 + isign*wa1[i + 1]*cr2;
- ch[ah + 2*l1*ido] = wa2[i]*cr3 - isign*wa2[i + 1]*ci3;
- ch[ah + 2*l1*ido + 1] = wa2[i]*ci3 + isign*wa2[i + 1]*cr3;
- ch[ah + 3*l1*ido] = wa3[i]*cr4 -isign*wa3[i + 1]*ci4;
- ch[ah + 3*l1*ido + 1] = wa3[i]*ci4 + isign*wa3[i + 1]*cr4;
- }
- }
- }
- }
-
-
- static void
- fftpack_passf5(int ido,
- int l1,
- real cc[],
- real ch[],
- real wa1[],
- real wa2[],
- real wa3[],
- real wa4[],
- int isign)
- {
- const real tr11 = 0.309016994374947;
- const real ti11 = 0.951056516295154;
- const real tr12 = -0.809016994374947;
- const real ti12 = 0.587785252292473;
-
- int i, k, ac, ah;
- real ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, ti2, ti3,
- ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
-
- if (ido == 2)
- {
- for (k = 1; k <= l1; ++k)
- {
- ac = (5*k - 4)*ido + 1;
- ti5 = cc[ac] - cc[ac + 3*ido];
- ti2 = cc[ac] + cc[ac + 3*ido];
- ti4 = cc[ac + ido] - cc[ac + 2*ido];
- ti3 = cc[ac + ido] + cc[ac + 2*ido];
- tr5 = cc[ac - 1] - cc[ac + 3*ido - 1];
- tr2 = cc[ac - 1] + cc[ac + 3*ido - 1];
- tr4 = cc[ac + ido - 1] - cc[ac + 2*ido - 1];
- tr3 = cc[ac + ido - 1] + cc[ac + 2*ido - 1];
- ah = (k - 1)*ido;
- ch[ah] = cc[ac - ido - 1] + tr2 + tr3;
- ch[ah + 1] = cc[ac - ido] + ti2 + ti3;
- cr2 = cc[ac - ido - 1] + tr11*tr2 + tr12*tr3;
- ci2 = cc[ac - ido] + tr11*ti2 + tr12*ti3;
- cr3 = cc[ac - ido - 1] + tr12*tr2 + tr11*tr3;
- ci3 = cc[ac - ido] + tr12*ti2 + tr11*ti3;
- cr5 = isign*(ti11*tr5 + ti12*tr4);
- ci5 = isign*(ti11*ti5 + ti12*ti4);
- cr4 = isign*(ti12*tr5 - ti11*tr4);
- ci4 = isign*(ti12*ti5 - ti11*ti4);
- ch[ah + l1*ido] = cr2 - ci5;
- ch[ah + 4*l1*ido] = cr2 + ci5;
- ch[ah + l1*ido + 1] = ci2 + cr5;
- ch[ah + 2*l1*ido + 1] = ci3 + cr4;
- ch[ah + 2*l1*ido] = cr3 - ci4;
- ch[ah + 3*l1*ido] = cr3 + ci4;
- ch[ah + 3*l1*ido + 1] = ci3 - cr4;
- ch[ah + 4*l1*ido + 1] = ci2 - cr5;
- }
- }
- else
- {
- for (k=1; k<=l1; k++)
- {
- for (i=0; i<ido-1; i+=2)
- {
- ac = i + 1 + (k*5 - 4)*ido;
- ti5 = cc[ac] - cc[ac + 3*ido];
- ti2 = cc[ac] + cc[ac + 3*ido];
- ti4 = cc[ac + ido] - cc[ac + 2*ido];
- ti3 = cc[ac + ido] + cc[ac + 2*ido];
- tr5 = cc[ac - 1] - cc[ac + 3*ido - 1];
- tr2 = cc[ac - 1] + cc[ac + 3*ido - 1];
- tr4 = cc[ac + ido - 1] - cc[ac + 2*ido - 1];
- tr3 = cc[ac + ido - 1] + cc[ac + 2*ido - 1];
- ah = i + (k - 1)*ido;
- ch[ah] = cc[ac - ido - 1] + tr2 + tr3;
- ch[ah + 1] = cc[ac - ido] + ti2 + ti3;
- cr2 = cc[ac - ido - 1] + tr11*tr2 + tr12*tr3;
- ci2 = cc[ac - ido] + tr11*ti2 + tr12*ti3;
- cr3 = cc[ac - ido - 1] + tr12*tr2 + tr11*tr3;
- ci3 = cc[ac - ido] + tr12*ti2 + tr11*ti3;
- cr5 = isign*(ti11*tr5 + ti12*tr4);
- ci5 = isign*(ti11*ti5 + ti12*ti4);
- cr4 = isign*(ti12*tr5 - ti11*tr4);
- ci4 = isign*(ti12*ti5 - ti11*ti4);
- dr3 = cr3 - ci4;
- dr4 = cr3 + ci4;
- di3 = ci3 + cr4;
- di4 = ci3 - cr4;
- dr5 = cr2 + ci5;
- dr2 = cr2 - ci5;
- di5 = ci2 - cr5;
- di2 = ci2 + cr5;
- ch[ah + l1*ido] = wa1[i]*dr2 - isign*wa1[i+1]*di2;
- ch[ah + l1*ido + 1] = wa1[i]*di2 + isign*wa1[i+1]*dr2;
- ch[ah + 2*l1*ido] = wa2[i]*dr3 - isign*wa2[i+1]*di3;
- ch[ah + 2*l1*ido + 1] = wa2[i]*di3 + isign*wa2[i+1]*dr3;
- ch[ah + 3*l1*ido] = wa3[i]*dr4 - isign*wa3[i+1]*di4;
- ch[ah + 3*l1*ido + 1] = wa3[i]*di4 + isign*wa3[i+1]*dr4;
- ch[ah + 4*l1*ido] = wa4[i]*dr5 - isign*wa4[i+1]*di5;
- ch[ah + 4*l1*ido + 1] = wa4[i]*di5 + isign*wa4[i+1]*dr5;
- }
- }
- }
- }
-
-
- static void
- fftpack_passf(int * nac,
- int ido,
- int ip,
- int l1,
- int idl1,
- real cc[],
- real ch[],
- real wa[],
- int isign)
- {
- int idij, idlj, idot, ipph, i, j, k, l, jc, lc, ik, nt, idj, idl, inc,idp;
- real wai, war;
-
- idot = ido / 2;
- nt = ip*idl1;
- ipph = (ip + 1) / 2;
- idp = ip*ido;
- if (ido >= l1)
- {
- for (j=1; j<ipph; j++)
- {
- jc = ip - j;
- for (k=0; k<l1; k++)
- {
- for (i=0; i<ido; i++)
- {
- ch[i + (k + j*l1)*ido] = cc[i + (j + k*ip)*ido] + cc[i + (jc + k*ip)*ido];
- ch[i + (k + jc*l1)*ido] = cc[i + (j + k*ip)*ido] - cc[i + (jc + k*ip)*ido];
- }
- }
- }
- for (k=0; k<l1; k++)
- for (i=0; i<ido; i++)
- ch[i + k*ido] = cc[i + k*ip*ido];
- }
- else
- {
- for (j=1; j<ipph; j++)
- {
- jc = ip - j;
- for (i=0; i<ido; i++)
- {
- for (k=0; k<l1; k++)
- {
- ch[i + (k + j*l1)*ido] = cc[i + (j + k*ip)*ido] + cc[i + (jc + k*ip)*ido];
- ch[i + (k + jc*l1)*ido] = cc[i + (j + k*ip)*ido] - cc[i + (jc + k*ip)*ido];
- }
- }
- }
- for (i=0; i<ido; i++)
- for (k=0; k<l1; k++)
- ch[i + k*ido] = cc[i + k*ip*ido];
- }
-
- idl = 2 - ido;
- inc = 0;
- for (l=1; l<ipph; l++)
- {
- lc = ip - l;
- idl += ido;
- for (ik=0; ik<idl1; ik++)
- {
- cc[ik + l*idl1] = ch[ik] + wa[idl - 2]*ch[ik + idl1];
- cc[ik + lc*idl1] = isign*wa[idl-1]*ch[ik + (ip-1)*idl1];
- }
- idlj = idl;
- inc += ido;
- for (j=2; j<ipph; j++)
- {
- jc = ip - j;
- idlj += inc;
- if (idlj > idp) idlj -= idp;
- war = wa[idlj - 2];
- wai = wa[idlj-1];
- for (ik=0; ik<idl1; ik++)
- {
- cc[ik + l*idl1] += war*ch[ik + j*idl1];
- cc[ik + lc*idl1] += isign*wai*ch[ik + jc*idl1];
- }
- }
- }
- for (j=1; j<ipph; j++)
- for (ik=0; ik<idl1; ik++)
- ch[ik] += ch[ik + j*idl1];
- for (j=1; j<ipph; j++)
- {
- jc = ip - j;
- for (ik=1; ik<idl1; ik+=2)
- {
- ch[ik - 1 + j*idl1] = cc[ik - 1 + j*idl1] - cc[ik + jc*idl1];
- ch[ik - 1 + jc*idl1] = cc[ik - 1 + j*idl1] + cc[ik + jc*idl1];
- ch[ik + j*idl1] = cc[ik + j*idl1] + cc[ik - 1 + jc*idl1];
- ch[ik + jc*idl1] = cc[ik + j*idl1] - cc[ik - 1 + jc*idl1];
- }
- }
- *nac = 1;
- if (ido == 2)
- return;
- *nac = 0;
- for (ik=0; ik<idl1; ik++)
- {
- cc[ik] = ch[ik];
- }
- for (j=1; j<ip; j++)
- {
- for (k=0; k<l1; k++)
- {
- cc[(k + j*l1)*ido + 0] = ch[(k + j*l1)*ido + 0];
- cc[(k + j*l1)*ido + 1] = ch[(k + j*l1)*ido + 1];
- }
- }
- if (idot <= l1)
- {
- idij = 0;
- for (j=1; j<ip; j++)
- {
- idij += 2;
- for (i=3; i<ido; i+=2)
- {
- idij += 2;
- for (k=0; k<l1; k++)
- {
- cc[i - 1 + (k + j*l1)*ido] =
- wa[idij - 2]*ch[i - 1 + (k + j*l1)*ido] -
- isign*wa[idij-1]*ch[i + (k + j*l1)*ido];
- cc[i + (k + j*l1)*ido] =
- wa[idij - 2]*ch[i + (k + j*l1)*ido] +
- isign*wa[idij-1]*ch[i - 1 + (k + j*l1)*ido];
- }
- }
- }
- }
- else
- {
- idj = 2 - ido;
- for (j=1; j<ip; j++)
- {
- idj += ido;
- for (k = 0; k < l1; k++)
- {
- idij = idj;
- for (i=3; i<ido; i+=2)
- {
- idij += 2;
- cc[i - 1 + (k + j*l1)*ido] =
- wa[idij - 2]*ch[i - 1 + (k + j*l1)*ido] -
- isign*wa[idij-1]*ch[i + (k + j*l1)*ido];
- cc[i + (k + j*l1)*ido] =
- wa[idij - 2]*ch[i + (k + j*l1)*ido] +
- isign*wa[idij-1]*ch[i - 1 + (k + j*l1)*ido];
- }
- }
- }
- }
- }
-
-
-
- static void
- fftpack_radf2(int ido,
- int l1,
- real cc[],
- real ch[],
- real wa1[])
- {
- int i, k, ic;
- real ti2, tr2;
- for (k=0; k<l1; k++)
- {
- ch[2*k*ido] = cc[k*ido] + cc[(k + l1)*ido];
- ch[(2*k+1)*ido + ido-1] = cc[k*ido] - cc[(k + l1)*ido];
- }
- if (ido < 2)
- return;
- if (ido != 2)
- {
- for (k=0; k<l1; k++)
- {
- for (i=2; i<ido; i+=2)
- {
- ic = ido - i;
- tr2 = wa1[i - 2]*cc[i-1 + (k + l1)*ido] + wa1[i - 1]*cc[i + (k + l1)*ido];
- ti2 = wa1[i - 2]*cc[i + (k + l1)*ido] - wa1[i - 1]*cc[i-1 + (k + l1)*ido];
- ch[i + 2*k*ido] = cc[i + k*ido] + ti2;
- ch[ic + (2*k+1)*ido] = ti2 - cc[i + k*ido];
- ch[i - 1 + 2*k*ido] = cc[i - 1 + k*ido] + tr2;
- ch[ic - 1 + (2*k+1)*ido] = cc[i - 1 + k*ido] - tr2;
- }
- }
- if (ido % 2 == 1)
- return;
- }
- for (k=0; k<l1; k++)
- {
- ch[(2*k+1)*ido] = -cc[ido-1 + (k + l1)*ido];
- ch[ido-1 + 2*k*ido] = cc[ido-1 + k*ido];
- }
- }
-
-
- static void
- fftpack_radb2(int ido,
- int l1,
- real cc[],
- real ch[],
- real wa1[])
- {
- int i, k, ic;
- real ti2, tr2;
- for (k=0; k<l1; k++)
- {
- ch[k*ido] = cc[2*k*ido] + cc[ido-1 + (2*k+1)*ido];
- ch[(k + l1)*ido] = cc[2*k*ido] - cc[ido-1 + (2*k+1)*ido];
- }
- if (ido < 2)
- return;
- if (ido != 2)
- {
- for (k = 0; k < l1; ++k)
- {
- for (i = 2; i < ido; i += 2)
- {
- ic = ido - i;
- ch[i-1 + k*ido] = cc[i-1 + 2*k*ido] + cc[ic-1 + (2*k+1)*ido];
- tr2 = cc[i-1 + 2*k*ido] - cc[ic-1 + (2*k+1)*ido];
- ch[i + k*ido] = cc[i + 2*k*ido] - cc[ic + (2*k+1)*ido];
- ti2 = cc[i + (2*k)*ido] + cc[ic + (2*k+1)*ido];
- ch[i-1 + (k + l1)*ido] = wa1[i - 2]*tr2 - wa1[i - 1]*ti2;
- ch[i + (k + l1)*ido] = wa1[i - 2]*ti2 + wa1[i - 1]*tr2;
- }
- }
- if (ido % 2 == 1)
- return;
- }
- for (k = 0; k < l1; k++)
- {
- ch[ido-1 + k*ido] = 2*cc[ido-1 + 2*k*ido];
- ch[ido-1 + (k + l1)*ido] = -2*cc[(2*k+1)*ido];
- }
- }
-
-
- static void
- fftpack_radf3(int ido,
- int l1,
- real cc[],
- real ch[],
- real wa1[],
- real wa2[])
- {
- const real taur = -0.5;
- const real taui = 0.866025403784439;
- int i, k, ic;
- real ci2, di2, di3, cr2, dr2, dr3, ti2, ti3, tr2, tr3;
-
- for (k=0; k<l1; k++)
- {
- cr2 = cc[(k + l1)*ido] + cc[(k + 2*l1)*ido];
- ch[3*k*ido] = cc[k*ido] + cr2;
- ch[(3*k+2)*ido] = taui*(cc[(k + l1*2)*ido] - cc[(k + l1)*ido]);
- ch[ido-1 + (3*k + 1)*ido] = cc[k*ido] + taur*cr2;
- }
- if (ido == 1)
- return;
- for (k=0; k<l1; k++)
- {
- for (i=2; i<ido; i+=2)
- {
- ic = ido - i;
- dr2 = wa1[i - 2]*cc[i - 1 + (k + l1)*ido] +wa1[i - 1]*cc[i + (k + l1)*ido];
- di2 = wa1[i - 2]*cc[i + (k + l1)*ido] - wa1[i - 1]*cc[i - 1 + (k + l1)*ido];
- dr3 = wa2[i - 2]*cc[i - 1 + (k + l1*2)*ido] + wa2[i - 1]*cc[i + (k + l1*2)*ido];
- di3 = wa2[i - 2]*cc[i + (k + l1*2)*ido] - wa2[i - 1]*cc[i - 1 + (k + l1*2)*ido];
- cr2 = dr2 + dr3;
- ci2 = di2 + di3;
- ch[i - 1 + 3*k*ido] = cc[i - 1 + k*ido] + cr2;
- ch[i + 3*k*ido] = cc[i + k*ido] + ci2;
- tr2 = cc[i - 1 + k*ido] + taur*cr2;
- ti2 = cc[i + k*ido] + taur*ci2;
- tr3 = taui*(di2 - di3);
- ti3 = taui*(dr3 - dr2);
- ch[i - 1 + (3*k + 2)*ido] = tr2 + tr3;
- ch[ic - 1 + (3*k + 1)*ido] = tr2 - tr3;
- ch[i + (3*k + 2)*ido] = ti2 + ti3;
- ch[ic + (3*k + 1)*ido] = ti3 - ti2;
- }
- }
- }
-
-
- static void
- fftpack_radb3(int ido,
- int l1,
- real cc[],
- real ch[],
- real wa1[],
- real wa2[])
- {
- const real taur = -0.5;
- const real taui = 0.866025403784439;
- int i, k, ic;
- real ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
-
- for (k=0; k<l1; k++)
- {
- tr2 = 2*cc[ido-1 + (3*k + 1)*ido];
- cr2 = cc[3*k*ido] + taur*tr2;
- ch[k*ido] = cc[3*k*ido] + tr2;
- ci3 = 2*taui*cc[(3*k + 2)*ido];
- ch[(k + l1)*ido] = cr2 - ci3;
- ch[(k + 2*l1)*ido] = cr2 + ci3;
- }
- if (ido == 1)
- return;
-
- for (k=0; k<l1; k++)
- {
- for (i=2; i<ido; i+=2)
- {
- ic = ido - i;
- tr2 = cc[i - 1 + (3*k + 2)*ido] + cc[ic - 1 + (3*k + 1)*ido];
- cr2 = cc[i - 1 + 3*k*ido] + taur*tr2;
- ch[i - 1 + k*ido] = cc[i - 1 + 3*k*ido] + tr2;
- ti2 = cc[i + (3*k + 2)*ido]- cc[ic + (3*k + 1)*ido];
- ci2 = cc[i + 3*k*ido] + taur*ti2;
- ch[i + k*ido] = cc[i + 3*k*ido] + ti2;
- cr3 = taui*(cc[i - 1 + (3*k + 2)*ido] - cc[ic - 1 + (3*k + 1)*ido]);
- ci3 = taui*(cc[i + (3*k + 2)*ido] + cc[ic + (3*k + 1)*ido]);
- dr2 = cr2 - ci3;
- dr3 = cr2 + ci3;
- di2 = ci2 + cr3;
- di3 = ci2 - cr3;
- ch[i - 1 + (k + l1)*ido] = wa1[i - 2]*dr2 - wa1[i - 1]*di2;
- ch[i + (k + l1)*ido] = wa1[i - 2]*di2 + wa1[i - 1]*dr2;
- ch[i - 1 + (k + 2*l1)*ido] = wa2[i - 2]*dr3 - wa2[i - 1]*di3;
- ch[i + (k + 2*l1)*ido] = wa2[i - 2]*di3 + wa2[i - 1]*dr3;
- }
- }
- }
-
-
- static void
- fftpack_radf4(int ido,
- int l1,
- real cc[],
- real ch[],
- real wa1[],
- real wa2[],
- real wa3[])
- {
- const real hsqt2 = 0.7071067811865475;
- int i, k, ic;
- real ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;
-
- for (k=0; k<l1; k++)
- {
- tr1 = cc[(k + l1)*ido] + cc[(k + 3*l1)*ido];
- tr2 = cc[k*ido] + cc[(k + 2*l1)*ido];
- ch[4*k*ido] = tr1 + tr2;
- ch[ido-1 + (4*k + 3)*ido] = tr2 - tr1;
- ch[ido-1 + (4*k + 1)*ido] = cc[k*ido] - cc[(k + 2*l1)*ido];
- ch[(4*k + 2)*ido] = cc[(k + 3*l1)*ido] - cc[(k + l1)*ido];
- }
- if (ido < 2)
- return;
- if (ido != 2)
- {
- for (k=0; k<l1; k++)
- {
- for (i=2; i<ido; i += 2)
- {
- ic = ido - i;
- cr2 = wa1[i - 2]*cc[i - 1 + (k + l1)*ido] + wa1[i - 1]*cc[i + (k + l1)*ido];
- ci2 = wa1[i - 2]*cc[i + (k + l1)*ido] - wa1[i - 1]*cc[i - 1 + (k + l1)*ido];
- cr3 = wa2[i - 2]*cc[i - 1 + (k + 2*l1)*ido] + wa2[i - 1]*cc[i + (k + 2*l1)*ido];
- ci3 = wa2[i - 2]*cc[i + (k + 2*l1)*ido] - wa2[i - 1]*cc[i - 1 + (k + 2*l1)*ido];
- cr4 = wa3[i - 2]*cc[i - 1 + (k + 3*l1)*ido] + wa3[i - 1]*cc[i + (k + 3*l1)*ido];
- ci4 = wa3[i - 2]*cc[i + (k + 3*l1)*ido] - wa3[i - 1]*cc[i - 1 + (k + 3*l1)*ido];
- tr1 = cr2 + cr4;
- tr4 = cr4 - cr2;
- ti1 = ci2 + ci4;
- ti4 = ci2 - ci4;
- ti2 = cc[i + k*ido] + ci3;
- ti3 = cc[i + k*ido] - ci3;
- tr2 = cc[i - 1 + k*ido] + cr3;
- tr3 = cc[i - 1 + k*ido] - cr3;
- ch[i - 1 + 4*k*ido] = tr1 + tr2;
- ch[ic - 1 + (4*k + 3)*ido] = tr2 - tr1;
- ch[i + 4*k*ido] = ti1 + ti2;
- ch[ic + (4*k + 3)*ido] = ti1 - ti2;
- ch[i - 1 + (4*k + 2)*ido] = ti4 + tr3;
- ch[ic - 1 + (4*k + 1)*ido] = tr3 - ti4;
- ch[i + (4*k + 2)*ido] = tr4 + ti3;
- ch[ic + (4*k + 1)*ido] = tr4 - ti3;
- }
- }
- if (ido % 2 == 1)
- return;
- }
- for (k=0; k<l1; k++)
- {
- ti1 = -hsqt2*(cc[ido-1 + (k + l1)*ido] + cc[ido-1 + (k + 3*l1)*ido]);
- tr1 = hsqt2*(cc[ido-1 + (k + l1)*ido] - cc[ido-1 + (k + 3*l1)*ido]);
- ch[ido-1 + 4*k*ido] = tr1 + cc[ido-1 + k*ido];
- ch[ido-1 + (4*k + 2)*ido] = cc[ido-1 + k*ido] - tr1;
- ch[(4*k + 1)*ido] = ti1 - cc[ido-1 + (k + 2*l1)*ido];
- ch[(4*k + 3)*ido] = ti1 + cc[ido-1 + (k + 2*l1)*ido];
- }
- }
-
-
- static void
- fftpack_radb4(int ido,
- int l1,
- real cc[],
- real ch[],
- real wa1[],
- real wa2[],
- real wa3[])
- {
- const real sqrt2 = 1.414213562373095;
- int i, k, ic;
- real ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;
- for (k = 0; k < l1; k++)
- {
- tr1 = cc[4*k*ido] - cc[ido-1 + (4*k + 3)*ido];
- tr2 = cc[4*k*ido] + cc[ido-1 + (4*k + 3)*ido];
- tr3 = cc[ido-1 + (4*k + 1)*ido] + cc[ido-1 + (4*k + 1)*ido];
- tr4 = cc[(4*k + 2)*ido] + cc[(4*k + 2)*ido];
- ch[k*ido] = tr2 + tr3;
- ch[(k + l1)*ido] = tr1 - tr4;
- ch[(k + 2*l1)*ido] = tr2 - tr3;
- ch[(k + 3*l1)*ido] = tr1 + tr4;
- }
- if (ido < 2)
- return;
- if (ido != 2)
- {
- for (k = 0; k < l1; ++k)
- {
- for (i = 2; i < ido; i += 2)
- {
- ic = ido - i;
- ti1 = cc[i + 4*k*ido] + cc[ic + (4*k + 3)*ido];
- ti2 = cc[i + 4*k*ido] - cc[ic + (4*k + 3)*ido];
- ti3 = cc[i + (4*k + 2)*ido] - cc[ic + (4*k + 1)*ido];
- tr4 = cc[i + (4*k + 2)*ido] + cc[ic + (4*k + 1)*ido];
- tr1 = cc[i - 1 + 4*k*ido] - cc[ic - 1 + (4*k + 3)*ido];
- tr2 = cc[i - 1 + 4*k*ido] + cc[ic - 1 + (4*k + 3)*ido];
- ti4 = cc[i - 1 + (4*k + 2)*ido] - cc[ic - 1 + (4*k + 1)*ido];
- tr3 = cc[i - 1 + (4*k + 2)*ido] + cc[ic - 1 + (4*k + 1)*ido];
- ch[i - 1 + k*ido] = tr2 + tr3;
- cr3 = tr2 - tr3;
- ch[i + k*ido] = ti2 + ti3;
- ci3 = ti2 - ti3;
- cr2 = tr1 - tr4;
- cr4 = tr1 + tr4;
- ci2 = ti1 + ti4;
- ci4 = ti1 - ti4;
- ch[i - 1 + (k + l1)*ido] = wa1[i - 2]*cr2 - wa1[i - 1]*ci2;
- ch[i + (k + l1)*ido] = wa1[i - 2]*ci2 + wa1[i - 1]*cr2;
- ch[i - 1 + (k + 2*l1)*ido] = wa2[i - 2]*cr3 - wa2[i - 1]*ci3;
- ch[i + (k + 2*l1)*ido] = wa2[i - 2]*ci3 + wa2[i - 1]*cr3;
- ch[i - 1 + (k + 3*l1)*ido] = wa3[i - 2]*cr4 - wa3[i - 1]*ci4;
- ch[i + (k + 3*l1)*ido] = wa3[i - 2]*ci4 + wa3[i - 1]*cr4;
- }
- }
- if (ido % 2 == 1)
- return;
- }
- for (k = 0; k < l1; k++)
- {
- ti1 = cc[(4*k + 1)*ido] + cc[(4*k + 3)*ido];
- ti2 = cc[(4*k + 3)*ido] - cc[(4*k + 1)*ido];
- tr1 = cc[ido-1 + 4*k*ido] - cc[ido-1 + (4*k + 2)*ido];
- tr2 = cc[ido-1 + 4*k*ido] + cc[ido-1 + (4*k + 2)*ido];
- ch[ido-1 + k*ido] = tr2 + tr2;
- ch[ido-1 + (k + l1)*ido] = sqrt2*(tr1 - ti1);
- ch[ido-1 + (k + 2*l1)*ido] = ti2 + ti2;
- ch[ido-1 + (k + 3*l1)*ido] = -sqrt2*(tr1 + ti1);
- }
- }
-
-
- static void
- fftpack_radf5(int ido,
- int l1,
- real cc[],
- real ch[],
- real wa1[],
- real wa2[],
- real wa3[],
- real wa4[])
- {
- const real tr11 = 0.309016994374947;
- const real ti11 = 0.951056516295154;
- const real tr12 = -0.809016994374947;
- const real ti12 = 0.587785252292473;
- int i, k, ic;
- real ci2, di2, ci4, ci5, di3, di4, di5, ci3, cr2, cr3, dr2, dr3, dr4, dr5,
- cr5, cr4, ti2, ti3, ti5, ti4, tr2, tr3, tr4, tr5;
-
- for (k = 0; k < l1; k++)
- {
- cr2 = cc[(k + 4*l1)*ido] + cc[(k + l1)*ido];
- ci5 = cc[(k + 4*l1)*ido] - cc[(k + l1)*ido];
- cr3 = cc[(k + 3*l1)*ido] + cc[(k + 2*l1)*ido];
- ci4 = cc[(k + 3*l1)*ido] - cc[(k + 2*l1)*ido];
- ch[5*k*ido] = cc[k*ido] + cr2 + cr3;
- ch[ido-1 + (5*k + 1)*ido] = cc[k*ido] + tr11*cr2 + tr12*cr3;
- ch[(5*k + 2)*ido] = ti11*ci5 + ti12*ci4;
- ch[ido-1 + (5*k + 3)*ido] = cc[k*ido] + tr12*cr2 + tr11*cr3;
- ch[(5*k + 4)*ido] = ti12*ci5 - ti11*ci4;
- }
- if (ido == 1)
- return;
- for (k = 0; k < l1; ++k)
- {
- for (i = 2; i < ido; i += 2)
- {
- ic = ido - i;
- dr2 = wa1[i - 2]*cc[i - 1 + (k + l1)*ido] + wa1[i - 1]*cc[i + (k + l1)*ido];
- di2 = wa1[i - 2]*cc[i + (k + l1)*ido] - wa1[i - 1]*cc[i - 1 + (k + l1)*ido];
- dr3 = wa2[i - 2]*cc[i - 1 + (k + 2*l1)*ido] + wa2[i - 1]*cc[i + (k + 2*l1)*ido];
- di3 = wa2[i - 2]*cc[i + (k + 2*l1)*ido] - wa2[i - 1]*cc[i - 1 + (k + 2*l1)*ido];
- dr4 = wa3[i - 2]*cc[i - 1 + (k + 3*l1)*ido] + wa3[i - 1]*cc[i + (k + 3*l1)*ido];
- di4 = wa3[i - 2]*cc[i + (k + 3*l1)*ido] - wa3[i - 1]*cc[i - 1 + (k + 3*l1)*ido];
- dr5 = wa4[i - 2]*cc[i - 1 + (k + 4*l1)*ido] + wa4[i - 1]*cc[i + (k + 4*l1)*ido];
- di5 = wa4[i - 2]*cc[i + (k + 4*l1)*ido] - wa4[i - 1]*cc[i - 1 + (k + 4*l1)*ido];
- cr2 = dr2 + dr5;
- ci5 = dr5 - dr2;
- cr5 = di2 - di5;
- ci2 = di2 + di5;
- cr3 = dr3 + dr4;
- ci4 = dr4 - dr3;
- cr4 = di3 - di4;
- ci3 = di3 + di4;
- ch[i - 1 + 5*k*ido] = cc[i - 1 + k*ido] + cr2 + cr3;
- ch[i + 5*k*ido] = cc[i + k*ido] + ci2 + ci3;
- tr2 = cc[i - 1 + k*ido] + tr11*cr2 + tr12*cr3;
- ti2 = cc[i + k*ido] + tr11*ci2 + tr12*ci3;
- tr3 = cc[i - 1 + k*ido] + tr12*cr2 + tr11*cr3;
- ti3 = cc[i + k*ido] + tr12*ci2 + tr11*ci3;
- tr5 = ti11*cr5 + ti12*cr4;
- ti5 = ti11*ci5 + ti12*ci4;
- tr4 = ti12*cr5 - ti11*cr4;
- ti4 = ti12*ci5 - ti11*ci4;
- ch[i - 1 + (5*k + 2)*ido] = tr2 + tr5;
- ch[ic - 1 + (5*k + 1)*ido] = tr2 - tr5;
- ch[i + (5*k + 2)*ido] = ti2 + ti5;
- ch[ic + (5*k + 1)*ido] = ti5 - ti2;
- ch[i - 1 + (5*k + 4)*ido] = tr3 + tr4;
- ch[ic - 1 + (5*k + 3)*ido] = tr3 - tr4;
- ch[i + (5*k + 4)*ido] = ti3 + ti4;
- ch[ic + (5*k + 3)*ido] = ti4 - ti3;
- }
- }
- }
-
-
- static void
- fftpack_radb5(int ido,
- int l1,
- real cc[],
- real ch[],
- real wa1[],
- real wa2[],
- real wa3[],
- real wa4[])
- {
- const real tr11 = 0.309016994374947;
- const real ti11 = 0.951056516295154;
- const real tr12 = -0.809016994374947;
- const real ti12 = 0.587785252292473;
-
- int i, k, ic;
- real ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, ti2, ti3,
- ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
-
- for (k = 0; k < l1; k++)
- {
- ti5 = 2*cc[(5*k + 2)*ido];
- ti4 = 2*cc[(5*k + 4)*ido];
- tr2 = 2*cc[ido-1 + (5*k + 1)*ido];
- tr3 = 2*cc[ido-1 + (5*k + 3)*ido];
- ch[k*ido] = cc[5*k*ido] + tr2 + tr3;
- cr2 = cc[5*k*ido] + tr11*tr2 + tr12*tr3;
- cr3 = cc[5*k*ido] + tr12*tr2 + tr11*tr3;
- ci5 = ti11*ti5 + ti12*ti4;
- ci4 = ti12*ti5 - ti11*ti4;
- ch[(k + l1)*ido] = cr2 - ci5;
- ch[(k + 2*l1)*ido] = cr3 - ci4;
- ch[(k + 3*l1)*ido] = cr3 + ci4;
- ch[(k + 4*l1)*ido] = cr2 + ci5;
- }
- if (ido == 1) return;
- for (k = 0; k < l1; ++k)
- {
- for (i = 2; i < ido; i += 2)
- {
- ic = ido - i;
- ti5 = cc[i + (5*k + 2)*ido] + cc[ic + (5*k + 1)*ido];
- ti2 = cc[i + (5*k + 2)*ido] - cc[ic + (5*k + 1)*ido];
- ti4 = cc[i + (5*k + 4)*ido] + cc[ic + (5*k + 3)*ido];
- ti3 = cc[i + (5*k + 4)*ido] - cc[ic + (5*k + 3)*ido];
- tr5 = cc[i - 1 + (5*k + 2)*ido] - cc[ic - 1 + (5*k + 1)*ido];
- tr2 = cc[i - 1 + (5*k + 2)*ido] + cc[ic - 1 + (5*k + 1)*ido];
- tr4 = cc[i - 1 + (5*k + 4)*ido] - cc[ic - 1 + (5*k + 3)*ido];
- tr3 = cc[i - 1 + (5*k + 4)*ido] + cc[ic - 1 + (5*k + 3)*ido];
- ch[i - 1 + k*ido] = cc[i - 1 + 5*k*ido] + tr2 + tr3;
- ch[i + k*ido] = cc[i + 5*k*ido] + ti2 + ti3;
- cr2 = cc[i - 1 + 5*k*ido] + tr11*tr2 + tr12*tr3;
- ci2 = cc[i + 5*k*ido] + tr11*ti2 + tr12*ti3;
- cr3 = cc[i - 1 + 5*k*ido] + tr12*tr2 + tr11*tr3;
- ci3 = cc[i + 5*k*ido] + tr12*ti2 + tr11*ti3;
- cr5 = ti11*tr5 + ti12*tr4;
- ci5 = ti11*ti5 + ti12*ti4;
- cr4 = ti12*tr5 - ti11*tr4;
- ci4 = ti12*ti5 - ti11*ti4;
- dr3 = cr3 - ci4;
- dr4 = cr3 + ci4;
- di3 = ci3 + cr4;
- di4 = ci3 - cr4;
- dr5 = cr2 + ci5;
- dr2 = cr2 - ci5;
- di5 = ci2 - cr5;
- di2 = ci2 + cr5;
- ch[i - 1 + (k + l1)*ido] = wa1[i - 2]*dr2 - wa1[i - 1]*di2;
- ch[i + (k + l1)*ido] = wa1[i - 2]*di2 + wa1[i - 1]*dr2;
- ch[i - 1 + (k + 2*l1)*ido] = wa2[i - 2]*dr3 - wa2[i - 1]*di3;
- ch[i + (k + 2*l1)*ido] = wa2[i - 2]*di3 + wa2[i - 1]*dr3;
- ch[i - 1 + (k + 3*l1)*ido] = wa3[i - 2]*dr4 - wa3[i - 1]*di4;
- ch[i + (k + 3*l1)*ido] = wa3[i - 2]*di4 + wa3[i - 1]*dr4;
- ch[i - 1 + (k + 4*l1)*ido] = wa4[i - 2]*dr5 - wa4[i - 1]*di5;
- ch[i + (k + 4*l1)*ido] = wa4[i - 2]*di5 + wa4[i - 1]*dr5;
- }
- }
- }
-
-
- static void
- fftpack_radfg(int ido,
- int ip,
- int l1,
- int idl1,
- real cc[],
- real ch[],
- real wa[])
- {
- const real twopi = 6.28318530717959;
- int idij, ipph, i, j, k, l, j2, ic, jc, lc, ik, is, nbd;
- real dc2, ai1, ai2, ar1, ar2, ds2, dcp, arg, dsp, ar1h, ar2h;
- arg = twopi / ip;
- dcp = cos(arg);
- dsp = sin(arg);
- ipph = (ip + 1) / 2;
- nbd = (ido - 1) / 2;
- if (ido != 1)
- {
- for (ik=0; ik<idl1; ik++) ch[ik] = cc[ik];
- for (j=1; j<ip; j++)
- for (k=0; k<l1; k++)
- ch[(k + j*l1)*ido] = cc[(k + j*l1)*ido];
- if (nbd <= l1)
- {
- is = -ido;
- for (j=1; j<ip; j++)
- {
- is += ido;
- idij = is-1;
- for (i=2; i<ido; i+=2)
- {
- idij += 2;
- for (k=0; k<l1; k++)
- {
- ch[i - 1 + (k + j*l1)*ido] =
- wa[idij - 1]*cc[i - 1 + (k + j*l1)*ido] + wa[idij]*cc[i + (k + j*l1)*ido];
- ch[i + (k + j*l1)*ido] =
- wa[idij - 1]*cc[i + (k + j*l1)*ido] - wa[idij]*cc[i - 1 + (k + j*l1)*ido];
- }
- }
- }
- }
- else
- {
- is = -ido;
- for (j=1; j<ip; j++)
- {
- is += ido;
- for (k=0; k<l1; k++)
- {
- idij = is-1;
- for (i=2; i<ido; i+=2)
- {
- idij += 2;
- ch[i - 1 + (k + j*l1)*ido] =
- wa[idij - 1]*cc[i - 1 + (k + j*l1)*ido] + wa[idij]*cc[i + (k + j*l1)*ido];
- ch[i + (k + j*l1)*ido] =
- wa[idij - 1]*cc[i + (k + j*l1)*ido] - wa[idij]*cc[i - 1 + (k + j*l1)*ido];
- }
- }
- }
- }
- if (nbd >= l1)
- {
- for (j=1; j<ipph; j++)
- {
- jc = ip - j;
- for (k=0; k<l1; k++)
- {
- for (i=2; i<ido; i+=2)
- {
- cc[i - 1 + (k + j*l1)*ido] = ch[i - 1 + (k + j*l1)*ido] + ch[i - 1 + (k + jc*l1)*ido];
- cc[i - 1 + (k + jc*l1)*ido] = ch[i + (k + j*l1)*ido] - ch[i + (k + jc*l1)*ido];
- cc[i + (k + j*l1)*ido] = ch[i + (k + j*l1)*ido] + ch[i + (k + jc*l1)*ido];
- cc[i + (k + jc*l1)*ido] = ch[i - 1 + (k + jc*l1)*ido] - ch[i - 1 + (k + j*l1)*ido];
- }
- }
- }
- }
- else
- {
- for (j=1; j<ipph; j++)
- {
- jc = ip - j;
- for (i=2; i<ido; i+=2)
- {
- for (k=0; k<l1; k++)
- {
- cc[i - 1 + (k + j*l1)*ido] =
- ch[i - 1 + (k + j*l1)*ido] + ch[i - 1 + (k + jc*l1)*ido];
- cc[i - 1 + (k + jc*l1)*ido] = ch[i + (k + j*l1)*ido] - ch[i + (k + jc*l1)*ido];
- cc[i + (k + j*l1)*ido] = ch[i + (k + j*l1)*ido] + ch[i + (k + jc*l1)*ido];
- cc[i + (k + jc*l1)*ido] = ch[i - 1 + (k + jc*l1)*ido] - ch[i - 1 + (k + j*l1)*ido];
- }
- }
- }
- }
- }
- else
- {
- for (ik=0; ik<idl1; ik++)
- cc[ik] = ch[ik];
- }
- for (j=1; j<ipph; j++)
- {
- jc = ip - j;
- for (k=0; k<l1; k++)
- {
- cc[(k + j*l1)*ido] = ch[(k + j*l1)*ido] + ch[(k + jc*l1)*ido];
- cc[(k + jc*l1)*ido] = ch[(k + jc*l1)*ido] - ch[(k + j*l1)*ido];
- }
- }
-
- ar1 = 1;
- ai1 = 0;
- for (l=1; l<ipph; l++)
- {
- lc = ip - l;
- ar1h = dcp*ar1 - dsp*ai1;
- ai1 = dcp*ai1 + dsp*ar1;
- ar1 = ar1h;
- for (ik=0; ik<idl1; ik++)
- {
- ch[ik + l*idl1] = cc[ik] + ar1*cc[ik + idl1];
- ch[ik + lc*idl1] = ai1*cc[ik + (ip-1)*idl1];
- }
- dc2 = ar1;
- ds2 = ai1;
- ar2 = ar1;
- ai2 = ai1;
- for (j=2; j<ipph; j++)
- {
- jc = ip - j;
- ar2h = dc2*ar2 - ds2*ai2;
- ai2 = dc2*ai2 + ds2*ar2;
- ar2 = ar2h;
- for (ik=0; ik<idl1; ik++)
- {
- ch[ik + l*idl1] += ar2*cc[ik + j*idl1];
- ch[ik + lc*idl1] += ai2*cc[ik + jc*idl1];
- }
- }
- }
- for (j=1; j<ipph; j++)
- for (ik=0; ik<idl1; ik++)
- ch[ik] += cc[ik + j*idl1];
-
- if (ido >= l1)
- {
- for (k=0; k<l1; k++)
- {
- for (i=0; i<ido; i++)
- {
- cc[i + k*ip*ido] = ch[i + k*ido];
- }
- }
- }
- else
- {
- for (i=0; i<ido; i++)
- {
- for (k=0; k<l1; k++)
- {
- cc[i + k*ip*ido] = ch[i + k*ido];
- }
- }
- }
- for (j=1; j<ipph; j++)
- {
- jc = ip - j;
- j2 = 2*j;
- for (k=0; k<l1; k++)
- {
- cc[ido-1 + (j2 - 1 + k*ip)*ido] = ch[(k + j*l1)*ido];
- cc[(j2 + k*ip)*ido] = ch[(k + jc*l1)*ido];
- }
- }
- if (ido == 1) return;
- if (nbd >= l1)
- {
- for (j=1; j<ipph; j++)
- {
- jc = ip - j;
- j2 = 2*j;
- for (k=0; k<l1; k++)
- {
- for (i=2; i<ido; i+=2)
- {
- ic = ido - i;
- cc[i - 1 + (j2 + k*ip)*ido] = ch[i - 1 + (k + j*l1)*ido] + ch[i - 1 + (k + jc*l1)*ido];
- cc[ic - 1 + (j2 - 1 + k*ip)*ido] = ch[i - 1 + (k + j*l1)*ido] - ch[i - 1 + (k + jc*l1)*ido];
- cc[i + (j2 + k*ip)*ido] = ch[i + (k + j*l1)*ido] + ch[i + (k + jc*l1)*ido];
- cc[ic + (j2 - 1 + k*ip)*ido] = ch[i + (k + jc*l1)*ido] - ch[i + (k + j*l1)*ido];
- }
- }
- }
- }
- else
- {
- for (j=1; j<ipph; j++)
- {
- jc = ip - j;
- j2 = 2*j;
- for (i=2; i<ido; i+=2)
- {
- ic = ido - i;
- for (k=0; k<l1; k++)
- {
- cc[i - 1 + (j2 + k*ip)*ido] = ch[i - 1 + (k + j*l1)*ido] + ch[i - 1 + (k + jc*l1)*ido];
- cc[ic - 1 + (j2 - 1 + k*ip)*ido] = ch[i - 1 + (k + j*l1)*ido] - ch[i - 1 + (k + jc*l1)*ido];
- cc[i + (j2 + k*ip)*ido] = ch[i + (k + j*l1)*ido] + ch[i + (k + jc*l1)*ido];
- cc[ic + (j2 - 1 + k*ip)*ido] = ch[i + (k + jc*l1)*ido] - ch[i + (k + j*l1)*ido];
- }
- }
- }
- }
- }
-
-
- static void
- fftpack_radbg(int ido,
- int ip,
- int l1,
- int idl1,
- real cc[],
- real ch[],
- real wa[])
- {
- const real twopi = 6.28318530717959;
- int idij, ipph, i, j, k, l, j2, ic, jc, lc, ik, is;
- real dc2, ai1, ai2, ar1, ar2, ds2;
- int nbd;
- real dcp, arg, dsp, ar1h, ar2h;
- arg = twopi / ip;
- dcp = cos(arg);
- dsp = sin(arg);
- nbd = (ido - 1) / 2;
- ipph = (ip + 1) / 2;
-
- if (ido >= l1)
- {
- for (k=0; k<l1; k++)
- {
- for (i=0; i<ido; i++)
- {
- ch[i + k*ido] = cc[i + k*ip*ido];
- }
- }
- }
- else
- {
- for (i=0; i<ido; i++)
- {
- for (k=0; k<l1; k++)
- {
- ch[i + k*ido] = cc[i + k*ip*ido];
- }
- }
- }
- for (j=1; j<ipph; j++)
- {
- jc = ip - j;
- j2 = 2*j;
- for (k=0; k<l1; k++)
- {
- ch[(k + j*l1)*ido] = cc[ido-1 + (j2 - 1 + k*ip)*ido] + cc[ido-1 + (j2 - 1 + k*ip)*ido];
- ch[(k + jc*l1)*ido] = cc[(j2 + k*ip)*ido] + cc[(j2 + k*ip)*ido];
- }
- }
-
- if (ido != 1)
- {
- if (nbd >= l1)
- {
- for (j=1; j<ipph; j++)
- {
- jc = ip - j;
- for (k=0; k<l1; k++)
- {
- for (i=2; i<ido; i+=2)
- {
- ic = ido - i;
- ch[i - 1 + (k + j*l1)*ido] = cc[i - 1 + (2*j + k*ip)*ido] + cc[ic - 1 + (2*j - 1 + k*ip)*ido];
- ch[i - 1 + (k + jc*l1)*ido] = cc[i - 1 + (2*j + k*ip)*ido] - cc[ic - 1 + (2*j - 1 + k*ip)*ido];
- ch[i + (k + j*l1)*ido] = cc[i + (2*j + k*ip)*ido] - cc[ic + (2*j - 1 + k*ip)*ido];
- ch[i + (k + jc*l1)*ido] = cc[i + (2*j + k*ip)*ido] + cc[ic + (2*j - 1 + k*ip)*ido];
- }
- }
- }
- }
- else
- {
- for (j=1; j<ipph; j++)
- {
- jc = ip - j;
- for (i=2; i<ido; i+=2)
- {
- ic = ido - i;
- for (k=0; k<l1; k++)
- {
- ch[i - 1 + (k + j*l1)*ido] = cc[i - 1 + (2*j + k*ip)*ido] + cc[ic - 1 + (2*j - 1 + k*ip)*ido];
- ch[i - 1 + (k + jc*l1)*ido] = cc[i - 1 + (2*j + k*ip)*ido] - cc[ic - 1 + (2*j - 1 + k*ip)*ido];
- ch[i + (k + j*l1)*ido] = cc[i + (2*j + k*ip)*ido] - cc[ic + (2*j - 1 + k*ip)*ido];
- ch[i + (k + jc*l1)*ido] = cc[i + (2*j + k*ip)*ido] + cc[ic + (2*j - 1 + k*ip)*ido];
- }
- }
- }
- }
- }
-
- ar1 = 1;
- ai1 = 0;
- for (l=1; l<ipph; l++)
- {
- lc = ip - l;
- ar1h = dcp*ar1 - dsp*ai1;
- ai1 = dcp*ai1 + dsp*ar1;
- ar1 = ar1h;
- for (ik=0; ik<idl1; ik++)
- {
- cc[ik + l*idl1] = ch[ik] + ar1*ch[ik + idl1];
- cc[ik + lc*idl1] = ai1*ch[ik + (ip-1)*idl1];
- }
- dc2 = ar1;
- ds2 = ai1;
- ar2 = ar1;
- ai2 = ai1;
- for (j=2; j<ipph; j++)
- {
- jc = ip - j;
- ar2h = dc2*ar2 - ds2*ai2;
- ai2 = dc2*ai2 + ds2*ar2;
- ar2 = ar2h;
- for (ik=0; ik<idl1; ik++)
- {
- cc[ik + l*idl1] += ar2*ch[ik + j*idl1];
- cc[ik + lc*idl1] += ai2*ch[ik + jc*idl1];
- }
- }
- }
- for (j=1; j<ipph; j++)
- {
- for (ik=0; ik<idl1; ik++)
- {
- ch[ik] += ch[ik + j*idl1];
- }
- }
- for (j=1; j<ipph; j++)
- {
- jc = ip - j;
- for (k=0; k<l1; k++)
- {
- ch[(k + j*l1)*ido] = cc[(k + j*l1)*ido] - cc[(k + jc*l1)*ido];
- ch[(k + jc*l1)*ido] = cc[(k + j*l1)*ido] + cc[(k + jc*l1)*ido];
- }
- }
-
- if (ido == 1) return;
- if (nbd >= l1)
- {
- for (j=1; j<ipph; j++)
- {
- jc = ip - j;
- for (k=0; k<l1; k++)
- {
- for (i=2; i<ido; i+=2)
- {
- ch[i - 1 + (k + j*l1)*ido] = cc[i - 1 + (k + j*l1)*ido] - cc[i + (k + jc*l1)*ido];
- ch[i - 1 + (k + jc*l1)*ido] = cc[i - 1 + (k + j*l1)*ido] + cc[i + (k + jc*l1)*ido];
- ch[i + (k + j*l1)*ido] = cc[i + (k + j*l1)*ido] + cc[i - 1 + (k + jc*l1)*ido];
- ch[i + (k + jc*l1)*ido] = cc[i + (k + j*l1)*ido] - cc[i - 1 + (k + jc*l1)*ido];
- }
- }
- }
- }
- else
- {
- for (j=1; j<ipph; j++)
- {
- jc = ip - j;
- for (i=2; i<ido; i+=2)
- {
- for (k=0; k<l1; k++)
- {
- ch[i - 1 + (k + j*l1)*ido] = cc[i - 1 + (k + j*l1)*ido] - cc[i + (k + jc*l1)*ido];
- ch[i - 1 + (k + jc*l1)*ido] = cc[i - 1 + (k + j *l1)*ido] + cc[i + (k + jc*l1)*ido];
- ch[i + (k + j*l1)*ido] = cc[i + (k + j*l1)*ido] + cc[i - 1 + (k + jc*l1)*ido];
- ch[i + (k + jc*l1)*ido] = cc[i + (k + j*l1)*ido] - cc[i - 1 + (k + jc*l1)*ido];
- }
- }
- }
- }
- for (ik=0; ik<idl1; ik++)
- {
- cc[ik] = ch[ik];
- }
- for (j=1; j<ip; j++)
- for (k=0; k<l1; k++)
- cc[(k + j*l1)*ido] = ch[(k + j*l1)*ido];
-
- if (nbd <= l1)
- {
- is = -ido;
- for (j=1; j<ip; j++)
- {
- is += ido;
- idij = is-1;
- for (i=2; i<ido; i+=2)
- {
- idij += 2;
- for (k=0; k<l1; k++)
- {
- cc[i - 1 + (k + j*l1)*ido] = wa[idij - 1]*ch[i - 1 + (k + j*l1)*ido] - wa[idij]*ch[i + (k + j*l1)*ido];
- cc[i + (k + j*l1)*ido] = wa[idij - 1]*ch[i + (k + j*l1)*ido] + wa[idij]*ch[i - 1 + (k + j*l1)*ido];
- }
- }
- }
- }
- else
- {
- is = -ido;
- for (j=1; j<ip; j++)
- {
- is += ido;
- for (k=0; k<l1; k++)
- {
- idij = is;
- for (i=2; i<ido; i+=2)
- {
- idij += 2;
- cc[i - 1 + (k + j*l1)*ido] = wa[idij-1]*ch[i - 1 + (k + j*l1)*ido] - wa[idij]*ch[i + (k + j*l1)*ido];
- cc[i + (k + j*l1)*ido] = wa[idij-1]*ch[i + (k + j*l1)*ido] + wa[idij]*ch[i - 1 + (k + j*l1)*ido];
- }
- }
- }
- }
- }
-
-
-
- static void
- fftpack_cfftf1(int n,
- real c[],
- real ch[],
- real wa[],
- int ifac[15],
- int isign)
- {
- int idot, i;
- int k1, l1, l2;
- int na, nf, ip, iw, ix2, ix3, ix4, nac, ido, idl1;
- real *cinput, *coutput;
- nf = ifac[1];
- na = 0;
- l1 = 1;
- iw = 0;
-
- for (k1=2; k1<=nf+1; k1++)
- {
- ip = ifac[k1];
- l2 = ip*l1;
- ido = n / l2;
- idot = ido + ido;
- idl1 = idot*l1;
- if (na)
- {
- cinput = ch;
- coutput = c;
- }
- else
- {
- cinput = c;
- coutput = ch;
- }
- switch (ip)
- {
- case 4:
- ix2 = iw + idot;
- ix3 = ix2 + idot;
- fftpack_passf4(idot, l1, cinput, coutput, &wa[iw], &wa[ix2], &wa[ix3], isign);
- na = !na;
- break;
- case 2:
- fftpack_passf2(idot, l1, cinput, coutput, &wa[iw], isign);
- na = !na;
- break;
- case 3:
- ix2 = iw + idot;
- fftpack_passf3(idot, l1, cinput, coutput, &wa[iw], &wa[ix2], isign);
- na = !na;
- break;
- case 5:
- ix2 = iw + idot;
- ix3 = ix2 + idot;
- ix4 = ix3 + idot;
- fftpack_passf5(idot, l1, cinput, coutput, &wa[iw], &wa[ix2], &wa[ix3], &wa[ix4], isign);
- na = !na;
- break;
- default:
- fftpack_passf(&nac, idot, ip, l1, idl1, cinput, coutput, &wa[iw], isign);
- if (nac != 0) na = !na;
- }
- l1 = l2;
- iw += (ip - 1)*idot;
- }
- if (na == 0)
- return;
- for (i=0; i<2*n; i++)
- c[i] = ch[i];
- }
-
-
- void
- fftpack_cfftf(int n,
- real c[],
- real wsave[])
- {
- int iw1, iw2;
-
- if (n == 1)
- return;
- iw1 = 2*n;
- iw2 = iw1 + 2*n;
- fftpack_cfftf1(n, c, wsave, wsave+iw1, (int*)(wsave+iw2), -1);
- }
-
-
- void
- fftpack_cfftb(int n,
- real c[],
- real wsave[])
- {
- int iw1, iw2;
-
- if (n == 1)
- return;
- iw1 = 2*n;
- iw2 = iw1 + 2*n;
- fftpack_cfftf1(n, c, wsave, wsave+iw1, (int*)(wsave+iw2), +1);
- }
-
-
- static void
- fftpack_factorize(int n,
- int ifac[15])
- {
- static const int ntryh[4] = { 3,4,2,5 };
- int ntry=3, i, j=0, ib, nf=0, nl=n, nq, nr;
-
- startloop:
- if (j < 4)
- ntry = ntryh[j];
- else
- ntry+= 2;
- j++;
- do
- {
- nq = nl / ntry;
- nr = nl - ntry*nq;
- if (nr != 0) goto startloop;
- nf++;
- ifac[nf + 1] = ntry;
- nl = nq;
- if (ntry == 2 && nf != 1)
- {
- for (i=2; i<=nf; i++)
- {
- ib = nf - i + 2;
- ifac[ib + 1] = ifac[ib];
- }
- ifac[2] = 2;
- }
- }
- while (nl != 1);
- ifac[0] = n;
- ifac[1] = nf;
- }
-
-
- static void
- fftpack_cffti1(int n,
- real wa[],
- int ifac[15])
- {
- const real twopi = 6.28318530717959;
- real arg, argh, argld, fi;
- int idot, i, j;
- int i1, k1, l1, l2;
- int ld, ii, nf, ip;
- int ido, ipm;
-
- fftpack_factorize(n,ifac);
- nf = ifac[1];
- argh = twopi/(real)n;
- i = 1;
- l1 = 1;
- for (k1=1; k1<=nf; k1++)
- {
- ip = ifac[k1+1];
- ld = 0;
- l2 = l1*ip;
- ido = n / l2;
- idot = ido + ido + 2;
- ipm = ip - 1;
- for (j=1; j<=ipm; j++)
- {
- i1 = i;
- wa[i-1] = 1;
- wa[i] = 0;
- ld += l1;
- fi = 0;
- argld = ld*argh;
- for (ii=4; ii<=idot; ii+=2)
- {
- i+= 2;
- fi+= 1;
- arg = fi*argld;
- wa[i-1] = cos(arg);
- wa[i] = sin(arg);
- }
- if (ip > 5)
- {
- wa[i1-1] = wa[i-1];
- wa[i1] = wa[i];
- }
- }
- l1 = l2;
- }
- }
-
-
-
-
- static void
- fftpack_rfftf1(int n,
- real c[],
- real ch[],
- real wa[],
- int ifac[15])
- {
- int i;
- int k1, l1, l2, na, kh, nf, ip, iw, ix2, ix3, ix4, ido, idl1;
- real *cinput, *coutput;
- nf = ifac[1];
- na = 1;
- l2 = n;
- iw = n-1;
- for (k1 = 1; k1 <= nf; ++k1)
- {
- kh = nf - k1;
- ip = ifac[kh + 2];
- l1 = l2 / ip;
- ido = n / l2;
- idl1 = ido*l1;
- iw -= (ip - 1)*ido;
- na = !na;
- if (na)
- {
- cinput = ch;
- coutput = c;
- }
- else
- {
- cinput = c;
- coutput = ch;
- }
- switch (ip)
- {
- case 4:
- ix2 = iw + ido;
- ix3 = ix2 + ido;
- fftpack_radf4(ido, l1, cinput, coutput, &wa[iw], &wa[ix2], &wa[ix3]);
- break;
- case 2:
- fftpack_radf2(ido, l1, cinput, coutput, &wa[iw]);
- break;
- case 3:
- ix2 = iw + ido;
- fftpack_radf3(ido, l1, cinput, coutput, &wa[iw], &wa[ix2]);
- break;
- case 5:
- ix2 = iw + ido;
- ix3 = ix2 + ido;
- ix4 = ix3 + ido;
- fftpack_radf5(ido, l1, cinput, coutput, &wa[iw], &wa[ix2], &wa[ix3], &wa[ix4]);
- break;
- default:
- if (ido == 1)
- na = !na;
- if (na == 0)
- {
- fftpack_radfg(ido, ip, l1, idl1, c, ch, &wa[iw]);
- na = 1;
- }
- else
- {
- fftpack_radfg(ido, ip, l1, idl1, ch, c, &wa[iw]);
- na = 0;
- }
- }
- l2 = l1;
- }
- if (na == 1)
- return;
- for (i = 0; i < n; i++)
- c[i] = ch[i];
- }
-
-
- static void
- fftpack_rfftb1(int n,
- real c[],
- real ch[],
- real wa[],
- int ifac[15])
- {
- int i;
- int k1, l1, l2, na, nf, ip, iw, ix2, ix3, ix4, ido, idl1;
- real *cinput, *coutput;
- nf = ifac[1];
- na = 0;
- l1 = 1;
- iw = 0;
-
- for (k1=1; k1<=nf; k1++)
- {
- ip = ifac[k1 + 1];
- l2 = ip*l1;
- ido = n / l2;
- idl1 = ido*l1;
- if (na)
- {
- cinput = ch;
- coutput = c;
- }
- else
- {
- cinput = c;
- coutput = ch;
- }
- switch (ip)
- {
- case 4:
- ix2 = iw + ido;
- ix3 = ix2 + ido;
- fftpack_radb4(ido, l1, cinput, coutput, &wa[iw], &wa[ix2], &wa[ix3]);
- na = !na;
- break;
- case 2:
- fftpack_radb2(ido, l1, cinput, coutput, &wa[iw]);
- na = !na;
- break;
- case 3:
- ix2 = iw + ido;
- fftpack_radb3(ido, l1, cinput, coutput, &wa[iw], &wa[ix2]);
- na = !na;
- break;
- case 5:
- ix2 = iw + ido;
- ix3 = ix2 + ido;
- ix4 = ix3 + ido;
- fftpack_radb5(ido, l1, cinput, coutput, &wa[iw], &wa[ix2], &wa[ix3], &wa[ix4]);
- na = !na;
- break;
- default:
- fftpack_radbg(ido, ip, l1, idl1, cinput, coutput, &wa[iw]);
- if (ido == 1) na = !na;
- }
- l1 = l2;
- iw += (ip - 1)*ido;
- }
- if (na == 0)
- return;
- for (i=0; i<n; i++)
- c[i] = ch[i];
- }
-
-
-
-
- static void
- fftpack_rffti1(int n,
- real wa[],
- int ifac[15])
- {
- const real twopi = 6.28318530717959;
- real arg, argh, argld, fi;
- int i, j;
- int k1, l1, l2;
- int ld, ii, nf, ip, is;
- int ido, ipm, nfm1;
- fftpack_factorize(n,ifac);
- nf = ifac[1];
- argh = twopi / n;
- is = 0;
- nfm1 = nf - 1;
- l1 = 1;
- if (nfm1 == 0) return;
- for (k1 = 1; k1 <= nfm1; k1++)
- {
- ip = ifac[k1 + 1];
- ld = 0;
- l2 = l1*ip;
- ido = n / l2;
- ipm = ip - 1;
- for (j = 1; j <= ipm; ++j)
- {
- ld += l1;
- i = is;
- argld = (real) ld*argh;
- fi = 0;
- for (ii = 3; ii <= ido; ii += 2)
- {
- i += 2;
- fi += 1;
- arg = fi*argld;
- wa[i - 2] = cos(arg);
- wa[i - 1] = sin(arg);
- }
- is += ido;
- }
- l1 = l2;
- }
- }
-
-
-
-
- /* End of fftpack - begin GROMACS code */
-
-
++#include "external/fftpack/fftpack.h"
+
+/** Contents of the FFTPACK fft datatype.
+ *
+ * FFTPACK only does 1d transforms, so we use a pointers to another fft for
+ * the transform in the next dimension.
+ * Thus, a 3d-structure contains a pointer to a 2d one, which in turns contains
+ * a pointer to a 1d. The 1d structure has next==NULL.
+ */
+struct gmx_fft
+{
+ int ndim; /**< Dimensions, including our subdimensions. */
+ int n; /**< Number of points in this dimension. */
+ int ifac[15]; /**< 15 bytes needed for cfft and rfft */
+ struct gmx_fft *next; /**< Pointer to next dimension, or NULL. */
+ real * work; /**< 1st 4n reserved for cfft, 1st 2n for rfft */
+};
+
+#include <math.h>
+#include <stdio.h>
+
+
- #else
- int
- gmx_fft_fftpack_empty;
+int
+gmx_fft_init_1d(gmx_fft_t * pfft,
+ int nx,
+ int flags)
+{
+ gmx_fft_t fft;
+
+ if(pfft==NULL)
+ {
+ gmx_fatal(FARGS,"Invalid FFT opaque type pointer.");
+ return EINVAL;
+ }
+ *pfft = NULL;
+
+ if( (fft = (struct gmx_fft *)malloc(sizeof(struct gmx_fft))) == NULL)
+ {
+ return ENOMEM;
+ }
+
+ fft->next = NULL;
+ fft->n = nx;
+
+ /* Need 4*n storage for 1D complex FFT */
+ if( (fft->work = (real *)malloc(sizeof(real)*(4*nx))) == NULL)
+ {
+ free(fft);
+ return ENOMEM;
+ }
+
+ if(fft->n>1)
+ fftpack_cffti1(nx,fft->work,fft->ifac);
+
+ *pfft = fft;
+ return 0;
+};
+
+
+
+int
+gmx_fft_init_1d_real(gmx_fft_t * pfft,
+ int nx,
+ int flags)
+{
+ gmx_fft_t fft;
+
+ if(pfft==NULL)
+ {
+ gmx_fatal(FARGS,"Invalid FFT opaque type pointer.");
+ return EINVAL;
+ }
+ *pfft = NULL;
+
+ if( (fft = (struct gmx_fft *)malloc(sizeof(struct gmx_fft))) == NULL)
+ {
+ return ENOMEM;
+ }
+
+ fft->next = NULL;
+ fft->n = nx;
+
+ /* Need 2*n storage for 1D real FFT */
+ if((fft->work = (real *)malloc(sizeof(real)*(2*nx)))==NULL)
+ {
+ free(fft);
+ return ENOMEM;
+ }
+
+ if(fft->n>1)
+ fftpack_rffti1(nx,fft->work,fft->ifac);
+
+ *pfft = fft;
+ return 0;
+}
+
+
+
+int
+gmx_fft_init_2d(gmx_fft_t * pfft,
+ int nx,
+ int ny,
+ int flags)
+{
+ gmx_fft_t fft;
+ int rc;
+
+ if(pfft==NULL)
+ {
+ gmx_fatal(FARGS,"Invalid FFT opaque type pointer.");
+ return EINVAL;
+ }
+ *pfft = NULL;
+
+ /* Create the X transform */
+ if( (rc = gmx_fft_init_1d(&fft,nx,flags)) != 0)
+ {
+ return rc;
+ }
+
+ /* Create Y transform as a link from X */
+ if( (rc=gmx_fft_init_1d(&(fft->next),ny,flags)) != 0)
+ {
+ free(fft);
+ return rc;
+ }
+
+ *pfft = fft;
+ return 0;
+};
+
+
+int
+gmx_fft_init_2d_real(gmx_fft_t * pfft,
+ int nx,
+ int ny,
+ int flags)
+{
+ gmx_fft_t fft;
+ int nyc = (ny/2 + 1);
+ int rc;
+
+ if(pfft==NULL)
+ {
+ gmx_fatal(FARGS,"Invalid FFT opaque type pointer.");
+ return EINVAL;
+ }
+ *pfft = NULL;
+
+ /* Create the X transform */
+ if( (fft = (struct gmx_fft *)malloc(sizeof(struct gmx_fft))) == NULL)
+ {
+ return ENOMEM;
+ }
+
+ fft->n = nx;
+
+ /* Need 4*nx storage for 1D complex FFT, and another
+ * 2*nx*nyc elements for complex-to-real storage in our high-level routine.
+ */
+ if( (fft->work = (real *)malloc(sizeof(real)*(4*nx+2*nx*nyc))) == NULL)
+ {
+ free(fft);
+ return ENOMEM;
+ }
+ fftpack_cffti1(nx,fft->work,fft->ifac);
+
+ /* Create real Y transform as a link from X */
+ if( (rc=gmx_fft_init_1d_real(&(fft->next),ny,flags)) != 0)
+ {
+ free(fft);
+ return rc;
+ }
+
+ *pfft = fft;
+ return 0;
+}
+
+
+int
+gmx_fft_init_3d(gmx_fft_t * pfft,
+ int nx,
+ int ny,
+ int nz,
+ int flags)
+{
+ gmx_fft_t fft;
+ int rc;
+
+ if(pfft==NULL)
+ {
+ gmx_fatal(FARGS,"Invalid FFT opaque type pointer.");
+ return EINVAL;
+ }
+ *pfft = NULL;
+
+ /* Create the X transform */
+
+ if( (fft = (struct gmx_fft *)malloc(sizeof(struct gmx_fft))) == NULL)
+ {
+ return ENOMEM;
+ }
+
+ fft->n = nx;
+
+ /* Need 4*nx storage for 1D complex FFT, and another
+ * 2*nz elements for gmx_fft_transpose_2d_nelem() storage.
+ */
+ if( (fft->work = (real *)malloc(sizeof(real)*(4*nx+2*nz))) == NULL)
+ {
+ free(fft);
+ return ENOMEM;
+ }
+
+ fftpack_cffti1(nx,fft->work,fft->ifac);
+
+
+ /* Create 2D Y/Z transforms as a link from X */
+ if( (rc=gmx_fft_init_2d(&(fft->next),ny,nz,flags)) != 0)
+ {
+ free(fft);
+ return rc;
+ }
+
+ *pfft = fft;
+ return 0;
+};
+
+
+int
+gmx_fft_init_3d_real(gmx_fft_t * pfft,
+ int nx,
+ int ny,
+ int nz,
+ int flags)
+{
+ gmx_fft_t fft;
+ int nzc = (nz/2 + 1);
+ int rc;
+
+ if(pfft==NULL)
+ {
+ gmx_fatal(FARGS,"Invalid FFT opaque type pointer.");
+ return EINVAL;
+ }
+ *pfft = NULL;
+
+ /* Create the X transform */
+ if( (fft = (struct gmx_fft *)malloc(sizeof(struct gmx_fft))) == NULL)
+ {
+ return ENOMEM;
+ }
+
+ fft->n = nx;
+
+ /* Need 4*nx storage for 1D complex FFT, another
+ * 2*nx*ny*nzc elements to copy the entire 3D matrix when
+ * doing out-of-place complex-to-real FFTs, and finally
+ * 2*nzc elements for transpose work space.
+ */
+ if( (fft->work = (real *)malloc(sizeof(real)*(4*nx+2*nx*ny*nzc+2*nzc))) == NULL)
+ {
+ free(fft);
+ return ENOMEM;
+ }
+ fftpack_cffti1(nx,fft->work,fft->ifac);
+
+ /* Create 2D real Y/Z transform as a link from X */
+ if( (rc=gmx_fft_init_2d_real(&(fft->next),ny,nz,flags)) != 0)
+ {
+ free(fft);
+ return rc;
+ }
+
+ *pfft = fft;
+ return 0;
+}
+
+
+int
+gmx_fft_1d (gmx_fft_t fft,
+ enum gmx_fft_direction dir,
+ void * in_data,
+ void * out_data)
+{
+ int i,n;
+ real * p1;
+ real * p2;
+
+ n=fft->n;
+
+ if(n==1)
+ {
+ p1 = (real *)in_data;
+ p2 = (real *)out_data;
+ p2[0] = p1[0];
+ p2[1] = p1[1];
+ }
+
+ /* FFTPACK only does in-place transforms, so emulate out-of-place
+ * by copying data to the output array first.
+ */
+ if( in_data != out_data )
+ {
+ p1 = (real *)in_data;
+ p2 = (real *)out_data;
+
+ /* n complex = 2*n real elements */
+ for(i=0;i<2*n;i++)
+ {
+ p2[i] = p1[i];
+ }
+ }
+
+ /* Elements 0 .. 2*n-1 in work are used for ffac values,
+ * Elements 2*n .. 4*n-1 are internal FFTPACK work space.
+ */
+
+ if(dir == GMX_FFT_FORWARD)
+ {
+ fftpack_cfftf1(n,(real *)out_data,fft->work+2*n,fft->work,fft->ifac, -1);
+ }
+ else if(dir == GMX_FFT_BACKWARD)
+ {
+ fftpack_cfftf1(n,(real *)out_data,fft->work+2*n,fft->work,fft->ifac, 1);
+ }
+ else
+ {
+ gmx_fatal(FARGS,"FFT plan mismatch - bad plan or direction.");
+ return EINVAL;
+ }
+
+ return 0;
+}
+
+
+
+int
+gmx_fft_1d_real (gmx_fft_t fft,
+ enum gmx_fft_direction dir,
+ void * in_data,
+ void * out_data)
+{
+ int i,n;
+ real * p1;
+ real * p2;
+
+ n = fft->n;
+
+ if(n==1)
+ {
+ p1 = (real *)in_data;
+ p2 = (real *)out_data;
+ p2[0] = p1[0];
+ if(dir == GMX_FFT_REAL_TO_COMPLEX)
+ p2[1] = 0.0;
+ }
+
+ if(dir == GMX_FFT_REAL_TO_COMPLEX)
+ {
+ /* FFTPACK only does in-place transforms, so emulate out-of-place
+ * by copying data to the output array first. This works fine, since
+ * the complex array must be larger than the real.
+ */
+ if( in_data != out_data )
+ {
+ p1 = (real *)in_data;
+ p2 = (real *)out_data;
+
+ for(i=0;i<2*(n/2+1);i++)
+ {
+ p2[i] = p1[i];
+ }
+ }
+
+ /* Elements 0 .. n-1 in work are used for ffac values,
+ * Elements n .. 2*n-1 are internal FFTPACK work space.
+ */
+ fftpack_rfftf1(n,(real *)out_data,fft->work+n,fft->work,fft->ifac);
+
+ /*
+ * FFTPACK has a slightly more compact storage than we, time to
+ * convert it: ove most of the array one step up to make room for
+ * zero imaginary parts.
+ */
+ p2 = (real *)out_data;
+ for(i=n-1;i>0;i--)
+ {
+ p2[i+1] = p2[i];
+ }
+ /* imaginary zero freq. */
+ p2[1] = 0;
+
+ /* Is n even? */
+ if( (n & 0x1) == 0 )
+ {
+ p2[n+1] = 0;
+ }
+
+ }
+ else if(dir == GMX_FFT_COMPLEX_TO_REAL)
+ {
+ /* FFTPACK only does in-place transforms, and we cannot just copy
+ * input to output first here since our real array is smaller than
+ * the complex one. However, since the FFTPACK complex storage format
+ * is more compact than ours (2 reals) it will fit, so compact it
+ * and copy on-the-fly to the output array.
+ */
+ p1 = (real *) in_data;
+ p2 = (real *)out_data;
+
+ p2[0] = p1[0];
+ for(i=1;i<n;i++)
+ {
+ p2[i] = p1[i+1];
+ }
+ fftpack_rfftb1(n,(real *)out_data,fft->work+n,fft->work,fft->ifac);
+ }
+ else
+ {
+ gmx_fatal(FARGS,"FFT plan mismatch - bad plan or direction.");
+ return EINVAL;
+ }
+
+ return 0;
+}
+
+
+int
+gmx_fft_2d (gmx_fft_t fft,
+ enum gmx_fft_direction dir,
+ void * in_data,
+ void * out_data)
+{
+ int i,nx,ny;
+ t_complex * data;
+
+ nx = fft->n;
+ ny = fft->next->n;
+
+ /* FFTPACK only does in-place transforms, so emulate out-of-place
+ * by copying data to the output array first.
+ * For 2D there is likely enough data to benefit from memcpy().
+ */
+ if( in_data != out_data )
+ {
+ memcpy(out_data,in_data,sizeof(t_complex)*nx*ny);
+ }
+
+ /* Much easier to do pointer arithmetic when base has the correct type */
+ data = (t_complex *)out_data;
+
+ /* y transforms */
+ for(i=0;i<nx;i++)
+ {
+ gmx_fft_1d(fft->next,dir,data+i*ny,data+i*ny);
+ }
+
+ /* Transpose in-place to get data in place for x transform now */
+ gmx_fft_transpose_2d(data,data,nx,ny);
+
+ /* x transforms */
+ for(i=0;i<ny;i++)
+ {
+ gmx_fft_1d(fft,dir,data+i*nx,data+i*nx);
+ }
+
+ /* Transpose in-place to get data back in original order */
+ gmx_fft_transpose_2d(data,data,ny,nx);
+
+ return 0;
+}
+
+
+
+int
+gmx_fft_2d_real (gmx_fft_t fft,
+ enum gmx_fft_direction dir,
+ void * in_data,
+ void * out_data)
+{
+ int i,j,nx,ny,nyc;
+ t_complex * data;
+ real * work;
+ real * p1;
+ real * p2;
+
+ nx=fft->n;
+ ny=fft->next->n;
+ /* Number of complex elements in y direction */
+ nyc=(ny/2+1);
+
+ work = fft->work+4*nx;
+
+ if(dir==GMX_FFT_REAL_TO_COMPLEX)
+ {
+ /* If we are doing an in-place transform the 2D array is already
+ * properly padded by the user, and we are all set.
+ *
+ * For out-of-place there is no array padding, but FFTPACK only
+ * does in-place FFTs internally, so we need to start by copying
+ * data from the input to the padded (larger) output array.
+ */
+ if( in_data != out_data )
+ {
+ p1 = (real *)in_data;
+ p2 = (real *)out_data;
+
+ for(i=0;i<nx;i++)
+ {
+ for(j=0;j<ny;j++)
+ {
+ p2[i*nyc*2+j] = p1[i*ny+j];
+ }
+ }
+ }
+ data = (t_complex *)out_data;
+
+ /* y real-to-complex FFTs */
+ for(i=0;i<nx;i++)
+ {
+ gmx_fft_1d_real(fft->next,GMX_FFT_REAL_TO_COMPLEX,data+i*nyc,data+i*nyc);
+ }
+
+ /* Transform to get X data in place */
+ gmx_fft_transpose_2d(data,data,nx,nyc);
+
+ /* Complex-to-complex X FFTs */
+ for(i=0;i<nyc;i++)
+ {
+ gmx_fft_1d(fft,GMX_FFT_FORWARD,data+i*nx,data+i*nx);
+ }
+
+ /* Transpose back */
+ gmx_fft_transpose_2d(data,data,nyc,nx);
+
+ }
+ else if(dir==GMX_FFT_COMPLEX_TO_REAL)
+ {
+ /* An in-place complex-to-real transform is straightforward,
+ * since the output array must be large enough for the padding to fit.
+ *
+ * For out-of-place complex-to-real transforms we cannot just copy
+ * data to the output array, since it is smaller than the input.
+ * In this case there's nothing to do but employing temporary work data,
+ * starting at work+4*nx and using nx*nyc*2 elements.
+ */
+ if(in_data != out_data)
+ {
+ memcpy(work,in_data,sizeof(t_complex)*nx*nyc);
+ data = (t_complex *)work;
+ }
+ else
+ {
+ /* in-place */
+ data = (t_complex *)out_data;
+ }
+
+ /* Transpose to get X arrays */
+ gmx_fft_transpose_2d(data,data,nx,nyc);
+
+ /* Do X iFFTs */
+ for(i=0;i<nyc;i++)
+ {
+ gmx_fft_1d(fft,GMX_FFT_BACKWARD,data+i*nx,data+i*nx);
+ }
+
+ /* Transpose to get Y arrays */
+ gmx_fft_transpose_2d(data,data,nyc,nx);
+
+ /* Do Y iFFTs */
+ for(i=0;i<nx;i++)
+ {
+ gmx_fft_1d_real(fft->next,GMX_FFT_COMPLEX_TO_REAL,data+i*nyc,data+i*nyc);
+ }
+
+ if( in_data != out_data )
+ {
+ /* Output (pointed to by data) is now in padded format.
+ * Pack it into out_data if we were doing an out-of-place transform.
+ */
+ p1 = (real *)data;
+ p2 = (real *)out_data;
+
+ for(i=0;i<nx;i++)
+ {
+ for(j=0;j<ny;j++)
+ {
+ p2[i*ny+j] = p1[i*nyc*2+j];
+ }
+ }
+ }
+ }
+ else
+ {
+ gmx_fatal(FARGS,"FFT plan mismatch - bad plan or direction.");
+ return EINVAL;
+ }
+
+ return 0;
+}
+
+
+
+int
+gmx_fft_3d (gmx_fft_t fft,
+ enum gmx_fft_direction dir,
+ void * in_data,
+ void * out_data)
+{
+ int i,nx,ny,nz,rc;
+ t_complex * data;
+ t_complex * work;
+ nx=fft->n;
+ ny=fft->next->n;
+ nz=fft->next->next->n;
+
+ /* First 4*nx positions are FFTPACK workspace, then ours starts */
+ work = (t_complex *)(fft->work+4*nx);
+
+ /* FFTPACK only does in-place transforms, so emulate out-of-place
+ * by copying data to the output array first.
+ * For 3D there is likely enough data to benefit from memcpy().
+ */
+ if( in_data != out_data )
+ {
+ memcpy(out_data,in_data,sizeof(t_complex)*nx*ny*nz);
+ }
+
+ /* Much easier to do pointer arithmetic when base has the correct type */
+ data = (t_complex *)out_data;
+
+ /* Perform z transforms */
+ for(i=0;i<nx*ny;i++)
+ gmx_fft_1d(fft->next->next,dir,data+i*nz,data+i*nz);
+
+ /* For each X slice, transpose the y & z dimensions inside the slice */
+ for(i=0;i<nx;i++)
+ {
+ gmx_fft_transpose_2d(data+i*ny*nz,data+i*ny*nz,ny,nz);
+ }
+
+ /* Array is now (nx,nz,ny) - perform y transforms */
+ for(i=0;i<nx*nz;i++)
+ {
+ gmx_fft_1d(fft->next,dir,data+i*ny,data+i*ny);
+ }
+
+ /* Transpose back to (nx,ny,nz) */
+ for(i=0;i<nx;i++)
+ {
+ gmx_fft_transpose_2d(data+i*ny*nz,data+i*ny*nz,nz,ny);
+ }
+
+ /* Transpose entire x & y slices to go from
+ * (nx,ny,nz) to (ny,nx,nz).
+ * Use work data elements 4*n .. 4*n+2*nz-1.
+ */
+ rc=gmx_fft_transpose_2d_nelem(data,data,nx,ny,nz,work);
+ if( rc != 0)
+ {
+ gmx_fatal(FARGS,"Cannot transpose X & Y/Z in gmx_fft_3d().");
+ return rc;
+ }
+
+ /* Then go from (ny,nx,nz) to (ny,nz,nx) */
+ for(i=0;i<ny;i++)
+ {
+ gmx_fft_transpose_2d(data+i*nx*nz,data+i*nx*nz,nx,nz);
+ }
+
+ /* Perform x transforms */
+ for(i=0;i<ny*nz;i++)
+ {
+ gmx_fft_1d(fft,dir,data+i*nx,data+i*nx);
+ }
+
+ /* Transpose back from (ny,nz,nx) to (ny,nx,nz) */
+ for(i=0;i<ny;i++)
+ {
+ gmx_fft_transpose_2d(data+i*nz*nx,data+i*nz*nx,nz,nx);
+ }
+
+ /* Transpose from (ny,nx,nz) to (nx,ny,nz)
+ * Use work data elements 4*n .. 4*n+2*nz-1.
+ */
+ rc = gmx_fft_transpose_2d_nelem(data,data,ny,nx,nz,work);
+ if( rc != 0)
+ {
+ gmx_fatal(FARGS,"Cannot transpose Y/Z & X in gmx_fft_3d().");
+ return rc;
+ }
+
+ return 0;
+}
+
+
+int
+gmx_fft_3d_real (gmx_fft_t fft,
+ enum gmx_fft_direction dir,
+ void * in_data,
+ void * out_data)
+{
+ int i,j,k;
+ int nx,ny,nz,nzc,rc;
+ t_complex * data;
+ t_complex * work_transp;
+ t_complex * work_c2r;
+ real * p1;
+ real * p2;
+
+ nx=fft->n;
+ ny=fft->next->n;
+ nz=fft->next->next->n;
+ nzc=(nz/2+1);
+
+
+ /* First 4*nx positions are FFTPACK workspace, then ours starts.
+ * We have 2*nx*ny*nzc elements for temp complex-to-real storage when
+ * doing out-of-place transforms, and another 2*nzc for transpose data.
+ */
+ work_c2r = (t_complex *)(fft->work+4*nx);
+ work_transp = (t_complex *)(fft->work+4*nx+2*nx*ny*nzc);
+
+ /* Much easier to do pointer arithmetic when base has the correct type */
+ data = (t_complex *)out_data;
+
+ if(dir==GMX_FFT_REAL_TO_COMPLEX)
+ {
+ /* FFTPACK only does in-place transforms, so emulate out-of-place
+ * by copying data to the output array first. This is guaranteed to
+ * work for real-to-complex since complex data is larger than the real.
+ * For 3D there is likely enough data to benefit from memcpy().
+ */
+ if( in_data != out_data )
+ {
+ p1 = (real *)in_data;
+ p2 = (real *)out_data;
+
+ for(i=0;i<nx;i++)
+ {
+ for(j=0;j<ny;j++)
+ {
+ for(k=0;k<nz;k++)
+ {
+ p2[(i*ny+j)*2*nzc+k] = p1[(i*ny+j)*nz+k];
+ }
+ }
+ }
+ }
+ data = (t_complex *)out_data;
+
+ /* Transform the Y/Z slices real-to-complex */
+ for(i=0;i<nx;i++)
+ {
+ gmx_fft_2d_real(fft->next,dir,data+i*ny*nzc,data+i*ny*nzc);
+ }
+
+ /* Transpose x & y slices to go from
+ * (nx,ny,nzc) to (ny,nx,nzc).
+ */
+ rc=gmx_fft_transpose_2d_nelem(data,data,nx,ny,nzc,work_transp);
+ if( rc != 0)
+ {
+ gmx_fatal(FARGS,"Cannot transpose X & Y/Z gmx_fft_3d_real().");
+ return rc;
+ }
+
+ /* Then transpose from (ny,nx,nzc) to (ny,nzc,nx) */
+ for(i=0;i<ny;i++)
+ {
+ gmx_fft_transpose_2d(data+i*nx*nzc,data+i*nx*nzc,nx,nzc);
+ }
+
+ /* Perform x transforms */
+ for(i=0;i<ny*nzc;i++)
+ {
+ gmx_fft_1d(fft,GMX_FFT_FORWARD,data+i*nx,data+i*nx);
+ }
+
+ /* Transpose from (ny,nzc,nx) back to (ny,nx,nzc) */
+ for(i=0;i<ny;i++)
+ {
+ gmx_fft_transpose_2d(data+i*nzc*nx,data+i*nzc*nx,nzc,nx);
+ }
+
+ /* Transpose back from (ny,nx,nzc) to (nx,ny,nz) */
+ rc=gmx_fft_transpose_2d_nelem(data,data,ny,nx,nzc,work_transp);
+ if( rc != 0)
+ {
+ gmx_fatal(FARGS,"Cannot transpose Y/Z & X in gmx_fft_3d_real().");
+ return rc;
+ }
+
+ }
+ else if(dir==GMX_FFT_COMPLEX_TO_REAL)
+ {
+ /* An in-place complex-to-real transform is straightforward,
+ * since the output array must be large enough for the padding to fit.
+ *
+ * For out-of-place complex-to-real transforms we cannot just copy
+ * data to the output array, since it is smaller than the input.
+ * In this case there's nothing to do but employing temporary work data.
+ */
+ if(in_data != out_data)
+ {
+ memcpy(work_c2r,in_data,sizeof(t_complex)*nx*ny*nzc);
+ data = (t_complex *)work_c2r;
+ }
+ else
+ {
+ /* in-place */
+ data = (t_complex *)out_data;
+ }
+
+ /* Transpose x & y slices to go from
+ * (nx,ny,nz) to (ny,nx,nz).
+ */
+ gmx_fft_transpose_2d_nelem(data,data,nx,ny,nzc,work_transp);
+
+ /* Then go from (ny,nx,nzc) to (ny,nzc,nx) */
+ for(i=0;i<ny;i++)
+ {
+ gmx_fft_transpose_2d(data+i*nx*nzc,data+i*nx*nzc,nx,nzc);
+ }
+
+
+ /* Perform x transforms */
+ for(i=0;i<ny*nzc;i++)
+ {
+ gmx_fft_1d(fft,GMX_FFT_BACKWARD,data+i*nx,data+i*nx);
+ }
+
+ /* Transpose back from (ny,nzc,nx) to (ny,nx,nzc) */
+ for(i=0;i<ny;i++)
+ {
+ gmx_fft_transpose_2d(data+i*nzc*nx,data+i*nzc*nx,nzc,nx);
+ }
+
+ /* Transpose back from (ny,nx,nzc) to (nx,ny,nz) */
+ gmx_fft_transpose_2d_nelem(data,data,ny,nx,nzc,work_transp);
+
+
+ /* Do 2D complex-to-real */
+ for(i=0;i<nx;i++)
+ {
+ gmx_fft_2d_real(fft->next,dir,data+i*ny*nzc,data+i*ny*nzc);
+ }
+
+ if( in_data != out_data )
+ {
+ /* Output (pointed to by data) is now in padded format.
+ * Pack it into out_data if we were doing an out-of-place transform.
+ */
+ p1 = (real *)data;
+ p2 = (real *)out_data;
+
+ for(i=0;i<nx;i++)
+ {
+ for(j=0;j<ny;j++)
+ {
+ for(k=0;k<nz;k++)
+ {
+ p2[(i*ny+j)*nz+k] = p1[(i*ny+j)*nzc*2+k];
+ }
+ }
+ }
+ }
+
+ }
+ else
+ {
+ gmx_fatal(FARGS,"FFT plan mismatch - bad plan or direction.");
+ return EINVAL;
+ }
+
+ return 0;
+}
+
+
+
+
+void
+gmx_fft_destroy(gmx_fft_t fft)
+{
+ if(fft != NULL)
+ {
+ free(fft->work);
+ if(fft->next != NULL)
+ gmx_fft_destroy(fft->next);
+ free(fft);
+ }
+}
+#endif /* GMX_FFT_FFTPACK */
--- /dev/null
- bFirstStep,bStateFromTPX,bInitStep,bLastStep,
+/* -*- mode: c; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4; c-file-style: "stroustrup"; -*-
+ *
+ *
+ * This source code is part of
+ *
+ * G R O M A C S
+ *
+ * GROningen MAchine for Chemical Simulations
+ *
+ * VERSION 3.2.0
+ * Written by David van der Spoel, Erik Lindahl, Berk Hess, and others.
+ * Copyright (c) 1991-2000, University of Groningen, The Netherlands.
+ * Copyright (c) 2001-2004, The GROMACS development team,
+ * check out http://www.gromacs.org for more information.
+
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * If you want to redistribute modifications, please consider that
+ * scientific software is very special. Version control is crucial -
+ * bugs must be traceable. We will be happy to consider code for
+ * inclusion in the official distribution, but derived work must not
+ * be called official GROMACS. Details are found in the README & COPYING
+ * files - if they are missing, get the official version at www.gromacs.org.
+ *
+ * To help us fund GROMACS development, we humbly ask that you cite
+ * the papers on the package - you can find them in the top README file.
+ *
+ * For more info, check our website at http://www.gromacs.org
+ *
+ * And Hey:
+ * Gallium Rubidium Oxygen Manganese Argon Carbon Silicon
+ */
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+
+#include "typedefs.h"
+#include "smalloc.h"
+#include "sysstuff.h"
+#include "vec.h"
+#include "statutil.h"
+#include "vcm.h"
+#include "mdebin.h"
+#include "nrnb.h"
+#include "calcmu.h"
+#include "index.h"
+#include "vsite.h"
+#include "update.h"
+#include "ns.h"
+#include "trnio.h"
+#include "xtcio.h"
+#include "mdrun.h"
+#include "confio.h"
+#include "network.h"
+#include "pull.h"
+#include "xvgr.h"
+#include "physics.h"
+#include "names.h"
+#include "xmdrun.h"
+#include "ionize.h"
+#include "disre.h"
+#include "orires.h"
+#include "dihre.h"
+#include "pme.h"
+#include "mdatoms.h"
+#include "repl_ex.h"
+#include "qmmm.h"
+#include "domdec.h"
+#include "partdec.h"
+#include "topsort.h"
+#include "coulomb.h"
+#include "constr.h"
+#include "shellfc.h"
+#include "compute_io.h"
+#include "mvdata.h"
+#include "checkpoint.h"
+#include "mtop_util.h"
+#include "sighandler.h"
+#include "string2.h"
+#include "membed.h"
+
+#ifdef GMX_LIB_MPI
+#include <mpi.h>
+#endif
+#ifdef GMX_THREAD_MPI
+#include "tmpi.h"
+#endif
+
+#ifdef GMX_FAHCORE
+#include "corewrap.h"
+#endif
+
+
+double do_md(FILE *fplog,t_commrec *cr,int nfile,const t_filenm fnm[],
+ const output_env_t oenv, gmx_bool bVerbose,gmx_bool bCompact,
+ int nstglobalcomm,
+ gmx_vsite_t *vsite,gmx_constr_t constr,
+ int stepout,t_inputrec *ir,
+ gmx_mtop_t *top_global,
+ t_fcdata *fcd,
+ t_state *state_global,
+ t_mdatoms *mdatoms,
+ t_nrnb *nrnb,gmx_wallcycle_t wcycle,
+ gmx_edsam_t ed,t_forcerec *fr,
+ int repl_ex_nst,int repl_ex_seed,gmx_membed_t membed,
+ real cpt_period,real max_hours,
+ const char *deviceOptions,
+ unsigned long Flags,
+ gmx_runtime_t *runtime)
+{
+ gmx_mdoutf_t *outf;
+ gmx_large_int_t step,step_rel;
+ double run_time;
+ double t,t0,lam0;
+ gmx_bool bGStatEveryStep,bGStat,bNstEner,bCalcEnerPres;
+ gmx_bool bNS,bNStList,bSimAnn,bStopCM,bRerunMD,bNotLastFrame=FALSE,
- if (opt2bSet("-cpi",nfile,fnm))
++ bFirstStep,bStateFromCP,bStateFromTPX,bInitStep,bLastStep,
+ bBornRadii,bStartingFromCpt;
+ gmx_bool bDoDHDL=FALSE;
+ gmx_bool do_ene,do_log,do_verbose,bRerunWarnNoV=TRUE,
+ bForceUpdate=FALSE,bCPT;
+ int mdof_flags;
+ gmx_bool bMasterState;
+ int force_flags,cglo_flags;
+ tensor force_vir,shake_vir,total_vir,tmp_vir,pres;
+ int i,m;
+ t_trxstatus *status;
+ rvec mu_tot;
+ t_vcm *vcm;
+ t_state *bufstate=NULL;
+ matrix *scale_tot,pcoupl_mu,M,ebox;
+ gmx_nlheur_t nlh;
+ t_trxframe rerun_fr;
+ gmx_repl_ex_t repl_ex=NULL;
+ int nchkpt=1;
+
+ gmx_localtop_t *top;
+ t_mdebin *mdebin=NULL;
+ t_state *state=NULL;
+ rvec *f_global=NULL;
+ int n_xtc=-1;
+ rvec *x_xtc=NULL;
+ gmx_enerdata_t *enerd;
+ rvec *f=NULL;
+ gmx_global_stat_t gstat;
+ gmx_update_t upd=NULL;
+ t_graph *graph=NULL;
+ globsig_t gs;
+
+ gmx_bool bFFscan;
+ gmx_groups_t *groups;
+ gmx_ekindata_t *ekind, *ekind_save;
+ gmx_shellfc_t shellfc;
+ int count,nconverged=0;
+ real timestep=0;
+ double tcount=0;
+ gmx_bool bIonize=FALSE;
+ gmx_bool bTCR=FALSE,bConverged=TRUE,bOK,bSumEkinhOld,bExchanged;
+ gmx_bool bAppend;
+ gmx_bool bResetCountersHalfMaxH=FALSE;
+ gmx_bool bVV,bIterations,bFirstIterate,bTemp,bPres,bTrotter;
+ real mu_aver=0,dvdl;
+ int a0,a1,gnx=0,ii;
+ atom_id *grpindex=NULL;
+ char *grpname;
+ t_coupl_rec *tcr=NULL;
+ rvec *xcopy=NULL,*vcopy=NULL,*cbuf=NULL;
+ matrix boxcopy={{0}},lastbox;
+ tensor tmpvir;
+ real fom,oldfom,veta_save,pcurr,scalevir,tracevir;
+ real vetanew = 0;
+ double cycles;
+ real saved_conserved_quantity = 0;
+ real last_ekin = 0;
+ int iter_i;
+ t_extmass MassQ;
+ int **trotter_seq;
+ char sbuf[STEPSTRSIZE],sbuf2[STEPSTRSIZE];
+ int handled_stop_condition=gmx_stop_cond_none; /* compare to get_stop_condition*/
+ gmx_iterate_t iterate;
+ gmx_large_int_t multisim_nsteps=-1; /* number of steps to do before first multisim
+ simulation stops. If equal to zero, don't
+ communicate any more between multisims.*/
+#ifdef GMX_FAHCORE
+ /* Temporary addition for FAHCORE checkpointing */
+ int chkpt_ret;
+#endif
+
+ /* Check for special mdrun options */
+ bRerunMD = (Flags & MD_RERUN);
+ bIonize = (Flags & MD_IONIZE);
+ bFFscan = (Flags & MD_FFSCAN);
+ bAppend = (Flags & MD_APPENDFILES);
+ if (Flags & MD_RESETCOUNTERSHALFWAY)
+ {
+ if (ir->nsteps > 0)
+ {
+ /* Signal to reset the counters half the simulation steps. */
+ wcycle_set_reset_counters(wcycle,ir->nsteps/2);
+ }
+ /* Signal to reset the counters halfway the simulation time. */
+ bResetCountersHalfMaxH = (max_hours > 0);
+ }
+
+ /* md-vv uses averaged full step velocities for T-control
+ md-vv-avek uses averaged half step velocities for T-control (but full step ekin for P control)
+ md uses averaged half step kinetic energies to determine temperature unless defined otherwise by GMX_EKIN_AVE_VEL; */
+ bVV = EI_VV(ir->eI);
+ if (bVV) /* to store the initial velocities while computing virial */
+ {
+ snew(cbuf,top_global->natoms);
+ }
+ /* all the iteratative cases - only if there are constraints */
+ bIterations = ((IR_NPT_TROTTER(ir)) && (constr) && (!bRerunMD));
+ bTrotter = (bVV && (IR_NPT_TROTTER(ir) || (IR_NVT_TROTTER(ir))));
+
+ if (bRerunMD)
+ {
+ /* Since we don't know if the frames read are related in any way,
+ * rebuild the neighborlist at every step.
+ */
+ ir->nstlist = 1;
+ ir->nstcalcenergy = 1;
+ nstglobalcomm = 1;
+ }
+
+ check_ir_old_tpx_versions(cr,fplog,ir,top_global);
+
+ nstglobalcomm = check_nstglobalcomm(fplog,cr,nstglobalcomm,ir);
+ bGStatEveryStep = (nstglobalcomm == 1);
+
+ if (!bGStatEveryStep && ir->nstlist == -1 && fplog != NULL)
+ {
+ fprintf(fplog,
+ "To reduce the energy communication with nstlist = -1\n"
+ "the neighbor list validity should not be checked at every step,\n"
+ "this means that exact integration is not guaranteed.\n"
+ "The neighbor list validity is checked after:\n"
+ " <n.list life time> - 2*std.dev.(n.list life time) steps.\n"
+ "In most cases this will result in exact integration.\n"
+ "This reduces the energy communication by a factor of 2 to 3.\n"
+ "If you want less energy communication, set nstlist > 3.\n\n");
+ }
+
+ if (bRerunMD || bFFscan)
+ {
+ ir->nstxtcout = 0;
+ }
+ groups = &top_global->groups;
+
+ /* Initial values */
+ init_md(fplog,cr,ir,oenv,&t,&t0,&state_global->lambda,&lam0,
+ nrnb,top_global,&upd,
+ nfile,fnm,&outf,&mdebin,
+ force_vir,shake_vir,mu_tot,&bSimAnn,&vcm,state_global,Flags);
+
+ clear_mat(total_vir);
+ clear_mat(pres);
+ /* Energy terms and groups */
+ snew(enerd,1);
+ init_enerdata(top_global->groups.grps[egcENER].nr,ir->n_flambda,enerd);
+ if (DOMAINDECOMP(cr))
+ {
+ f = NULL;
+ }
+ else
+ {
+ snew(f,top_global->natoms);
+ }
+
+ /* Kinetic energy data */
+ snew(ekind,1);
+ init_ekindata(fplog,top_global,&(ir->opts),ekind);
+ /* needed for iteration of constraints */
+ snew(ekind_save,1);
+ init_ekindata(fplog,top_global,&(ir->opts),ekind_save);
+ /* Copy the cos acceleration to the groups struct */
+ ekind->cosacc.cos_accel = ir->cos_accel;
+
+ gstat = global_stat_init(ir);
+ debug_gmx();
+
+ /* Check for polarizable models and flexible constraints */
+ shellfc = init_shell_flexcon(fplog,
+ top_global,n_flexible_constraints(constr),
+ (ir->bContinuation ||
+ (DOMAINDECOMP(cr) && !MASTER(cr))) ?
+ NULL : state_global->x);
+
+ if (DEFORM(*ir))
+ {
+#ifdef GMX_THREAD_MPI
+ tMPI_Thread_mutex_lock(&deform_init_box_mutex);
+#endif
+ set_deform_reference_box(upd,
+ deform_init_init_step_tpx,
+ deform_init_box_tpx);
+#ifdef GMX_THREAD_MPI
+ tMPI_Thread_mutex_unlock(&deform_init_box_mutex);
+#endif
+ }
+
+ {
+ double io = compute_io(ir,top_global->natoms,groups,mdebin->ebin->nener,1);
+ if ((io > 2000) && MASTER(cr))
+ fprintf(stderr,
+ "\nWARNING: This run will generate roughly %.0f Mb of data\n\n",
+ io);
+ }
+
+ if (DOMAINDECOMP(cr)) {
+ top = dd_init_local_top(top_global);
+
+ snew(state,1);
+ dd_init_local_state(cr->dd,state_global,state);
+
+ if (DDMASTER(cr->dd) && ir->nstfout) {
+ snew(f_global,state_global->natoms);
+ }
+ } else {
+ if (PAR(cr)) {
+ /* Initialize the particle decomposition and split the topology */
+ top = split_system(fplog,top_global,ir,cr);
+
+ pd_cg_range(cr,&fr->cg0,&fr->hcg);
+ pd_at_range(cr,&a0,&a1);
+ } else {
+ top = gmx_mtop_generate_local_top(top_global,ir);
+
+ a0 = 0;
+ a1 = top_global->natoms;
+ }
+
+ state = partdec_init_local_state(cr,state_global);
+ f_global = f;
+
+ atoms2md(top_global,ir,0,NULL,a0,a1-a0,mdatoms);
+
+ if (vsite) {
+ set_vsite_top(vsite,top,mdatoms,cr);
+ }
+
+ if (ir->ePBC != epbcNONE && !ir->bPeriodicMols) {
+ graph = mk_graph(fplog,&(top->idef),0,top_global->natoms,FALSE,FALSE);
+ }
+
+ if (shellfc) {
+ make_local_shells(cr,mdatoms,shellfc);
+ }
+
+ if (ir->pull && PAR(cr)) {
+ dd_make_local_pull_groups(NULL,ir->pull,mdatoms);
+ }
+ }
+
+ if (DOMAINDECOMP(cr))
+ {
+ /* Distribute the charge groups over the nodes from the master node */
+ dd_partition_system(fplog,ir->init_step,cr,TRUE,1,
+ state_global,top_global,ir,
+ state,&f,mdatoms,top,fr,
+ vsite,shellfc,constr,
+ nrnb,wcycle,FALSE);
+ }
+
+ update_mdatoms(mdatoms,state->lambda);
+
++ if (opt2bSet("-cpi",nfile,fnm))
++ {
++ bStateFromCP = gmx_fexist_master(opt2fn_master("-cpi",nfile,fnm,cr),cr);
++ }
++ else
++ {
++ bStateFromCP = FALSE;
++ }
++
+ if (MASTER(cr))
+ {
- bStateFromTPX = !opt2bSet("-cpi",nfile,fnm);
++ if (bStateFromCP)
+ {
+ /* Update mdebin with energy history if appending to output files */
+ if ( Flags & MD_APPENDFILES )
+ {
+ restore_energyhistory_from_state(mdebin,&state_global->enerhist);
+ }
+ else
+ {
+ /* We might have read an energy history from checkpoint,
+ * free the allocated memory and reset the counts.
+ */
+ done_energyhistory(&state_global->enerhist);
+ init_energyhistory(&state_global->enerhist);
+ }
+ }
+ /* Set the initial energy history in state by updating once */
+ update_energyhistory(&state_global->enerhist,mdebin);
+ }
+
+ if ((state->flags & (1<<estLD_RNG)) && (Flags & MD_READ_RNG)) {
+ /* Set the random state if we read a checkpoint file */
+ set_stochd_state(upd,state);
+ }
+
+ /* Initialize constraints */
+ if (constr) {
+ if (!DOMAINDECOMP(cr))
+ set_constraints(constr,top,ir,mdatoms,cr);
+ }
+
+ /* Check whether we have to GCT stuff */
+ bTCR = ftp2bSet(efGCT,nfile,fnm);
+ if (bTCR) {
+ if (MASTER(cr)) {
+ fprintf(stderr,"Will do General Coupling Theory!\n");
+ }
+ gnx = top_global->mols.nr;
+ snew(grpindex,gnx);
+ for(i=0; (i<gnx); i++) {
+ grpindex[i] = i;
+ }
+ }
+
+ if (repl_ex_nst > 0)
+ {
+ /* We need to be sure replica exchange can only occur
+ * when the energies are current */
+ check_nst_param(fplog,cr,"nstcalcenergy",ir->nstcalcenergy,
+ "repl_ex_nst",&repl_ex_nst);
+ /* This check needs to happen before inter-simulation
+ * signals are initialized, too */
+ }
+ if (repl_ex_nst > 0 && MASTER(cr))
+ repl_ex = init_replica_exchange(fplog,cr->ms,state_global,ir,
+ repl_ex_nst,repl_ex_seed);
+
+ if (!ir->bContinuation && !bRerunMD)
+ {
+ if (mdatoms->cFREEZE && (state->flags & (1<<estV)))
+ {
+ /* Set the velocities of frozen particles to zero */
+ for(i=mdatoms->start; i<mdatoms->start+mdatoms->homenr; i++)
+ {
+ for(m=0; m<DIM; m++)
+ {
+ if (ir->opts.nFreeze[mdatoms->cFREEZE[i]][m])
+ {
+ state->v[i][m] = 0;
+ }
+ }
+ }
+ }
+
+ if (constr)
+ {
+ /* Constrain the initial coordinates and velocities */
+ do_constrain_first(fplog,constr,ir,mdatoms,state,f,
+ graph,cr,nrnb,fr,top,shake_vir);
+ }
+ if (vsite)
+ {
+ /* Construct the virtual sites for the initial configuration */
+ construct_vsites(fplog,vsite,state->x,nrnb,ir->delta_t,NULL,
+ top->idef.iparams,top->idef.il,
+ fr->ePBC,fr->bMolPBC,graph,cr,state->box);
+ }
+ }
+
+ debug_gmx();
+
+ /* I'm assuming we need global communication the first time! MRS */
+ cglo_flags = (CGLO_TEMPERATURE | CGLO_GSTAT
+ | ((ir->comm_mode != ecmNO) ? CGLO_STOPCM:0)
+ | (bVV ? CGLO_PRESSURE:0)
+ | (bVV ? CGLO_CONSTRAINT:0)
+ | (bRerunMD ? CGLO_RERUNMD:0)
+ | ((Flags & MD_READ_EKIN) ? CGLO_READEKIN:0));
+
+ bSumEkinhOld = FALSE;
+ compute_globals(fplog,gstat,cr,ir,fr,ekind,state,state_global,mdatoms,nrnb,vcm,
+ NULL,enerd,force_vir,shake_vir,total_vir,pres,mu_tot,
+ constr,NULL,FALSE,state->box,
+ top_global,&pcurr,top_global->natoms,&bSumEkinhOld,cglo_flags);
+ if (ir->eI == eiVVAK) {
+ /* a second call to get the half step temperature initialized as well */
+ /* we do the same call as above, but turn the pressure off -- internally to
+ compute_globals, this is recognized as a velocity verlet half-step
+ kinetic energy calculation. This minimized excess variables, but
+ perhaps loses some logic?*/
+
+ compute_globals(fplog,gstat,cr,ir,fr,ekind,state,state_global,mdatoms,nrnb,vcm,
+ NULL,enerd,force_vir,shake_vir,total_vir,pres,mu_tot,
+ constr,NULL,FALSE,state->box,
+ top_global,&pcurr,top_global->natoms,&bSumEkinhOld,
+ cglo_flags &~ (CGLO_STOPCM | CGLO_PRESSURE));
+ }
+
+ /* Calculate the initial half step temperature, and save the ekinh_old */
+ if (!(Flags & MD_STARTFROMCPT))
+ {
+ for(i=0; (i<ir->opts.ngtc); i++)
+ {
+ copy_mat(ekind->tcstat[i].ekinh,ekind->tcstat[i].ekinh_old);
+ }
+ }
+ if (ir->eI != eiVV)
+ {
+ enerd->term[F_TEMP] *= 2; /* result of averages being done over previous and current step,
+ and there is no previous step */
+ }
+
+ /* if using an iterative algorithm, we need to create a working directory for the state. */
+ if (bIterations)
+ {
+ bufstate = init_bufstate(state);
+ }
+ if (bFFscan)
+ {
+ snew(xcopy,state->natoms);
+ snew(vcopy,state->natoms);
+ copy_rvecn(state->x,xcopy,0,state->natoms);
+ copy_rvecn(state->v,vcopy,0,state->natoms);
+ copy_mat(state->box,boxcopy);
+ }
+
+ /* need to make an initiation call to get the Trotter variables set, as well as other constants for non-trotter
+ temperature control */
+ trotter_seq = init_npt_vars(ir,state,&MassQ,bTrotter);
+
+ if (MASTER(cr))
+ {
+ if (constr && !ir->bContinuation && ir->eConstrAlg == econtLINCS)
+ {
+ fprintf(fplog,
+ "RMS relative constraint deviation after constraining: %.2e\n",
+ constr_rmsd(constr,FALSE));
+ }
+ if (EI_STATE_VELOCITY(ir->eI))
+ {
+ fprintf(fplog,"Initial temperature: %g K\n",enerd->term[F_TEMP]);
+ }
+ if (bRerunMD)
+ {
+ fprintf(stderr,"starting md rerun '%s', reading coordinates from"
+ " input trajectory '%s'\n\n",
+ *(top_global->name),opt2fn("-rerun",nfile,fnm));
+ if (bVerbose)
+ {
+ fprintf(stderr,"Calculated time to finish depends on nsteps from "
+ "run input file,\nwhich may not correspond to the time "
+ "needed to process input trajectory.\n\n");
+ }
+ }
+ else
+ {
+ char tbuf[20];
+ fprintf(stderr,"starting mdrun '%s'\n",
+ *(top_global->name));
+ if (ir->nsteps >= 0)
+ {
+ sprintf(tbuf,"%8.1f",(ir->init_step+ir->nsteps)*ir->delta_t);
+ }
+ else
+ {
+ sprintf(tbuf,"%s","infinite");
+ }
+ if (ir->init_step > 0)
+ {
+ fprintf(stderr,"%s steps, %s ps (continuing from step %s, %8.1f ps).\n",
+ gmx_step_str(ir->init_step+ir->nsteps,sbuf),tbuf,
+ gmx_step_str(ir->init_step,sbuf2),
+ ir->init_step*ir->delta_t);
+ }
+ else
+ {
+ fprintf(stderr,"%s steps, %s ps.\n",
+ gmx_step_str(ir->nsteps,sbuf),tbuf);
+ }
+ }
+ fprintf(fplog,"\n");
+ }
+
+ /* Set and write start time */
+ runtime_start(runtime);
+ print_date_and_time(fplog,cr->nodeid,"Started mdrun",runtime);
+ wallcycle_start(wcycle,ewcRUN);
+ if (fplog)
+ fprintf(fplog,"\n");
+
+ /* safest point to do file checkpointing is here. More general point would be immediately before integrator call */
+#ifdef GMX_FAHCORE
+ chkpt_ret=fcCheckPointParallel( cr->nodeid,
+ NULL,0);
+ if ( chkpt_ret == 0 )
+ gmx_fatal( 3,__FILE__,__LINE__, "Checkpoint error on step %d\n", 0 );
+#endif
+
+ debug_gmx();
+ /***********************************************************
+ *
+ * Loop over MD steps
+ *
+ ************************************************************/
+
+ /* if rerunMD then read coordinates and velocities from input trajectory */
+ if (bRerunMD)
+ {
+ if (getenv("GMX_FORCE_UPDATE"))
+ {
+ bForceUpdate = TRUE;
+ }
+
+ rerun_fr.natoms = 0;
+ if (MASTER(cr))
+ {
+ bNotLastFrame = read_first_frame(oenv,&status,
+ opt2fn("-rerun",nfile,fnm),
+ &rerun_fr,TRX_NEED_X | TRX_READ_V);
+ if (rerun_fr.natoms != top_global->natoms)
+ {
+ gmx_fatal(FARGS,
+ "Number of atoms in trajectory (%d) does not match the "
+ "run input file (%d)\n",
+ rerun_fr.natoms,top_global->natoms);
+ }
+ if (ir->ePBC != epbcNONE)
+ {
+ if (!rerun_fr.bBox)
+ {
+ gmx_fatal(FARGS,"Rerun trajectory frame step %d time %f does not contain a box, while pbc is used",rerun_fr.step,rerun_fr.time);
+ }
+ if (max_cutoff2(ir->ePBC,rerun_fr.box) < sqr(fr->rlistlong))
+ {
+ gmx_fatal(FARGS,"Rerun trajectory frame step %d time %f has too small box dimensions",rerun_fr.step,rerun_fr.time);
+ }
+ }
+ }
+
+ if (PAR(cr))
+ {
+ rerun_parallel_comm(cr,&rerun_fr,&bNotLastFrame);
+ }
+
+ if (ir->ePBC != epbcNONE)
+ {
+ /* Set the shift vectors.
+ * Necessary here when have a static box different from the tpr box.
+ */
+ calc_shifts(rerun_fr.box,fr->shift_vec);
+ }
+ }
+
+ /* loop over MD steps or if rerunMD to end of input trajectory */
+ bFirstStep = TRUE;
+ /* Skip the first Nose-Hoover integration when we get the state from tpx */
++ bStateFromTPX = !bStateFromCP;
+ bInitStep = bFirstStep && (bStateFromTPX || bVV);
+ bStartingFromCpt = (Flags & MD_STARTFROMCPT) && bInitStep;
+ bLastStep = FALSE;
+ bSumEkinhOld = FALSE;
+ bExchanged = FALSE;
+
+ init_global_signals(&gs,cr,ir,repl_ex_nst);
+
+ step = ir->init_step;
+ step_rel = 0;
+
+ if (ir->nstlist == -1)
+ {
+ init_nlistheuristics(&nlh,bGStatEveryStep,step);
+ }
+
+ if (MULTISIM(cr) && (repl_ex_nst <=0 ))
+ {
+ /* check how many steps are left in other sims */
+ multisim_nsteps=get_multisim_nsteps(cr, ir->nsteps);
+ }
+
+
+ /* and stop now if we should */
+ bLastStep = (bRerunMD || (ir->nsteps >= 0 && step_rel > ir->nsteps) ||
+ ((multisim_nsteps >= 0) && (step_rel >= multisim_nsteps )));
+ while (!bLastStep || (bRerunMD && bNotLastFrame)) {
+
+ wallcycle_start(wcycle,ewcSTEP);
+
+ if (bRerunMD) {
+ if (rerun_fr.bStep) {
+ step = rerun_fr.step;
+ step_rel = step - ir->init_step;
+ }
+ if (rerun_fr.bTime) {
+ t = rerun_fr.time;
+ }
+ else
+ {
+ t = step;
+ }
+ }
+ else
+ {
+ bLastStep = (step_rel == ir->nsteps);
+ t = t0 + step*ir->delta_t;
+ }
+
+ if (ir->efep != efepNO)
+ {
+ if (bRerunMD && rerun_fr.bLambda && (ir->delta_lambda!=0))
+ {
+ state_global->lambda = rerun_fr.lambda;
+ }
+ else
+ {
+ state_global->lambda = lam0 + step*ir->delta_lambda;
+ }
+ state->lambda = state_global->lambda;
+ bDoDHDL = do_per_step(step,ir->nstdhdl);
+ }
+
+ if (bSimAnn)
+ {
+ update_annealing_target_temp(&(ir->opts),t);
+ }
+
+ if (bRerunMD)
+ {
+ if (!(DOMAINDECOMP(cr) && !MASTER(cr)))
+ {
+ for(i=0; i<state_global->natoms; i++)
+ {
+ copy_rvec(rerun_fr.x[i],state_global->x[i]);
+ }
+ if (rerun_fr.bV)
+ {
+ for(i=0; i<state_global->natoms; i++)
+ {
+ copy_rvec(rerun_fr.v[i],state_global->v[i]);
+ }
+ }
+ else
+ {
+ for(i=0; i<state_global->natoms; i++)
+ {
+ clear_rvec(state_global->v[i]);
+ }
+ if (bRerunWarnNoV)
+ {
+ fprintf(stderr,"\nWARNING: Some frames do not contain velocities.\n"
+ " Ekin, temperature and pressure are incorrect,\n"
+ " the virial will be incorrect when constraints are present.\n"
+ "\n");
+ bRerunWarnNoV = FALSE;
+ }
+ }
+ }
+ copy_mat(rerun_fr.box,state_global->box);
+ copy_mat(state_global->box,state->box);
+
+ if (vsite && (Flags & MD_RERUN_VSITE))
+ {
+ if (DOMAINDECOMP(cr))
+ {
+ gmx_fatal(FARGS,"Vsite recalculation with -rerun is not implemented for domain decomposition, use particle decomposition");
+ }
+ if (graph)
+ {
+ /* Following is necessary because the graph may get out of sync
+ * with the coordinates if we only have every N'th coordinate set
+ */
+ mk_mshift(fplog,graph,fr->ePBC,state->box,state->x);
+ shift_self(graph,state->box,state->x);
+ }
+ construct_vsites(fplog,vsite,state->x,nrnb,ir->delta_t,state->v,
+ top->idef.iparams,top->idef.il,
+ fr->ePBC,fr->bMolPBC,graph,cr,state->box);
+ if (graph)
+ {
+ unshift_self(graph,state->box,state->x);
+ }
+ }
+ }
+
+ /* Stop Center of Mass motion */
+ bStopCM = (ir->comm_mode != ecmNO && do_per_step(step,ir->nstcomm));
+
+ /* Copy back starting coordinates in case we're doing a forcefield scan */
+ if (bFFscan)
+ {
+ for(ii=0; (ii<state->natoms); ii++)
+ {
+ copy_rvec(xcopy[ii],state->x[ii]);
+ copy_rvec(vcopy[ii],state->v[ii]);
+ }
+ copy_mat(boxcopy,state->box);
+ }
+
+ if (bRerunMD)
+ {
+ /* for rerun MD always do Neighbour Searching */
+ bNS = (bFirstStep || ir->nstlist != 0);
+ bNStList = bNS;
+ }
+ else
+ {
+ /* Determine whether or not to do Neighbour Searching and LR */
+ bNStList = (ir->nstlist > 0 && step % ir->nstlist == 0);
+
+ bNS = (bFirstStep || bExchanged || bNStList ||
+ (ir->nstlist == -1 && nlh.nabnsb > 0));
+
+ if (bNS && ir->nstlist == -1)
+ {
+ set_nlistheuristics(&nlh,bFirstStep || bExchanged,step);
+ }
+ }
+
+ /* check whether we should stop because another simulation has
+ stopped. */
+ if (MULTISIM(cr))
+ {
+ if ( (multisim_nsteps >= 0) && (step_rel >= multisim_nsteps) &&
+ (multisim_nsteps != ir->nsteps) )
+ {
+ if (bNS)
+ {
+ if (MASTER(cr))
+ {
+ fprintf(stderr,
+ "Stopping simulation %d because another one has finished\n",
+ cr->ms->sim);
+ }
+ bLastStep=TRUE;
+ gs.sig[eglsCHKPT] = 1;
+ }
+ }
+ }
+
+ /* < 0 means stop at next step, > 0 means stop at next NS step */
+ if ( (gs.set[eglsSTOPCOND] < 0 ) ||
+ ( (gs.set[eglsSTOPCOND] > 0 ) && ( bNS || ir->nstlist==0)) )
+ {
+ bLastStep = TRUE;
+ }
+
+ /* Determine whether or not to update the Born radii if doing GB */
+ bBornRadii=bFirstStep;
+ if (ir->implicit_solvent && (step % ir->nstgbradii==0))
+ {
+ bBornRadii=TRUE;
+ }
+
+ do_log = do_per_step(step,ir->nstlog) || bFirstStep || bLastStep;
+ do_verbose = bVerbose &&
+ (step % stepout == 0 || bFirstStep || bLastStep);
+
+ if (bNS && !(bFirstStep && ir->bContinuation && !bRerunMD))
+ {
+ if (bRerunMD)
+ {
+ bMasterState = TRUE;
+ }
+ else
+ {
+ bMasterState = FALSE;
+ /* Correct the new box if it is too skewed */
+ if (DYNAMIC_BOX(*ir))
+ {
+ if (correct_box(fplog,step,state->box,graph))
+ {
+ bMasterState = TRUE;
+ }
+ }
+ if (DOMAINDECOMP(cr) && bMasterState)
+ {
+ dd_collect_state(cr->dd,state,state_global);
+ }
+ }
+
+ if (DOMAINDECOMP(cr))
+ {
+ /* Repartition the domain decomposition */
+ wallcycle_start(wcycle,ewcDOMDEC);
+ dd_partition_system(fplog,step,cr,
+ bMasterState,nstglobalcomm,
+ state_global,top_global,ir,
+ state,&f,mdatoms,top,fr,
+ vsite,shellfc,constr,
+ nrnb,wcycle,do_verbose);
+ wallcycle_stop(wcycle,ewcDOMDEC);
+ /* If using an iterative integrator, reallocate space to match the decomposition */
+ }
+ }
+
+ if (MASTER(cr) && do_log && !bFFscan)
+ {
+ print_ebin_header(fplog,step,t,state->lambda);
+ }
+
+ if (ir->efep != efepNO)
+ {
+ update_mdatoms(mdatoms,state->lambda);
+ }
+
+ if (bRerunMD && rerun_fr.bV)
+ {
+
+ /* We need the kinetic energy at minus the half step for determining
+ * the full step kinetic energy and possibly for T-coupling.*/
+ /* This may not be quite working correctly yet . . . . */
+ compute_globals(fplog,gstat,cr,ir,fr,ekind,state,state_global,mdatoms,nrnb,vcm,
+ wcycle,enerd,NULL,NULL,NULL,NULL,mu_tot,
+ constr,NULL,FALSE,state->box,
+ top_global,&pcurr,top_global->natoms,&bSumEkinhOld,
+ CGLO_RERUNMD | CGLO_GSTAT | CGLO_TEMPERATURE);
+ }
+ clear_mat(force_vir);
+
+ /* Ionize the atoms if necessary */
+ if (bIonize)
+ {
+ ionize(fplog,oenv,mdatoms,top_global,t,ir,state->x,state->v,
+ mdatoms->start,mdatoms->start+mdatoms->homenr,state->box,cr);
+ }
+
+ /* Update force field in ffscan program */
+ if (bFFscan)
+ {
+ if (update_forcefield(fplog,
+ nfile,fnm,fr,
+ mdatoms->nr,state->x,state->box))
+ {
+ gmx_finalize_par();
+
+ exit(0);
+ }
+ }
+
+ /* We write a checkpoint at this MD step when:
+ * either at an NS step when we signalled through gs,
+ * or at the last step (but not when we do not want confout),
+ * but never at the first step or with rerun.
+ */
+ bCPT = (((gs.set[eglsCHKPT] && (bNS || ir->nstlist == 0)) ||
+ (bLastStep && (Flags & MD_CONFOUT))) &&
+ step > ir->init_step && !bRerunMD);
+ if (bCPT)
+ {
+ gs.set[eglsCHKPT] = 0;
+ }
+
+ /* Determine the energy and pressure:
+ * at nstcalcenergy steps and at energy output steps (set below).
+ */
+ bNstEner = do_per_step(step,ir->nstcalcenergy);
+ bCalcEnerPres =
+ (bNstEner ||
+ (ir->epc != epcNO && do_per_step(step,ir->nstpcouple)));
+
+ /* Do we need global communication ? */
+ bGStat = (bCalcEnerPres || bStopCM ||
+ do_per_step(step,nstglobalcomm) ||
+ (ir->nstlist == -1 && !bRerunMD && step >= nlh.step_nscheck));
+
+ do_ene = (do_per_step(step,ir->nstenergy) || bLastStep);
+
+ if (do_ene || do_log)
+ {
+ bCalcEnerPres = TRUE;
+ bGStat = TRUE;
+ }
+
+ /* these CGLO_ options remain the same throughout the iteration */
+ cglo_flags = ((bRerunMD ? CGLO_RERUNMD : 0) |
+ (bGStat ? CGLO_GSTAT : 0)
+ );
+
+ force_flags = (GMX_FORCE_STATECHANGED |
+ ((DYNAMIC_BOX(*ir) || bRerunMD) ? GMX_FORCE_DYNAMICBOX : 0) |
+ GMX_FORCE_ALLFORCES |
+ (bNStList ? GMX_FORCE_DOLR : 0) |
+ GMX_FORCE_SEPLRF |
+ (bCalcEnerPres ? GMX_FORCE_VIRIAL : 0) |
+ (bDoDHDL ? GMX_FORCE_DHDL : 0)
+ );
+
+ if (shellfc)
+ {
+ /* Now is the time to relax the shells */
+ count=relax_shell_flexcon(fplog,cr,bVerbose,bFFscan ? step+1 : step,
+ ir,bNS,force_flags,
+ bStopCM,top,top_global,
+ constr,enerd,fcd,
+ state,f,force_vir,mdatoms,
+ nrnb,wcycle,graph,groups,
+ shellfc,fr,bBornRadii,t,mu_tot,
+ state->natoms,&bConverged,vsite,
+ outf->fp_field);
+ tcount+=count;
+
+ if (bConverged)
+ {
+ nconverged++;
+ }
+ }
+ else
+ {
+ /* The coordinates (x) are shifted (to get whole molecules)
+ * in do_force.
+ * This is parallellized as well, and does communication too.
+ * Check comments in sim_util.c
+ */
+
+ do_force(fplog,cr,ir,step,nrnb,wcycle,top,top_global,groups,
+ state->box,state->x,&state->hist,
+ f,force_vir,mdatoms,enerd,fcd,
+ state->lambda,graph,
+ fr,vsite,mu_tot,t,outf->fp_field,ed,bBornRadii,
+ (bNS ? GMX_FORCE_NS : 0) | force_flags);
+ }
+
+ if (bTCR)
+ {
+ mu_aver = calc_mu_aver(cr,state->x,mdatoms->chargeA,
+ mu_tot,&top_global->mols,mdatoms,gnx,grpindex);
+ }
+
+ if (bTCR && bFirstStep)
+ {
+ tcr=init_coupling(fplog,nfile,fnm,cr,fr,mdatoms,&(top->idef));
+ fprintf(fplog,"Done init_coupling\n");
+ fflush(fplog);
+ }
+
+ if (bVV && !bStartingFromCpt && !bRerunMD)
+ /* ############### START FIRST UPDATE HALF-STEP FOR VV METHODS############### */
+ {
+ if (ir->eI==eiVV && bInitStep)
+ {
+ /* if using velocity verlet with full time step Ekin,
+ * take the first half step only to compute the
+ * virial for the first step. From there,
+ * revert back to the initial coordinates
+ * so that the input is actually the initial step.
+ */
+ copy_rvecn(state->v,cbuf,0,state->natoms); /* should make this better for parallelizing? */
+ } else {
+ /* this is for NHC in the Ekin(t+dt/2) version of vv */
+ trotter_update(ir,step,ekind,enerd,state,total_vir,mdatoms,&MassQ,trotter_seq,ettTSEQ1);
+ }
+
+ update_coords(fplog,step,ir,mdatoms,state,
+ f,fr->bTwinRange && bNStList,fr->f_twin,fcd,
+ ekind,M,wcycle,upd,bInitStep,etrtVELOCITY1,
+ cr,nrnb,constr,&top->idef);
+
+ if (bIterations)
+ {
+ gmx_iterate_init(&iterate,bIterations && !bInitStep);
+ }
+ /* for iterations, we save these vectors, as we will be self-consistently iterating
+ the calculations */
+
+ /*#### UPDATE EXTENDED VARIABLES IN TROTTER FORMULATION */
+
+ /* save the state */
+ if (bIterations && iterate.bIterate) {
+ copy_coupling_state(state,bufstate,ekind,ekind_save,&(ir->opts));
+ }
+
+ bFirstIterate = TRUE;
+ while (bFirstIterate || (bIterations && iterate.bIterate))
+ {
+ if (bIterations && iterate.bIterate)
+ {
+ copy_coupling_state(bufstate,state,ekind_save,ekind,&(ir->opts));
+ if (bFirstIterate && bTrotter)
+ {
+ /* The first time through, we need a decent first estimate
+ of veta(t+dt) to compute the constraints. Do
+ this by computing the box volume part of the
+ trotter integration at this time. Nothing else
+ should be changed by this routine here. If
+ !(first time), we start with the previous value
+ of veta. */
+
+ veta_save = state->veta;
+ trotter_update(ir,step,ekind,enerd,state,total_vir,mdatoms,&MassQ,trotter_seq,ettTSEQ0);
+ vetanew = state->veta;
+ state->veta = veta_save;
+ }
+ }
+
+ bOK = TRUE;
+ if ( !bRerunMD || rerun_fr.bV || bForceUpdate) { /* Why is rerun_fr.bV here? Unclear. */
+ dvdl = 0;
+
+ update_constraints(fplog,step,&dvdl,ir,ekind,mdatoms,state,graph,f,
+ &top->idef,shake_vir,NULL,
+ cr,nrnb,wcycle,upd,constr,
+ bInitStep,TRUE,bCalcEnerPres,vetanew);
+
+ if (!bOK && !bFFscan)
+ {
+ gmx_fatal(FARGS,"Constraint error: Shake, Lincs or Settle could not solve the constrains");
+ }
+
+ }
+ else if (graph)
+ { /* Need to unshift here if a do_force has been
+ called in the previous step */
+ unshift_self(graph,state->box,state->x);
+ }
+
+
+ /* if VV, compute the pressure and constraints */
+ /* For VV2, we strictly only need this if using pressure
+ * control, but we really would like to have accurate pressures
+ * printed out.
+ * Think about ways around this in the future?
+ * For now, keep this choice in comments.
+ */
+ /*bPres = (ir->eI==eiVV || IR_NPT_TROTTER(ir)); */
+ /*bTemp = ((ir->eI==eiVV &&(!bInitStep)) || (ir->eI==eiVVAK && IR_NPT_TROTTER(ir)));*/
+ bPres = TRUE;
+ bTemp = ((ir->eI==eiVV &&(!bInitStep)) || (ir->eI==eiVVAK));
+ compute_globals(fplog,gstat,cr,ir,fr,ekind,state,state_global,mdatoms,nrnb,vcm,
+ wcycle,enerd,force_vir,shake_vir,total_vir,pres,mu_tot,
+ constr,NULL,FALSE,state->box,
+ top_global,&pcurr,top_global->natoms,&bSumEkinhOld,
+ cglo_flags
+ | CGLO_ENERGY
+ | (bStopCM ? CGLO_STOPCM : 0)
+ | (bTemp ? CGLO_TEMPERATURE:0)
+ | (bPres ? CGLO_PRESSURE : 0)
+ | (bPres ? CGLO_CONSTRAINT : 0)
+ | ((bIterations && iterate.bIterate) ? CGLO_ITERATE : 0)
+ | (bFirstIterate ? CGLO_FIRSTITERATE : 0)
+ | CGLO_SCALEEKIN
+ );
+ /* explanation of above:
+ a) We compute Ekin at the full time step
+ if 1) we are using the AveVel Ekin, and it's not the
+ initial step, or 2) if we are using AveEkin, but need the full
+ time step kinetic energy for the pressure (always true now, since we want accurate statistics).
+ b) If we are using EkinAveEkin for the kinetic energy for the temperture control, we still feed in
+ EkinAveVel because it's needed for the pressure */
+
+ /* temperature scaling and pressure scaling to produce the extended variables at t+dt */
+ if (!bInitStep)
+ {
+ if (bTrotter)
+ {
+ trotter_update(ir,step,ekind,enerd,state,total_vir,mdatoms,&MassQ,trotter_seq,ettTSEQ2);
+ }
+ else
+ {
+ update_tcouple(fplog,step,ir,state,ekind,wcycle,upd,&MassQ,mdatoms);
+ }
+ }
+
+ if (bIterations &&
+ done_iterating(cr,fplog,step,&iterate,bFirstIterate,
+ state->veta,&vetanew))
+ {
+ break;
+ }
+ bFirstIterate = FALSE;
+ }
+
+ if (bTrotter && !bInitStep) {
+ copy_mat(shake_vir,state->svir_prev);
+ copy_mat(force_vir,state->fvir_prev);
+ if (IR_NVT_TROTTER(ir) && ir->eI==eiVV) {
+ /* update temperature and kinetic energy now that step is over - this is the v(t+dt) point */
+ enerd->term[F_TEMP] = sum_ekin(&(ir->opts),ekind,NULL,(ir->eI==eiVV),FALSE,FALSE);
+ enerd->term[F_EKIN] = trace(ekind->ekin);
+ }
+ }
+ /* if it's the initial step, we performed this first step just to get the constraint virial */
+ if (bInitStep && ir->eI==eiVV) {
+ copy_rvecn(cbuf,state->v,0,state->natoms);
+ }
+
+ if (fr->bSepDVDL && fplog && do_log)
+ {
+ fprintf(fplog,sepdvdlformat,"Constraint",0.0,dvdl);
+ }
+ enerd->term[F_DHDL_CON] += dvdl;
+ }
+
+ /* MRS -- now done iterating -- compute the conserved quantity */
+ if (bVV) {
+ saved_conserved_quantity = compute_conserved_from_auxiliary(ir,state,&MassQ);
+ if (ir->eI==eiVV)
+ {
+ last_ekin = enerd->term[F_EKIN]; /* does this get preserved through checkpointing? */
+ }
+ if ((ir->eDispCorr != edispcEnerPres) && (ir->eDispCorr != edispcAllEnerPres))
+ {
+ saved_conserved_quantity -= enerd->term[F_DISPCORR];
+ }
+ }
+
+ /* ######## END FIRST UPDATE STEP ############## */
+ /* ######## If doing VV, we now have v(dt) ###### */
+
+ /* ################## START TRAJECTORY OUTPUT ################# */
+
+ /* Now we have the energies and forces corresponding to the
+ * coordinates at time t. We must output all of this before
+ * the update.
+ * for RerunMD t is read from input trajectory
+ */
+ mdof_flags = 0;
+ if (do_per_step(step,ir->nstxout)) { mdof_flags |= MDOF_X; }
+ if (do_per_step(step,ir->nstvout)) { mdof_flags |= MDOF_V; }
+ if (do_per_step(step,ir->nstfout)) { mdof_flags |= MDOF_F; }
+ if (do_per_step(step,ir->nstxtcout)) { mdof_flags |= MDOF_XTC; }
+ if (bCPT) { mdof_flags |= MDOF_CPT; };
+
+#if defined(GMX_FAHCORE) || defined(GMX_WRITELASTSTEP)
+ if (bLastStep)
+ {
+ /* Enforce writing positions and velocities at end of run */
+ mdof_flags |= (MDOF_X | MDOF_V);
+ }
+#endif
+#ifdef GMX_FAHCORE
+ if (MASTER(cr))
+ fcReportProgress( ir->nsteps, step );
+
+ /* sync bCPT and fc record-keeping */
+ if (bCPT && MASTER(cr))
+ fcRequestCheckPoint();
+#endif
+
+ if (mdof_flags != 0)
+ {
+ wallcycle_start(wcycle,ewcTRAJ);
+ if (bCPT)
+ {
+ if (state->flags & (1<<estLD_RNG))
+ {
+ get_stochd_state(upd,state);
+ }
+ if (MASTER(cr))
+ {
+ if (bSumEkinhOld)
+ {
+ state_global->ekinstate.bUpToDate = FALSE;
+ }
+ else
+ {
+ update_ekinstate(&state_global->ekinstate,ekind);
+ state_global->ekinstate.bUpToDate = TRUE;
+ }
+ update_energyhistory(&state_global->enerhist,mdebin);
+ }
+ }
+ write_traj(fplog,cr,outf,mdof_flags,top_global,
+ step,t,state,state_global,f,f_global,&n_xtc,&x_xtc);
+ if (bCPT)
+ {
+ nchkpt++;
+ bCPT = FALSE;
+ }
+ debug_gmx();
+ if (bLastStep && step_rel == ir->nsteps &&
+ (Flags & MD_CONFOUT) && MASTER(cr) &&
+ !bRerunMD && !bFFscan)
+ {
+ /* x and v have been collected in write_traj,
+ * because a checkpoint file will always be written
+ * at the last step.
+ */
+ fprintf(stderr,"\nWriting final coordinates.\n");
+ if (ir->ePBC != epbcNONE && !ir->bPeriodicMols &&
+ DOMAINDECOMP(cr))
+ {
+ /* Make molecules whole only for confout writing */
+ do_pbc_mtop(fplog,ir->ePBC,state->box,top_global,state_global->x);
+ }
+ write_sto_conf_mtop(ftp2fn(efSTO,nfile,fnm),
+ *top_global->name,top_global,
+ state_global->x,state_global->v,
+ ir->ePBC,state->box);
+ debug_gmx();
+ }
+ wallcycle_stop(wcycle,ewcTRAJ);
+ }
+
+ /* kludge -- virial is lost with restart for NPT control. Must restart */
+ if (bStartingFromCpt && bVV)
+ {
+ copy_mat(state->svir_prev,shake_vir);
+ copy_mat(state->fvir_prev,force_vir);
+ }
+ /* ################## END TRAJECTORY OUTPUT ################ */
+
+ /* Determine the wallclock run time up till now */
+ run_time = gmx_gettime() - (double)runtime->real;
+
+ /* Check whether everything is still allright */
+ if (((int)gmx_get_stop_condition() > handled_stop_condition)
+#ifdef GMX_THREAD_MPI
+ && MASTER(cr)
+#endif
+ )
+ {
+ /* this is just make gs.sig compatible with the hack
+ of sending signals around by MPI_Reduce with together with
+ other floats */
+ if ( gmx_get_stop_condition() == gmx_stop_cond_next_ns )
+ gs.sig[eglsSTOPCOND]=1;
+ if ( gmx_get_stop_condition() == gmx_stop_cond_next )
+ gs.sig[eglsSTOPCOND]=-1;
+ /* < 0 means stop at next step, > 0 means stop at next NS step */
+ if (fplog)
+ {
+ fprintf(fplog,
+ "\n\nReceived the %s signal, stopping at the next %sstep\n\n",
+ gmx_get_signal_name(),
+ gs.sig[eglsSTOPCOND]==1 ? "NS " : "");
+ fflush(fplog);
+ }
+ fprintf(stderr,
+ "\n\nReceived the %s signal, stopping at the next %sstep\n\n",
+ gmx_get_signal_name(),
+ gs.sig[eglsSTOPCOND]==1 ? "NS " : "");
+ fflush(stderr);
+ handled_stop_condition=(int)gmx_get_stop_condition();
+ }
+ else if (MASTER(cr) && (bNS || ir->nstlist <= 0) &&
+ (max_hours > 0 && run_time > max_hours*60.0*60.0*0.99) &&
+ gs.sig[eglsSTOPCOND] == 0 && gs.set[eglsSTOPCOND] == 0)
+ {
+ /* Signal to terminate the run */
+ gs.sig[eglsSTOPCOND] = 1;
+ if (fplog)
+ {
+ fprintf(fplog,"\nStep %s: Run time exceeded %.3f hours, will terminate the run\n",gmx_step_str(step,sbuf),max_hours*0.99);
+ }
+ fprintf(stderr, "\nStep %s: Run time exceeded %.3f hours, will terminate the run\n",gmx_step_str(step,sbuf),max_hours*0.99);
+ }
+
+ if (bResetCountersHalfMaxH && MASTER(cr) &&
+ run_time > max_hours*60.0*60.0*0.495)
+ {
+ gs.sig[eglsRESETCOUNTERS] = 1;
+ }
+
+ if (ir->nstlist == -1 && !bRerunMD)
+ {
+ /* When bGStatEveryStep=FALSE, global_stat is only called
+ * when we check the atom displacements, not at NS steps.
+ * This means that also the bonded interaction count check is not
+ * performed immediately after NS. Therefore a few MD steps could
+ * be performed with missing interactions.
+ * But wrong energies are never written to file,
+ * since energies are only written after global_stat
+ * has been called.
+ */
+ if (step >= nlh.step_nscheck)
+ {
+ nlh.nabnsb = natoms_beyond_ns_buffer(ir,fr,&top->cgs,
+ nlh.scale_tot,state->x);
+ }
+ else
+ {
+ /* This is not necessarily true,
+ * but step_nscheck is determined quite conservatively.
+ */
+ nlh.nabnsb = 0;
+ }
+ }
+
+ /* In parallel we only have to check for checkpointing in steps
+ * where we do global communication,
+ * otherwise the other nodes don't know.
+ */
+ if (MASTER(cr) && ((bGStat || !PAR(cr)) &&
+ cpt_period >= 0 &&
+ (cpt_period == 0 ||
+ run_time >= nchkpt*cpt_period*60.0)) &&
+ gs.set[eglsCHKPT] == 0)
+ {
+ gs.sig[eglsCHKPT] = 1;
+ }
+
+ if (bIterations)
+ {
+ gmx_iterate_init(&iterate,bIterations);
+ }
+
+ /* for iterations, we save these vectors, as we will be redoing the calculations */
+ if (bIterations && iterate.bIterate)
+ {
+ copy_coupling_state(state,bufstate,ekind,ekind_save,&(ir->opts));
+ }
+ bFirstIterate = TRUE;
+ while (bFirstIterate || (bIterations && iterate.bIterate))
+ {
+ /* We now restore these vectors to redo the calculation with improved extended variables */
+ if (bIterations)
+ {
+ copy_coupling_state(bufstate,state,ekind_save,ekind,&(ir->opts));
+ }
+
+ /* We make the decision to break or not -after- the calculation of Ekin and Pressure,
+ so scroll down for that logic */
+
+ /* ######### START SECOND UPDATE STEP ################# */
+ /* Box is changed in update() when we do pressure coupling,
+ * but we should still use the old box for energy corrections and when
+ * writing it to the energy file, so it matches the trajectory files for
+ * the same timestep above. Make a copy in a separate array.
+ */
+ copy_mat(state->box,lastbox);
+
+ bOK = TRUE;
+ if (!(bRerunMD && !rerun_fr.bV && !bForceUpdate))
+ {
+ wallcycle_start(wcycle,ewcUPDATE);
+ dvdl = 0;
+ /* UPDATE PRESSURE VARIABLES IN TROTTER FORMULATION WITH CONSTRAINTS */
+ if (bTrotter)
+ {
+ if (bIterations && iterate.bIterate)
+ {
+ if (bFirstIterate)
+ {
+ scalevir = 1;
+ }
+ else
+ {
+ /* we use a new value of scalevir to converge the iterations faster */
+ scalevir = tracevir/trace(shake_vir);
+ }
+ msmul(shake_vir,scalevir,shake_vir);
+ m_add(force_vir,shake_vir,total_vir);
+ clear_mat(shake_vir);
+ }
+ trotter_update(ir,step,ekind,enerd,state,total_vir,mdatoms,&MassQ,trotter_seq,ettTSEQ3);
+ /* We can only do Berendsen coupling after we have summed
+ * the kinetic energy or virial. Since the happens
+ * in global_state after update, we should only do it at
+ * step % nstlist = 1 with bGStatEveryStep=FALSE.
+ */
+ }
+ else
+ {
+ update_tcouple(fplog,step,ir,state,ekind,wcycle,upd,&MassQ,mdatoms);
+ update_pcouple(fplog,step,ir,state,pcoupl_mu,M,wcycle,
+ upd,bInitStep);
+ }
+
+ if (bVV)
+ {
+ /* velocity half-step update */
+ update_coords(fplog,step,ir,mdatoms,state,f,
+ fr->bTwinRange && bNStList,fr->f_twin,fcd,
+ ekind,M,wcycle,upd,FALSE,etrtVELOCITY2,
+ cr,nrnb,constr,&top->idef);
+ }
+
+ /* Above, initialize just copies ekinh into ekin,
+ * it doesn't copy position (for VV),
+ * and entire integrator for MD.
+ */
+
+ if (ir->eI==eiVVAK)
+ {
+ copy_rvecn(state->x,cbuf,0,state->natoms);
+ }
+
+ update_coords(fplog,step,ir,mdatoms,state,f,fr->bTwinRange && bNStList,fr->f_twin,fcd,
+ ekind,M,wcycle,upd,bInitStep,etrtPOSITION,cr,nrnb,constr,&top->idef);
+ wallcycle_stop(wcycle,ewcUPDATE);
+
+ update_constraints(fplog,step,&dvdl,ir,ekind,mdatoms,state,graph,f,
+ &top->idef,shake_vir,force_vir,
+ cr,nrnb,wcycle,upd,constr,
+ bInitStep,FALSE,bCalcEnerPres,state->veta);
+
+ if (ir->eI==eiVVAK)
+ {
+ /* erase F_EKIN and F_TEMP here? */
+ /* just compute the kinetic energy at the half step to perform a trotter step */
+ compute_globals(fplog,gstat,cr,ir,fr,ekind,state,state_global,mdatoms,nrnb,vcm,
+ wcycle,enerd,force_vir,shake_vir,total_vir,pres,mu_tot,
+ constr,NULL,FALSE,lastbox,
+ top_global,&pcurr,top_global->natoms,&bSumEkinhOld,
+ cglo_flags | CGLO_TEMPERATURE
+ );
+ wallcycle_start(wcycle,ewcUPDATE);
+ trotter_update(ir,step,ekind,enerd,state,total_vir,mdatoms,&MassQ,trotter_seq,ettTSEQ4);
+ /* now we know the scaling, we can compute the positions again again */
+ copy_rvecn(cbuf,state->x,0,state->natoms);
+
+ update_coords(fplog,step,ir,mdatoms,state,f,fr->bTwinRange && bNStList,fr->f_twin,fcd,
+ ekind,M,wcycle,upd,bInitStep,etrtPOSITION,cr,nrnb,constr,&top->idef);
+ wallcycle_stop(wcycle,ewcUPDATE);
+
+ /* do we need an extra constraint here? just need to copy out of state->v to upd->xp? */
+ /* are the small terms in the shake_vir here due
+ * to numerical errors, or are they important
+ * physically? I'm thinking they are just errors, but not completely sure.
+ * For now, will call without actually constraining, constr=NULL*/
+ update_constraints(fplog,step,&dvdl,ir,ekind,mdatoms,state,graph,f,
+ &top->idef,tmp_vir,force_vir,
+ cr,nrnb,wcycle,upd,NULL,
+ bInitStep,FALSE,bCalcEnerPres,
+ state->veta);
+ }
+ if (!bOK && !bFFscan)
+ {
+ gmx_fatal(FARGS,"Constraint error: Shake, Lincs or Settle could not solve the constrains");
+ }
+
+ if (fr->bSepDVDL && fplog && do_log)
+ {
+ fprintf(fplog,sepdvdlformat,"Constraint",0.0,dvdl);
+ }
+ enerd->term[F_DHDL_CON] += dvdl;
+ }
+ else if (graph)
+ {
+ /* Need to unshift here */
+ unshift_self(graph,state->box,state->x);
+ }
+
+ if (vsite != NULL)
+ {
+ wallcycle_start(wcycle,ewcVSITECONSTR);
+ if (graph != NULL)
+ {
+ shift_self(graph,state->box,state->x);
+ }
+ construct_vsites(fplog,vsite,state->x,nrnb,ir->delta_t,state->v,
+ top->idef.iparams,top->idef.il,
+ fr->ePBC,fr->bMolPBC,graph,cr,state->box);
+
+ if (graph != NULL)
+ {
+ unshift_self(graph,state->box,state->x);
+ }
+ wallcycle_stop(wcycle,ewcVSITECONSTR);
+ }
+
+ /* ############## IF NOT VV, Calculate globals HERE, also iterate constraints ############ */
+ if (ir->nstlist == -1 && bFirstIterate)
+ {
+ gs.sig[eglsNABNSB] = nlh.nabnsb;
+ }
+ compute_globals(fplog,gstat,cr,ir,fr,ekind,state,state_global,mdatoms,nrnb,vcm,
+ wcycle,enerd,force_vir,shake_vir,total_vir,pres,mu_tot,
+ constr,
+ bFirstIterate ? &gs : NULL,
+ (step_rel % gs.nstms == 0) &&
+ (multisim_nsteps<0 || (step_rel<multisim_nsteps)),
+ lastbox,
+ top_global,&pcurr,top_global->natoms,&bSumEkinhOld,
+ cglo_flags
+ | (!EI_VV(ir->eI) ? CGLO_ENERGY : 0)
+ | (!EI_VV(ir->eI) && bStopCM ? CGLO_STOPCM : 0)
+ | (!EI_VV(ir->eI) ? CGLO_TEMPERATURE : 0)
+ | (!EI_VV(ir->eI) || bRerunMD ? CGLO_PRESSURE : 0)
+ | (bIterations && iterate.bIterate ? CGLO_ITERATE : 0)
+ | (bFirstIterate ? CGLO_FIRSTITERATE : 0)
+ | CGLO_CONSTRAINT
+ );
+ if (ir->nstlist == -1 && bFirstIterate)
+ {
+ nlh.nabnsb = gs.set[eglsNABNSB];
+ gs.set[eglsNABNSB] = 0;
+ }
+ /* bIterate is set to keep it from eliminating the old ekin kinetic energy terms */
+ /* ############# END CALC EKIN AND PRESSURE ################# */
+
+ /* Note: this is OK, but there are some numerical precision issues with using the convergence of
+ the virial that should probably be addressed eventually. state->veta has better properies,
+ but what we actually need entering the new cycle is the new shake_vir value. Ideally, we could
+ generate the new shake_vir, but test the veta value for convergence. This will take some thought. */
+
+ if (bIterations &&
+ done_iterating(cr,fplog,step,&iterate,bFirstIterate,
+ trace(shake_vir),&tracevir))
+ {
+ break;
+ }
+ bFirstIterate = FALSE;
+ }
+
+ update_box(fplog,step,ir,mdatoms,state,graph,f,
+ ir->nstlist==-1 ? &nlh.scale_tot : NULL,pcoupl_mu,nrnb,wcycle,upd,bInitStep,FALSE);
+
+ /* ################# END UPDATE STEP 2 ################# */
+ /* #### We now have r(t+dt) and v(t+dt/2) ############# */
+
+ /* The coordinates (x) were unshifted in update */
+ if (bFFscan && (shellfc==NULL || bConverged))
+ {
+ if (print_forcefield(fplog,enerd->term,mdatoms->homenr,
+ f,NULL,xcopy,
+ &(top_global->mols),mdatoms->massT,pres))
+ {
+ gmx_finalize_par();
+
+ fprintf(stderr,"\n");
+ exit(0);
+ }
+ }
+ if (!bGStat)
+ {
+ /* We will not sum ekinh_old,
+ * so signal that we still have to do it.
+ */
+ bSumEkinhOld = TRUE;
+ }
+
+ if (bTCR)
+ {
+ /* Only do GCT when the relaxation of shells (minimization) has converged,
+ * otherwise we might be coupling to bogus energies.
+ * In parallel we must always do this, because the other sims might
+ * update the FF.
+ */
+
+ /* Since this is called with the new coordinates state->x, I assume
+ * we want the new box state->box too. / EL 20040121
+ */
+ do_coupling(fplog,oenv,nfile,fnm,tcr,t,step,enerd->term,fr,
+ ir,MASTER(cr),
+ mdatoms,&(top->idef),mu_aver,
+ top_global->mols.nr,cr,
+ state->box,total_vir,pres,
+ mu_tot,state->x,f,bConverged);
+ debug_gmx();
+ }
+
+ /* ######### BEGIN PREPARING EDR OUTPUT ########### */
+
+ /* sum up the foreign energy and dhdl terms */
+ sum_dhdl(enerd,state->lambda,ir);
+
+ /* use the directly determined last velocity, not actually the averaged half steps */
+ if (bTrotter && ir->eI==eiVV)
+ {
+ enerd->term[F_EKIN] = last_ekin;
+ }
+ enerd->term[F_ETOT] = enerd->term[F_EPOT] + enerd->term[F_EKIN];
+
+ if (bVV)
+ {
+ enerd->term[F_ECONSERVED] = enerd->term[F_ETOT] + saved_conserved_quantity;
+ }
+ else
+ {
+ enerd->term[F_ECONSERVED] = enerd->term[F_ETOT] + compute_conserved_from_auxiliary(ir,state,&MassQ);
+ }
+ /* Check for excessively large energies */
+ if (bIonize)
+ {
+#ifdef GMX_DOUBLE
+ real etot_max = 1e200;
+#else
+ real etot_max = 1e30;
+#endif
+ if (fabs(enerd->term[F_ETOT]) > etot_max)
+ {
+ fprintf(stderr,"Energy too large (%g), giving up\n",
+ enerd->term[F_ETOT]);
+ }
+ }
+ /* ######### END PREPARING EDR OUTPUT ########### */
+
+ /* Time for performance */
+ if (((step % stepout) == 0) || bLastStep)
+ {
+ runtime_upd_proc(runtime);
+ }
+
+ /* Output stuff */
+ if (MASTER(cr))
+ {
+ gmx_bool do_dr,do_or;
+
+ if (!(bStartingFromCpt && (EI_VV(ir->eI))))
+ {
+ if (bNstEner)
+ {
+ upd_mdebin(mdebin,bDoDHDL, TRUE,
+ t,mdatoms->tmass,enerd,state,lastbox,
+ shake_vir,force_vir,total_vir,pres,
+ ekind,mu_tot,constr);
+ }
+ else
+ {
+ upd_mdebin_step(mdebin);
+ }
+
+ do_dr = do_per_step(step,ir->nstdisreout);
+ do_or = do_per_step(step,ir->nstorireout);
+
+ print_ebin(outf->fp_ene,do_ene,do_dr,do_or,do_log?fplog:NULL,
+ step,t,
+ eprNORMAL,bCompact,mdebin,fcd,groups,&(ir->opts));
+ }
+ if (ir->ePull != epullNO)
+ {
+ pull_print_output(ir->pull,step,t);
+ }
+
+ if (do_per_step(step,ir->nstlog))
+ {
+ if(fflush(fplog) != 0)
+ {
+ gmx_fatal(FARGS,"Cannot flush logfile - maybe you are out of disk space?");
+ }
+ }
+ }
+
+
+ /* Remaining runtime */
+ if (MULTIMASTER(cr) && (do_verbose || gmx_got_usr_signal() ))
+ {
+ if (shellfc)
+ {
+ fprintf(stderr,"\n");
+ }
+ print_time(stderr,runtime,step,ir,cr);
+ }
+
+ /* Replica exchange */
+ bExchanged = FALSE;
+ if ((repl_ex_nst > 0) && (step > 0) && !bLastStep &&
+ do_per_step(step,repl_ex_nst))
+ {
+ bExchanged = replica_exchange(fplog,cr,repl_ex,
+ state_global,enerd->term,
+ state,step,t);
+
+ if (bExchanged && DOMAINDECOMP(cr))
+ {
+ dd_partition_system(fplog,step,cr,TRUE,1,
+ state_global,top_global,ir,
+ state,&f,mdatoms,top,fr,
+ vsite,shellfc,constr,
+ nrnb,wcycle,FALSE);
+ }
+ }
+
+ bFirstStep = FALSE;
+ bInitStep = FALSE;
+ bStartingFromCpt = FALSE;
+
+ /* ####### SET VARIABLES FOR NEXT ITERATION IF THEY STILL NEED IT ###### */
+ /* With all integrators, except VV, we need to retain the pressure
+ * at the current step for coupling at the next step.
+ */
+ if ((state->flags & (1<<estPRES_PREV)) &&
+ (bGStatEveryStep ||
+ (ir->nstpcouple > 0 && step % ir->nstpcouple == 0)))
+ {
+ /* Store the pressure in t_state for pressure coupling
+ * at the next MD step.
+ */
+ copy_mat(pres,state->pres_prev);
+ }
+
+ /* ####### END SET VARIABLES FOR NEXT ITERATION ###### */
+
+ if ( (membed!=NULL) && (!bLastStep) )
+ {
+ rescale_membed(step_rel,membed,state_global->x);
+ }
+
+ if (bRerunMD)
+ {
+ if (MASTER(cr))
+ {
+ /* read next frame from input trajectory */
+ bNotLastFrame = read_next_frame(oenv,status,&rerun_fr);
+ }
+
+ if (PAR(cr))
+ {
+ rerun_parallel_comm(cr,&rerun_fr,&bNotLastFrame);
+ }
+ }
+
+ if (!bRerunMD || !rerun_fr.bStep)
+ {
+ /* increase the MD step number */
+ step++;
+ step_rel++;
+ }
+
+ cycles = wallcycle_stop(wcycle,ewcSTEP);
+ if (DOMAINDECOMP(cr) && wcycle)
+ {
+ dd_cycles_add(cr->dd,cycles,ddCyclStep);
+ }
+
+ if (step_rel == wcycle_get_reset_counters(wcycle) ||
+ gs.set[eglsRESETCOUNTERS] != 0)
+ {
+ /* Reset all the counters related to performance over the run */
+ reset_all_counters(fplog,cr,step,&step_rel,ir,wcycle,nrnb,runtime);
+ wcycle_set_reset_counters(wcycle,-1);
+ /* Correct max_hours for the elapsed time */
+ max_hours -= run_time/(60.0*60.0);
+ bResetCountersHalfMaxH = FALSE;
+ gs.set[eglsRESETCOUNTERS] = 0;
+ }
+
+ }
+ /* End of main MD loop */
+ debug_gmx();
+
+ /* Stop the time */
+ runtime_end(runtime);
+
+ if (bRerunMD && MASTER(cr))
+ {
+ close_trj(status);
+ }
+
+ if (!(cr->duty & DUTY_PME))
+ {
+ /* Tell the PME only node to finish */
+ gmx_pme_finish(cr);
+ }
+
+ if (MASTER(cr))
+ {
+ if (ir->nstcalcenergy > 0 && !bRerunMD)
+ {
+ print_ebin(outf->fp_ene,FALSE,FALSE,FALSE,fplog,step,t,
+ eprAVER,FALSE,mdebin,fcd,groups,&(ir->opts));
+ }
+ }
+
+ done_mdoutf(outf);
+
+ debug_gmx();
+
+ if (ir->nstlist == -1 && nlh.nns > 0 && fplog)
+ {
+ fprintf(fplog,"Average neighborlist lifetime: %.1f steps, std.dev.: %.1f steps\n",nlh.s1/nlh.nns,sqrt(nlh.s2/nlh.nns - sqr(nlh.s1/nlh.nns)));
+ fprintf(fplog,"Average number of atoms that crossed the half buffer length: %.1f\n\n",nlh.ab/nlh.nns);
+ }
+
+ if (shellfc && fplog)
+ {
+ fprintf(fplog,"Fraction of iterations that converged: %.2f %%\n",
+ (nconverged*100.0)/step_rel);
+ fprintf(fplog,"Average number of force evaluations per MD step: %.2f\n\n",
+ tcount/step_rel);
+ }
+
+ if (repl_ex_nst > 0 && MASTER(cr))
+ {
+ print_replica_exchange_statistics(fplog,repl_ex);
+ }
+
+ runtime->nsteps_done = step_rel;
+
+ return 0;
+}
#include "readinp.h"
#include "calcgrid.h"
#include "checkpoint.h"
++#include "macros.h"
#include "gmx_ana.h"
#include "names.h"
- #include "macros.h"
-
+ #include "perf_est.h"
- enum {
- ddnoSEL, ddnoINTERLEAVE, ddnoPP_PME, ddnoCARTESIAN, ddnoNR
- };
/* Enum for situations that can occur during log file parsing, the
* corresponding string entries can be found in do_the_tests() in
biod.pnpi.spb.ru / alexxy / gromacs.git / commitdiff