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