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!
19      subroutine add_sm_st_corio(au,ad,jq,irow,i,j,value,i0,i1)
20!
21!     stores the stiffness coefficient (i,j) with value "value"
22!     in the stiffness matrix stored in spare matrix format
23!
24!     modification for Coriolis: the Coriolis matrix is antisymmetric,
25!     i.e. the transpose is the negative matrix: A^T=-A
26!
27      implicit none
28!
29      integer jq(*),irow(*),i,j,ii,jj,ipointer,id,i0,i1
30      real*8 ad(*),au(*),value,valuenew
31!
32      if(i.eq.j) then
33c         if(i0.eq.i1) then
34c            ad(i)=ad(i)+value
35c         else
36c            ad(i)=ad(i)+2.d0*value
37c         endif
38         return
39      elseif(i.gt.j) then
40         ii=i
41         jj=j
42         valuenew=value
43      else
44         ii=j
45         jj=i
46         valuenew=-value
47      endif
48!
49      call nident(irow(jq(jj)),ii,jq(jj+1)-jq(jj),id)
50!
51      ipointer=jq(jj)+id-1
52!
53      if(irow(ipointer).ne.ii) then
54         write(*,*) '*ERROR in add_sm_st: coefficient should be 0'
55         call exit(201)
56      else
57         au(ipointer)=au(ipointer)+valuenew
58      endif
59!
60      return
61      end
62
63
64
65
66
67
68
69
70
71
72
73
74
75