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 detectactivecont1(vold, nk, mi, aubi, irowbi, jqbi,
20     &      neqtot, fext, aubb, adbb, ltot,
21     &      irowbb, jqbb, auw, iroww, jqw, neqslav, gapdof,
22     &      auib, irowib, jqib,  icolbb, nactdof, qtmp, neq)
23!
24      implicit none
25!
26      integer irowbi(*),jqbi(*),nk, neqtot, irowbb(*), jqbb(*),
27     & iroww(*), jqw(*), neqslav,  irowib(*), jqib(*),
28     & icolbb(*),mi(*), nactdof(0:mi(2),*), ltot(*),
29     & i,j,icol,idof,irow,jdof, neq(*)
30!
31      real*8 vold(0:mi(2),*), fext(*), aubb(*), adbb(*),
32     & auw(*),  auib(*),aubi(*), gapdof(*),node,value,qtmp(*)
33!
34!     create field qtmp, from vold
35!      from sorting nodes to DOF
36      do i=1,nk
37         do j=1,3
38!           write(*,*)'DEBUG i j dof',i,j, nactdof(j,i)
39            if(nactdof(j,i).gt.0) then
40C               idof = nactdof(j,i)
41              qtmp(nactdof(j,i)) = vold(j,i) ! TODO: where is vold coming from ? prediction.c? initial force?
42            endif
43         enddo
44      enddo
45!
46!      We compute g as qtmp = (Kbi * qtmp) + (Kib*qtmp)
47!      to account for the missing terms due to the low triangle structure
48!       of the matrices
49!
50!      calculate Kbi * qtmp
51      do i=1,neq(1)
52         do j=jqbi(i), jqbi(i+1)-1
53!           write(*,*)'DEBUG i j dof',i,j
54            value   = aubi(j)
55            irow    = irowbi(j)
56            gapdof(irow) = gapdof(irow)+value*qtmp(i)
57         enddo
58      enddo
59!
60!
61!     calculate Kib'*qtmp and add to g.
62!     transposed multiplication
63      do i=1,neqtot
64         do j=jqib(i),jqib(i+1)-1
65            value = auib(j)
66            icol  = irowib(j)
67            gapdof(i)  = gapdof(i)+value*qtmp(icol)
68         enddo
69      enddo
70!
71!     add external force
72!
73      do i=1,neqtot
74         jdof = ltot(i)
75         node = int(jdof/10.d0)
76         idof = jdof - 10*node
77C          value = fext(idof) ! DEBUG
78         gapdof(i) = fext(idof) - gapdof(i)
79      enddo
80!
81      return
82      end
83