00001 /* clacp2.f -- translated by f2c (version 20061008). 00002 You must link the resulting object file with libf2c: 00003 on Microsoft Windows system, link with libf2c.lib; 00004 on Linux or Unix systems, link with .../path/to/libf2c.a -lm 00005 or, if you install libf2c.a in a standard place, with -lf2c -lm 00006 -- in that order, at the end of the command line, as in 00007 cc *.o -lf2c -lm 00008 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., 00009 00010 http://www.netlib.org/f2c/libf2c.zip 00011 */ 00012 00013 #include "f2c.h" 00014 #include "blaswrap.h" 00015 00016 /* Subroutine */ int clacp2_(char *uplo, integer *m, integer *n, real *a, 00017 integer *lda, complex *b, integer *ldb) 00018 { 00019 /* System generated locals */ 00020 integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4; 00021 00022 /* Local variables */ 00023 integer i__, j; 00024 extern logical lsame_(char *, char *); 00025 00026 00027 /* -- LAPACK auxiliary routine (version 3.2) -- */ 00028 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ 00029 /* November 2006 */ 00030 00031 /* .. Scalar Arguments .. */ 00032 /* .. */ 00033 /* .. Array Arguments .. */ 00034 /* .. */ 00035 00036 /* Purpose */ 00037 /* ======= */ 00038 00039 /* CLACP2 copies all or part of a real two-dimensional matrix A to a */ 00040 /* complex matrix B. */ 00041 00042 /* Arguments */ 00043 /* ========= */ 00044 00045 /* UPLO (input) CHARACTER*1 */ 00046 /* Specifies the part of the matrix A to be copied to B. */ 00047 /* = 'U': Upper triangular part */ 00048 /* = 'L': Lower triangular part */ 00049 /* Otherwise: All of the matrix A */ 00050 00051 /* M (input) INTEGER */ 00052 /* The number of rows of the matrix A. M >= 0. */ 00053 00054 /* N (input) INTEGER */ 00055 /* The number of columns of the matrix A. N >= 0. */ 00056 00057 /* A (input) REAL array, dimension (LDA,N) */ 00058 /* The m by n matrix A. If UPLO = 'U', only the upper trapezium */ 00059 /* is accessed; if UPLO = 'L', only the lower trapezium is */ 00060 /* accessed. */ 00061 00062 /* LDA (input) INTEGER */ 00063 /* The leading dimension of the array A. LDA >= max(1,M). */ 00064 00065 /* B (output) COMPLEX array, dimension (LDB,N) */ 00066 /* On exit, B = A in the locations specified by UPLO. */ 00067 00068 /* LDB (input) INTEGER */ 00069 /* The leading dimension of the array B. LDB >= max(1,M). */ 00070 00071 /* ===================================================================== */ 00072 00073 /* .. Local Scalars .. */ 00074 /* .. */ 00075 /* .. External Functions .. */ 00076 /* .. */ 00077 /* .. Intrinsic Functions .. */ 00078 /* .. */ 00079 /* .. Executable Statements .. */ 00080 00081 /* Parameter adjustments */ 00082 a_dim1 = *lda; 00083 a_offset = 1 + a_dim1; 00084 a -= a_offset; 00085 b_dim1 = *ldb; 00086 b_offset = 1 + b_dim1; 00087 b -= b_offset; 00088 00089 /* Function Body */ 00090 if (lsame_(uplo, "U")) { 00091 i__1 = *n; 00092 for (j = 1; j <= i__1; ++j) { 00093 i__2 = min(j,*m); 00094 for (i__ = 1; i__ <= i__2; ++i__) { 00095 i__3 = i__ + j * b_dim1; 00096 i__4 = i__ + j * a_dim1; 00097 b[i__3].r = a[i__4], b[i__3].i = 0.f; 00098 /* L10: */ 00099 } 00100 /* L20: */ 00101 } 00102 00103 } else if (lsame_(uplo, "L")) { 00104 i__1 = *n; 00105 for (j = 1; j <= i__1; ++j) { 00106 i__2 = *m; 00107 for (i__ = j; i__ <= i__2; ++i__) { 00108 i__3 = i__ + j * b_dim1; 00109 i__4 = i__ + j * a_dim1; 00110 b[i__3].r = a[i__4], b[i__3].i = 0.f; 00111 /* L30: */ 00112 } 00113 /* L40: */ 00114 } 00115 00116 } else { 00117 i__1 = *n; 00118 for (j = 1; j <= i__1; ++j) { 00119 i__2 = *m; 00120 for (i__ = 1; i__ <= i__2; ++i__) { 00121 i__3 = i__ + j * b_dim1; 00122 i__4 = i__ + j * a_dim1; 00123 b[i__3].r = a[i__4], b[i__3].i = 0.f; 00124 /* L50: */ 00125 } 00126 /* L60: */ 00127 } 00128 } 00129 00130 return 0; 00131 00132 /* End of CLACP2 */ 00133 00134 } /* clacp2_ */