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 projectgrad(vector,ndesi,nodedesi,dgdxglob,nactive,
20     &   nobject,nnlconst,ipoacti,nk,rhs,iconst,objectset,xlambd,xtf,
21     &   objnorm)
22!
23!     calculates the projected gradient, the lagrange multipliers and
24!     the correction term due to nonlinear constraints
25!
26      implicit none
27!
28      character*81 objectset(5,*)
29!
30      integer ndesi,nodedesi(*),irow,icol,nactive,nobject,nnlconst,
31     &   ipoacti(*),nk,ipos,node,iconst,i
32!
33      real*8 dgdxglob(2,nk,nobject),vector(ndesi),rhs(*),scalar,dd,
34     &   len,xlambd(*),xtf(*),objnorm(nobject)
35!
36!     calculation of the vector
37!
38      do irow=1,ndesi
39         do icol=1,nactive
40            if(icol.le.nnlconst) then
41               ipos=ipoacti(icol)
42               node=nodedesi(irow)
43               vector(irow)=vector(irow)
44     &                      +rhs(icol)*dgdxglob(2,node,ipos)
45            else
46               if(ipoacti(icol).eq.irow) then
47                  vector(irow)=vector(irow)+rhs(icol)
48               endif
49            endif
50         enddo
51      enddo
52!
53!     calculation of the scalar value
54!
55      scalar=0.d0
56      if(iconst.le.nnlconst) then
57         do irow=1,ndesi
58            ipos=ipoacti(iconst)
59            node=nodedesi(irow)
60            scalar=scalar+dgdxglob(2,node,1)*dgdxglob(2,node,ipos)
61         enddo
62      else
63         node=nodedesi(ipoacti(iconst))
64         scalar=dgdxglob(2,node,1)
65      endif
66!
67!     multiplication of scalar and vector
68!
69      do irow=1,ndesi
70         node=nodedesi(irow)
71         dgdxglob(2,node,nobject)=dgdxglob(2,node,nobject)
72     &                            +vector(irow)*scalar
73      enddo
74!
75!     calculation of lagrange multiplier
76!
77      do icol=1,nactive
78         xlambd(icol)=xlambd(icol)+(-1)*rhs(icol)*xtf(iconst)
79      enddo
80!
81!     calculation of correction term
82!
83      if(iconst.le.nnlconst) then
84         do irow=1,ndesi
85            node=nodedesi(irow)
86             if(abs(objnorm(iconst)).gt.0.d0) then
87                dgdxglob(1,node,nobject)=dgdxglob(1,node,nobject)
88     &                   +vector(irow)*objnorm(iconst)
89     &                   /abs(objnorm(iconst))
90             else
91                dgdxglob(1,node,nobject)=dgdxglob(1,node,nobject)
92     &                   +vector(irow)*objnorm(iconst)
93             endif
94         enddo
95      endif
96!
97      return
98      end
99