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 postprojectgrad(ndesi,nodedesi,dgdxglob,nactive,
20     &   nobject,nnlconst,ipoacti,nk,objectset,inameacti)
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,m,inameacti(*)
30!
31      real*8 dgdxglob(2,nk,nobject),scalar,dd,len
32!
33!     calculation of final projected gradient
34!     in case of an active constraint
35!
36      if(nactive.gt.0) then
37         do irow=1,ndesi
38            node=nodedesi(irow)
39            dgdxglob(2,node,nobject)=dgdxglob(2,node,1)
40     &          -dgdxglob(2,node,nobject)
41         enddo
42         objectset(1,nobject)(1:11)='PROJECTGRAD'
43!
44         write(*,*)
45         write(*,*) '*INFO: at least 1 constraint active.'
46         write(*,*) '       projected gradient calculated'
47!
48!     prepare output of objective sensitivity as feasible direction
49!
50      else
51         objectset(1,1)(1:11)='PROJECTGRAD'
52         do i=12,20
53            objectset(1,1)(i:i)=' '
54         enddo
55         do i=1,ndesi
56            dgdxglob(1,nodedesi(i),1)=0.d0
57         enddo
58         write(*,*)
59         write(*,*) '*INFO: no constraint active'
60         write(*,*) '       no projected gradient calculated'
61         write(*,*) '       senstivity of the objective function'
62         write(*,*) '       taken as feasible direction'
63         write(*,*)
64      endif
65!
66      return
67      end
68
69