CalculiX  2.13
A Free Software Three-Dimensional Structural Finite Element Program
Functions/Subroutines
dloads.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine dloads (inpc, textpart, set, istartset, iendset, ialset, nset, nelemload, sideload, xload, nload, nload_, ielmat, iamload, amname, nam, lakon, ne, dload_flag, istep, istat, n, iline, ipol, inl, ipoinp, inp, cbody, ibody, xbody, nbody, nbody_, xbodyold, iperturb, physcon, nam_, namtot_, namta, amta, nmethod, ipoinpc, maxsectors, mi, idefload, idefbody, ipkon, thicke)
 

Function/Subroutine Documentation

◆ dloads()

subroutine dloads ( character*1, dimension(*)  inpc,
character*132, dimension(16)  textpart,
character*81, dimension(*)  set,
integer, dimension(*)  istartset,
integer, dimension(*)  iendset,
integer, dimension(*)  ialset,
integer  nset,
integer, dimension(2,*)  nelemload,
character*20, dimension(*)  sideload,
real*8, dimension(2,*)  xload,
integer  nload,
integer  nload_,
integer, dimension(mi(3),*)  ielmat,
integer, dimension(2,*)  iamload,
character*80, dimension(*)  amname,
integer  nam,
character*8, dimension(*)  lakon,
integer  ne,
logical  dload_flag,
integer  istep,
integer  istat,
integer  n,
integer  iline,
integer  ipol,
integer  inl,
integer, dimension(2,*)  ipoinp,
integer, dimension(3,*)  inp,
character*81, dimension(*)  cbody,
integer, dimension(3,*)  ibody,
real*8, dimension(7,*)  xbody,
integer  nbody,
integer  nbody_,
real*8, dimension(7,*)  xbodyold,
integer  iperturb,
real*8, dimension(*)  physcon,
integer  nam_,
integer  namtot_,
integer, dimension(3,*)  namta,
real*8, dimension(2,*)  amta,
integer  nmethod,
integer, dimension(0:*)  ipoinpc,
integer  maxsectors,
integer, dimension(*)  mi,
integer, dimension(*)  idefload,
integer, dimension(*)  idefbody,
integer, dimension(*)  ipkon,
real*8, dimension(mi(3),*)  thicke 
)
26 !
27 ! reading the input deck: *DLOAD
28 !
29  implicit none
30 !
31  logical dload_flag,submodel,edgeload,surface
32 !
33  character*1 inpc(*)
34  character*8 lakon(*)
35  character*20 sideload(*),label
36  character*80 amname(*),amplitude
37  character*81 set(*),elset,cbody(*)
38  character*132 textpart(16)
39 !
40  integer istartset(*),iendset(*),ialset(*),nelemload(2,*),mi(*),
41  & ielmat(mi(3),*),nset,nload,nload_,istep,istat,n,i,j,l,key,
42  & iamload(2,*),nam,iamplitude,ipos,ne,iline,ipol,iperturb,
43  & inl,ipoinp(2,*),inp(3,*),ibody(3,*),nbody,nbody_,nam_,namtot,
44  & namtot_,namta(3,*),idelay,nmethod,lc,isector,node,ipoinpc(0:*),
45  & maxsectors,jsector,iglobstep,idefload(*),idefbody(*),ipkon(*),
46  & k,indexe
47 !
48  real*8 xload(2,*),xbody(7,*),xmagnitude,dd,p1(3),p2(3),bodyf(3),
49  & xbodyold(7,*),physcon(*),amta(2,*),xxmagnitude,thicke(mi(3),*),
50  & thickness
51 !
52  iamplitude=0
53  idelay=0
54  lc=1
55  isector=0
56  submodel=.false.
57  iglobstep=0
58  edgeload=.false.
59  surface=.false.
60 !
61  if(istep.lt.1) then
62  write(*,*) '*ERROR reading *DLOAD: *DLOAD should only be used'
63  write(*,*) ' within a STEP'
64  call exit(201)
65  endif
66 !
67  do i=2,n
68  if((textpart(i)(1:6).eq.'OP=NEW').and.(.not.dload_flag)) then
69  do j=1,nload
70  if(sideload(j)(1:1).eq.'P') then
71  xload(1,j)=0.d0
72  endif
73  enddo
74  do j=1,nbody
75  xbody(1,j)=0.d0
76  enddo
77  elseif(textpart(i)(1:10).eq.'AMPLITUDE=') then
78  read(textpart(i)(11:90),'(a80)') amplitude
79  do j=1,nam
80  if(amname(j).eq.amplitude) then
81  iamplitude=j
82  exit
83  endif
84  enddo
85  if(j.gt.nam) then
86  write(*,*)'*ERROR reading *DLOAD: nonexistent amplitude'
87  write(*,*) ' '
88  call inputerror(inpc,ipoinpc,iline,
89  &"*DLOAD%")
90  call exit(201)
91  endif
92  iamplitude=j
93  elseif(textpart(i)(1:10).eq.'TIMEDELAY=') THEN
94  if(idelay.ne.0) then
95  write(*,*)
96  & '*ERROR reading *DLOAD: the parameter TIME DELAY'
97  write(*,*) ' is used twice in the same keyword'
98  write(*,*) ' '
99  call inputerror(inpc,ipoinpc,iline,
100  &"*DLOAD%")
101  call exit(201)
102  else
103  idelay=1
104  endif
105  nam=nam+1
106  if(nam.gt.nam_) then
107  write(*,*) '*ERROR reading *DLOAD: increase nam_'
108  call exit(201)
109  endif
110  amname(nam)='
111  & '
112  if(iamplitude.eq.0) then
113  write(*,*) '*ERROR reading *DLOAD: time delay must be'
114  write(*,*) ' preceded by the amplitude parameter'
115  call exit(201)
116  endif
117  namta(3,nam)=sign(iamplitude,namta(3,iamplitude))
118  iamplitude=nam
119  if(nam.eq.1) then
120  namtot=0
121  else
122  namtot=namta(2,nam-1)
123  endif
124  namtot=namtot+1
125  if(namtot.gt.namtot_) then
126  write(*,*) '*ERROR dloads: increase namtot_'
127  call exit(201)
128  endif
129  namta(1,nam)=namtot
130  namta(2,nam)=namtot
131  read(textpart(i)(11:30),'(f20.0)',iostat=istat)
132  & amta(1,namtot)
133  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
134  &"*DLOAD%")
135  elseif(textpart(i)(1:9).eq.'LOADCASE=') then
136  read(textpart(i)(10:19),'(i10)',iostat=istat) lc
137  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
138  &"*DLOAD%")
139  if(nmethod.ne.5) then
140  write(*,*)
141  & '*ERROR reading *DLOAD: the parameter LOAD CASE'
142  write(*,*) ' is only allowed in STEADY STATE'
143  write(*,*) ' DYNAMICS calculations'
144  call exit(201)
145  endif
146  elseif(textpart(i)(1:7).eq.'SECTOR=') then
147  read(textpart(i)(8:17),'(i10)',iostat=istat) isector
148  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
149  &"*DLOAD%")
150  if((nmethod.le.3).or.(iperturb.gt.1)) then
151  write(*,*) '*ERROR reading *DLOAD: the parameter SECTOR'
152  write(*,*) ' is only allowed in MODAL DYNAMICS or'
153  write(*,*) ' STEADY STATE DYNAMICS calculations'
154  call exit(201)
155  endif
156  if(isector.gt.maxsectors) then
157  write(*,*) '*ERROR reading *DLOAD: sector ',isector
158  write(*,*) ' exceeds number of sectors'
159  call exit(201)
160  endif
161  isector=isector-1
162  elseif(textpart(i)(1:8).eq.'SUBMODEL') then
163  submodel=.true.
164  elseif(textpart(i)(1:5).eq.'STEP=') then
165  read(textpart(i)(6:15),'(i10)',iostat=istat) iglobstep
166  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
167  &"*DLOAD%")
168  else
169  write(*,*)
170  & '*WARNING reading *DLOAD: parameter not recognized:'
171  write(*,*) ' ',
172  & textpart(i)(1:index(textpart(i),' ')-1)
173  call inputwarning(inpc,ipoinpc,iline,
174  &"*DLOAD%")
175  endif
176  enddo
177 !
178 ! check for the presence of an amplitude in submodel cases
179 !
180  if(submodel) then
181  if(iamplitude.ne.0) then
182  write(*,*) '*WARNING reading *DSLOAD:'
183  write(*,*) ' no amplitude definition is allowed'
184  write(*,*) ' in combination with a submodel'
185  endif
186  endif
187 !
188 ! check whether global step was specified for submodel
189 !
190  if((submodel).and.(iglobstep.eq.0)) then
191  write(*,*) '*ERROR reading *DLOAD: no global step'
192  write(*,*) ' step specified for the submodel'
193  call inputerror(inpc,ipoinpc,iline,
194  &"*DLOAD%")
195  endif
196 !
197  do
198  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
199  & ipoinp,inp,ipoinpc)
200  if((istat.lt.0).or.(key.eq.1)) return
201 !
202  read(textpart(2)(1:20),'(a20)',iostat=istat) label
203 !
204 ! for submodels the load label is modified and the global
205 ! step is stored in iamload(1,*)
206 !
207  if(submodel) then
208  label(3:4)='SM'
209  iamplitude=iglobstep
210  endif
211 !
212  if(label(3:4).ne.'NP') then
213  read(textpart(3)(1:20),'(f20.0)',iostat=istat) xmagnitude
214  else
215  read(textpart(3)(1:10),'(i10)',iostat=istat) node
216  endif
217  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
218  &"*DLOAD%")
219  if(label(1:7).eq.'CENTRIF') then
220  do i=1,3
221  read(textpart(i+3)(1:20),'(f20.0)',iostat=istat) p1(i)
222  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
223  &"*DLOAD%")
224  enddo
225  do i=1,3
226  read(textpart(i+6)(1:20),'(f20.0)',iostat=istat) p2(i)
227  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
228  &"*DLOAD%")
229  enddo
230  dd=dsqrt(p2(1)**2+p2(2)**2+p2(3)**2)
231  do i=1,3
232  p2(i)=p2(i)/dd
233  enddo
234  elseif(label(1:4).eq.'GRAV') then
235  do i=1,3
236  read(textpart(i+3)(1:20),'(f20.0)',iostat=istat) bodyf(i)
237  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
238  &"*DLOAD%")
239  enddo
240  elseif(label(1:6).eq.'NEWTON') then
241  if(iperturb.le.1) then
242  write(*,*) '*ERROR reading *DLOAD: NEWTON gravity force'
243  write(*,*) ' can only be used in a nonlinear'
244  write(*,*) ' procedure'
245  call exit(201)
246  endif
247  if(physcon(3).le.0.d0) then
248  write(*,*) '*ERROR reading *DLOAD: NEWTON gravity force'
249  write(*,*) ' requires the definition of a'
250  write(*,*) ' positive gravity constant with'
251  write(*,*) ' a *PHYSICAL CONSTANTS card'
252  call exit(201)
253  endif
254  elseif(((label(1:2).ne.'P1').and.(label(1:2).ne.'P2').and.
255  & (label(1:2).ne.'P3').and.(label(1:2).ne.'P4').and.
256  & (label(1:2).ne.'P5').and.(label(1:2).ne.'P6').and.
257  & (label(1:2).ne.'P ').and.(label(1:2).ne.'BX').and.
258  & (label(1:2).ne.'BY').and.(label(1:2).ne.'BZ').and.
259 cBernhardiStart
260  & (label(1:2).ne.'ED')).or.
261  & ((label(3:6).ne.'NOR1').and.(label(3:6).ne.'NOR2').and.
262  & (label(3:6).ne.'NOR3').and.(label(3:6).ne.'NOR4')).and.
263 cBernhardiEnd
264  & ((label(3:4).ne.' ').and.(label(3:4).ne.'NU').and.
265  & (label(3:4).ne.'NP').and.(label(3:4).ne.'SM'))) then
266  call inputerror(inpc,ipoinpc,iline,
267  &"*DLOAD%")
268  endif
269 !
270  read(textpart(1)(1:10),'(i10)',iostat=istat) l
271  if(istat.eq.0) then
272  if(l.gt.ne) then
273  write(*,*) '*ERROR reading *DLOAD: element ',l
274  write(*,*) ' is not defined'
275  call exit(201)
276  endif
277  if((label(1:7).eq.'CENTRIF').or.(label(1:4).eq.'GRAV').or.
278  & (label(1:6).eq.'NEWTON')) then
279  elset(1:80)=textpart(1)(1:80)
280  elset(81:81)=' '
281  call bodyadd(cbody,ibody,xbody,nbody,nbody_,elset,label,
282  & iamplitude,xmagnitude,p1,p2,bodyf,xbodyold,lc,idefbody)
283  else
284  xxmagnitude=xmagnitude
285  if((lakon(l)(1:2).eq.'CP').or.
286  & (lakon(l)(2:2).eq.'A').or.
287  & (lakon(l)(7:7).eq.'E').or.
288  & (lakon(l)(7:7).eq.'S').or.
289  & (lakon(l)(7:7).eq.'A')) then
290  if(label(1:2).eq.'P1') then
291  label(1:2)='P3'
292  elseif(label(1:2).eq.'P2') then
293  label(1:2)='P4'
294  elseif(label(1:2).eq.'P3') then
295  label(1:2)='P5'
296  elseif(label(1:2).eq.'P4') then
297  label(1:2)='P6'
298  endif
299  elseif((lakon(l)(1:1).eq.'B').or.
300  & (lakon(l)(7:7).eq.'B')) then
301  if(label(1:2).eq.'P2') label(1:2)='P5'
302  elseif((lakon(l)(1:1).eq.'S').or.
303  & (lakon(l)(7:7).eq.'L')) then
304 c BernhardiStart
305  if(label(1:6).eq.'EDNOR1') then
306  label(1:2)='P3'
307  edgeload=.true.
308  elseif(label(1:6).eq.'EDNOR2') then
309  label(1:2)='P4'
310  edgeload=.true.
311  elseif(label(1:6).eq.'EDNOR3') then
312  label(1:2)='P5'
313  edgeload=.true.
314  elseif(label(1:6).eq.'EDNOR4') then
315  label(1:2)='P6'
316  edgeload=.true.
317  else
318  label(1:2)='P1'
319  endif
320 !
321 ! EDNOR is an edge load
322 !
323  if(edgeload) then
324  indexe=ipkon(l)
325  thickness=0.d0
326  do k=1,mi(3)
327  if(ielmat(k,l).ne.0) then
328  thickness=thickness+thicke(k,indexe+1)
329  else
330  exit
331  endif
332  enddo
333  xxmagnitude=xmagnitude/thickness
334  endif
335 c BernhardiEnd
336  endif
337  if(lc.ne.1) then
338  jsector=isector+maxsectors
339  else
340  jsector=isector
341  endif
342  if(label(3:4).ne.'NP') then
343  call loadadd(l,label,xxmagnitude,nelemload,sideload,
344  & xload,nload,nload_,iamload,iamplitude,
345  & nam,jsector,idefload)
346  else
347  call loadaddp(l,label,nelemload,sideload,
348  & xload,nload,nload_,iamload,iamplitude,
349  & nam,node)
350  endif
351  endif
352  else
353  read(textpart(1)(1:80),'(a80)',iostat=istat) elset
354  elset(81:81)=' '
355  ipos=index(elset,' ')
356 !
357 ! check for element set
358 !
359  elset(ipos:ipos)='E'
360  do i=1,nset
361  if(set(i).eq.elset) exit
362  enddo
363  if(i.gt.nset) then
364 !
365 ! check for facial surface
366 !
367  surface=.true.
368  elset(ipos:ipos)='T'
369  do i=1,nset
370  if(set(i).eq.elset) exit
371  enddo
372  if(i.gt.nset) then
373  elset(ipos:ipos)=' '
374  write(*,*) '*ERROR reading *DLOAD: element set '
375  write(*,*) ' or facial surface ',elset
376  write(*,*) ' has not yet been defined. '
377  call inputerror(inpc,ipoinpc,iline,
378  & "*DLOAD%")
379  call exit(201)
380  endif
381  endif
382 !
383  if((label(1:7).eq.'CENTRIF').or.(label(1:4).eq.'GRAV').or.
384  & (label(1:6).eq.'NEWTON')) then
385  call bodyadd(cbody,ibody,xbody,nbody,nbody_,elset,label,
386  & iamplitude,xmagnitude,p1,p2,bodyf,xbodyold,lc,idefbody)
387  else
388  l=ialset(istartset(i))
389  if(surface) then
390  write(label(2:2),'(i1)') l-10*(l/10)
391  l=l/10
392  endif
393  if((lakon(l)(1:2).eq.'CP').or.
394  & (lakon(l)(2:2).eq.'A').or.
395  & (lakon(l)(7:7).eq.'E').or.
396  & (lakon(l)(7:7).eq.'S').or.
397  & (lakon(l)(7:7).eq.'A')) then
398  if(label(1:2).eq.'P1') then
399  label(1:2)='P3'
400  elseif(label(1:2).eq.'P2') then
401  label(1:2)='P4'
402  elseif(label(1:2).eq.'P3') then
403  label(1:2)='P5'
404  elseif(label(1:2).eq.'P4') then
405  label(1:2)='P6'
406  endif
407  elseif((lakon(l)(1:1).eq.'B').or.
408  & (lakon(l)(7:7).eq.'B')) then
409  if(label(1:2).eq.'P2') label(1:2)='P5'
410  elseif((lakon(l)(1:1).eq.'S').or.
411  & (lakon(l)(7:7).eq.'L')) then
412 cBernhardiStart
413  if(label(1:6).eq.'EDNOR1') then
414  label(1:2)='P3'
415  edgeload=.true.
416  elseif(label(1:6).eq.'EDNOR2') then
417  label(1:2)='P4'
418  edgeload=.true.
419  elseif(label(1:6).eq.'EDNOR3') then
420  label(1:2)='P5'
421  edgeload=.true.
422  elseif(label(1:6).eq.'EDNOR4') then
423  label(1:2)='P6'
424  edgeload=.true.
425  else
426  label(1:2)='P1'
427  endif
428 cBernhardiEnd
429  endif
430 !
431  do j=istartset(i),iendset(i)
432  if(ialset(j).gt.0) then
433  l=ialset(j)
434  if(surface) then
435  write(label(2:2),'(i1)') l-10*(l/10)
436  l=l/10
437  endif
438  xxmagnitude=xmagnitude
439 !
440 ! EDNOR is an edge load
441 !
442  if(edgeload) then
443  indexe=ipkon(l)
444  thickness=0.d0
445  do k=1,mi(3)
446  if(ielmat(k,l).ne.0) then
447  thickness=thickness+thicke(k,indexe+1)
448  else
449  exit
450  endif
451  enddo
452  xxmagnitude=xmagnitude/thickness
453  endif
454 !
455  if(lc.ne.1) then
456  jsector=isector+maxsectors
457  else
458  jsector=isector
459  endif
460  if(label(3:4).ne.'NP') then
461  call loadadd(l,label,xxmagnitude,nelemload,
462  & sideload,xload,nload,nload_,iamload,
463  & iamplitude,nam,jsector,idefload)
464  else
465  call loadaddp(l,label,nelemload,
466  & sideload,xload,nload,nload_,iamload,
467  & iamplitude,nam,node)
468  endif
469  else
470  l=ialset(j-2)
471  do
472  l=l-ialset(j)
473  if(l.ge.ialset(j-1)) exit
474  xxmagnitude=xmagnitude
475 !
476 ! EDNOR is an edge load
477 !
478  if(edgeload) then
479  indexe=ipkon(l)
480  thickness=0.d0
481  do k=1,mi(3)
482  if(ielmat(k,l).ne.0) then
483  thickness=thickness+thicke(k,indexe+1)
484  else
485  exit
486  endif
487  enddo
488  xxmagnitude=xmagnitude/thickness
489  endif
490 !
491  if(lc.ne.1) then
492  jsector=isector+maxsectors
493  else
494  jsector=isector
495  endif
496  if(label(3:4).ne.'NP') then
497  call loadadd(l,label,xxmagnitude,nelemload,
498  & sideload,xload,nload,nload_,
499  & iamload,iamplitude,nam,jsector,idefload)
500  else
501  call loadaddp(l,label,nelemload,
502  & sideload,xload,nload,nload_,
503  & iamload,iamplitude,nam,node)
504  endif
505  enddo
506  endif
507  enddo
508  endif
509  endif
510  enddo
511 !
512  return
inputwarning
subroutine inputwarning(inpc, ipoinpc, iline, text)
Definition: inputwarning.f:20
loadadd
subroutine loadadd(nelement, label, value, nelemload, sideload, xload, nload, nload_, iamload, iamplitude, nam, isector, idefload)
Definition: loadadd.f:21
bodyadd
subroutine bodyadd(cbody, ibody, xbody, nbody, nbody_, set, label, iamplitude, xmagnitude, p1, p2, bodyf, xbodyold, lc, idefbody)
Definition: bodyadd.f:21
loadaddp
subroutine loadaddp(nelement, label, nelemload, sideload, xload, nload, nload_, iamload, iamplitude, nam, node)
Definition: loadaddp.f:21
getnewline
subroutine getnewline(inpc, textpart, istat, n, key, iline, ipol, inl, ipoinp, inp, ipoinpc)
Definition: getnewline.f:21
inputerror
subroutine inputerror(inpc, ipoinpc, iline, text)
Definition: inputerror.f:20
thickness
subroutine thickness(dgdx, nobject, nodedesiboun, ndesiboun, objectset, xo, yo, zo, x, y, z, nx, ny, nz, co, ifree, ndesia, ndesib, iobject, ndesi, dgdxglob, nk)
Definition: thickness.f:22
Hosted by OpenAircraft.com, (Michigan UAV, LLC)