dlacpy.c 3.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126
  1. /* dlacpy.f -- translated by f2c (version 20061008).
  2. You must link the resulting object file with libf2c:
  3. on Microsoft Windows system, link with libf2c.lib;
  4. on Linux or Unix systems, link with .../path/to/libf2c.a -lm
  5. or, if you install libf2c.a in a standard place, with -lf2c -lm
  6. -- in that order, at the end of the command line, as in
  7. cc *.o -lf2c -lm
  8. Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
  9. http://www.netlib.org/f2c/libf2c.zip
  10. */
  11. #include "f2c.h"
  12. #include "blaswrap.h"
  13. /* Subroutine */ int _starpu_dlacpy_(char *uplo, integer *m, integer *n, doublereal *
  14. a, integer *lda, doublereal *b, integer *ldb)
  15. {
  16. /* System generated locals */
  17. integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2;
  18. /* Local variables */
  19. integer i__, j;
  20. extern logical _starpu_lsame_(char *, char *);
  21. /* -- LAPACK auxiliary routine (version 3.2) -- */
  22. /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  23. /* November 2006 */
  24. /* .. Scalar Arguments .. */
  25. /* .. */
  26. /* .. Array Arguments .. */
  27. /* .. */
  28. /* Purpose */
  29. /* ======= */
  30. /* DLACPY copies all or part of a two-dimensional matrix A to another */
  31. /* matrix B. */
  32. /* Arguments */
  33. /* ========= */
  34. /* UPLO (input) CHARACTER*1 */
  35. /* Specifies the part of the matrix A to be copied to B. */
  36. /* = 'U': Upper triangular part */
  37. /* = 'L': Lower triangular part */
  38. /* Otherwise: All of the matrix A */
  39. /* M (input) INTEGER */
  40. /* The number of rows of the matrix A. M >= 0. */
  41. /* N (input) INTEGER */
  42. /* The number of columns of the matrix A. N >= 0. */
  43. /* A (input) DOUBLE PRECISION array, dimension (LDA,N) */
  44. /* The m by n matrix A. If UPLO = 'U', only the upper triangle */
  45. /* or trapezoid is accessed; if UPLO = 'L', only the lower */
  46. /* triangle or trapezoid is accessed. */
  47. /* LDA (input) INTEGER */
  48. /* The leading dimension of the array A. LDA >= max(1,M). */
  49. /* B (output) DOUBLE PRECISION array, dimension (LDB,N) */
  50. /* On exit, B = A in the locations specified by UPLO. */
  51. /* LDB (input) INTEGER */
  52. /* The leading dimension of the array B. LDB >= max(1,M). */
  53. /* ===================================================================== */
  54. /* .. Local Scalars .. */
  55. /* .. */
  56. /* .. External Functions .. */
  57. /* .. */
  58. /* .. Intrinsic Functions .. */
  59. /* .. */
  60. /* .. Executable Statements .. */
  61. /* Parameter adjustments */
  62. a_dim1 = *lda;
  63. a_offset = 1 + a_dim1;
  64. a -= a_offset;
  65. b_dim1 = *ldb;
  66. b_offset = 1 + b_dim1;
  67. b -= b_offset;
  68. /* Function Body */
  69. if (_starpu_lsame_(uplo, "U")) {
  70. i__1 = *n;
  71. for (j = 1; j <= i__1; ++j) {
  72. i__2 = min(j,*m);
  73. for (i__ = 1; i__ <= i__2; ++i__) {
  74. b[i__ + j * b_dim1] = a[i__ + j * a_dim1];
  75. /* L10: */
  76. }
  77. /* L20: */
  78. }
  79. } else if (_starpu_lsame_(uplo, "L")) {
  80. i__1 = *n;
  81. for (j = 1; j <= i__1; ++j) {
  82. i__2 = *m;
  83. for (i__ = j; i__ <= i__2; ++i__) {
  84. b[i__ + j * b_dim1] = a[i__ + j * a_dim1];
  85. /* L30: */
  86. }
  87. /* L40: */
  88. }
  89. } else {
  90. i__1 = *n;
  91. for (j = 1; j <= i__1; ++j) {
  92. i__2 = *m;
  93. for (i__ = 1; i__ <= i__2; ++i__) {
  94. b[i__ + j * b_dim1] = a[i__ + j * a_dim1];
  95. /* L50: */
  96. }
  97. /* L60: */
  98. }
  99. }
  100. return 0;
  101. /* End of DLACPY */
  102. } /* _starpu_dlacpy_ */