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 noelsets(inpc,textpart,set,istartset,iendset,ialset, 20 & nset,nset_,nalset,nalset_,nk,ne,irstrt,istep,istat,n,iline, 21 & ipol,inl,ipoinp,inp,ipoinpc,ier) 22! 23! reading the input deck: *NSET and *ELSET 24! 25 implicit none 26! 27 logical igen 28! 29 character*1 inpc(*) 30 character*81 set(*),noelset 31 character*132 textpart(16) 32! 33 integer nset,nset_,nalset,nalset_,istep,istat,n,key,i,nk,ne, 34 & kode,ipos,j,k,m,iset,nn,irstrt(*),istartset(*),iendset(*), 35 & ialset(*),iline,ipol,inl,ipoinp(2,*),inp(3,*),ipoinpc(0:*), 36 & ier,id 37! 38 if((istep.gt.0).and.(irstrt(1).ge.0)) then 39 write(*,*) 40 & '*ERROR reading *NSET/ELSET: *NSET/*ELSET should be placed' 41 write(*,*) ' before all step definitions' 42 ier=1 43 return 44 endif 45! 46 igen=.false. 47! 48! reading the name of the set 49! 50 if(textpart(1)(1:5).eq.'*NSET') then 51 do i=2,n 52 if(textpart(i)(1:5).eq.'NSET=') then 53 noelset(1:80)=textpart(i)(6:85) 54 if(textpart(i)(86:86).ne.' ') then 55 write(*,*) 56 & '*ERROR reading *NSET/ELSET: set name too long' 57 write(*,*) ' (more than 80 characters)' 58 write(*,*) ' set name:',textpart(2)(1:132) 59 ier=1 60 return 61 endif 62 noelset(81:81)=' ' 63 ipos=index(noelset,' ') 64 noelset(ipos:ipos)='N' 65 kode=0 66 elseif(textpart(i)(1:8).eq.'GENERATE') then 67 igen=.true. 68 else 69 write(*,*) 70 & '*WARNING reading *NSET/ELSET: parameter not recognized:' 71 write(*,*) ' ', 72 & textpart(i)(1:index(textpart(i),' ')-1) 73 call inputwarning(inpc,ipoinpc,iline, 74 & "*NSET or *ELSET%") 75 endif 76 enddo 77 else 78 do i=2,n 79 if(textpart(i)(1:6).eq.'ELSET=') then 80 noelset(1:80)=textpart(i)(7:86) 81 if(textpart(i)(87:87).ne.' ') then 82 write(*,*) 83 & '*ERROR reading *NSET/ELSET: set name too long' 84 write(*,*) ' (more than 80 characters)' 85 write(*,*) ' set name',textpart(2)(1:132) 86 ier=1 87 return 88 endif 89 noelset(81:81)=' ' 90 ipos=index(noelset,' ') 91 noelset(ipos:ipos)='E' 92 kode=1 93 elseif(textpart(i)(1:8).eq.'GENERATE') then 94 igen=.true. 95 else 96 write(*,*) 97 & '*WARNING reading *NSET/ELSET: parameter not recognized:' 98 write(*,*) ' ', 99 & textpart(i)(1:index(textpart(i),' ')-1) 100 call inputwarning(inpc,ipoinpc,iline, 101 & "*NSET or *ELSET%") 102 endif 103 enddo 104 endif 105! 106! check whether new set or old set 107! 108ccc to remove start 109c do iset=1,nset 110c if(set(iset).eq.noelset) then 111ccc to remove end 112 iset=0 113 call cident81(set,noelset,nset,id) 114 if(id.gt.0) then 115 if(set(id).eq.noelset) then 116 iset=id 117! 118! existent set 119! 120 if(iendset(iset).ne.nalset) then 121! 122! rearranging set information towards the end 123! 124 nn=iendset(iset)-istartset(iset)+1 125 if(nalset+nn.gt.nalset_) then 126 write(*,*) 127 & '*ERROR reading *NSET/ELSET: increase nalset_' 128 ier=1 129 return 130 endif 131 do k=1,nn 132 ialset(nalset+k)=ialset(istartset(iset)+k-1) 133 enddo 134 if(nn.gt.0) then 135 do k=istartset(iset),nalset 136 ialset(k)=ialset(k+nn) 137 enddo 138 do k=1,nset 139 if(istartset(k).gt.iendset(iset)) then 140 istartset(k)=istartset(k)-nn 141 iendset(k)=iendset(k)-nn 142 endif 143 enddo 144 endif 145 istartset(iset)=nalset-nn+1 146 iendset(iset)=nalset 147 endif 148 endif 149 endif 150ccc to remove start 151c enddo 152c if(iset.gt.nset) then 153ccc to remove end 154 if(iset.eq.0) then 155 nset=nset+1 156 if(nset.gt.nset_) then 157 write(*,*) '*ERROR reading *NSET/ELSET: increase nset_' 158 ier=1 159 return 160 endif 161ccc to remove start 162c set(nset)=noelset 163c istartset(nset)=nalset+1 164c iendset(nset)=0 165c iset=nset 166ccc to remove end 167 do j=nset,id+2,-1 168 istartset(j)=istartset(j-1) 169 iendset(j)=iendset(j-1) 170 set(j)=set(j-1) 171 enddo 172 set(id+1)=noelset 173 istartset(id+1)=nalset+1 174 iendset(id+1)=0 175 iset=id+1 176 endif 177! 178 do 179 call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl, 180 & ipoinp,inp,ipoinpc) 181 if((istat.lt.0).or.(key.eq.1)) then 182ccc to remove start 183c if(iendset(nset).eq.0) then 184ccc to remove end 185 if(iendset(iset).eq.0) then 186 do j=iset+1,nset 187 istartset(j-1)=istartset(j) 188 iendset(j-1)=iendset(j) 189 set(j-1)=set(j) 190 enddo 191 nset=nset-1 192 endif 193 return 194 endif 195 if(igen) n=3 196 if(nalset+n.gt.nalset_) then 197 write(*,*) '*ERROR reading *NSET/ELSET: increase nalset_' 198 ier=1 199 return 200 endif 201! 202 if(igen) then 203 if(textpart(3)(1:1).eq.' ') then 204 textpart(3)='1 205 & 206 &' 207 endif 208 do i=1,3 209 read(textpart(i)(1:10),'(i10)',iostat=istat) 210 & ialset(nalset+i) 211 if(istat.gt.0) then 212 call inputerror(inpc,ipoinpc,iline, 213 & "*NSET or *ELSET%",ier) 214 return 215 endif 216 enddo 217 if(kode.eq.0) then 218 if(ialset(nalset+1).gt.nk) then 219 write(*,*) 220 & '*ERROR reading *NSET/ELSET: starting value in' 221 write(*,*) ' set ', 222 & set(iset)(1:index(set(iset),' ')-2),' > nk' 223 ier=1 224 return 225 elseif(ialset(nalset+2).gt.nk) then 226 write(*,*) 227 & '*WARNING reading *NSET/ELSET: end value in' 228 write(*,*) ' set ', 229 & set(iset)(1:index(set(iset),' ')-2),' > nk;' 230 write(*,*) ' replaced by nk' 231 ialset(nalset+2)=nk 232 elseif(ialset(nalset+3).le.0) then 233 write(*,*) '*ERROR reading *NSET/ELSET: increment in' 234 write(*,*) ' set ', 235 & set(iset)(1:index(set(iset),' ')-2),' <=0' 236 ier=1 237 return 238 endif 239 else 240 if(ialset(nalset+1).gt.ne) then 241 write(*,*) 242 & '*ERROR reading *NSET/ELSET: starting value in' 243 write(*,*) ' set ', 244 & set(iset)(1:index(set(iset),' ')-2),' > ne' 245 ier=1 246 return 247 elseif(ialset(nalset+2).gt.ne) then 248 write(*,*) 249 & '*WARNING reading *NSET/ELSET: end value in' 250 write(*,*) ' set ', 251 & set(iset)(1:index(set(iset),' ')-2),' > ne;' 252 write(*,*) ' replaced by ne' 253 ialset(nalset+2)=nk 254 elseif(ialset(nalset+3).le.0) then 255 write(*,*) '*ERROR reading *NSET/ELSET: increment in' 256 write(*,*) ' set ', 257 & set(iset)(1:index(set(iset),' ')-2),' <=0' 258 ier=1 259 return 260 endif 261 endif 262 if(ialset(nalset+1).eq.ialset(nalset+2)) then 263 ialset(nalset+2)=0 264 ialset(nalset+3)=0 265 nalset=nalset+1 266 else 267 ialset(nalset+3)=-ialset(nalset+3) 268 nalset=nalset+3 269 endif 270 iendset(iset)=nalset 271 else 272 do i=1,n 273 read(textpart(i)(1:10),'(i10)',iostat=istat) 274 & ialset(nalset+1) 275 if(istat.gt.0) then 276! 277! set name 278! 279 noelset=textpart(i)(1:80) 280 noelset(81:81)=' ' 281 ipos=index(noelset,' ') 282 if(kode.eq.0) then 283 noelset(ipos:ipos)='N' 284 else 285 noelset(ipos:ipos)='E' 286 endif 287ccc to remove start 288c do j=1,nset 289c if(j.eq.iset)cycle 290c if(noelset.eq.set(j)) then 291c m=iendset(j)-istartset(j)+1 292c do k=1,m 293c ialset(nalset+k)=ialset(istartset(j)+k-1) 294c enddo 295c nalset=nalset+m 296c exit 297c endif 298c enddo 299ccc to remove end 300 j=0 301 call cident81(set,noelset,nset,id) 302 if(id.gt.0) then 303 if(set(id).eq.noelset) then 304 if(id.ne.iset) then 305 m=iendset(id)-istartset(id)+1 306 do k=1,m 307 ialset(nalset+k)=ialset(istartset(id)+k-1) 308 enddo 309 nalset=nalset+m 310 endif 311 j=id 312 endif 313 endif 314 if(j.eq.0) then 315 noelset(ipos:ipos)=' ' 316 if(kode.eq.0) then 317 write(*,*) 318 & '*ERROR reading *NSET/ELSET: node set ', 319 & noelset 320 else 321 write(*,*) 322 & '*ERROR reading *NSET/ELSET: element set ', 323 & noelset 324 endif 325 write(*,*) ' has not been defined yet' 326 ier=1 327 return 328 endif 329 else 330! 331! node or element number 332! 333 if(kode.eq.0) then 334 if(ialset(nalset+1).gt.nk) then 335 write(*,*) 336 & '*WARNING reading *NSET/ELSET: value ', 337 & ialset(nalset+1) 338 write(*,*) ' in set ', 339 & set(iset)(1:index(set(iset),' ')-2),' > nk' 340 else 341 nalset=nalset+1 342 endif 343 else 344 if(ialset(nalset+1).gt.ne) then 345 write(*,*) 346 & '*WARNING reading *NSET/ELSET: value ', 347 & ialset(nalset+1) 348 write(*,*) ' in set ', 349 & set(iset)(1:index(set(iset),' ')-2),' > ne;' 350 write(*,*) ' This is only allowed for' 351 write(*,*) 352 & ' global elsets in combination' 353 write(*,*) ' with submodels' 354c else 355c nalset=nalset+1 356 endif 357 nalset=nalset+1 358 endif 359 endif 360 enddo 361 iendset(iset)=nalset 362 endif 363 enddo 364! 365 return 366 end 367