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 writelm(iter,xlambd,nactive,nnlconst,objectset,
20     &   nobject,ipoacti,iconstacti,inameacti,nodedesi,dgdxglob,nk)
21!
22!     calculates the projected gradient
23!
24      implicit none
25!
26      character*81 objectset(5,*)
27!
28      integer nactive,nobject,nnlconst,iter,ipos,i,ipoacti(*),
29     &   iconstacti(*),inameacti(*),nodedesi(*),node,nk
30!
31      real*8 xlambd(*),dgdxglob(2,nk,*),val
32!
33      write(5,*)
34      write(5,*)
35      write(5,*) '  #######################################
36     &#####################################'
37      if(iter.eq.1) then
38         write(5,*) '  L A G R A N G E   M U L T P L I E R S
39     &   1ST   I T E R A T I O N'
40      elseif(iter.eq.2) then
41         write(5,*) '  L A G R A N G E   M U L T P L I E R S
42     &   2ND   I T E R A T I O N'
43      elseif(iter.eq.3) then
44         write(5,*) '  L A G R A N G E   M U L T P L I E R S
45     &   3RD   I T E R A T I O N'
46      elseif((iter.gt.3).and.(iter.lt.10)) then
47         write(5,'(a42,i1,a22)') '  L A G R A N G E
48     &   M U L T P L I E R S   ',iter,'TH   I T E R A T I O N'
49      else
50         write(5,'(a42,i3,a22)') '  L A G R A N G E
51     &   M U L T P L I E R S   ',iter,'TH   I T E R A T I O N'
52      endif
53      write(5,*)
54      write(5,103) 'NUMBER OF
55     &    ','CONSTRAINT      ','LE/     ','LAGRANGE      ','  ACTIVE/
56     & ','   NAME OF'
57      write(5,103) 'CONSTRAINT
58     &   ','FUNCTION        ','GE      ','MULTIPLIER    ','  INACTIVE'
59     &,'   CONSTRAINT'
60      write(5,*) '  #######################################
61     &#####################################'
62      write(5,*)
63!
64      do i=1,nactive
65         ipos=ipoacti(i)
66!
67!        writing of all nonlinear constraints
68!
69         if(i.le.nnlconst) then
70            if(iconstacti(i).eq.-1) then
71               if(xlambd(i).gt.0.d0) then
72                  write(5,101)
73     &            ipos-1,objectset(1,ipos),'LE  ',xlambd(i),'ACTIVE  ',
74     &            objectset(5,ipos)
75               else
76                  write(5,101)
77     &            ipos-1,objectset(1,ipos),'LE  ',xlambd(i),'INACTIVE',
78     &            objectset(5,ipos)
79               endif
80            else
81               if(xlambd(i).gt.0.d0) then
82                  write(5,101)
83     &            ipos-1,objectset(1,ipos),'GE  ',xlambd(i),'INACTIVE',
84     &            objectset(5,ipos)
85               else
86                  write(5,101)
87     &            ipos-1,objectset(1,ipos),'GE  ',xlambd(i),'ACTIVE  ',
88     &            objectset(5,ipos)
89               endif
90            endif
91!
92!        writing of all linear (geometric) constraints
93!
94         else
95!
96!           MAXMEMBERSIZE and MINMEMBERSIZE
97!
98            if(objectset(1,inameacti(i))(4:13).eq.'MEMBERSIZE') then
99               node=nodedesi(ipoacti(i))
100               val=dgdxglob(2,node,inameacti(i))
101               if(iconstacti(i).eq.-1) then
102                  if(((xlambd(i).gt.0.d0).and.(val.lt.0.d0)).or.
103     &               ((xlambd(i).lt.0.d0).and.(val.gt.0.d0))) then
104                     write(5,102)
105     &               inameacti(i)-1,objectset(1,inameacti(i)),'LE  ',
106     &               xlambd(i),'ACTIVE  ',nodedesi(ipos)
107                  else
108                     write(5,102)
109     &               inameacti(i)-1,objectset(1,inameacti(i)),'LE  ',
110     &               xlambd(i),'INACTIVE',nodedesi(ipos)
111                  endif
112               else
113                  if(((xlambd(i).lt.0.d0).and.(val.lt.0.d0)).or.
114     &               ((xlambd(i).gt.0.d0).and.(val.gt.0.d0))) then
115                     write(5,102)
116     &               inameacti(i)-1,objectset(1,inameacti(i)),'GE  ',
117     &               xlambd(i),'INACTIVE',nodedesi(ipos)
118                  else
119                     write(5,102)
120     &               inameacti(i)-1,objectset(1,inameacti(i)),'GE  ',
121     &               xlambd(i),'ACTIVE  ',nodedesi(ipos)
122                  endif
123               endif
124!
125!           FIXGROWTH and FIXSHRINKAGE
126!
127            else
128               if(iconstacti(i).eq.-1) then
129                  if(xlambd(i).gt.0.d0) then
130                     write(5,102)
131     &               inameacti(i)-1,objectset(1,inameacti(i)),'LE  ',
132     &               xlambd(i),'ACTIVE  ',nodedesi(ipos)
133                  else
134                     write(5,102)
135     &               inameacti(i)-1,objectset(1,inameacti(i)),'LE  ',
136     &               xlambd(i),'INACTIVE',nodedesi(ipos)
137                  endif
138               else
139                  if(xlambd(i).gt.0.d0) then
140                     write(5,102)
141     &               inameacti(i)-1,objectset(1,inameacti(i)),'GE  ',
142     &               xlambd(i),'INACTIVE',nodedesi(ipos)
143                  else
144                     write(5,102)
145     &               inameacti(i)-1,objectset(1,inameacti(i)),'GE  ',
146     &               xlambd(i),'ACTIVE  ',nodedesi(ipos)
147                  endif
148               endif
149            endif
150         endif
151      enddo
152      write(5,*)
153!
154      return
155!
156 101  format(1(3x,i2,8x,3x,a16,a4,3x,e14.7,3x,a8,3x,a80))
157 102  format(1(3x,i2,8x,3x,a16,a4,3x,e14.7,3x,a8,3x,i6))
158 103  format(1(3x,13a,3x,a16,a8,3x,a14,5x,a10,3x,a10))
159!
160      end
161