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 checkconstraint(nobject,objectset,g0,nactive, 20 & nnlconst,ipoacti,ndesi,dgdxglob,nk,nodedesi,iconstacti, 21 & objnorm,inameacti) 22! 23! check which constraints are active on the basis of the 24! function values of the constraints 25! 26 implicit none 27! 28 character*81 objectset(5,*) 29 character*20 empty 30! 31 integer iobject,nobject,istat,nactive,nnlconst,inameacti(*), 32 & ipoacti(*),ifree,i,ndesi,nk,node,nodedesi(ndesi), 33 & iconstacti(*),nconst 34! 35 real*8 g0(nobject),bounds(nobject),scale,bound,objnorm(nobject), 36 & dgdxglob(2,nk,nobject) 37 empty=' ' 38! 39 write(5,*) 40 write(5,*) 41 write(5,'(a113)') ' ################################################ 42 &#################################################################' 43 write(5,*) ' A S S E M B L Y O F A C T I V E S E T' 44 write(5,*) 45 write(5,101) 46 &'NUMBER OF ','CONSTRAINT ','LE/ ','FUNCTION ', 47 &'FUNCTION ','FUNCTION ',' ACTIVE/ ',' NAME OF' 48 write(5,101) 49 &'CONSTRAINT ','FUNCTION ','GE ','VALUE ', 50 &'BOUND ','VALUE NORM. ',' INACTIVE',' CONSTRAINT' 51 write(5,'(a113)') ' ################################################ 52 &#################################################################' 53 write(5,*) 54! 55! determine bounds of constraints 56! 57 do iobject=2,nobject 58! 59! determine bounds of geometric (linear) constraints 60! 61 if(objectset(5,iobject)(81:81).eq.'G') then 62 do i=1,ndesi 63 node=nodedesi(i) 64 if(dgdxglob(2,node,iobject).gt.0) then 65 g0(iobject)=1.d0+g0(iobject) 66 endif 67 enddo 68! 69! determine bounds of nonlinear constraints 70! 71 elseif(objectset(5,iobject)(81:81).eq.'C') then 72 if(objectset(1,iobject)(61:80).ne.empty) then 73 read(objectset(1,iobject)(61:80),'(f20.0)', 74 & iostat=istat) bound 75 else 76 write(*,*) '*WARNING in checkconstraint' 77 write(*,*) ' no absolute constraint boundary' 78 write(*,*) ' defined, system value taken' 79 bound=g0(iobject) 80 endif 81 if(objectset(1,iobject)(41:60).ne.empty) then 82 read(objectset(1,iobject)(41:60),'(f20.0)', 83 & iostat=istat) scale 84 else 85 write(*,*) '*WARNING in checkconstraint' 86 write(*,*) ' no relative constraint boundary' 87 write(*,*) ' defined, 1.0 taken' 88 scale=1.0d0 89 endif 90 bounds(iobject)=bound*scale 91 endif 92 enddo 93! 94! determine active constraints 95! 96 nconst=0 97 nactive=0 98 nnlconst=0 99 ifree=1 100! 101 do iobject=2,nobject 102! 103! determine all nonlinear constraints 104! 105 if(objectset(5,iobject)(81:81).eq.'C') then 106 nconst=nconst+1 107 if(objectset(1,iobject)(19:20).eq.'LE') then 108 objnorm(ifree)=g0(iobject)/bounds(iobject)-1 109 if(objnorm(ifree).gt.-0.02) then 110 nactive=nactive+1 111 nnlconst=nnlconst+1 112 ipoacti(ifree)=iobject 113 inameacti(ifree)=iobject 114 iconstacti(ifree)=-1 115 write(5,102) nconst,objectset(1,iobject),'LE ', 116 & g0(iobject),bounds(iobject),objnorm(ifree), 117 & 'ACTIVE ',objectset(5,iobject) 118 ifree=ifree+1 119 else 120 write(5,102) nconst,objectset(1,iobject),'LE ', 121 & g0(iobject),bounds(iobject),objnorm(ifree), 122 & 'INACTIVE',objectset(5,iobject) 123 endif 124 elseif(objectset(1,iobject)(19:20).eq.'GE') then 125 objnorm(ifree)=-1*(g0(iobject)/bounds(iobject))+1 126 if(objnorm(ifree).gt.-0.02) then 127 nactive=nactive+1 128 nnlconst=nnlconst+1 129 ipoacti(ifree)=iobject 130 inameacti(ifree)=iobject 131 iconstacti(ifree)=1 132 write(5,102) nconst,objectset(1,iobject),'GE ', 133 & g0(iobject),bounds(iobject),objnorm(ifree), 134 & 'ACTIVE ',objectset(5,iobject) 135 ifree=ifree+1 136 else 137 write(5,102) nconst,objectset(1,iobject),'GE ', 138 & g0(iobject),bounds(iobject),objnorm(ifree), 139 & 'INACTIVE',objectset(5,iobject) 140 endif 141 endif 142! 143! determine all linear constraints 144! 145 elseif(objectset(5,iobject)(81:81).eq.'G') then 146 nconst=nconst+1 147 if(objectset(1,iobject)(19:20).eq.'LE') then 148 if(g0(iobject)>0) then 149 do i=1,ndesi 150 node=nodedesi(i) 151 if(dgdxglob(2,node,iobject).eq.1) then 152 ipoacti(ifree)=i 153 inameacti(ifree)=iobject 154 iconstacti(ifree)=-1 155 ifree=ifree+1 156 nactive=nactive+1 157 endif 158 enddo 159 write(5,102) nconst,objectset(1,iobject),'LE ', 160 & g0(iobject),0,0,'ACTIVE ',objectset(5,iobject) 161 else 162 write(5,102) nconst,objectset(1,iobject),'LE ', 163 & g0(iobject),0,0,'INACTIVE',objectset(5,iobject) 164 endif 165 elseif(objectset(1,iobject)(19:20).eq.'GE') then 166 if(g0(iobject)>0) then 167 do i=1,ndesi 168 node=nodedesi(i) 169 if(dgdxglob(2,node,iobject).eq.1) then 170 ipoacti(ifree)=i 171 inameacti(ifree)=iobject 172 iconstacti(ifree)=1 173 ifree=ifree+1 174 nactive=nactive+1 175 endif 176 enddo 177 write(5,102) nconst,objectset(1,iobject),'GE ', 178 & g0(iobject),0,0,'ACTIVE ',objectset(5,iobject) 179 else 180 write(5,102) nconst,objectset(1,iobject),'GE ', 181 & g0(iobject),0,0,'INACTIVE',objectset(5,iobject) 182 endif 183 endif 184 endif 185 enddo 186! 187 return 188! 189 101 format(3x,13a,3x,a16,a11,3x,a11,3x,a11,3x,a8,3x,a10,3x,a10) 190 102 format(3x,i2,8x,3x,a16,a4,3x,e14.7,3x,e14.7,3x,e14.7,3x,a8,3x,a80) 191! 192 end 193