1!
2!     CalculiX - A 3-dimensional finite element program
3!              Copyright (C) 1998-2021 Guido Dhondt
4!
5!     This program is free software; you can redistribute it and/or
6!     modify it under the terms of the GNU General Public License as
7!     published by the Free Software Foundation(version 2);
8!
9!
10!     This program is distributed in the hope that it will be useful,
11!     but WITHOUT ANY WARRANTY; without even the implied warranty of
12!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13!     GNU General Public License for more details.
14!
15!     You should have received a copy of the GNU General Public License
16!     along with this program; if not, write to the Free Software
17!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18!
19C
20C-----MATRIX-VECTOR MULTIPLY FOR REAL SPARSE NONSYMMETRIC MATRICES---------
21c     matrix storage:
22c        au: nondiagonal terms, column by column
23c        ad: diagonal terms
24C
25      SUBROUTINE OPNONSYM(n,p,W,U,ad,au,jq,irow)
26      implicit real*8(a-h,o-z)
27!
28C-----------------------------------------------------------------------
29      integer  IROW(*),JQ(*),n
30      real*8   U(*),W(*),Au(*),AD(*),p(*)
31C-----------------------------------------------------------------------
32C>     SPARSE MATRIX-VECTOR MULTIPLY FOR LANCZS  U = A*W
33C>     SEE USPEC SUBROUTINE FOR DESCRIPTION OF THE ARRAYS THAT DEFINE
34C>     THE MATRIX
35!     the vector p is not needed but is kept for compatibility reasons
36!     with the calling program
37C-----------------------------------------------------------------------
38C
39C     COMPUTE THE DIAGONAL TERMS
40      DO 10 I = 1,N
41         U(I) = AD(I)*W(I)
42 10   CONTINUE
43C
44C     COMPUTE BY COLUMN
45      LLAST = 0
46      DO 30 J = 1,N
47C
48         DO 20 L = JQ(J),JQ(J+1)-1
49            I = IROW(L)
50C
51            U(I) = U(I) + Au(L)*W(J)
52C
53 20      CONTINUE
54C
55 30   CONTINUE
56C
57      RETURN
58      END
59
60
61
62
63