1
0
mirror of https://github.com/opencv/opencv.git synced 2026-07-21 19:33:03 +04:00
Files
opencv/3rdparty/clapack/src/dlacpy.c
T
Vadim Pisarevsky 2ee9d21dae Merge pull request #18571 from vpisarev:add_lapack
Added clapack

* bring a small subset of Lapack, automatically converted to C, into OpenCV

* added missing lsame_ prototype

* * small fix in make_clapack script
* trying to fix remaining CI problems

* fixed character arrays' initializers

* get rid of F2C_STR_MAX

* * added back single-precision versions for QR, LU and Cholesky decompositions. It adds very little extra overhead.
* added stub version of sdesdd.
* uncommented calls to all the single-precision Lapack functions from opencv/core/src/hal_internal.cpp.

* fixed warning from Visual Studio + cleaned f2c runtime a bit

* * regenerated Lapack w/o forward declarations of intrinsic functions (such as sqrt(), r_cnjg() etc.)
* at once, trailing whitespaces are removed from the generated sources, just in case
* since there is no declarations of intrinsic functions anymore, we could turn some of them into inline functions

* trying to eliminate the crash on ARM

* fixed API and semantics of s_copy

* * CLapack has been tested successfully. It's now time to restore the standard LAPACK detection procedure
* removed some more trailing whitespaces

* * retained only the essential stuff in CLapack
* added checks to lapack calls to gracefully return "not implemented" instead of returning invalid results with "ok" status

* disabled warning when building lapack

* cmake: update LAPACK detection

Co-authored-by: Alexander Alekhin <alexander.a.alekhin@gmail.com>
2020-11-05 21:46:51 +00:00

185 lines
4.5 KiB
C

/* -- translated by f2c (version 20201020 (for_lapack)). -- */
#include "f2c.h"
//> \brief \b DLACPY copies all or part of one two-dimensional array to another.
//
// =========== DOCUMENTATION ===========
//
// Online html documentation available at
// http://www.netlib.org/lapack/explore-html/
//
//> \htmlonly
//> Download DLACPY + dependencies
//> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlacpy.f">
//> [TGZ]</a>
//> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlacpy.f">
//> [ZIP]</a>
//> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlacpy.f">
//> [TXT]</a>
//> \endhtmlonly
//
// Definition:
// ===========
//
// SUBROUTINE DLACPY( UPLO, M, N, A, LDA, B, LDB )
//
// .. Scalar Arguments ..
// CHARACTER UPLO
// INTEGER LDA, LDB, M, N
// ..
// .. Array Arguments ..
// DOUBLE PRECISION A( LDA, * ), B( LDB, * )
// ..
//
//
//> \par Purpose:
// =============
//>
//> \verbatim
//>
//> DLACPY copies all or part of a two-dimensional matrix A to another
//> matrix B.
//> \endverbatim
//
// Arguments:
// ==========
//
//> \param[in] UPLO
//> \verbatim
//> UPLO is CHARACTER*1
//> Specifies the part of the matrix A to be copied to B.
//> = 'U': Upper triangular part
//> = 'L': Lower triangular part
//> Otherwise: All of the matrix A
//> \endverbatim
//>
//> \param[in] M
//> \verbatim
//> M is INTEGER
//> The number of rows of the matrix A. M >= 0.
//> \endverbatim
//>
//> \param[in] N
//> \verbatim
//> N is INTEGER
//> The number of columns of the matrix A. N >= 0.
//> \endverbatim
//>
//> \param[in] A
//> \verbatim
//> A is DOUBLE PRECISION array, dimension (LDA,N)
//> The m by n matrix A. If UPLO = 'U', only the upper triangle
//> or trapezoid is accessed; if UPLO = 'L', only the lower
//> triangle or trapezoid is accessed.
//> \endverbatim
//>
//> \param[in] LDA
//> \verbatim
//> LDA is INTEGER
//> The leading dimension of the array A. LDA >= max(1,M).
//> \endverbatim
//>
//> \param[out] B
//> \verbatim
//> B is DOUBLE PRECISION array, dimension (LDB,N)
//> On exit, B = A in the locations specified by UPLO.
//> \endverbatim
//>
//> \param[in] LDB
//> \verbatim
//> LDB is INTEGER
//> The leading dimension of the array B. LDB >= max(1,M).
//> \endverbatim
//
// Authors:
// ========
//
//> \author Univ. of Tennessee
//> \author Univ. of California Berkeley
//> \author Univ. of Colorado Denver
//> \author NAG Ltd.
//
//> \date December 2016
//
//> \ingroup OTHERauxiliary
//
// =====================================================================
/* Subroutine */ int dlacpy_(char *uplo, int *m, int *n, double *a, int *lda,
double *b, int *ldb)
{
// System generated locals
int a_dim1, a_offset, b_dim1, b_offset, i__1, i__2;
// Local variables
int i__, j;
extern int lsame_(char *, char *);
//
// -- LAPACK auxiliary routine (version 3.7.0) --
// -- LAPACK is a software package provided by Univ. of Tennessee, --
// -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
// December 2016
//
// .. Scalar Arguments ..
// ..
// .. Array Arguments ..
// ..
//
// =====================================================================
//
// .. Local Scalars ..
// ..
// .. External Functions ..
// ..
// .. Intrinsic Functions ..
// ..
// .. Executable Statements ..
//
// Parameter adjustments
a_dim1 = *lda;
a_offset = 1 + a_dim1;
a -= a_offset;
b_dim1 = *ldb;
b_offset = 1 + b_dim1;
b -= b_offset;
// Function Body
if (lsame_(uplo, "U")) {
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
i__2 = min(j,*m);
for (i__ = 1; i__ <= i__2; ++i__) {
b[i__ + j * b_dim1] = a[i__ + j * a_dim1];
// L10:
}
// L20:
}
} else if (lsame_(uplo, "L")) {
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
i__2 = *m;
for (i__ = j; i__ <= i__2; ++i__) {
b[i__ + j * b_dim1] = a[i__ + j * a_dim1];
// L30:
}
// L40:
}
} else {
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
i__2 = *m;
for (i__ = 1; i__ <= i__2; ++i__) {
b[i__ + j * b_dim1] = a[i__ + j * a_dim1];
// L50:
}
// L60:
}
}
return 0;
//
// End of DLACPY
//
} // dlacpy_