1 : C DMOMV SOURCE GOUNAND 05/02/16 21:15:19 5029
2 : SUBROUTINE DMOMV ( TRANS, N, ALPHA, NNZ, ROWPTR, COLIND, VAL,
3 : $ X, BETA, Y )
4 : IMPLICIT REAL*8 (A-H,O-Z)
5 : IMPLICIT INTEGER (I-N)
6 : ***********************************************************************
7 : C NOM : DMOMV
8 : C DESCRIPTION :
9 : C DMOMV is a modified (16/2/98), reduced,
10 : C version of DGEMV as defined in BLAS 2.
11 : C
12 : C It performs one of the matrix-vector operations
13 : C
14 : C y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,
15 : C
16 : C where alpha and beta are scalars, x and y are vectors
17 : C A is an n by n (square) matrix stored in Morse format
18 : C (also known as Compressed Row Storage (CRS)).
19 : C
20 : C LANGAGE : ESOPE
21 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
22 : C mél : gounand@semt2.smts.cea.fr
23 : C REFERENCE (bibtex-like) :
24 : C @BOOK{templates,
25 : C AUTHOR={R.Barrett, M.Berry, T.F.Chan, J.Demmel, J.Donato,
26 : C J.Dongarra, V.Eijkhout, R.Pozo, C.Romine,
27 : C H. Van der Vorst},
28 : C TITLE={Templates for the Solution of Linear Systems :
29 : C Building Blocks for Iterative Methods},
30 : C PUBLISHER={SIAM}, YEAR={1994}, ADDRESS={Philadelphia,PA} }
31 : C -> URL : http://www.netlib.org/templates/Templates.html
32 : C***********************************************************************
33 : C APPELES : -
34 : C***********************************************************************
35 : C ENTREES : TRANS, N, ALPHA,
36 : C NNZ, ROWPTR, COLIND, VAL,
37 : C X, BETA
38 : C ENTREES/SORTIES : Y
39 : C SORTIES : -
40 : C CODE RETOUR (IRET) : -
41 : C TRANS - CHARACTER*1.
42 : C On entry, TRANS specifies the operation to be performed as
43 : C follows:
44 : C TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
45 : C TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
46 : C TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.
47 : C Note : working with TRANS = 'T' might be slower due to storage format
48 : C If speed is more important than memory consumption, storing the
48 : C transpose matrix before calling DMOMV might help
49 : C
50 : C N - INTEGER.
51 : C On entry, N specifies the number of columns and rows
52 : C of the matrix A.
53 : C N must be at least zero.
54 : C
55 : C ALPHA - REAL*8.
56 : C On entry, ALPHA specifies the scalar alpha.
57 : C
58 : C NNZ : nombre de valeurs non nulles de la matrice Morse
59 : C ROWPTR, COLIND, VAL : pointeur de ligne, index de colonne
60 : C et valeurs de la matrice Morse
61 : C
62 : C X - REAL*8 array of DIMENSION N
63 : C
64 : C BETA - REAL*8.
65 : C On entry, BETA specifies the scalar beta. When BETA is
66 : C supplied as zero then Y need not be set on input.
67 : C
68 : C Y - REAL*8 array of DIMENSION N
69 : C Before entry with BETA non-zero, the array Y
70 : C must contain the vector y. On exit, Y is overwritten by the
71 : C updated vector y.
72 : C
73 : C***********************************************************************
74 : C VERSION : v1, 16/02/98, version initiale
75 : C HISTORIQUE : v1, 16/02/98, création
76 : C HISTORIQUE :
77 : C HISTORIQUE :
78 : C***********************************************************************
79 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
80 : C en cas de modification de ce sous-programme afin de faciliter
81 : C la maintenance !
82 : C***********************************************************************
83 : * .. Scalar Arguments ..
84 : REAL*8 ALPHA, BETA
85 : INTEGER N, NNZ
86 : CHARACTER*1 TRANS
87 : * .. Array Arguments ..
88 : * .. Morse Matrix
89 : INTEGER ROWPTR( N+1 )
90 : INTEGER COLIND( NNZ )
91 : REAL*8 VAL( NNZ )
92 : * .. Vectors
93 : REAL*8 X( N ), Y( N )
94 : * ..
95 : * Level 2 Blas routine.
96 : *
97 : * -- Written on 22-October-1986.
98 : * Jack Dongarra, Argonne National Lab.
99 : * Jeremy Du Croz, Nag Central Office.
100 : * Sven Hammarling, Nag Central Office.
101 : * Richard Hanson, Sandia National Labs.
102 : * -- Modified on 16-February-1998
103 : *
104 : -INC CCOPTIO
105 : *
106 : * .. Parameters ..
107 : REAL*8 ONE , ZERO
108 : PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
109 : * .. Local Scalars ..
110 : REAL*8 TEMP
111 : INTEGER I, J
112 : * .. External Functions ..
113 : LOGICAL LSAME
114 : EXTERNAL LSAME
115 : * ..
116 : * .. Executable Statements ..
117 : *
118 : * Test the input parameters.
119 : *
120 : IF ( .NOT.LSAME( TRANS, 'N' ).AND.
121 : $ .NOT.LSAME( TRANS, 'T' ).AND.
122 : $ .NOT.LSAME( TRANS, 'C' ) )THEN
123 : GOTO 9999
124 : ELSE IF( N.LE.0 )THEN
125 : GOTO 9998
126 : END IF
127 : *
128 : * Quick return if possible.
129 : *
130 : IF( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) )
131 : $ RETURN
132 : *
133 : * Start the operations. In this version the elements of A are
134 : * accessed sequentially with one pass through A.
135 : *
136 : * First form y := beta*y.
137 : *
138 : IF( BETA.NE.ONE )THEN
139 : IF( BETA.EQ.ZERO )THEN
140 : DO 10, I = 1, N
141 : Y( I ) = ZERO
142 : 10 CONTINUE
143 : ELSE
144 : DO 20, I = 1, N
145 : Y( I ) = BETA*Y( I )
146 : 20 CONTINUE
147 : END IF
148 : END IF
149 : IF( ALPHA.EQ.ZERO )
150 : $ RETURN
151 : IF( LSAME( TRANS, 'N' ) )THEN
152 : *
153 : * Form y := alpha*A*x + y.
154 : *
155 : DO 60, I = 1, N
156 : DO 50, J = ROWPTR( I ), (ROWPTR( I+1 ) - 1)
157 : *!!! IF ( X( COLIND( J )).NE.ZERO ) THEN
158 : Y( I ) = Y( I ) + (ALPHA * VAL( J ) * X( COLIND( J )))
159 : *!!! ENDIF
160 : 50 CONTINUE
161 : 60 CONTINUE
162 : ELSE
163 : *
164 : * Form y := alpha*A'*x + y.
165 : *
166 : DO 100, J = 1, N
167 : IF ( X( J ).NE.ZERO ) THEN
168 : TEMP = ALPHA * X( J )
169 : DO 90, I = ROWPTR( J ), (ROWPTR( J+1 ) - 1)
170 : Y( COLIND( I )) = Y( COLIND( I ))
171 : $ + VAL( I ) * TEMP
172 : 90 CONTINUE
173 : ENDIF
174 : 100 CONTINUE
175 : ENDIF
176 : *
177 : * Normal termination
178 : *
179 : RETURN
180 : *
181 : * Format handling
182 : *
183 : *
184 : * Error handling
185 : *
186 : 9998 CONTINUE
187 : WRITE(IOIMP,*) 'Dimension or increment lower than 1'
188 : WRITE(IOIMP,*) 'transmitted to subroutine dmomv'
189 : WRITE(IOIMP,*) 'nothing done'
190 : RETURN
191 : 9999 CONTINUE
192 : WRITE(IOIMP,*) 'Wrong option for TRANS'
193 : WRITE(IOIMP,*) 'transmitted to subroutine dmomv'
194 : WRITE(IOIMP,*) 'nothing done'
195 : RETURN
196 : *
197 : * End of DMOMV.
198 : *
199 : END
200 :
201 :
© Cast3M 2003 - All rights reserved.
Disclaimer