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 springs(inpc,textpart,nelcon,nmat,ntmat_,npmat_, 20 & plicon,nplicon, 21 & ncmat_,elcon,matname,irstrt,istep,istat,n,iline,ipol, 22 & inl,ipoinp,inp,nmat_,set,istartset,iendset,ialset, 23 & nset,ielmat,ielorien,ipoinpc,mi,norien,orname,ier) 24! 25! reading the input deck: *SPRING 26! 27 implicit none 28! 29 logical linear 30! 31 character*1 inpc(*) 32 character*80 matname(*),orientation,orname(*) 33 character*81 set(*),elset 34 character*132 textpart(16) 35! 36 integer mi(*),nelcon(2,*),nmat,ntmat_,ntmat,npmat_,npmat,istep, 37 & n,key,i,nplicon(0:ntmat_,*),ncmat_,istat,istartset(*),id, 38 & iendset(*),irstrt(*),iline,ipol,inl,ipoinp(2,*),inp(3,*),nmat_, 39 & ialset(*),ipos,nset,j,k,ielmat(mi(3),*),ielorien(mi(3),*), 40 & ipoinpc(0:*),idof,iorientation,norien,idof2,ier 41! 42 real*8 plicon(0:2*npmat_,ntmat_,*),temperature, 43 & elcon(0:ncmat_,ntmat_,*) 44! 45 linear=.true. 46! 47 ntmat=0 48 npmat=0 49! 50 orientation=' 51 & ' 52! 53 if((istep.gt.0).and.(irstrt(1).ge.0)) then 54 write(*,*) '*ERROR reading *SPRING: *SPRING should be placed' 55 write(*,*) ' before all step definitions' 56 ier=1 57 return 58 endif 59! 60 nmat=nmat+1 61 if(nmat.gt.nmat_) then 62 write(*,*) '*ERROR reading *SPRING: increase nmat_' 63 ier=1 64 return 65 endif 66 matname(nmat)(1:6)='SPRING' 67 do i=7,80 68 matname(nmat)(i:i)=' ' 69 enddo 70! 71 do i=2,n 72 if(textpart(i)(1:9).eq.'NONLINEAR') then 73 linear=.false. 74 elseif(textpart(i)(1:12).eq.'ORIENTATION=') then 75 orientation=textpart(i)(13:92) 76 elseif(textpart(i)(1:6).eq.'ELSET=') then 77 elset=textpart(i)(7:86) 78 elset(81:81)=' ' 79 ipos=index(elset,' ') 80 elset(ipos:ipos)='E' 81 else 82 write(*,*) 83 & '*WARNING reading *SPRING: parameter not recognized:' 84 write(*,*) ' ', 85 & textpart(i)(1:index(textpart(i),' ')-1) 86 call inputwarning(inpc,ipoinpc,iline, 87 &"*SPRING%") 88 endif 89 enddo 90! 91 if(orientation.eq.' ') then 92 iorientation=0 93 else 94 do i=1,norien 95 if(orname(i).eq.orientation) exit 96 enddo 97 if(i.gt.norien) then 98 write(*,*) 99 & '*ERROR reading *SPRING: nonexistent orientation' 100 write(*,*) ' ' 101 call inputerror(inpc,ipoinpc,iline, 102 & "*SPRING%",ier) 103 return 104 endif 105 iorientation=i 106 endif 107! 108 if(linear) then 109 nelcon(1,nmat)=2 110! 111! linear spring 112! 113 do 114 call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl, 115 & ipoinp,inp,ipoinpc) 116 if((istat.lt.0).or.(key.eq.1)) exit 117! 118! check whether the first field in the first line 119! underneath *SPRING contains a decimal point. If so, 120! this line is considered to be the start of material 121! data for SPRINGA elements. If not, it is considered 122! to contain degrees of freedom for SPRING1 or SPRING2 elements. 123! 124 if(ntmat.eq.0) then 125 idof=1 126 do i=1,132 127 if(textpart(1)(i:i).eq.'.') then 128 idof=0 129 exit 130 endif 131 enddo 132 if(idof.eq.1) then 133 read(textpart(2)(1:10),'(i10)',iostat=istat) idof2 134 if(istat.gt.0) then 135 call inputerror(inpc,ipoinpc,iline, 136 & "*SPRING%",ier) 137 return 138 endif 139 if(idof2.eq.0) then 140 if(ncmat_.lt.3) then 141 write(*,*) '*ERROR reading *SPRING: one degree' 142 write(*,*) ' of freedom was specified' 143 write(*,*) ' (no decimal point in entry),' 144 write(*,*) ' however, there are no' 145 write(*,*) ' SPRING1 elements' 146 write(*,*) ' in the input deck' 147 call inputerror(inpc,ipoinpc,iline, 148 & "*SPRING%",ier) 149 return 150 endif 151 read(textpart(1)(1:20),'(f20.0)',iostat=istat) 152 & elcon(3,1,nmat) 153 else 154 if(ncmat_.lt.4) then 155 write(*,*) '*ERROR reading *SPRING: two degrees' 156 write(*,*) ' of freedom were specified' 157 write(*,*) ' (no decimal point in entry),' 158 write(*,*) ' however, there are no' 159 write(*,*) ' SPRING2 elements' 160 write(*,*) ' in the input deck' 161 call inputerror(inpc,ipoinpc,iline, 162 & "*SPRING%",ier) 163 return 164 endif 165 read(textpart(1)(1:20),'(f20.0)',iostat=istat) 166 & elcon(3,1,nmat) 167 read(textpart(2)(1:20),'(f20.0)',iostat=istat) 168 & elcon(4,1,nmat) 169 endif 170 cycle 171 endif 172 endif 173! 174 ntmat=ntmat+1 175 nelcon(2,nmat)=ntmat 176 if(ntmat.gt.ntmat_) then 177 write(*,*) '*ERROR reading *SPRING: increase ntmat_' 178 ier=1 179 return 180 endif 181 do i=1,2 182 read(textpart(i)(1:20),'(f20.0)',iostat=istat) 183 & elcon(i,ntmat,nmat) 184 if(istat.gt.0) then 185 call inputerror(inpc,ipoinpc,iline, 186 & "*SPRING%",ier) 187 return 188 endif 189 enddo 190 if(textpart(3)(1:1).ne.' ') then 191 read(textpart(3)(1:20),'(f20.0)',iostat=istat) 192 & elcon(0,ntmat,nmat) 193 if(istat.gt.0) then 194 call inputerror(inpc,ipoinpc,iline, 195 & "*SPRING%",ier) 196 return 197 endif 198 else 199 elcon(0,ntmat,nmat)=0.d0 200 endif 201 enddo 202 else 203 nelcon(1,nmat)=-51 204! 205! nonlinear spring behavior 206! 207 do 208 call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl, 209 & ipoinp,inp,ipoinpc) 210 if((istat.lt.0).or.(key.eq.1)) exit 211! 212! check whether the first field in the first line 213! underneath *SPRING contains a decimal point. If so, 214! this line is considered to be the start of material 215! data for SPRINGA elements. If not, it is considered 216! to contain degrees of freedom for SPRING1 or SPRING2 elements. 217! 218 if(ntmat.eq.0) then 219 idof=1 220 do i=1,132 221 if(textpart(1)(i:i).eq.'.') then 222 idof=0 223 exit 224 endif 225 enddo 226 if(idof.eq.1) then 227 if(ncmat_.lt.4) then 228 write(*,*) '*ERROR reading *SPRING: a degree' 229 write(*,*) ' of freedom was specified' 230 write(*,*) ' (no decimal point in entry),' 231 write(*,*) ' however, there are neither' 232 write(*,*) ' SPRING1 nor SPRING2 elements' 233 write(*,*) ' in the input deck' 234 call inputerror(inpc,ipoinpc,iline, 235 & "*SPRING%",ier) 236 return 237 endif 238 read(textpart(1)(1:20),'(f20.0)',iostat=istat) 239 & elcon(3,1,nmat) 240 read(textpart(2)(1:20),'(f20.0)',iostat=istat) 241 & elcon(4,1,nmat) 242 cycle 243 endif 244 endif 245! 246 read(textpart(3)(1:20),'(f20.0)',iostat=istat) temperature 247 if(istat.gt.0) then 248 call inputerror(inpc,ipoinpc,iline, 249 & "*SPRING%",ier) 250 return 251 endif 252! 253! first temperature 254! 255 if(ntmat.eq.0) then 256 npmat=0 257 ntmat=ntmat+1 258 if(ntmat.gt.ntmat_) then 259 write(*,*) '*ERROR reading *SPRING: increase ntmat_' 260 ier=1 261 return 262 endif 263 nplicon(0,nmat)=ntmat 264 plicon(0,ntmat,nmat)=temperature 265! 266! new temperature 267! 268 elseif(plicon(0,ntmat,nmat).ne.temperature) then 269 npmat=0 270 ntmat=ntmat+1 271 if(ntmat.gt.ntmat_) then 272 write(*,*) '*ERROR reading *SPRING: increase ntmat_' 273 ier=1 274 return 275 endif 276 nplicon(0,nmat)=ntmat 277 plicon(0,ntmat,nmat)=temperature 278 endif 279 do i=1,2 280 read(textpart(i)(1:20),'(f20.0)',iostat=istat) 281 & plicon(2*npmat+i,ntmat,nmat) 282 if(istat.gt.0) then 283 call inputerror(inpc,ipoinpc,iline, 284 & "*SPRING%",ier) 285 return 286 endif 287 enddo 288 npmat=npmat+1 289 if(npmat.gt.npmat_) then 290 write(*,*) '*ERROR reading *SPRING: increase npmat_' 291 ier=1 292 return 293 endif 294 nplicon(ntmat,nmat)=npmat 295 enddo 296 endif 297! 298 if(ntmat.eq.0) then 299 write(*,*) '*ERROR reading *SPRING: *SPRING card without data' 300 ier=1 301 return 302 endif 303c do i=1,nset 304c if(set(i).eq.elset) exit 305c enddo 306 call cident81(set,elset,nset,id) 307 i=nset+1 308 if(id.gt.0) then 309 if(elset.eq.set(id)) then 310 i=id 311 endif 312 endif 313 if(i.gt.nset) then 314 elset(ipos:ipos)=' ' 315 write(*,*) '*ERROR reading *SPRING: element set ',elset 316 write(*,*) ' has not yet been defined. ' 317 call inputerror(inpc,ipoinpc,iline, 318 & "*SPRING%",ier) 319 return 320 endif 321! 322! assigning the elements of the set the appropriate material 323! 324 do j=istartset(i),iendset(i) 325 if(ialset(j).gt.0) then 326 ielmat(1,ialset(j))=nmat 327 ielorien(1,ialset(j))=iorientation 328 else 329 k=ialset(j-2) 330 do 331 k=k-ialset(j) 332 if(k.ge.ialset(j-1)) exit 333 ielmat(1,k)=nmat 334 ielorien(1,k)=iorientation 335 enddo 336 endif 337 enddo 338! 339 return 340 end 341 342