2 * This file is part of the GROMACS molecular simulation package.
4 * Copyright (c) 2012,2013, by the GROMACS development team, led by
5 * David van der Spoel, Berk Hess, Erik Lindahl, and including many
6 * others, as listed in the AUTHORS file in the top-level source
7 * directory and at http://www.gromacs.org.
9 * GROMACS is free software; you can redistribute it and/or
10 * modify it under the terms of the GNU Lesser General Public License
11 * as published by the Free Software Foundation; either version 2.1
12 * of the License, or (at your option) any later version.
14 * GROMACS is distributed in the hope that it will be useful,
15 * but WITHOUT ANY WARRANTY; without even the implied warranty of
16 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 * Lesser General Public License for more details.
19 * You should have received a copy of the GNU Lesser General Public
20 * License along with GROMACS; if not, see
21 * http://www.gnu.org/licenses, or write to the Free Software Foundation,
22 * Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
24 * If you want to redistribute modifications to GROMACS, please
25 * consider that scientific software is very special. Version
26 * control is crucial - bugs must be traceable. We will be happy to
27 * consider code for inclusion in the official distribution, but
28 * derived work must not be called official GROMACS. Details are found
29 * in the README & COPYING files - if they are missing, get the
30 * official version at http://www.gromacs.org.
32 * To help us fund GROMACS development, we humbly ask that you cite
33 * the research papers on the package. Check out http://www.gromacs.org.
36 #include <types/simple.h>
39 #include "gmx_lapack.h"
42 F77_FUNC(dlarft,DLARFT)(const char *direct,
52 /* System generated locals */
53 int t_dim1, t_offset, v_dim1, v_offset, i__1, i__2, i__3;
63 v_offset = 1 + v_dim1;
67 t_offset = 1 + t_dim1;
74 if (*direct=='F' || *direct=='f') {
76 for (i__ = 1; i__ <= i__1; ++i__) {
77 if (fabs(tau[i__])<GMX_DOUBLE_MIN) {
80 for (j = 1; j <= i__2; ++j) {
81 t[j + i__ * t_dim1] = 0.;
85 vii = v[i__ + i__ * v_dim1];
86 v[i__ + i__ * v_dim1] = 1.;
87 if (*storev=='C' || *storev=='c') {
92 F77_FUNC(dgemv,DGEMV)("Transpose", &i__2, &i__3, &d__1, &v[i__ + v_dim1],
93 ldv, &v[i__ + i__ * v_dim1], &c__1, &zero, &t[
94 i__ * t_dim1 + 1], &c__1);
100 F77_FUNC(dgemv,DGEMV)("No transpose", &i__2, &i__3, &d__1, &v[i__ *
101 v_dim1 + 1], ldv, &v[i__ + i__ * v_dim1], ldv, &
102 zero, &t[i__ * t_dim1 + 1], &c__1);
104 v[i__ + i__ * v_dim1] = vii;
108 F77_FUNC(dtrmv,DTRMV)("Upper", "No transpose", "Non-unit", &i__2, &t[
109 t_offset], ldt, &t[i__ * t_dim1 + 1], &c__1);
110 t[i__ + i__ * t_dim1] = tau[i__];
114 for (i__ = *k; i__ >= 1; --i__) {
115 if (fabs(tau[i__])<GMX_DOUBLE_MIN) {
118 for (j = i__; j <= i__1; ++j) {
119 t[j + i__ * t_dim1] = 0.;
124 if (*storev=='C' || *storev=='c') {
125 vii = v[*n - *k + i__ + i__ * v_dim1];
126 v[*n - *k + i__ + i__ * v_dim1] = 1.;
128 i__1 = *n - *k + i__;
131 F77_FUNC(dgemv,DGEMV)("Transpose", &i__1, &i__2, &d__1, &v[(i__ + 1)
132 * v_dim1 + 1], ldv, &v[i__ * v_dim1 + 1], &
133 c__1, &zero, &t[i__ + 1 + i__ * t_dim1], &
135 v[*n - *k + i__ + i__ * v_dim1] = vii;
137 vii = v[i__ + (*n - *k + i__) * v_dim1];
138 v[i__ + (*n - *k + i__) * v_dim1] = 1.;
141 i__2 = *n - *k + i__;
143 F77_FUNC(dgemv,DGEMV)("No transpose", &i__1, &i__2, &d__1, &v[i__ +
144 1 + v_dim1], ldv, &v[i__ + v_dim1], ldv, &
145 zero, &t[i__ + 1 + i__ * t_dim1], &c__1);
146 v[i__ + (*n - *k + i__) * v_dim1] = vii;
150 F77_FUNC(dtrmv,DTRMV)("Lower", "No transpose", "Non-unit", &i__1, &t[i__
151 + 1 + (i__ + 1) * t_dim1], ldt, &t[i__ + 1 + i__ *
155 t[i__ + i__ * t_dim1] = tau[i__];