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

Go to the source code of this file.

Functions/Subroutines

subroutine tempload (xforcold, xforc, xforcact, iamforc, nforc, xloadold, xload, xloadact, iamload, nload, ibody, xbody, nbody, xbodyold, xbodyact, t1old, t1, t1act, iamt1, nk, amta, namta, nam, ampli, time, reltime, ttime, dtime, ithermal, nmethod, xbounold, xboun, xbounact, iamboun, nboun, nodeboun, ndirboun, nodeforc, ndirforc, istep, iinc, co, vold, itg, ntg, amname, ikboun, ilboun, nelemload, sideload, mi, ntrans, trab, inotr, veold, integerglob, doubleglob, tieset, istartset, iendset, ialset, ntie, nmpc, ipompc, ikmpc, ilmpc, nodempc, coefmpc, ipobody, iponoel, inoel)
 

Function/Subroutine Documentation

◆ tempload()

subroutine tempload ( real*8, dimension(*)  xforcold,
real*8, dimension(*)  xforc,
real*8, dimension(*)  xforcact,
integer, dimension(*)  iamforc,
integer  nforc,
real*8, dimension(2,*)  xloadold,
real*8, dimension(2,*)  xload,
real*8, dimension(2,*)  xloadact,
integer, dimension(2,*)  iamload,
integer  nload,
integer, dimension(3,*)  ibody,
real*8, dimension(7,*)  xbody,
integer  nbody,
real*8, dimension(7,*)  xbodyold,
real*8, dimension(7,*)  xbodyact,
real*8, dimension(*)  t1old,
real*8, dimension(*)  t1,
real*8, dimension(*)  t1act,
integer, dimension(*)  iamt1,
integer  nk,
real*8, dimension(2,*)  amta,
integer, dimension(3,*)  namta,
integer  nam,
real*8, dimension(*)  ampli,
real*8  time,
real*8  reltime,
real*8  ttime,
real*8  dtime,
integer  ithermal,
integer  nmethod,
real*8, dimension(*)  xbounold,
real*8, dimension(*)  xboun,
real*8, dimension(*)  xbounact,
integer, dimension(*)  iamboun,
integer  nboun,
integer, dimension(*)  nodeboun,
integer, dimension(*)  ndirboun,
integer, dimension(2,*)  nodeforc,
integer, dimension(*)  ndirforc,
integer  istep,
integer  iinc,
real*8, dimension(3,*)  co,
real*8, dimension(0:mi(2),*)  vold,
integer, dimension(*)  itg,
integer  ntg,
character*80, dimension(*)  amname,
integer, dimension(*)  ikboun,
integer, dimension(*)  ilboun,
integer, dimension(2,*)  nelemload,
character*20, dimension(*)  sideload,
integer, dimension(*)  mi,
integer  ntrans,
real*8, dimension(7,*)  trab,
integer, dimension(2,*)  inotr,
real*8, dimension(0:mi(2),*)  veold,
integer, dimension(*)  integerglob,
real*8, dimension(*)  doubleglob,
character*81, dimension(3,*)  tieset,
integer, dimension(*)  istartset,
integer, dimension(*)  iendset,
integer, dimension(*)  ialset,
integer  ntie,
integer  nmpc,
integer, dimension(*)  ipompc,
integer, dimension(*)  ikmpc,
integer, dimension(*)  ilmpc,
integer, dimension(3,*)  nodempc,
real*8, dimension(*)  coefmpc,
integer, dimension(2,*)  ipobody,
integer, dimension(*)  iponoel,
integer, dimension(2,*)  inoel 
)
29 !
30 ! calculates the loading at a given time
31 !
32  implicit none
33 !
34  logical gasnode
35 !
36  character*1 entity
37  character*20 sideload(*)
38  character*80 amname(*)
39  character*81 tieset(3,*)
40 !
41  integer iamforc(*),iamload(2,*),iamt1(*),nelemload(2,*),
42  & nam,i,istart,iend,id,nforc,nload,nk,namta(3,*),ithermal,
43  & nmethod,iamt1i,iamboun(*),nboun,iamforci,iambouni,
44  & iamloadi1,iamloadi2,ibody(3,*),itg(*),ntg,idof,one,
45  & nbody,iambodyi,nodeboun(*),ndirboun(*),nodeforc(2,*),
46  & ndirforc(*),istep,iinc,msecpt,node,j,ikboun(*),ilboun(*),
47  & ipresboun,mi(*),ntrans,inotr(2,*),idummy,integerglob(*),
48  & istartset(*),iendset(*),ialset(*),ntie,iselect(1),
49  & nmpc,ikmpc(*),ilmpc(*),nodempc(3,*),k,ist,index,ipompc(*),
50  & ipobody(2,*),iponoel(*),inoel(2,*)
51 !
52  real*8 xforc(*),xforcact(*),xload(2,*),xloadact(2,*),
53  & t1(*),t1act(*),amta(2,*),ampli(*),time,fixed_temp,
54  & xforcold(*),xloadold(2,*),t1old(*),reltime,coefmpc(*),
55  & xbounold(*),xboun(*),xbounact(*),ttime,dtime,reftime,
56  & xbody(7,*),xbodyold(7,*),xbodyact(7,*),co(3,*),
57  & vold(0:mi(2),*),abqtime(2),coords(3),trab(7,*),
58  & veold(0:mi(2),*),ddummy,doubleglob(*)
59 !
60  data msecpt /1/
61  data one /1/
62 !
63 ! if an amplitude is active, the loading is scaled according to
64 ! the actual time. If no amplitude is active, then the load is
65 ! - scaled according to the relative time for a static step
66 ! - applied as a step loading for a dynamic step
67 !
68 ! calculating all amplitude values for the current time
69 !
70  do i=1,nam
71  if(namta(3,i).lt.0) then
72  reftime=ttime+time
73  else
74  reftime=time
75  endif
76  if(abs(namta(3,i)).ne.i) then
77  reftime=reftime-amta(1,namta(1,i))
78  istart=namta(1,abs(namta(3,i)))
79  iend=namta(2,abs(namta(3,i)))
80  if(istart.eq.0) then
81  call uamplitude(reftime,amname(namta(3,i)),ampli(i))
82  cycle
83  endif
84  else
85  istart=namta(1,i)
86  iend=namta(2,i)
87  if(istart.eq.0) then
88  call uamplitude(reftime,amname(i),ampli(i))
89  cycle
90  endif
91  endif
92  call identamta(amta,reftime,istart,iend,id)
93  if(id.lt.istart) then
94  ampli(i)=amta(2,istart)
95  elseif(id.eq.iend) then
96  ampli(i)=amta(2,iend)
97  else
98  ampli(i)=amta(2,id)+(amta(2,id+1)-amta(2,id))
99  & *(reftime-amta(1,id))/(amta(1,id+1)-amta(1,id))
100  endif
101  enddo
102 !
103 ! scaling the boundary conditions
104 !
105  do i=1,nboun
106  if((xboun(i).lt.1.2357111318d0).and.
107  & (xboun(i).gt.1.2357111316d0)) then
108 !
109 ! user subroutine for boundary conditions
110 !
111  node=nodeboun(i)
112 !
113 ! check whether node is a gasnode
114 !
115  gasnode=.false.
116  call nident(itg,node,ntg,id)
117  if(id.gt.0) then
118  if(itg(id).eq.node) then
119  gasnode=.true.
120  endif
121  endif
122 !
123  abqtime(1)=time
124  abqtime(2)=ttime+time
125 !
126 ! a gasnode cannot move (displacement DOFs are used
127 ! for other purposes, e.g. mass flow and pressure)
128 !
129  if(gasnode) then
130  do j=1,3
131  coords(j)=co(j,node)
132  enddo
133  else
134  do j=1,3
135 c coords(j)=co(j,node)+vold(j,node)
136  coords(j)=co(j,node)
137  enddo
138  endif
139 !
140  if(ndirboun(i).eq.0) then
141  call utemp(xbounact(i),msecpt,istep,iinc,abqtime,node,
142  & coords,vold,mi,iponoel,inoel,
143  & ipobody,xbodyact,ibody)
144  else
145  call uboun(xbounact(i),istep,iinc,abqtime,node,
146  & ndirboun(i),coords,vold,mi,iponoel,inoel,
147  & ipobody,xbodyact,ibody)
148  endif
149  cycle
150  endif
151  if((xboun(i).lt.1.9232931375d0).and.
152  & (xboun(i).gt.1.9232931373d0)) then
153 !
154 ! boundary conditions for submodel
155 !
156  node=nodeboun(i)
157 !
158 ! check whether node is a gasnode
159 !
160  gasnode=.false.
161  call nident(itg,node,ntg,id)
162  if(id.gt.0) then
163  if(itg(id).eq.node) then
164  gasnode=.true.
165  endif
166  endif
167 !
168 ! for the interpolation of submodels the undeformed
169 ! geometry is taken
170 !
171  do j=1,3
172  coords(j)=co(j,node)
173  enddo
174 !
175  entity='N'
176  one=1
177  iselect(1)=ndirboun(i)+1
178  call interpolsubmodel(integerglob,doubleglob,xbounact(i),
179  & coords,iselect,one,node,tieset,istartset,iendset,
180  & ialset,ntie,entity)
181 !
182  if(nmethod.eq.1) then
183  xbounact(i)=xbounold(i)+
184  & (xbounact(i)-xbounold(i))*reltime
185  endif
186 c write(*,*) 'tempload ',node,ndirboun(i),xbounact(i)
187  cycle
188  endif
189 !
190  if(nam.gt.0) then
191  iambouni=iamboun(i)
192  else
193  iambouni=0
194  endif
195  if(iambouni.gt.0) then
196  xbounact(i)=xboun(i)*ampli(iambouni)
197  elseif(nmethod.eq.1) then
198  xbounact(i)=xbounold(i)+
199  & (xboun(i)-xbounold(i))*reltime
200  else
201  xbounact(i)=xboun(i)
202  endif
203  enddo
204 !
205 ! scaling the loading
206 !
207  do i=1,nforc
208  if(ndirforc(i).eq.0) then
209  if((xforc(i).lt.1.2357111318d0).and.
210  & (xforc(i).gt.1.2357111316d0)) then
211 !
212 ! user subroutine for the concentrated heat flux
213 !
214  node=nodeforc(1,i)
215 !
216 ! check whether node is a gasnode
217 !
218  gasnode=.false.
219  call nident(itg,node,ntg,id)
220  if(id.gt.0) then
221  if(itg(id).eq.node) then
222  gasnode=.true.
223  endif
224  endif
225 !
226  abqtime(1)=time
227  abqtime(2)=ttime+time
228 !
229 ! a gasnode cannot move (displacement DOFs are used
230 ! for other purposes, e.g. mass flow and pressure)
231 !
232  if(gasnode) then
233  do j=1,3
234  coords(j)=co(j,node)
235  enddo
236  else
237  do j=1,3
238 c coords(j)=co(j,node)+vold(j,node)
239  coords(j)=co(j,node)
240  enddo
241  endif
242 !
243  call cflux(xforcact(i),msecpt,istep,iinc,abqtime,node,
244  & coords,vold,mi)
245  cycle
246  endif
247  else
248  if((xforc(i).lt.1.2357111318d0).and.
249  & (xforc(i).gt.1.2357111316d0)) then
250 !
251 ! user subroutine for the concentrated load
252 !
253  node=nodeforc(1,i)
254 !
255  abqtime(1)=time
256  abqtime(2)=ttime+time
257 !
258  do j=1,3
259 c coords(j)=co(j,node)+vold(j,node)
260  coords(j)=co(j,node)
261  enddo
262 !
263  call cload(xforcact(i),istep,iinc,abqtime,node,
264  & ndirforc(i),coords,vold,mi,ntrans,trab,inotr,veold)
265  cycle
266  elseif((xforc(i).lt.1.9232931375d0).and.
267  & (xforc(i).gt.1.9232931373d0)) then
268 !
269 ! boundary conditions for submodel
270 !
271  node=nodeforc(1,i)
272 !
273 ! for the interpolation of submodels the undeformed
274 ! geometry is taken
275 !
276  do j=1,3
277  coords(j)=co(j,node)
278  enddo
279 !
280  entity='N'
281  one=1
282  iselect(1)=ndirforc(i)+10
283  call interpolsubmodel(integerglob,doubleglob,xforcact(i),
284  & coords,iselect,one,node,tieset,istartset,iendset,
285  & ialset,ntie,entity)
286 !
287  if(nmethod.eq.1) then
288  xforcact(i)=xforcold(i)+
289  & (xforcact(i)-xforcold(i))*reltime
290  endif
291  cycle
292  endif
293  endif
294 !
295  if(nam.gt.0) then
296  iamforci=iamforc(i)
297  else
298  iamforci=0
299  endif
300  if(iamforci.gt.0) then
301  xforcact(i)=xforc(i)*ampli(iamforci)
302  elseif(nmethod.eq.1) then
303  xforcact(i)=xforcold(i)+
304  & (xforc(i)-xforcold(i))*reltime
305  else
306  xforcact(i)=xforc(i)
307  endif
308  enddo
309 !
310  do i=1,nload
311  ipresboun=0
312 !
313 ! check for pressure boundary conditions
314 !
315  if(sideload(i)(3:4).eq.'NP') then
316  node=nelemload(2,i)
317  idof=8*(node-1)+2
318  call nident(ikboun,idof,nboun,id)
319  if(id.gt.0) then
320  if(ikboun(id).eq.idof) then
321  ipresboun=1
322  xloadact(1,i)=xbounact(ilboun(id))
323  endif
324  endif
325  endif
326 !
327  if(ipresboun.eq.0) then
328  if(nam.gt.0) then
329  iamloadi1=iamload(1,i)
330  iamloadi2=iamload(2,i)
331  else
332  iamloadi1=0
333  iamloadi2=0
334  endif
335  if(iamloadi1.gt.0) then
336  xloadact(1,i)=xload(1,i)*ampli(iamloadi1)
337  elseif(nmethod.eq.1) then
338  xloadact(1,i)=xloadold(1,i)+
339  & (xload(1,i)-xloadold(1,i))*reltime
340  else
341  xloadact(1,i)=xload(1,i)
342  endif
343  if(iamloadi2.gt.0) then
344  xloadact(2,i)=xload(2,i)*ampli(iamloadi2)
345 c elseif(nmethod.eq.1) then
346 c xloadact(2,i)=xload(2,i)
347  else
348  xloadact(2,i)=xload(2,i)
349  endif
350  endif
351  enddo
352 !
353  do i=1,nbody
354  if(nam.gt.0) then
355  iambodyi=ibody(2,i)
356  else
357  iambodyi=0
358  endif
359  if(iambodyi.gt.0) then
360  xbodyact(1,i)=xbody(1,i)*ampli(iambodyi)
361  elseif(nmethod.eq.1) then
362  xbodyact(1,i)=xbodyold(1,i)+
363  & (xbody(1,i)-xbodyold(1,i))*reltime
364  else
365  xbodyact(1,i)=xbody(1,i)
366  endif
367  enddo
368 !
369 ! scaling the temperatures
370 !
371  if(ithermal.eq.1) then
372  do i=1,nk
373  if((t1(i).lt.1.2357111318d0).and.
374  & (t1(i).gt.1.2357111316d0)) then
375 !
376  abqtime(1)=time
377  abqtime(2)=ttime+time
378 !
379  do j=1,3
380 c coords(j)=co(j,i)+vold(j,i)
381  coords(j)=co(j,i)
382  enddo
383  call utemp(t1act(i),msecpt,istep,iinc,abqtime,i,
384  & coords,vold,mi,iponoel,inoel,
385  & ipobody,xbodyact,ibody)
386  cycle
387  endif
388 !
389  if((t1(i).lt.1.9232931375d0).and.
390  & (t1(i).gt.1.9232931373d0)) then
391 !
392 ! for the interpolation of submodels the undeformed
393 ! geometry is taken
394 !
395  do j=1,3
396  coords(j)=co(j,i)
397  enddo
398 !
399  entity='N'
400  one=1
401  iselect(1)=1
402  call interpolsubmodel(integerglob,doubleglob,t1act(i),
403  & coords,iselect,one,i,tieset,istartset,iendset,
404  & ialset,ntie,entity)
405 !
406  if(nmethod.eq.1) then
407  t1act(i)=t1old(i)+(t1act(i)-t1old(i))*reltime
408  endif
409  cycle
410  endif
411 !
412  if(nam.gt.0) then
413  iamt1i=iamt1(i)
414  else
415  iamt1i=0
416  endif
417  if(iamt1i.gt.0) then
418  t1act(i)=t1(i)*ampli(iamt1i)
419  elseif(nmethod.eq.1) then
420  t1act(i)=t1old(i)+(t1(i)-t1old(i))*reltime
421  else
422  t1act(i)=t1(i)
423  endif
424  enddo
425 !
426 ! taking temperature MPC's into account
427 !
428  do j=1,nmpc
429  k=mod(ikmpc(j),8)
430  if(k.ne.0) cycle
431  i=ilmpc(j)
432  ist=ipompc(i)
433  node=nodempc(1,ist)
434  index=nodempc(3,ist)
435  fixed_temp=0.d0
436  if(index.ne.0) then
437  do
438  fixed_temp=fixed_temp-
439  & coefmpc(index)*t1act(nodempc(1,index))
440  index=nodempc(3,index)
441  if(index.eq.0) exit
442  enddo
443  endif
444  t1act(node)=fixed_temp/coefmpc(ist)
445  enddo
446  endif
447 c write(*,*) 'nboun'
448 c do i=1,nboun
449 c write(*,'(i7,1x,e11.4,1x,e11.4)') i,xbounact(i),xboun(i)
450 c enddo
451 c write(*,*) 'nforc'
452 c do i=1,nforc
453 c write(*,'(i7,1x,e11.4,1x,e11.4)') i,xforcact(i),xforc(i)
454 c enddo
455 c write(*,*) 'nload'
456 c do i=1,nload
457 c write(*,'(i7,1x,e11.4,1x,e11.4)') i,xloadact(1,i),xload(1,i)
458 c enddo
459 !
460  return
uamplitude
subroutine uamplitude(time, name, amplitude)
Definition: uamplitude.f:20
cflux
subroutine cflux(flux, msecpt, kstep, kinc, time, node, coords, vold, mi)
Definition: cflux.f:21
utemp
subroutine utemp(temp, msecpt, kstep, kinc, time, node, coords, vold, mi, iponoel, inoel, ipobody, xbody, ibody)
Definition: utemp.f:21
identamta
subroutine identamta(amta, reftime, istart, iend, id)
Definition: identamta.f:26
nident
subroutine nident(x, px, n, id)
Definition: nident.f:26
uboun
subroutine uboun(boun, kstep, kinc, time, node, idof, coords, vold, mi, iponoel, inoel, ipobody, xbody, ibody)
Definition: uboun.f:21
cload
subroutine cload(xload, kstep, kinc, time, node, idof, coords, vold, mi, ntrans, trab, inotr, veold)
Definition: cload.f:21
interpolsubmodel
subroutine interpolsubmodel(integerglob, doubleglob, value, coords, iselect, nselect, nodeface, tieset, istartset, iendset, ialset, ntie, entity)
Definition: interpolsubmodel.f:22
Hosted by OpenAircraft.com, (Michigan UAV, LLC)