ergo
template_lapack_lacpy.h
Go to the documentation of this file.
1 /* Ergo, version 3.2, a program for linear scaling electronic structure
2  * calculations.
3  * Copyright (C) 2012 Elias Rudberg, Emanuel H. Rubensson, and Pawel Salek.
4  *
5  * This program is free software: you can redistribute it and/or modify
6  * it under the terms of the GNU General Public License as published by
7  * the Free Software Foundation, either version 3 of the License, or
8  * (at your option) any later version.
9  *
10  * This program is distributed in the hope that it will be useful,
11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13  * GNU General Public License for more details.
14  *
15  * You should have received a copy of the GNU General Public License
16  * along with this program. If not, see <http://www.gnu.org/licenses/>.
17  *
18  * Primary academic reference:
19  * Kohn−Sham Density Functional Theory Electronic Structure Calculations
20  * with Linearly Scaling Computational Time and Memory Usage,
21  * Elias Rudberg, Emanuel H. Rubensson, and Pawel Salek,
22  * J. Chem. Theory Comput. 7, 340 (2011),
23  * <http://dx.doi.org/10.1021/ct100611z>
24  *
25  * For further information about Ergo, see <http://www.ergoscf.org>.
26  */
27 
28  /* This file belongs to the template_lapack part of the Ergo source
29  * code. The source files in the template_lapack directory are modified
30  * versions of files originally distributed as CLAPACK, see the
31  * Copyright/license notice in the file template_lapack/COPYING.
32  */
33 
34 
35 #ifndef TEMPLATE_LAPACK_LACPY_HEADER
36 #define TEMPLATE_LAPACK_LACPY_HEADER
37 
38 
39 template<class Treal>
40 int template_lapack_lacpy(const char *uplo, const integer *m, const integer *n, const Treal *
41  a, const integer *lda, Treal *b, const integer *ldb)
42 {
43 /* -- LAPACK auxiliary routine (version 3.0) --
44  Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
45  Courant Institute, Argonne National Lab, and Rice University
46  February 29, 1992
47 
48 
49  Purpose
50  =======
51 
52  DLACPY copies all or part of a two-dimensional matrix A to another
53  matrix B.
54 
55  Arguments
56  =========
57 
58  UPLO (input) CHARACTER*1
59  Specifies the part of the matrix A to be copied to B.
60  = 'U': Upper triangular part
61  = 'L': Lower triangular part
62  Otherwise: All of the matrix A
63 
64  M (input) INTEGER
65  The number of rows of the matrix A. M >= 0.
66 
67  N (input) INTEGER
68  The number of columns of the matrix A. N >= 0.
69 
70  A (input) DOUBLE PRECISION array, dimension (LDA,N)
71  The m by n matrix A. If UPLO = 'U', only the upper triangle
72  or trapezoid is accessed; if UPLO = 'L', only the lower
73  triangle or trapezoid is accessed.
74 
75  LDA (input) INTEGER
76  The leading dimension of the array A. LDA >= max(1,M).
77 
78  B (output) DOUBLE PRECISION array, dimension (LDB,N)
79  On exit, B = A in the locations specified by UPLO.
80 
81  LDB (input) INTEGER
82  The leading dimension of the array B. LDB >= max(1,M).
83 
84  =====================================================================
85 
86 
87  Parameter adjustments */
88  /* System generated locals */
89  integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2;
90  /* Local variables */
91  integer i__, j;
92 #define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1]
93 #define b_ref(a_1,a_2) b[(a_2)*b_dim1 + a_1]
94 
95  a_dim1 = *lda;
96  a_offset = 1 + a_dim1 * 1;
97  a -= a_offset;
98  b_dim1 = *ldb;
99  b_offset = 1 + b_dim1 * 1;
100  b -= b_offset;
101 
102  /* Function Body */
103  if (template_blas_lsame(uplo, "U")) {
104  i__1 = *n;
105  for (j = 1; j <= i__1; ++j) {
106  i__2 = minMACRO(j,*m);
107  for (i__ = 1; i__ <= i__2; ++i__) {
108  b_ref(i__, j) = a_ref(i__, j);
109 /* L10: */
110  }
111 /* L20: */
112  }
113  } else if (template_blas_lsame(uplo, "L")) {
114  i__1 = *n;
115  for (j = 1; j <= i__1; ++j) {
116  i__2 = *m;
117  for (i__ = j; i__ <= i__2; ++i__) {
118  b_ref(i__, j) = a_ref(i__, j);
119 /* L30: */
120  }
121 /* L40: */
122  }
123  } else {
124  i__1 = *n;
125  for (j = 1; j <= i__1; ++j) {
126  i__2 = *m;
127  for (i__ = 1; i__ <= i__2; ++i__) {
128  b_ref(i__, j) = a_ref(i__, j);
129 /* L50: */
130  }
131 /* L60: */
132  }
133  }
134  return 0;
135 
136 /* End of DLACPY */
137 
138 } /* dlacpy_ */
139 
140 #undef b_ref
141 #undef a_ref
142 
143 
144 #endif