File: MB01SD.f

package info (click to toggle)
dynare 4.3.0-2
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 40,640 kB
  • sloc: fortran: 82,231; cpp: 72,734; ansic: 28,874; pascal: 13,241; sh: 4,300; objc: 3,281; yacc: 2,833; makefile: 1,288; lex: 1,162; python: 162; lisp: 54; xml: 8
file content (123 lines) | stat: -rw-r--r-- 3,665 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
      SUBROUTINE MB01SD( JOBS, M, N, A, LDA, R, C )
C
C     SLICOT RELEASE 5.0.
C
C     Copyright (c) 2002-2009 NICONET e.V.
C
C     This program is free software: you can redistribute it and/or
C     modify it under the terms of the GNU General Public License as
C     published by the Free Software Foundation, either version 2 of
C     the License, or (at your option) any later version.
C
C     This program is distributed in the hope that it will be useful,
C     but WITHOUT ANY WARRANTY; without even the implied warranty of
C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C     GNU General Public License for more details.
C
C     You should have received a copy of the GNU General Public License
C     along with this program.  If not, see
C     <http://www.gnu.org/licenses/>.
C
C     PURPOSE
C
C     To scale a general M-by-N matrix A using the row and column
C     scaling factors in the vectors R and C.
C
C     ARGUMENTS
C
C     Mode Parameters
C
C     JOBS    CHARACTER*1
C             Specifies the scaling operation to be done, as follows:
C             = 'R':  row scaling, i.e., A will be premultiplied
C                     by diag(R);
C             = 'C':  column scaling, i.e., A will be postmultiplied
C                     by diag(C);
C             = 'B':  both row and column scaling, i.e., A will be
C                     replaced by diag(R) * A * diag(C).
C
C     Input/Output Parameters
C
C     M       (input) INTEGER
C             The number of rows of the matrix A.  M >= 0.
C
C     N       (input) INTEGER
C             The number of columns of the matrix A.  N >= 0.
C
C     A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
C             On entry, the M-by-N matrix A.
C             On exit, the scaled matrix.  See JOBS for the form of the
C             scaled matrix.
C
C     LDA     INTEGER
C             The leading dimension of the array A.  LDA >= max(1,M).
C
C     R       (input) DOUBLE PRECISION array, dimension (M)
C             The row scale factors for A.
C             R is not referenced if JOBS = 'C'.
C
C     C       (input) DOUBLE PRECISION array, dimension (N)
C             The column scale factors for A.
C             C is not referenced if JOBS = 'R'.
C
C
C     CONTRIBUTOR
C
C     A. Varga, German Aerospace Center,
C     DLR Oberpfaffenhofen, April 1998.
C     Based on the RASP routine DMSCAL.
C
C    ******************************************************************
C
C     .. Scalar Arguments ..
      CHARACTER          JOBS
      INTEGER            LDA, M, N
C     .. Array Arguments ..
      DOUBLE PRECISION   A(LDA,*), C(*), R(*)
C     .. Local Scalars ..
      INTEGER            I, J
      DOUBLE PRECISION   CJ
C     .. External Functions ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
C     .. Executable Statements ..
C
C     Quick return if possible.
C
      IF( M.EQ.0 .OR. N.EQ.0 )
     $   RETURN
C
      IF( LSAME( JOBS, 'C' ) ) THEN
C
C        Column scaling, no row scaling.
C
         DO 20 J = 1, N
            CJ = C(J)
            DO 10 I = 1, M
               A(I,J) = CJ*A(I,J)
   10       CONTINUE
   20    CONTINUE
      ELSE IF( LSAME( JOBS, 'R' ) ) THEN
C
C        Row scaling, no column scaling.
C
         DO 40 J = 1, N
            DO 30 I = 1, M
               A(I,J) = R(I)*A(I,J)
   30       CONTINUE
   40    CONTINUE
      ELSE IF( LSAME( JOBS, 'B' ) ) THEN
C
C        Row and column scaling.
C
         DO 60 J = 1, N
            CJ = C(J)
            DO 50 I = 1, M
               A(I,J) = CJ*R(I)*A(I,J)
   50       CONTINUE
   60    CONTINUE
      END IF
C
      RETURN
C *** Last line of MB01SD ***
      END