← Back to branch summary

~ubuntu-branches/ubuntu/saucy/digikam/saucy

« back to all changes in this revision

Viewing changes to libs/3rdparty/clapack/dtrsm.c

  • Committer: Package Import Robot
  • Author(s): Felix Geyer, Rohan Garg, Philip Muškovac, Felix Geyer
  • Date: 2011-09-23 18:18:55 UTC
  • mfrom: (1.2.36 upstream)
  • Revision ID: package-import@ubuntu.com-20110923181855-ifs67wxkugshev9k
Tags: 2:2.1.1-0ubuntu1
https://launchpad.net/bugs/834190
https://launchpad.net/bugs/804894
[ Rohan Garg ]
* New upstream release (LP: #834190)
  - debian/control
    + Build with libqtwebkit-dev
 - debian/kipi-plugins-common
    + Install libkvkontakte required by kipi-plugins
 - debian/digikam
    + Install panoramagui

[ Philip Muškovac ]
* New upstream release
  - debian/control:
    + Add libcv-dev, libcvaux-dev, libhighgui-dev, libboost-graph1.46-dev,
      libksane-dev, libxml2-dev, libxslt-dev, libqt4-opengl-dev, libqjson-dev,
      libgpod-dev and libqca2-dev to build-deps
    + Add packages for kipi-plugins, libmediawiki, libkface, libkgeomap and
      libkvkontakte
  - debian/rules:
    + Don't build with gphoto2 since it doesn't build with it.
  - Add kubuntu_fix_test_linking.diff to fix linking of the dngconverter test
  - update install files
  - update kubuntu_01_mysqld_executable_name.diff for new cmake layout
    and rename to kubuntu_mysqld_executable_name.diff
* Fix typo in digikam-data description (LP: #804894)
* Fix Vcs links

[ Felix Geyer ]
* Move library data files to the new packages libkface-data, libkgeomap-data
  and libkvkontakte-data.
* Override version of the embedded library packages to 1.0~digikam<version>.
* Exclude the library packages from digikam-dbg to prevent file conflicts in
  the future.
* Call dh_install with --list-missing.

Show diffs side-by-side

added added

removed removed

Lines of Context:
libs/3rdparty/clapack/dtrsm.c
1
 
#include "blaswrap.h"
2
 
#include "f2c.h"
3
 
 
4
 
/* Subroutine */ int dtrsm_(char *side, char *uplo, char *transa, char *diag, 
5
 
        integer *m, integer *n, doublereal *alpha, doublereal *a, integer *
6
 
        lda, doublereal *b, integer *ldb)
7
 
{
8
 
    /* System generated locals */
9
 
    integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3;
10
 
    /* Local variables */
11
 
    static integer info;
12
 
    static doublereal temp;
13
 
    static integer i__, j, k;
14
 
    static logical lside;
15
 
    extern logical lsame_(char *, char *);
16
 
    static integer nrowa;
17
 
    static logical upper;
18
 
    extern /* Subroutine */ int xerbla_(char *, integer *);
19
 
    static logical nounit;
20
 
#define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1]
21
 
#define b_ref(a_1,a_2) b[(a_2)*b_dim1 + a_1]
22
 
/*  Purpose   
23
 
    =======   
24
 
    DTRSM  solves one of the matrix equations   
25
 
       op( A )*X = alpha*B,   or   X*op( A ) = alpha*B,   
26
 
    where alpha is a scalar, X and B are m by n matrices, A is a unit, or   
27
 
    non-unit,  upper or lower triangular matrix  and  op( A )  is one  of   
28
 
       op( A ) = A   or   op( A ) = A'.   
29
 
    The matrix X is overwritten on B.   
30
 
    Parameters   
31
 
    ==========   
32
 
    SIDE   - CHARACTER*1.   
33
 
             On entry, SIDE specifies whether op( A ) appears on the left   
34
 
             or right of X as follows:   
35
 
                SIDE = 'L' or 'l'   op( A )*X = alpha*B.   
36
 
                SIDE = 'R' or 'r'   X*op( A ) = alpha*B.   
37
 
             Unchanged on exit.   
38
 
    UPLO   - CHARACTER*1.   
39
 
             On entry, UPLO specifies whether the matrix A is an upper or   
40
 
             lower triangular matrix as follows:   
41
 
                UPLO = 'U' or 'u'   A is an upper triangular matrix.   
42
 
                UPLO = 'L' or 'l'   A is a lower triangular matrix.   
43
 
             Unchanged on exit.   
44
 
    TRANSA - CHARACTER*1.   
45
 
             On entry, TRANSA specifies the form of op( A ) to be used in   
46
 
             the matrix multiplication as follows:   
47
 
                TRANSA = 'N' or 'n'   op( A ) = A.   
48
 
                TRANSA = 'T' or 't'   op( A ) = A'.   
49
 
                TRANSA = 'C' or 'c'   op( A ) = A'.   
50
 
             Unchanged on exit.   
51
 
    DIAG   - CHARACTER*1.   
52
 
             On entry, DIAG specifies whether or not A is unit triangular   
53
 
             as follows:   
54
 
                DIAG = 'U' or 'u'   A is assumed to be unit triangular.   
55
 
                DIAG = 'N' or 'n'   A is not assumed to be unit   
56
 
                                    triangular.   
57
 
             Unchanged on exit.   
58
 
    M      - INTEGER.   
59
 
             On entry, M specifies the number of rows of B. M must be at   
60
 
             least zero.   
61
 
             Unchanged on exit.   
62
 
    N      - INTEGER.   
63
 
             On entry, N specifies the number of columns of B.  N must be   
64
 
             at least zero.   
65
 
             Unchanged on exit.   
66
 
    ALPHA  - DOUBLE PRECISION.   
67
 
             On entry,  ALPHA specifies the scalar  alpha. When  alpha is   
68
 
             zero then  A is not referenced and  B need not be set before   
69
 
             entry.   
70
 
             Unchanged on exit.   
71
 
    A      - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m   
72
 
             when  SIDE = 'L' or 'l'  and is  n  when  SIDE = 'R' or 'r'.   
73
 
             Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k   
74
 
             upper triangular part of the array  A must contain the upper   
75
 
             triangular matrix  and the strictly lower triangular part of   
76
 
             A is not referenced.   
77
 
             Before entry  with  UPLO = 'L' or 'l',  the  leading  k by k   
78
 
             lower triangular part of the array  A must contain the lower   
79
 
             triangular matrix  and the strictly upper triangular part of   
80
 
             A is not referenced.   
81
 
             Note that when  DIAG = 'U' or 'u',  the diagonal elements of   
82
 
             A  are not referenced either,  but are assumed to be  unity.   
83
 
             Unchanged on exit.   
84
 
    LDA    - INTEGER.   
85
 
             On entry, LDA specifies the first dimension of A as declared   
86
 
             in the calling (sub) program.  When  SIDE = 'L' or 'l'  then   
87
 
             LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'   
88
 
             then LDA must be at least max( 1, n ).   
89
 
             Unchanged on exit.   
90
 
    B      - DOUBLE PRECISION array of DIMENSION ( LDB, n ).   
91
 
             Before entry,  the leading  m by n part of the array  B must   
92
 
             contain  the  right-hand  side  matrix  B,  and  on exit  is   
93
 
             overwritten by the solution matrix  X.   
94
 
    LDB    - INTEGER.   
95
 
             On entry, LDB specifies the first dimension of B as declared   
96
 
             in  the  calling  (sub)  program.   LDB  must  be  at  least   
97
 
             max( 1, m ).   
98
 
             Unchanged on exit.   
99
 
    Level 3 Blas routine.   
100
 
    -- Written on 8-February-1989.   
101
 
       Jack Dongarra, Argonne National Laboratory.   
102
 
       Iain Duff, AERE Harwell.   
103
 
       Jeremy Du Croz, Numerical Algorithms Group Ltd.   
104
 
       Sven Hammarling, Numerical Algorithms Group Ltd.   
105
 
       Test the input parameters.   
106
 
       Parameter adjustments */
107
 
    a_dim1 = *lda;
108
 
    a_offset = 1 + a_dim1 * 1;
109
 
    a -= a_offset;
110
 
    b_dim1 = *ldb;
111
 
    b_offset = 1 + b_dim1 * 1;
112
 
    b -= b_offset;
113
 
    /* Function Body */
114
 
    lside = lsame_(side, "L");
115
 
    if (lside) {
116
 
        nrowa = *m;
117
 
    } else {
118
 
        nrowa = *n;
119
 
    }
120
 
    nounit = lsame_(diag, "N");
121
 
    upper = lsame_(uplo, "U");
122
 
    info = 0;
123
 
    if (! lside && ! lsame_(side, "R")) {
124
 
        info = 1;
125
 
    } else if (! upper && ! lsame_(uplo, "L")) {
126
 
        info = 2;
127
 
    } else if (! lsame_(transa, "N") && ! lsame_(transa,
128
 
             "T") && ! lsame_(transa, "C")) {
129
 
        info = 3;
130
 
    } else if (! lsame_(diag, "U") && ! lsame_(diag, 
131
 
            "N")) {
132
 
        info = 4;
133
 
    } else if (*m < 0) {
134
 
        info = 5;
135
 
    } else if (*n < 0) {
136
 
        info = 6;
137
 
    } else if (*lda < max(1,nrowa)) {
138
 
        info = 9;
139
 
    } else if (*ldb < max(1,*m)) {
140
 
        info = 11;
141
 
    }
142
 
    if (info != 0) {
143
 
        xerbla_("DTRSM ", &info);
144
 
        return 0;
145
 
    }
146
 
/*     Quick return if possible. */
147
 
    if (*n == 0) {
148
 
        return 0;
149
 
    }
150
 
/*     And when  alpha.eq.zero. */
151
 
    if (*alpha == 0.) {
152
 
        i__1 = *n;
153
 
        for (j = 1; j <= i__1; ++j) {
154
 
            i__2 = *m;
155
 
            for (i__ = 1; i__ <= i__2; ++i__) {
156
 
                b_ref(i__, j) = 0.;
157
 
/* L10: */
158
 
            }
159
 
/* L20: */
160
 
        }
161
 
        return 0;
162
 
    }
163
 
/*     Start the operations. */
164
 
    if (lside) {
165
 
        if (lsame_(transa, "N")) {
166
 
/*           Form  B := alpha*inv( A )*B. */
167
 
            if (upper) {
168
 
                i__1 = *n;
169
 
                for (j = 1; j <= i__1; ++j) {
170
 
                    if (*alpha != 1.) {
171
 
                        i__2 = *m;
172
 
                        for (i__ = 1; i__ <= i__2; ++i__) {
173
 
                            b_ref(i__, j) = *alpha * b_ref(i__, j);
174
 
/* L30: */
175
 
                        }
176
 
                    }
177
 
                    for (k = *m; k >= 1; --k) {
178
 
                        if (b_ref(k, j) != 0.) {
179
 
                            if (nounit) {
180
 
                                b_ref(k, j) = b_ref(k, j) / a_ref(k, k);
181
 
                            }
182
 
                            i__2 = k - 1;
183
 
                            for (i__ = 1; i__ <= i__2; ++i__) {
184
 
                                b_ref(i__, j) = b_ref(i__, j) - b_ref(k, j) * 
185
 
                                        a_ref(i__, k);
186
 
/* L40: */
187
 
                            }
188
 
                        }
189
 
/* L50: */
190
 
                    }
191
 
/* L60: */
192
 
                }
193
 
            } else {
194
 
                i__1 = *n;
195
 
                for (j = 1; j <= i__1; ++j) {
196
 
                    if (*alpha != 1.) {
197
 
                        i__2 = *m;
198
 
                        for (i__ = 1; i__ <= i__2; ++i__) {
199
 
                            b_ref(i__, j) = *alpha * b_ref(i__, j);
200
 
/* L70: */
201
 
                        }
202
 
                    }
203
 
                    i__2 = *m;
204
 
                    for (k = 1; k <= i__2; ++k) {
205
 
                        if (b_ref(k, j) != 0.) {
206
 
                            if (nounit) {
207
 
                                b_ref(k, j) = b_ref(k, j) / a_ref(k, k);
208
 
                            }
209
 
                            i__3 = *m;
210
 
                            for (i__ = k + 1; i__ <= i__3; ++i__) {
211
 
                                b_ref(i__, j) = b_ref(i__, j) - b_ref(k, j) * 
212
 
                                        a_ref(i__, k);
213
 
/* L80: */
214
 
                            }
215
 
                        }
216
 
/* L90: */
217
 
                    }
218
 
/* L100: */
219
 
                }
220
 
            }
221
 
        } else {
222
 
/*           Form  B := alpha*inv( A' )*B. */
223
 
            if (upper) {
224
 
                i__1 = *n;
225
 
                for (j = 1; j <= i__1; ++j) {
226
 
                    i__2 = *m;
227
 
                    for (i__ = 1; i__ <= i__2; ++i__) {
228
 
                        temp = *alpha * b_ref(i__, j);
229
 
                        i__3 = i__ - 1;
230
 
                        for (k = 1; k <= i__3; ++k) {
231
 
                            temp -= a_ref(k, i__) * b_ref(k, j);
232
 
/* L110: */
233
 
                        }
234
 
                        if (nounit) {
235
 
                            temp /= a_ref(i__, i__);
236
 
                        }
237
 
                        b_ref(i__, j) = temp;
238
 
/* L120: */
239
 
                    }
240
 
/* L130: */
241
 
                }
242
 
            } else {
243
 
                i__1 = *n;
244
 
                for (j = 1; j <= i__1; ++j) {
245
 
                    for (i__ = *m; i__ >= 1; --i__) {
246
 
                        temp = *alpha * b_ref(i__, j);
247
 
                        i__2 = *m;
248
 
                        for (k = i__ + 1; k <= i__2; ++k) {
249
 
                            temp -= a_ref(k, i__) * b_ref(k, j);
250
 
/* L140: */
251
 
                        }
252
 
                        if (nounit) {
253
 
                            temp /= a_ref(i__, i__);
254
 
                        }
255
 
                        b_ref(i__, j) = temp;
256
 
/* L150: */
257
 
                    }
258
 
/* L160: */
259
 
                }
260
 
            }
261
 
        }
262
 
    } else {
263
 
        if (lsame_(transa, "N")) {
264
 
/*           Form  B := alpha*B*inv( A ). */
265
 
            if (upper) {
266
 
                i__1 = *n;
267
 
                for (j = 1; j <= i__1; ++j) {
268
 
                    if (*alpha != 1.) {
269
 
                        i__2 = *m;
270
 
                        for (i__ = 1; i__ <= i__2; ++i__) {
271
 
                            b_ref(i__, j) = *alpha * b_ref(i__, j);
272
 
/* L170: */
273
 
                        }
274
 
                    }
275
 
                    i__2 = j - 1;
276
 
                    for (k = 1; k <= i__2; ++k) {
277
 
                        if (a_ref(k, j) != 0.) {
278
 
                            i__3 = *m;
279
 
                            for (i__ = 1; i__ <= i__3; ++i__) {
280
 
                                b_ref(i__, j) = b_ref(i__, j) - a_ref(k, j) * 
281
 
                                        b_ref(i__, k);
282
 
/* L180: */
283
 
                            }
284
 
                        }
285
 
/* L190: */
286
 
                    }
287
 
                    if (nounit) {
288
 
                        temp = 1. / a_ref(j, j);
289
 
                        i__2 = *m;
290
 
                        for (i__ = 1; i__ <= i__2; ++i__) {
291
 
                            b_ref(i__, j) = temp * b_ref(i__, j);
292
 
/* L200: */
293
 
                        }
294
 
                    }
295
 
/* L210: */
296
 
                }
297
 
            } else {
298
 
                for (j = *n; j >= 1; --j) {
299
 
                    if (*alpha != 1.) {
300
 
                        i__1 = *m;
301
 
                        for (i__ = 1; i__ <= i__1; ++i__) {
302
 
                            b_ref(i__, j) = *alpha * b_ref(i__, j);
303
 
/* L220: */
304
 
                        }
305
 
                    }
306
 
                    i__1 = *n;
307
 
                    for (k = j + 1; k <= i__1; ++k) {
308
 
                        if (a_ref(k, j) != 0.) {
309
 
                            i__2 = *m;
310
 
                            for (i__ = 1; i__ <= i__2; ++i__) {
311
 
                                b_ref(i__, j) = b_ref(i__, j) - a_ref(k, j) * 
312
 
                                        b_ref(i__, k);
313
 
/* L230: */
314
 
                            }
315
 
                        }
316
 
/* L240: */
317
 
                    }
318
 
                    if (nounit) {
319
 
                        temp = 1. / a_ref(j, j);
320
 
                        i__1 = *m;
321
 
                        for (i__ = 1; i__ <= i__1; ++i__) {
322
 
                            b_ref(i__, j) = temp * b_ref(i__, j);
323
 
/* L250: */
324
 
                        }
325
 
                    }
326
 
/* L260: */
327
 
                }
328
 
            }
329
 
        } else {
330
 
/*           Form  B := alpha*B*inv( A' ). */
331
 
            if (upper) {
332
 
                for (k = *n; k >= 1; --k) {
333
 
                    if (nounit) {
334
 
                        temp = 1. / a_ref(k, k);
335
 
                        i__1 = *m;
336
 
                        for (i__ = 1; i__ <= i__1; ++i__) {
337
 
                            b_ref(i__, k) = temp * b_ref(i__, k);
338
 
/* L270: */
339
 
                        }
340
 
                    }
341
 
                    i__1 = k - 1;
342
 
                    for (j = 1; j <= i__1; ++j) {
343
 
                        if (a_ref(j, k) != 0.) {
344
 
                            temp = a_ref(j, k);
345
 
                            i__2 = *m;
346
 
                            for (i__ = 1; i__ <= i__2; ++i__) {
347
 
                                b_ref(i__, j) = b_ref(i__, j) - temp * b_ref(
348
 
                                        i__, k);
349
 
/* L280: */
350
 
                            }
351
 
                        }
352
 
/* L290: */
353
 
                    }
354
 
                    if (*alpha != 1.) {
355
 
                        i__1 = *m;
356
 
                        for (i__ = 1; i__ <= i__1; ++i__) {
357
 
                            b_ref(i__, k) = *alpha * b_ref(i__, k);
358
 
/* L300: */
359
 
                        }
360
 
                    }
361
 
/* L310: */
362
 
                }
363
 
            } else {
364
 
                i__1 = *n;
365
 
                for (k = 1; k <= i__1; ++k) {
366
 
                    if (nounit) {
367
 
                        temp = 1. / a_ref(k, k);
368
 
                        i__2 = *m;
369
 
                        for (i__ = 1; i__ <= i__2; ++i__) {
370
 
                            b_ref(i__, k) = temp * b_ref(i__, k);
371
 
/* L320: */
372
 
                        }
373
 
                    }
374
 
                    i__2 = *n;
375
 
                    for (j = k + 1; j <= i__2; ++j) {
376
 
                        if (a_ref(j, k) != 0.) {
377
 
                            temp = a_ref(j, k);
378
 
                            i__3 = *m;
379
 
                            for (i__ = 1; i__ <= i__3; ++i__) {
380
 
                                b_ref(i__, j) = b_ref(i__, j) - temp * b_ref(
381
 
                                        i__, k);
382
 
/* L330: */
383
 
                            }
384
 
                        }
385
 
/* L340: */
386
 
                    }
387
 
                    if (*alpha != 1.) {
388
 
                        i__2 = *m;
389
 
                        for (i__ = 1; i__ <= i__2; ++i__) {
390
 
                            b_ref(i__, k) = *alpha * b_ref(i__, k);
391
 
/* L350: */
392
 
                        }
393
 
                    }
394
 
/* L360: */
395
 
                }
396
 
            }
397
 
        }
398
 
    }
399
 
    return 0;
400
 
/*     End of DTRSM . */
401
 
} /* dtrsm_ */
402
 
#undef b_ref
403
 
#undef a_ref
404