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 objective_disp(nodeset,istartset,iendset,ialset,
20     &  nk,idesvarc,iobject,mi,g0,nobject,vold,objectset)
21!
22!     calculates the sum of the square of the displacements of a node
23!     set
24!
25      implicit none
26!
27      character*81 objectset(5,*)
28!
29      integer nk,istartset(*),iendset(*),ialset(*),nodeset,idir,
30     &  idesvarc,iobject,mi(*),j,k,nobject,idesvar
31!
32      real*8 g0(nobject),vold(0:mi(2),*)
33!
34!
35!
36      idesvar=idesvarc+1
37!
38      g0(iobject)=0.d0
39!
40!     check for the existence of a set, else take the complete mesh
41!
42      if(nodeset.eq.0) then
43         if(objectset(1,iobject)(1:8).eq.'ALL-DISP') then
44            do j=1,nk
45               do idir=1,3
46                  g0(iobject)=g0(iobject)+vold(idir,j)**2
47               enddo
48            enddo
49         elseif(objectset(1,iobject)(1:6).eq.'X-DISP') then
50            do j=1,nk
51               g0(iobject)=g0(iobject)+vold(1,j)**2
52            enddo
53         elseif(objectset(1,iobject)(1:6).eq.'Y-DISP') then
54            do j=1,nk
55               g0(iobject)=g0(iobject)+vold(2,j)**2
56            enddo
57         elseif(objectset(1,iobject)(1:6).eq.'Z-DISP') then
58            do j=1,nk
59               g0(iobject)=g0(iobject)+vold(3,j)**2
60            enddo
61         endif
62      else
63         do j=istartset(nodeset),iendset(nodeset)
64            if(ialset(j).gt.0) then
65               if(objectset(1,iobject)(1:8).eq.'ALL-DISP') then
66                  do idir=1,3
67                     g0(iobject)=g0(iobject)+vold(idir,ialset(j))**2
68                  enddo
69               elseif(objectset(1,iobject)(1:6).eq.'X-DISP') then
70                  g0(iobject)=g0(iobject)+vold(1,ialset(j))**2
71               elseif(objectset(1,iobject)(1:6).eq.'Y-DISP') then
72                  g0(iobject)=g0(iobject)+vold(2,ialset(j))**2
73               elseif(objectset(1,iobject)(1:6).eq.'Z-DISP') then
74                  g0(iobject)=g0(iobject)+vold(3,ialset(j))**2
75               endif
76            else
77               k=ialset(j-2)
78               do
79                  k=k-ialset(j)
80                  if(k.ge.ialset(j-1)) exit
81                  if(objectset(1,iobject)(1:8).eq.'ALL-DISP') then
82                     do idir=1,3
83                       g0(iobject)=g0(iobject)+vold(idir,k)**2
84                     enddo
85                  elseif(objectset(1,iobject)(1:6).eq.'X-DISP') then
86                     g0(iobject)=g0(iobject)+vold(1,k)**2
87                 elseif(objectset(1,iobject)(1:6).eq.'Y-DISP') then
88                     g0(iobject)=g0(iobject)+vold(2,k)**2
89                 elseif(objectset(1,iobject)(1:6).eq.'Z-DISP') then
90                     g0(iobject)=g0(iobject)+vold(3,k)**2
91                 endif
92               enddo
93            endif
94         enddo
95      endif
96!
97!     Euclidian length
98!
99      g0(iobject)=dsqrt(g0(iobject))
100!
101      return
102      end
103
104