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