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

Go to the source code of this file.

Functions/Subroutines

subroutine resultsini_em (nk, v, ithermal, filab, iperturb, f, fn, nactdof, iout, qa, b, nodeboun, ndirboun, xboun, nboun, ipompc, nodempc, coefmpc, labmpc, nmpc, nmethod, cam, neq, veold, dtime, mi, vini, nprint, prlab, intpointvarm, calcul_fn, calcul_f, calcul_qa, calcul_cauchy, nener, ikin, intpointvart, xforc, nforc)
 

Function/Subroutine Documentation

◆ resultsini_em()

subroutine resultsini_em ( integer  nk,
real*8, dimension(0:mi(2),*)  v,
integer, dimension(2)  ithermal,
character*87, dimension(*)  filab,
integer, dimension(*)  iperturb,
real*8, dimension(*)  f,
real*8, dimension(0:mi(2),*)  fn,
integer, dimension(0:mi(2),*)  nactdof,
integer  iout,
real*8, dimension(*)  qa,
real*8, dimension(*)  b,
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,
integer  nmethod,
real*8, dimension(5)  cam,
integer  neq,
real*8, dimension(0:mi(2),*)  veold,
real*8  dtime,
integer, dimension(*)  mi,
real*8, dimension(0:mi(2),*)  vini,
integer  nprint,
character*6, dimension(*)  prlab,
integer  intpointvarm,
integer  calcul_fn,
integer  calcul_f,
integer  calcul_qa,
integer  calcul_cauchy,
integer  nener,
integer  ikin,
integer  intpointvart,
real*8, dimension(*)  xforc,
integer  nforc 
)
25 !
26 ! initialization
27 !
28 ! 1. storing the calculated primary variables nodewise
29 ! 2. inserting the boundary conditions nodewise (SPC's and MPC's)
30 ! 3. determining which derived variables (strains, stresses,
31 ! internal forces...) have to be calculated
32 !
33  implicit none
34 !
35  character*6 prlab(*)
36  character*20 labmpc(*)
37  character*87 filab(*)
38 !
39  integer mi(*),nactdof(0:mi(2),*),nodeboun(*),ndirboun(*),
40  & ipompc(*),nodempc(3,*),mt,nk,ithermal(2),i,j,
41  & nener,iperturb(*),iout,nboun,nmpc,nmethod,ist,ndir,node,index,
42  & neq,nprint,ikin,calcul_fn,nforc,
43  & calcul_f,calcul_cauchy,calcul_qa,intpointvarm,intpointvart,
44  & irefnode,irotnode,iexpnode,irefnodeprev
45 !
46  real*8 v(0:mi(2),*),vini(0:mi(2),*),f(*),fn(0:mi(2),*),
47  & cam(5),b(*),xboun(*),coefmpc(*),veold(0:mi(2),*),xforc(*),
48  & qa(*),dtime,bnac,fixed_disp
49 !
50  mt=mi(2)+1
51 !
52  if((iout.ne.2).and.(iout.gt.-1)) then
53 !
54  if((nmethod.ne.4).or.(iperturb(1).le.1)) then
55  if(ithermal(1).ne.2) then
56  do i=1,nk
57  do j=1,mi(2)
58  if(nactdof(j,i).gt.0) then
59  bnac=b(nactdof(j,i))
60  else
61  cycle
62  endif
63 c v(j,i)=v(j,i)+bnac
64  v(j,i)=bnac
65  if((iperturb(1).ne.0).and.(abs(nmethod).eq.1)) then
66  if(dabs(bnac).gt.cam(1)) then
67  cam(1)=dabs(bnac)
68  cam(4)=nactdof(j,i)-0.5d0
69  endif
70  endif
71  enddo
72  enddo
73  endif
74  if(ithermal(1).gt.1) then
75  do i=1,nk
76  if(nactdof(0,i).gt.0) then
77  bnac=b(nactdof(0,i))
78  else
79  cycle
80  endif
81  v(0,i)=v(0,i)+bnac
82 c v(0,i)=bnac
83  if((iperturb(1).ne.0).and.(abs(nmethod).eq.1)) then
84  if(dabs(bnac).gt.cam(2)) then
85  cam(2)=dabs(bnac)
86  cam(5)=nactdof(0,i)-0.5d0
87  endif
88  endif
89  enddo
90  endif
91 !
92  else
93 !
94 ! direct integration dynamic step
95 ! b contains the acceleration increment
96 !
97  if(ithermal(1).ne.2) then
98  do i=1,nk
99  do j=1,mi(2)
100  veold(j,i)=0.d0
101  if(nactdof(j,i).gt.0) then
102  bnac=b(nactdof(j,i))
103  else
104  cycle
105  endif
106 c v(j,i)=v(j,i)+bnac
107  v(j,i)=bnac
108  if(dabs(bnac).gt.cam(1)) then
109  cam(1)=dabs(bnac)
110  cam(4)=nactdof(j,i)-0.5d0
111  endif
112  enddo
113  enddo
114  endif
115  if(ithermal(1).gt.1) then
116  do i=1,nk
117  veold(0,i)=0.d0
118  if(nactdof(0,i).gt.0) then
119  bnac=b(nactdof(0,i))
120  else
121  cycle
122  endif
123  v(0,i)=v(0,i)+bnac
124  if(dabs(bnac).gt.cam(2)) then
125  cam(2)=dabs(bnac)
126  cam(5)=nactdof(0,i)-0.5d0
127  endif
128  cam(3)=max(cam(3),dabs(v(0,i)-vini(0,i)))
129  enddo
130  endif
131  endif
132 !
133  endif
134 !
135 ! initialization
136 !
137  calcul_fn=0
138  calcul_f=0
139  calcul_qa=0
140  calcul_cauchy=0
141 !
142 ! determining which quantities have to be calculated
143 !
144  if((iperturb(1).ge.2).or.((iperturb(1).le.0).and.(iout.lt.0)))
145  & then
146  if((iout.lt.1).and.(iout.gt.-2)) then
147  calcul_fn=1
148  calcul_f=1
149  calcul_qa=1
150  elseif((iout.ne.-2).and.(iperturb(2).eq.1)) then
151  calcul_cauchy=1
152  endif
153  endif
154 !
155  if(iout.gt.0) then
156  if((filab(5)(1:4).eq.'RF ').or.
157  & (filab(10)(1:4).eq.'RFL ')) then
158  calcul_fn=1
159  else
160  do i=1,nprint
161  if((prlab(i)(1:4).eq.'RF ').or.
162  & (prlab(i)(1:4).eq.'RFL ')) then
163  calcul_fn=1
164  exit
165  endif
166  enddo
167  endif
168  endif
169 !
170 ! check whether user-defined concentrated forces were defined
171 !
172  do i=1,nforc
173  if((xforc(i).lt.1.2357111318d0).and.
174  & (xforc(i).gt.1.2357111316d0)) then
175  calcul_fn=1
176  exit
177  endif
178  enddo
179 !
180 ! initializing fn
181 !
182  if(calcul_fn.eq.1) then
183  do i=1,nk
184  do j=0,mi(2)
185  fn(j,i)=0.d0
186  enddo
187  enddo
188  endif
189 !
190 ! initializing f
191 !
192  if(calcul_f.eq.1) then
193  do i=1,neq
194  f(i)=0.d0
195  enddo
196  endif
197 !
198 ! SPC's and MPC's have to be taken into account for
199 ! iout=0,1 and -1
200 !
201  if(abs(iout).lt.2) then
202 !
203 ! inserting the boundary conditions
204 !
205  do i=1,nboun
206  if(ndirboun(i).gt.mi(2)) cycle
207  fixed_disp=xboun(i)
208 c if((nmethod.eq.4).and.(iperturb(1).gt.1)) then
209 c ndir=ndirboun(i)
210 c node=nodeboun(i)
211 c veold(ndir,node)=(xboun(i)-v(ndir,node))/dtime
212 c endif
213  v(ndirboun(i),nodeboun(i))=fixed_disp
214  enddo
215 !
216 ! inserting the mpc information
217 !
218  do i=1,nmpc
219  ist=ipompc(i)
220  node=nodempc(1,ist)
221  ndir=nodempc(2,ist)
222  if(ndir.eq.0) then
223  if(ithermal(1).lt.2) cycle
224  elseif(ndir.gt.mi(2)) then
225  cycle
226  else
227  if(ithermal(1).eq.2) cycle
228  endif
229  index=nodempc(3,ist)
230  fixed_disp=0.d0
231  if(index.ne.0) then
232  do
233  fixed_disp=fixed_disp-coefmpc(index)*
234  & v(nodempc(2,index),nodempc(1,index))
235  index=nodempc(3,index)
236  if(index.eq.0) exit
237  enddo
238  endif
239  fixed_disp=fixed_disp/coefmpc(ist)
240  v(ndir,node)=fixed_disp
241  enddo
242  endif
243 !
244 ! storing the knot information in the .dat-file
245 !
246  irefnodeprev=0
247  do i=1,nmpc
248  if(iout.gt.0) then
249  if(labmpc(i)(1:4).eq.'KNOT') then
250  irefnode=nodempc(1,nodempc(3,ipompc(i)))
251  if(irefnode.ne.irefnodeprev) then
252  irefnodeprev=irefnode
253  iexpnode=nodempc(1,nodempc(3,nodempc(3,ipompc(i))))
254  if(labmpc(i)(5:5).ne.'2') then
255  irotnode=nodempc(1,nodempc(3,nodempc(3,
256  & nodempc(3,ipompc(i)))))
257  else
258  irotnode=nodempc(1,nodempc(3,nodempc(3,
259  & nodempc(3,nodempc(3,nodempc(3,ipompc(i)))))))
260  endif
261 c write(5,*)
262 c write(5,'(a5)') labmpc(i)(1:5)
263 c write(5,'("tra",i5,3(1x,e11.4))')
264 c & irefnode,(v(j,irefnode),j=1,3)
265 c write(5,'("rot",i5,3(1x,e11.4))')
266 c & irotnode,(v(j,irotnode),j=1,3)
267 c if(labmpc(i)(5:5).eq.'2') then
268 c write(5,'("exp",i5,3(1x,e11.4))')
269 c & iexpnode,(v(j,iexpnode),j=1,3)
270 c else
271 c write(5,'("exp",i5,3(1x,e11.4))')
272 c & iexpnode,v(1,iexpnode)
273 c endif
274  endif
275  endif
276  endif
277  enddo
278 !
279 ! check whether there are any strain output requests
280 !
281  nener=0
282  ikin=0
283  if((filab(7)(1:4).eq.'ENER').or.(filab(27)(1:4).eq.'CELS')) then
284  nener=1
285  endif
286 
287  do i=1,nprint
288  if((prlab(i)(1:4).eq.'ENER').or.(prlab(i)(1:4).eq.'ELSE').or.
289  & (prlab(i)(1:4).eq.'CELS')) then
290  nener=1
291  elseif(prlab(i)(1:4).eq.'ELKE') then
292  ikin=1
293  endif
294  enddo
295 !
296  qa(1)=0.d0
297  qa(2)=0.d0
298 !
299 ! check whether integration point variables are needed in
300 ! modal dynamics and steady state dynamics calculations
301 !
302  intpointvarm=1
303  intpointvart=1
304 !
305  if((nmethod.ge.4).and.(iperturb(1).lt.2)) then
306  intpointvarm=0
307  if((filab(3)(1:4).eq.'S ').or.
308  & (filab(4)(1:4).eq.'E ').or.
309  & (filab(5)(1:4).eq.'RF ').or.
310  & (filab(6)(1:4).eq.'PEEQ').or.
311  & (filab(7)(1:4).eq.'ENER').or.
312  & (filab(8)(1:4).eq.'SDV ').or.
313  & (filab(13)(1:4).eq.'ZZS ').or.
314  & (filab(13)(1:4).eq.'ERR ').or.
315  & (filab(18)(1:4).eq.'PHS ').or.
316  & (filab(20)(1:4).eq.'MAXS').or.
317  & (filab(26)(1:4).eq.'CONT').or.
318  & (filab(27)(1:4).eq.'CELS')) intpointvarm=1
319  do i=1,nprint
320  if((prlab(i)(1:4).eq.'S ').or.
321  & (prlab(i)(1:4).eq.'E ').or.
322  & (prlab(i)(1:4).eq.'PEEQ').or.
323  & (prlab(i)(1:4).eq.'ENER').or.
324  & (prlab(i)(1:4).eq.'ELKE').or.
325  & (prlab(i)(1:4).eq.'CDIS').or.
326  & (prlab(i)(1:4).eq.'CSTR').or.
327  & (prlab(i)(1:4).eq.'CELS').or.
328  & (prlab(i)(1:4).eq.'SDV ').or.
329  & (prlab(i)(1:4).eq.'RF ')) then
330  intpointvarm=1
331  exit
332  endif
333  enddo
334 !
335  intpointvart=0
336  if((filab(9)(1:4).eq.'HFL ').or.
337  & (filab(10)(1:4).eq.'RFL ')) intpointvart=1
338  do i=1,nprint
339  if((prlab(i)(1:4).eq.'HFL ').or.
340  & (prlab(i)(1:4).eq.'RFL ')) intpointvart=1
341  enddo
342 !
343 ! if internal forces are requested integration point
344 ! values have to be calculated
345 !
346  if(calcul_fn.eq.1) then
347  intpointvarm=1
348  intpointvart=1
349  endif
350  endif
351 !
352  return
max
#define max(a, b)
Definition: cascade.c:32
Hosted by OpenAircraft.com, (Michigan UAV, LLC)