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 cloads(inpc,textpart,set,istartset,iendset, 20 & ialset,nset,nodeforc,ndirforc,xforc,nforc,nforc_,iamforc, 21 & amname,nam,ntrans,trab,inotr,co,ikforc,ilforc,nk, 22 & cload_flag,istep,istat,n,iline,ipol,inl,ipoinp,inp,nam_, 23 & namtot_,namta,amta,nmethod,iaxial,iperturb,ipoinpc, 24 & maxsectors,idefforc,ipompc,nodempc, 25 & nmpc,ikmpc,ilmpc,labmpc,iamplitudedefault,namtot,ier) 26! 27! reading the input deck: *CLOADS 28! 29 implicit none 30! 31 logical cload_flag,add,user,submodel,green 32! 33 character*1 inpc(*) 34 character*20 labmpc(*) 35 character*80 amplitude,amname(*) 36 character*81 set(*),noset 37 character*132 textpart(16) 38! 39 integer istartset(*),iendset(*),ialset(*),nodeforc(2,*), 40 & nset,nforc,nforc_,istep,istat,n,i,j,k,l,iforcdir,key, 41 & iamforc(*),nam,iamplitude,ntrans,inotr(2,*),ipos,ikforc(*), 42 & ilforc(*),nk,iline,ipol,inl,ipoinp(2,*),inp(3,*),nam_,namtot, 43 & namtot_,namta(3,*),idelay,lc,nmethod,ndirforc(*),isector, 44 & iperturb(*),iaxial,ipoinpc(0:*),maxsectors,jsector,idefforc(*), 45 & iglobstep,ipompc(*),nodempc(3,*),nmpc,ikmpc(*),ilmpc(*), 46 & iamplitudedefault,ier,id 47! 48 real*8 xforc(*),forcval,co(3,*),trab(7,*),amta(2,*),omega0 49! 50 iamplitude=iamplitudedefault 51 idelay=0 52 lc=1 53 isector=0 54 user=.false. 55 add=.false. 56 iglobstep=0 57 submodel=.false. 58 green=.false. 59! 60 if(istep.lt.1) then 61 write(*,*) '*ERROR reading *CLOAD: *CLOAD should only be used' 62 write(*,*) ' within a STEP' 63 ier=1 64 return 65 endif 66! 67 do i=2,n 68 if((textpart(i)(1:6).eq.'OP=NEW').and.(.not.cload_flag)) then 69 do j=1,nforc 70 xforc(j)=0.d0 71 enddo 72 elseif(textpart(i)(1:10).eq.'AMPLITUDE=') then 73 read(textpart(i)(11:90),'(a80)') amplitude 74 do j=1,nam 75 if(amname(j).eq.amplitude) then 76 iamplitude=j 77 exit 78 endif 79 enddo 80 if(j.gt.nam) then 81 write(*,*)'*ERROR reading *CLOAD: nonexistent amplitude' 82 write(*,*) ' ' 83 call inputerror(inpc,ipoinpc,iline, 84 & "*CLOAD%",ier) 85 return 86 endif 87 iamplitude=j 88 elseif(textpart(i)(1:10).eq.'TIMEDELAY=') THEN 89 if(idelay.ne.0) then 90 write(*,*) 91 & '*ERROR reading *CLOAD: the parameter TIME DELAY' 92 write(*,*) ' is used twice in the same keyword' 93 write(*,*) ' ' 94 call inputerror(inpc,ipoinpc,iline, 95 & "*CLOAD%",ier) 96 return 97 else 98 idelay=1 99 endif 100 nam=nam+1 101 if(nam.gt.nam_) then 102 write(*,*) '*ERROR reading *CLOAD: increase nam_' 103 ier=1 104 return 105 endif 106 amname(nam)=' 107 & ' 108 if(iamplitude.eq.0) then 109 write(*,*) '*ERROR reading *CLOAD: time delay must be' 110 write(*,*) ' preceded by the amplitude parameter' 111 ier=1 112 return 113 endif 114 namta(3,nam)=sign(iamplitude,namta(3,iamplitude)) 115 iamplitude=nam 116c if(nam.eq.1) then 117c namtot=0 118c else 119c namtot=namta(2,nam-1) 120c endif 121 namtot=namtot+1 122 if(namtot.gt.namtot_) then 123 write(*,*) '*ERROR cloads: increase namtot_' 124 ier=1 125 return 126 endif 127 namta(1,nam)=namtot 128 namta(2,nam)=namtot 129c call reorderampl(amname,namta,nam) 130 read(textpart(i)(11:30),'(f20.0)',iostat=istat) 131 & amta(1,namtot) 132 if(istat.gt.0) then 133 call inputerror(inpc,ipoinpc,iline, 134 & "*CLOAD%",ier) 135 return 136 endif 137 elseif(textpart(i)(1:9).eq.'LOADCASE=') then 138 read(textpart(i)(10:19),'(i10)',iostat=istat) lc 139 if(istat.gt.0) then 140 call inputerror(inpc,ipoinpc,iline, 141 & "*CLOAD%",ier) 142 return 143 endif 144 if(nmethod.ne.5) then 145 write(*,*) 146 & '*ERROR reading *CLOAD: the parameter LOAD CASE' 147 write(*,*) ' is only allowed in STEADY STATE' 148 write(*,*) ' DYNAMICS calculations' 149 ier=1 150 return 151 endif 152 elseif(textpart(i)(1:7).eq.'SECTOR=') then 153 read(textpart(i)(8:17),'(i10)',iostat=istat) isector 154 if(istat.gt.0) then 155 call inputerror(inpc,ipoinpc,iline, 156 & "*CLOAD%",ier) 157 return 158 endif 159 if((nmethod.le.3).or.(iperturb(1).gt.1)) then 160 write(*,*) '*ERROR reading *CLOAD: the parameter SECTOR' 161 write(*,*) ' is only allowed in MODAL DYNAMICS or' 162 write(*,*) ' STEADY STATE DYNAMICS calculations' 163 ier=1 164 return 165 endif 166 if(isector.gt.maxsectors) then 167 write(*,*) '*ERROR reading *CLOAD: sector ',isector 168 write(*,*) ' exceeds number of sectors' 169 ier=1 170 return 171 endif 172 isector=isector-1 173 elseif(textpart(i)(1:4).eq.'USER') then 174 user=.true. 175 elseif(textpart(i)(1:8).eq.'SUBMODEL') then 176 submodel=.true. 177 elseif(textpart(i)(1:5).eq.'STEP=') then 178 read(textpart(i)(6:15),'(i10)',iostat=istat) iglobstep 179 if(istat.gt.0) then 180 call inputerror(inpc,ipoinpc,iline, 181 & "*CLOAD%",ier) 182 return 183 endif 184 elseif(textpart(i)(1:8).eq.'DATASET=') then 185 read(textpart(i)(9:18),'(i10)',iostat=istat) iglobstep 186 if(istat.gt.0) then 187 call inputerror(inpc,ipoinpc,iline, 188 & "*CLOAD%",ier) 189 return 190 endif 191! 192! the mode number for submodels 193! is stored as a negative global step 194! 195 iglobstep=-iglobstep 196 elseif(textpart(i)(1:7).eq.'OMEGA0=') then 197 green=.true. 198 read(textpart(i)(8:27),'(f20.0)',iostat=istat) omega0 199 if(istat.gt.0) then 200 call inputerror(inpc,ipoinpc,iline, 201 & "*CLOAD%",ier) 202 return 203 endif 204 omega0=omega0**2 205 else 206 write(*,*) 207 & '*WARNING reading *CLOAD: parameter not recognized:' 208 write(*,*) ' ', 209 & textpart(i)(1:index(textpart(i),' ')-1) 210 call inputwarning(inpc,ipoinpc,iline, 211 &"*CLOAD%") 212 endif 213 enddo 214! 215! check whether global step was specified for submodel 216! 217 if((submodel).and.(iglobstep.eq.0)) then 218 write(*,*) '*ERROR reading *CLOAD: no global step' 219 write(*,*) ' step specified for the submodel' 220 call inputerror(inpc,ipoinpc,iline, 221 & "*CLOAD%",ier) 222 return 223 endif 224! 225! storing the step for submodels in iamboun 226! 227 if(submodel) then 228 if(iamplitude.ne.0) then 229 write(*,*) '*WARNING reading *CLOAD:' 230 write(*,*) ' no amplitude definition is allowed' 231 write(*,*) ' in combination with a submodel' 232 endif 233 iamplitude=iglobstep 234 endif 235! 236 if(user.and.(iamplitude.ne.0)) then 237 write(*,*) '*WARNING: no amplitude definition is allowed' 238 write(*,*) ' for concentrated loads defined by a' 239 write(*,*) ' user routine' 240 iamplitude=0 241 endif 242! 243 do 244 call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl, 245 & ipoinp,inp,ipoinpc) 246 if((istat.lt.0).or.(key.eq.1)) return 247! 248 read(textpart(2)(1:10),'(i10)',iostat=istat) iforcdir 249 if(istat.gt.0) then 250 call inputerror(inpc,ipoinpc,iline, 251 & "*CLOAD%",ier) 252 return 253 endif 254 if((iforcdir.lt.1).or.(iforcdir.gt.6)) then 255 write(*,*) 256 & '*ERROR reading *CLOAD: nonexistent degree of freedom' 257 write(*,*) ' ' 258 call inputerror(inpc,ipoinpc,iline, 259 & "*CLOAD%",ier) 260 return 261 endif 262c if(iforcdir.gt.3) iforcdir=iforcdir+1 263! 264! for Green function applications the value of omega_0^2 is stored as 265! force value 266! 267 if(green) then 268 forcval=omega0 269 elseif(textpart(3)(1:1).eq.' ') then 270 forcval=0.d0 271 else 272 read(textpart(3)(1:20),'(f20.0)',iostat=istat) forcval 273 if(istat.gt.0) then 274 call inputerror(inpc,ipoinpc,iline, 275 & "*CLOAD%",ier) 276 return 277 endif 278 if(iaxial.eq.180) forcval=forcval/iaxial 279 endif 280! 281! dummy flux consisting of the first primes 282! 283 if(user) forcval=1.2357111317d0 284 if(submodel) forcval=1.9232931374d0 285! 286 read(textpart(1)(1:10),'(i10)',iostat=istat) l 287 if(istat.eq.0) then 288 if(l.gt.nk) then 289 write(*,*) '*ERROR reading *CLOAD: node ',l 290 write(*,*) ' is not defined' 291 ier=1 292 return 293 endif 294 if(submodel) then 295 if(ntrans.gt.0) then 296 if(inotr(1,l).gt.0) then 297 write(*,*) '*ERROR reading *CLOAD: in submodel' 298 write(*,*) ' node',l,' a local coordinate' 299 write(*,*) ' system was defined. This is not' 300 write(*,*) ' allowed' 301 ier=1 302 return 303 endif 304 endif 305 endif 306 if(lc.ne.1) then 307 jsector=isector+maxsectors 308 else 309 jsector=isector 310 endif 311 call forcadd(l,iforcdir,forcval,nodeforc,ndirforc,xforc, 312 & nforc,nforc_,iamforc,iamplitude,nam,ntrans,trab,inotr,co, 313 & ikforc,ilforc,jsector,add,user,idefforc,ipompc,nodempc, 314 & nmpc,ikmpc,ilmpc,labmpc) 315 else 316 read(textpart(1)(1:80),'(a80)',iostat=istat) noset 317 noset(81:81)=' ' 318 ipos=index(noset,' ') 319 noset(ipos:ipos)='N' 320c do i=1,nset 321c if(set(i).eq.noset) exit 322c enddo 323 call cident81(set,noset,nset,id) 324 i=nset+1 325 if(id.gt.0) then 326 if(noset.eq.set(id)) then 327 i=id 328 endif 329 endif 330 if(i.gt.nset) then 331 noset(ipos:ipos)=' ' 332 write(*,*) '*ERROR reading *CLOAD: node set ',noset 333 write(*,*) ' has not yet been defined. ' 334 call inputerror(inpc,ipoinpc,iline, 335 & "*CLOAD%",ier) 336 return 337 endif 338 do j=istartset(i),iendset(i) 339 if(ialset(j).gt.0) then 340 k=ialset(j) 341 if(submodel) then 342 if(ntrans.gt.0) then 343 if(inotr(1,k).gt.0) then 344 write(*,*) 345 & '*ERROR reading *CLOAD: in submodel' 346 write(*,*) ' node',k, 347 & ' a local coordinate' 348 write(*,*) 349 & ' system was defined. This is not' 350 write(*,*) ' allowed' 351 ier=1 352 return 353 endif 354 endif 355 endif 356 if(lc.ne.1) then 357 jsector=isector+maxsectors 358 else 359 jsector=isector 360 endif 361 call forcadd(k,iforcdir,forcval, 362 & nodeforc,ndirforc,xforc,nforc,nforc_,iamforc, 363 & iamplitude,nam,ntrans,trab,inotr,co,ikforc,ilforc, 364 & jsector,add,user,idefforc,ipompc,nodempc, 365 & nmpc,ikmpc,ilmpc,labmpc) 366 else 367 k=ialset(j-2) 368 do 369 k=k-ialset(j) 370 if(k.ge.ialset(j-1)) exit 371 if(submodel) then 372 if(ntrans.gt.0) then 373 if(inotr(1,k).gt.0) then 374 write(*,*) 375 & '*ERROR reading *CLOAD: in submodel' 376 write(*,*) ' node',k, 377 & ' a local coordinate' 378 write(*,*) 379 & ' system was defined. This is not' 380 write(*,*) ' allowed' 381 ier=1 382 return 383 endif 384 endif 385 endif 386 if(lc.ne.1) then 387 jsector=isector+maxsectors 388 else 389 jsector=isector 390 endif 391 call forcadd(k,iforcdir,forcval, 392 & nodeforc,ndirforc,xforc,nforc,nforc_, 393 & iamforc,iamplitude,nam,ntrans,trab,inotr,co, 394 & ikforc,ilforc,jsector,add,user,idefforc, 395 & ipompc,nodempc,nmpc,ikmpc,ilmpc,labmpc) 396 enddo 397 endif 398 enddo 399 endif 400 enddo 401! 402 return 403 end 404 405