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

Go to the source code of this file.

Functions/Subroutines

subroutine dynresults (nk, v, ithermal, nactdof, vold, nodeboun, ndirboun, xboun, nboun, ipompc, nodempc, coefmpc, labmpc, nmpc, b, bp, veold, dtime, mi, imdnode, nmdnode, imdboun, nmdboun, imdmpc, nmdmpc, nmethod, time)
 

Function/Subroutine Documentation

◆ dynresults()

subroutine dynresults ( integer  nk,
real*8, dimension(0:mi(2),*)  v,
integer  ithermal,
integer, dimension(0:mi(2),*)  nactdof,
real*8, dimension(0:mi(2),*)  vold,
integer, dimension(*)  nodeboun,
integer, dimension(*)  ndirboun,
real*8, dimension(*)  xboun,
integer  nboun,
integer, dimension(*)  ipompc,
integer, dimension(3,*)  nodempc,
real*8, dimension(*)  coefmpc,
character*20, dimension(*)  labmpc,
integer  nmpc,
real*8, dimension(*)  b,
real*8, dimension(*)  bp,
real*8, dimension(0:mi(2),*)  veold,
real*8  dtime,
integer, dimension(*)  mi,
integer, dimension(*)  imdnode,
integer  nmdnode,
integer, dimension(*)  imdboun,
integer  nmdboun,
integer, dimension(*)  imdmpc,
integer  nmdmpc,
integer  nmethod,
real*8  time 
)
23 !
24 ! calculates the displacements or temperatures in a modal dynamics
25 ! calculation
26 !
27  implicit none
28 !
29  character*20 labmpc(*)
30 !
31  integer nodeboun(*),ndirboun(*),ipompc(*),imdnode(*),nmdnode,
32  & nodempc(3,*),nk,ithermal,i,j,index,mi(*),nactdof(0:mi(2),*),
33  & nboun,nmpc,ist,ndir,node,incrementalmpc,jmin,jmax,
34  & imdboun(*),nmdboun,imdmpc(*),nmdmpc,nmethod
35 !
36  real*8 v(0:mi(2),*),vold(0:mi(2),*),xboun(*),coefmpc(*),
37  & fixed_disp,b(*),veold(0:mi(2),*),bp(*),dtime,time,omega
38 !
39 ! omega is needed to calculated the velocity in steady state
40 ! dynamics calculations
41 !
42  omega=8.d0*datan(1.d0)*time
43 !
44  if(ithermal.le.1) then
45  jmin=1
46  jmax=3
47  elseif(ithermal.eq.2) then
48  jmin=0
49  jmax=min(2,mi(2))
50  else
51  jmin=0
52  jmax=3
53  endif
54 !
55 ! output for all nodes
56 !
57  if(nmdnode.eq.0) then
58 !
59 ! extracting the displacement information from the solution
60 !
61  do i=1,nk
62  do j=jmin,jmax
63  if(nactdof(j,i).gt.0) then
64  v(j,i)=b(nactdof(j,i))
65 c vold(j,i)=b(nactdof(j,i))
66  else
67  v(j,i)=0.d0
68 c vold(j,i)=0.d0
69  endif
70  enddo
71  enddo
72 !
73 ! inserting the boundary conditions
74 !
75  do i=1,nboun
76  if(ndirboun(i).gt.3) cycle
77  fixed_disp=xboun(i)
78  v(ndirboun(i),nodeboun(i))=fixed_disp
79 c vold(ndirboun(i),nodeboun(i))=fixed_disp
80  enddo
81 !
82 ! inserting the mpc information
83 ! the parameter incrementalmpc indicates whether the
84 ! incremental displacements enter the mpc or the total
85 ! displacements (incrementalmpc=0)
86 !
87  do i=1,nmpc
88  if((labmpc(i)(1:20).eq.' ').or.
89  & (labmpc(i)(1:6).eq.'CYCLIC').or.
90  & (labmpc(i)(1:9).eq.'SUBCYCLIC')) then
91  incrementalmpc=0
92  else
93  incrementalmpc=1
94  endif
95  ist=ipompc(i)
96  node=nodempc(1,ist)
97  ndir=nodempc(2,ist)
98  if(ndir.eq.0) then
99  if(ithermal.lt.2) cycle
100  else
101  if(ithermal.eq.2) cycle
102  endif
103  index=nodempc(3,ist)
104  fixed_disp=0.d0
105  if(index.ne.0) then
106  do
107  if(incrementalmpc.eq.0) then
108  fixed_disp=fixed_disp-coefmpc(index)*
109  & v(nodempc(2,index),nodempc(1,index))
110  else
111  fixed_disp=fixed_disp-coefmpc(index)*
112  & (v(nodempc(2,index),nodempc(1,index))-
113  & vold(nodempc(2,index),nodempc(1,index)))
114  endif
115  index=nodempc(3,index)
116  if(index.eq.0) exit
117  enddo
118  endif
119  fixed_disp=fixed_disp/coefmpc(ist)
120  if(incrementalmpc.eq.1) then
121  fixed_disp=fixed_disp+vold(ndir,node)
122  endif
123  v(ndir,node)=fixed_disp
124 c vold(ndir,node)=fixed_disp
125  enddo
126 !
127 ! extracting the velocity information from the solution
128 !
129  if(nmethod.eq.4) then
130  do i=1,nk
131  do j=jmin,jmax
132  if(nactdof(j,i).gt.0) then
133  veold(j,i)=bp(nactdof(j,i))
134  else
135  veold(j,i)=0.d0
136  endif
137  enddo
138  enddo
139 !
140 ! inserting the boundary conditions
141 !
142  do i=1,nboun
143  if(ndirboun(i).gt.3) cycle
144  fixed_disp=xboun(i)
145  veold(ndirboun(i),nodeboun(i))=
146  & (fixed_disp-vold(ndirboun(i),nodeboun(i)))/dtime
147  enddo
148 !
149 ! inserting the mpc information
150 ! the parameter incrementalmpc indicates whether the
151 ! incremental displacements enter the mpc or the total
152 ! displacements (incrementalmpc=0)
153 !
154  do i=1,nmpc
155  if((labmpc(i)(1:20).eq.' ').or.
156  & (labmpc(i)(1:6).eq.'CYCLIC').or.
157  & (labmpc(i)(1:9).eq.'SUBCYCLIC')) then
158  incrementalmpc=0
159  else
160  incrementalmpc=1
161  endif
162  ist=ipompc(i)
163  node=nodempc(1,ist)
164  ndir=nodempc(2,ist)
165  if(ndir.eq.0) then
166  if(ithermal.lt.2) cycle
167  else
168  if(ithermal.eq.2) cycle
169  endif
170  index=nodempc(3,ist)
171  fixed_disp=0.d0
172  if(index.ne.0) then
173  do
174  fixed_disp=fixed_disp-coefmpc(index)*
175  & veold(nodempc(2,index),nodempc(1,index))
176  index=nodempc(3,index)
177  if(index.eq.0) exit
178  enddo
179  endif
180  veold(ndir,node)=fixed_disp/coefmpc(ist)
181  enddo
182 !
183 ! extracting the velocity information from the solution
184 !
185  elseif(nmethod.eq.5) then
186  do i=1,nk
187  do j=jmin,jmax
188  if(nactdof(j,i).gt.0) then
189  veold(j,i)=bp(nactdof(j,i))*omega
190  else
191  veold(j,i)=0.d0
192  endif
193  enddo
194  enddo
195 !
196 ! inserting the boundary conditions
197 !
198  do i=1,nboun
199  if(ndirboun(i).gt.3) cycle
200  veold(ndirboun(i),nodeboun(i))=xboun(i)*omega
201  enddo
202 !
203 ! inserting the mpc information
204 ! the parameter incrementalmpc indicates whether the
205 ! incremental displacements enter the mpc or the total
206 ! displacements (incrementalmpc=0)
207 !
208  do i=1,nmpc
209  if((labmpc(i)(1:20).eq.' ').or.
210  & (labmpc(i)(1:6).eq.'CYCLIC').or.
211  & (labmpc(i)(1:9).eq.'SUBCYCLIC')) then
212  incrementalmpc=0
213  else
214  incrementalmpc=1
215  endif
216  ist=ipompc(i)
217  node=nodempc(1,ist)
218  ndir=nodempc(2,ist)
219  if(ndir.eq.0) then
220  if(ithermal.lt.2) cycle
221  else
222  if(ithermal.eq.2) cycle
223  endif
224  index=nodempc(3,ist)
225  fixed_disp=0.d0
226  if(index.ne.0) then
227  do
228  fixed_disp=fixed_disp-coefmpc(index)*
229  & veold(nodempc(2,index),nodempc(1,index))
230  index=nodempc(3,index)
231  if(index.eq.0) exit
232  enddo
233  endif
234  veold(ndir,node)=fixed_disp/coefmpc(ist)
235  enddo
236  endif
237 !
238  do i=1,nk
239  do j=jmin,jmax
240  vold(j,i)=v(j,i)
241  enddo
242  enddo
243 !
244 ! output for a selected number of nodes (fields imdnode,
245 ! imdboun and imdmpc)
246 !
247  else
248 !
249 ! extracting the displacement information from the solution
250 !
251  do i=1,nmdnode
252  do j=jmin,jmax
253  if(nactdof(j,imdnode(i)).gt.0) then
254  v(j,imdnode(i))=b(nactdof(j,imdnode(i)))
255 c vold(j,imdnode(i))=b(nactdof(j,imdnode(i)))
256  else
257  v(j,imdnode(i))=0.d0
258 c vold(j,imdnode(i))=0.d0
259  endif
260  enddo
261  enddo
262 !
263 ! inserting the boundary conditions
264 !
265  do j=1,nmdboun
266  i=imdboun(j)
267  if(ndirboun(i).gt.3) cycle
268  fixed_disp=xboun(i)
269  v(ndirboun(i),nodeboun(i))=fixed_disp
270 c vold(ndirboun(i),nodeboun(i))=fixed_disp
271  enddo
272 !
273 ! inserting the mpc information
274 ! the parameter incrementalmpc indicates whether the
275 ! incremental displacements enter the mpc or the total
276 ! displacements (incrementalmpc=0)
277 !
278  do j=1,nmdmpc
279  i=imdmpc(j)
280  if((labmpc(i)(1:20).eq.' ').or.
281  & (labmpc(i)(1:6).eq.'CYCLIC').or.
282  & (labmpc(i)(1:9).eq.'SUBCYCLIC')) then
283  incrementalmpc=0
284  else
285  incrementalmpc=1
286  endif
287  ist=ipompc(i)
288  node=nodempc(1,ist)
289  ndir=nodempc(2,ist)
290  if(ndir.eq.0) then
291  if(ithermal.lt.2) cycle
292  else
293  if(ithermal.eq.2) cycle
294  endif
295  index=nodempc(3,ist)
296  fixed_disp=0.d0
297  if(index.ne.0) then
298  do
299  if(incrementalmpc.eq.0) then
300  fixed_disp=fixed_disp-coefmpc(index)*
301  & v(nodempc(2,index),nodempc(1,index))
302  else
303  fixed_disp=fixed_disp-coefmpc(index)*
304  & (v(nodempc(2,index),nodempc(1,index))-
305  & vold(nodempc(2,index),nodempc(1,index)))
306  endif
307  index=nodempc(3,index)
308  if(index.eq.0) exit
309  enddo
310  endif
311  fixed_disp=fixed_disp/coefmpc(ist)
312  if(incrementalmpc.eq.1) then
313  fixed_disp=fixed_disp+vold(ndir,node)
314  endif
315  v(ndir,node)=fixed_disp
316 c vold(ndir,node)=fixed_disp
317  enddo
318 !
319 ! extracting the velocity information from the solution
320 !
321  if(nmethod.eq.4) then
322  do i=1,nmdnode
323  do j=jmin,jmax
324  if(nactdof(j,imdnode(i)).gt.0) then
325  veold(j,imdnode(i))=bp(nactdof(j,imdnode(i)))
326  else
327  veold(j,imdnode(i))=0.d0
328  endif
329  enddo
330  enddo
331 !
332 ! inserting the boundary conditions
333 !
334  do j=1,nmdboun
335  i=imdboun(j)
336  if(ndirboun(i).gt.3) cycle
337  fixed_disp=xboun(i)
338  veold(ndirboun(i),nodeboun(i))=
339  & (fixed_disp-vold(ndirboun(i),nodeboun(i)))/dtime
340  enddo
341 !
342 ! inserting the mpc information
343 ! the parameter incrementalmpc indicates whether the
344 ! incremental displacements enter the mpc or the total
345 ! displacements (incrementalmpc=0)
346 !
347  do j=1,nmdmpc
348  i=imdmpc(j)
349  if((labmpc(i)(1:20).eq.' ').or.
350  & (labmpc(i)(1:6).eq.'CYCLIC').or.
351  & (labmpc(i)(1:9).eq.'SUBCYCLIC')) then
352  incrementalmpc=0
353  else
354  incrementalmpc=1
355  endif
356  ist=ipompc(i)
357  node=nodempc(1,ist)
358  ndir=nodempc(2,ist)
359  if(ndir.eq.0) then
360  if(ithermal.lt.2) cycle
361  else
362  if(ithermal.eq.2) cycle
363  endif
364  index=nodempc(3,ist)
365  fixed_disp=0.d0
366  if(index.ne.0) then
367  do
368  fixed_disp=fixed_disp-coefmpc(index)*
369  & veold(nodempc(2,index),nodempc(1,index))
370  index=nodempc(3,index)
371  if(index.eq.0) exit
372  enddo
373  endif
374  veold(ndir,node)=fixed_disp/coefmpc(ist)
375  enddo
376  elseif(nmethod.eq.5) then
377  do i=1,nmdnode
378  do j=jmin,jmax
379  if(nactdof(j,imdnode(i)).gt.0) then
380  veold(j,imdnode(i))=bp(nactdof(j,imdnode(i)))*omega
381  else
382  veold(j,imdnode(i))=0.d0
383  endif
384  enddo
385  enddo
386 !
387 ! inserting the boundary conditions
388 !
389  do j=1,nmdboun
390  i=imdboun(j)
391  if(ndirboun(i).gt.3) cycle
392  veold(ndirboun(i),nodeboun(i))=xboun(i)*omega
393  enddo
394 !
395 ! inserting the mpc information
396 ! the parameter incrementalmpc indicates whether the
397 ! incremental displacements enter the mpc or the total
398 ! displacements (incrementalmpc=0)
399 !
400  do j=1,nmdmpc
401  i=imdmpc(j)
402  if((labmpc(i)(1:20).eq.' ').or.
403  & (labmpc(i)(1:6).eq.'CYCLIC').or.
404  & (labmpc(i)(1:9).eq.'SUBCYCLIC')) then
405  incrementalmpc=0
406  else
407  incrementalmpc=1
408  endif
409  ist=ipompc(i)
410  node=nodempc(1,ist)
411  ndir=nodempc(2,ist)
412  if(ndir.eq.0) then
413  if(ithermal.lt.2) cycle
414  else
415  if(ithermal.eq.2) cycle
416  endif
417  index=nodempc(3,ist)
418  fixed_disp=0.d0
419  if(index.ne.0) then
420  do
421  fixed_disp=fixed_disp-coefmpc(index)*
422  & veold(nodempc(2,index),nodempc(1,index))
423  index=nodempc(3,index)
424  if(index.eq.0) exit
425  enddo
426  endif
427  veold(ndir,node)=fixed_disp/coefmpc(ist)
428  enddo
429  endif
430 !
431  do i=1,nmdnode
432  do j=jmin,jmax
433  vold(j,imdnode(i))=v(j,imdnode(i))
434  enddo
435  enddo
436  endif
437 !
438  return
min
#define min(a, b)
Definition: cascade.c:31
Hosted by OpenAircraft.com, (Michigan UAV, LLC)