#include "f2c.h" #include "blaswrap.h" /* Subroutine */ int zlacp2_(char *uplo, integer *m, integer *n, doublereal * a, integer *lda, doublecomplex *b, integer *ldb) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4; /* Local variables */ integer i__, j; extern logical lsame_(char *, char *); /* -- LAPACK auxiliary routine (version 3.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* .. Array Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* ZLACP2 copies all or part of a real two-dimensional matrix A to a */ /* complex matrix B. */ /* Arguments */ /* ========= */ /* UPLO (input) 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 */ /* M (input) INTEGER */ /* The number of rows of the matrix A. M >= 0. */ /* N (input) INTEGER */ /* The number of columns of the matrix A. N >= 0. */ /* A (input) DOUBLE PRECISION array, dimension (LDA,N) */ /* The m by n matrix A. If UPLO = 'U', only the upper trapezium */ /* is accessed; if UPLO = 'L', only the lower trapezium is */ /* accessed. */ /* LDA (input) INTEGER */ /* The leading dimension of the array A. LDA >= max(1,M). */ /* B (output) COMPLEX*16 array, dimension (LDB,N) */ /* On exit, B = A in the locations specified by UPLO. */ /* LDB (input) INTEGER */ /* The leading dimension of the array B. LDB >= max(1,M). */ /* ===================================================================== */ /* .. 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__) { i__3 = i__ + j * b_dim1; i__4 = i__ + j * a_dim1; b[i__3].r = a[i__4], b[i__3].i = 0.; /* 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__) { i__3 = i__ + j * b_dim1; i__4 = i__ + j * a_dim1; b[i__3].r = a[i__4], b[i__3].i = 0.; /* L30: */ } /* L40: */ } } else { i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { i__3 = i__ + j * b_dim1; i__4 = i__ + j * a_dim1; b[i__3].r = a[i__4], b[i__3].i = 0.; /* L50: */ } /* L60: */ } } return 0; /* End of ZLACP2 */ } /* zlacp2_ */