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 lump(adb,aub,adl,irow,jq,neq) 20! 21! lumping the matrix stored in adb,aub and storing the result 22! in adl 23! 24 implicit none 25! 26 integer irow(*),jq(*),neq,i,j,k 27! 28 real*8 adb(*),aub(*),adl(*) 29! 30 do i=1,neq 31 adl(i)=adb(i) 32 enddo 33! 34 do j=1,neq 35 do k=jq(j),jq(j+1)-1 36 i=irow(k) 37 adl(i)=adl(i)+aub(k) 38 adl(j)=adl(j)+aub(k) 39 enddo 40 enddo 41! 42! change of meaning of adb and adl 43! first adb is replaced by adb-adl 44! then, adl is replaced by 1./adl 45! 46 do i=1,neq 47 adb(i)=adb(i)-adl(i) 48 adl(i)=1.d0/adl(i) 49 enddo 50! 51 return 52 end 53