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 geometricconstraints(inpc,textpart,istat,n,
20     &     iline,ipol,inl,ipoinp,inp,ipoinpc,nobject,objectset,
21     &     set,nset,ier,nmethod)
22!
23!     reading the input deck: *GEOMETRIC CONSTRAINT
24!
25      implicit none
26!
27      character*1 inpc(*), settype
28      character*132 textpart(16)
29      character*81 objectset(5,*),set(*),drname
30!
31      integer istat,n,key,i,iline,ipol,inl,ipoinp(2,*),nset,id,m,
32     &     inp(3,*),ipoinpc(0:*),nobject,k,ipos,ier,nmethod,nsets
33!
34      real*8 absval
35!
36!     geometric constraints can only be defined
37!     within feasible direction steps.
38!
39      if(nmethod.ne.16) then
40        write(*,*) '*ERROR reading *GEOMETRIC CONSTRAINT'
41        write(*,*) '       *GEOMETRIC CONSTRAINT can only be specified'
42        write(*,*) '       within a *FEASIBILE DIRECTION step.'
43        call inputerror(inpc,ipoinpc,iline,
44     &       "*GEOMETRIC CONSTRAINT%",ier)
45        return
46      endif
47!
48      do
49!
50        call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
51     &       ipoinp,inp,ipoinpc)
52!
53        if((istat.lt.0).or.(key.eq.1)) exit
54        drname=textpart(1)(1:80)
55!
56!     store the constraint (a geometric constraint is not connected to
57!     an existing design response
58!
59        nobject=nobject+1
60        do i=1,5
61          objectset(i,nobject)(1:81)=' '
62        enddo
63!
64        objectset(5,nobject)(81:81)='G'
65        if(textpart(1)(1:12).eq.'FIXSHRINKAGE') then
66          objectset(1,nobject)(1:12)='FIXSHRINKAGE'
67c          do k=13,20
68c            objectset(1,nobject)(k:k)=' '
69c          enddo
70          settype='N'
71          objectset(1,nobject)(19:20)='GE'
72          nsets=1
73        elseif(textpart(1)(1:9).eq.'FIXGROWTH') then
74          objectset(1,nobject)(1:9)='FIXGROWTH'
75c          do k=10,20
76c            objectset(1,nobject)(k:k)=' '
77c          enddo
78          settype='N'
79          objectset(1,nobject)(19:20)='LE'
80          nsets=1
81        elseif (textpart(1)(1:13).eq.'MAXMEMBERSIZE') then
82          objectset(1,nobject)(1:13)='MAXMEMBERSIZE'
83c          do k=14,20
84c            objectset(1,nobject)(k:k)=' '
85c          enddo
86          settype='N'
87          objectset(1,nobject)(19:20)='LE'
88          nsets=2
89        elseif (textpart(1)(1:13).eq.'MINMEMBERSIZE') then
90          objectset(1,nobject)(1:13)='MINMEMBERSIZE'
91c          do k=14,20
92c            objectset(1,nobject)(k:k)=' '
93c          enddo
94          settype='N'
95          objectset(1,nobject)(19:20)='GE'
96          nsets=2
97        else
98          write(*,*) '*ERROR reading *GEOMETRIC CONSTRAINT'
99          write(*,*) '       given constraint type is not a'
100          write(*,*) '       valid option.'
101          call inputerror(inpc,ipoinpc,iline,
102     &         "*GEOMETRIC CONSTRAINT%",ier)
103          return
104        endif
105!
106!       reading the sets needed for the geometric constraint
107!
108        do m=1,nsets
109          objectset(2+m,nobject)(1:80)=textpart(1+m)(1:80)
110	  ipos=index(objectset(2+m,nobject),' ')
111          if(n.lt.m+1) then
112            write(*,*)'*ERROR reading *GEOMETRIC CONSTRAINT'
113            write(*,*)'       set ',m,' is lacking'
114            call inputerror(inpc,ipoinpc,iline,
115     &           "*GEOMETRIC CONSTRAINT%",ier)
116            return
117          endif
118          objectset(2+m,nobject)(ipos:ipos)=settype
119!
120c          do i=1,nset
121c            if(set(i).eq.objectset(2+l,nobject)) exit
122c          enddo
123          call cident81(set,objectset(2+m,nobject),nset,id)
124          i=nset+1
125          if(id.gt.0) then
126            if(objectset(2+m,nobject).eq.set(id)) then
127              i=id
128            endif
129          endif
130          if(i.gt.nset) then
131            write(*,*) '*ERROR reading *GEOMETRIC CONSTRAINT'
132            write(*,*) '       unknown set name: '
133            write(*,*) objectset(2+m,nobject)
134            call inputerror(inpc,ipoinpc,iline,
135     &           "*GEOMETRIC CONSTRAINT%",ier)
136            return
137          endif
138        enddo
139!
140!     assume that geometric constraints always take ONLY a single
141!     absolute value and no relative values!
142!
143        if(objectset(1,nobject)(4:13).eq.'MEMBERSIZE') then
144          if(n.ge.(2+nsets)) then
145            read(textpart(2+nsets)(1:20),'(f20.0)',iostat=istat) absval
146            if(istat.gt.0) then
147              call inputerror(inpc,ipoinpc,iline,
148     &             "*GEOMETRIC CONSTRAINT%",ier)
149              return
150            endif
151            if(istat.le.0) then
152              objectset(1,nobject)(61:80)=textpart(2+nsets)(1:20)
153            endif
154          else
155            write(*,*) '*ERROR reading *GEOMETRIC CONSTRAINT'
156            write(*,*) '       no absolute value for MEMBERSIZE'
157            write(*,*) '       specified.'
158            call inputerror(inpc,ipoinpc,iline,
159     &           "*GEOMETRIC CONSTRAINT%",ier)
160            return
161          endif
162        endif
163      enddo
164!
165      return
166      end
167