Mercurial > octave-nkf
annotate libcruft/lapack/clacpy.f @ 7789:82be108cc558
First attempt at single precision tyeps
* * *
corrections to qrupdate single precision routines
* * *
prefer demotion to single over promotion to double
* * *
Add single precision support to log2 function
* * *
Trivial PROJECT file update
* * *
Cache optimized hermitian/transpose methods
* * *
Add tests for tranpose/hermitian and ChangeLog entry for new transpose code
author | David Bateman <dbateman@free.fr> |
---|---|
date | Sun, 27 Apr 2008 22:34:17 +0200 |
parents | |
children |
rev | line source |
---|---|
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1 SUBROUTINE CLACPY( UPLO, M, N, A, LDA, B, LDB ) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2 * |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3 * -- LAPACK auxiliary routine (version 3.1) -- |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
5 * November 2006 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
6 * |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
7 * .. Scalar Arguments .. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
8 CHARACTER UPLO |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
9 INTEGER LDA, LDB, M, N |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
10 * .. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
11 * .. Array Arguments .. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
12 COMPLEX A( LDA, * ), B( LDB, * ) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
13 * .. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
14 * |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
15 * Purpose |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
16 * ======= |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
17 * |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
18 * CLACPY copies all or part of a two-dimensional matrix A to another |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
19 * matrix B. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
20 * |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
21 * Arguments |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
22 * ========= |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
23 * |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
24 * UPLO (input) CHARACTER*1 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
25 * Specifies the part of the matrix A to be copied to B. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
26 * = 'U': Upper triangular part |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
27 * = 'L': Lower triangular part |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
28 * Otherwise: All of the matrix A |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
29 * |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
30 * M (input) INTEGER |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
31 * The number of rows of the matrix A. M >= 0. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
32 * |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
33 * N (input) INTEGER |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
34 * The number of columns of the matrix A. N >= 0. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
35 * |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
36 * A (input) COMPLEX array, dimension (LDA,N) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
37 * The m by n matrix A. If UPLO = 'U', only the upper trapezium |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
38 * is accessed; if UPLO = 'L', only the lower trapezium is |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
39 * accessed. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
40 * |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
41 * LDA (input) INTEGER |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
42 * The leading dimension of the array A. LDA >= max(1,M). |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
43 * |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
44 * B (output) COMPLEX array, dimension (LDB,N) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
45 * On exit, B = A in the locations specified by UPLO. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
46 * |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
47 * LDB (input) INTEGER |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
48 * The leading dimension of the array B. LDB >= max(1,M). |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
49 * |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
50 * ===================================================================== |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
51 * |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
52 * .. Local Scalars .. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
53 INTEGER I, J |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
54 * .. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
55 * .. External Functions .. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
56 LOGICAL LSAME |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
57 EXTERNAL LSAME |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
58 * .. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
59 * .. Intrinsic Functions .. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
60 INTRINSIC MIN |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
61 * .. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
62 * .. Executable Statements .. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
63 * |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
64 IF( LSAME( UPLO, 'U' ) ) THEN |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
65 DO 20 J = 1, N |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
66 DO 10 I = 1, MIN( J, M ) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
67 B( I, J ) = A( I, J ) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
68 10 CONTINUE |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
69 20 CONTINUE |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
70 * |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
71 ELSE IF( LSAME( UPLO, 'L' ) ) THEN |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
72 DO 40 J = 1, N |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
73 DO 30 I = J, M |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
74 B( I, J ) = A( I, J ) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
75 30 CONTINUE |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
76 40 CONTINUE |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
77 * |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
78 ELSE |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
79 DO 60 J = 1, N |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
80 DO 50 I = 1, M |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
81 B( I, J ) = A( I, J ) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
82 50 CONTINUE |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
83 60 CONTINUE |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
84 END IF |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
85 * |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
86 RETURN |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
87 * |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
88 * End of CLACPY |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
89 * |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
90 END |