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