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 bodyforce(cbody,ibody,ipobody,nbody,set,istartset, 20 & iendset,ialset,inewton,nset,ifreebody,k) 21! 22! assigns the body forces to the elements by use of field ipobody 23! 24 implicit none 25! 26 character*81 cbody(*),elset,set(*) 27! 28 integer ibody(3,*),ipobody(2,*),i,j,l,istartset(*),nbody, 29 & iendset(*),ialset(*),kindofbodyforce,inewton,nset,istat, 30 & ifreebody,k,index,id 31! 32 elset=cbody(k) 33 kindofbodyforce=ibody(1,k) 34 if(kindofbodyforce.eq.3) inewton=1 35! 36! check whether element number or set name 37! 38 read(elset,'(i21)',iostat=istat) l 39 if(istat.eq.0) then 40 if(ipobody(1,l).eq.0) then 41 ipobody(1,l)=k 42 else 43! 44 index=l 45 do 46 if(ipobody(1,index).eq.k) exit 47 if(ipobody(2,index).eq.0) then 48 ipobody(2,index)=ifreebody 49 ipobody(1,ifreebody)=k 50 ipobody(2,ifreebody)=0 51 ifreebody=ifreebody+1 52 exit 53 endif 54 index=ipobody(2,index) 55 enddo 56 endif 57 return 58 endif 59! 60! set name 61! 62c do i=1,nset 63c if(set(i).eq.elset) exit 64c enddo 65 call cident81(set,elset,nset,id) 66 i=nset+1 67 if(id.gt.0) then 68 if(elset.eq.set(id)) then 69 i=id 70 endif 71 endif 72! 73 do j=istartset(i),iendset(i) 74 if(ialset(j).gt.0) then 75 l=ialset(j) 76 if(ipobody(1,l).eq.0) then 77 ipobody(1,l)=k 78 else 79! 80 index=l 81 do 82 if(ipobody(1,index).eq.k) exit 83 if(ipobody(2,index).eq.0) then 84 ipobody(2,index)=ifreebody 85 ipobody(1,ifreebody)=k 86 ipobody(2,ifreebody)=0 87 ifreebody=ifreebody+1 88 exit 89 endif 90 index=ipobody(2,index) 91 enddo 92 endif 93 else 94 l=ialset(j-2) 95 do 96 l=l-ialset(j) 97 if(l.ge.ialset(j-1)) exit 98 if(ipobody(1,l).eq.0) then 99 ipobody(1,l)=k 100 else 101! 102 index=l 103 do 104 if(ipobody(1,index).eq.k) exit 105 if(ipobody(2,index).eq.0) then 106 ipobody(2,index)=ifreebody 107 ipobody(1,ifreebody)=k 108 ipobody(2,ifreebody)=0 109 ifreebody=ifreebody+1 110 exit 111 endif 112 index=ipobody(2,index) 113 enddo 114 endif 115 enddo 116 endif 117 enddo 118! 119 return 120 end 121 122