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 preprojectgrad(vector,ndesi,nodedesi,dgdxglob,nactive,
20     &   nobject,nnlconst,ipoacti,nk,rhs,iconst,objectset,xtf)
21!
22!     calculates the projected gradient
23!
24      implicit none
25!
26      character*81 objectset(5,*)
27!
28      integer ndesi,nodedesi(*),irow,icol,nactive,nobject,nnlconst,
29     &   ipoacti(*),nk,ipos,node,iconst,i
30!
31      real*8 dgdxglob(2,nk,nobject),vector(ndesi),rhs(*),scalar,dd,
32     &   len,xtf(*),brauch,nutz
33!
34!     initialization of enlarged field dgdxglob and
35!     calculate the second part of xlambd
36!
37      do irow=1,nk
38         dgdxglob(2,irow,nobject)=0.d0
39         dgdxglob(1,irow,nobject)=0.d0
40      enddo
41!
42      do icol=1,nactive
43         if(icol.le.nnlconst) then
44            do irow=1,ndesi
45               ipos=ipoacti(icol)
46               node=nodedesi(irow)
47               xtf(icol)=xtf(icol)+dgdxglob(2,node,1)
48     &                   *dgdxglob(2,node,ipos)
49            enddo
50         else
51            ipos=ipoacti(icol)
52            node=nodedesi(ipos)
53            xtf(icol)=dgdxglob(2,node,1)
54         endif
55      enddo
56!
57      return
58      end
59
60
61
62
63