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

Go to the source code of this file.

Functions/Subroutines

subroutine frdfluid (co, nk, konf, ipkonf, lakonf, nef, vold, kode, time, ielmat, matname, filab, inum, ntrans, inotr, trab, mi, istep, stn, qfn, nactdohinv, xmach, xkappa, physcon, xturb)
 

Function/Subroutine Documentation

◆ frdfluid()

subroutine frdfluid ( real*8, dimension(3,*)  co,
integer  nk,
integer, dimension(*)  konf,
integer, dimension(*)  ipkonf,
character*8, dimension(*)  lakonf,
integer  nef,
real*8, dimension(0:mi(2),*)  vold,
integer  kode,
real*8  time,
integer, dimension(mi(3),*)  ielmat,
character*80, dimension(*)  matname,
character*87, dimension(*)  filab,
integer, dimension(*)  inum,
integer  ntrans,
integer, dimension(2,*)  inotr,
real*8, dimension(7,*)  trab,
integer, dimension(*)  mi,
integer  istep,
real*8, dimension(6,*)  stn,
real*8, dimension(3,*)  qfn,
integer, dimension(*)  nactdohinv,
real*8, dimension(*)  xmach,
real*8, dimension(*)  xkappa,
real*8, dimension(*)  physcon,
real*8, dimension(2,*)  xturb 
)
22 !
23 ! stores the results in frd format
24 !
25  implicit none
26 !
27  character*1 c
28  character*3 m1,m2,m3,m4,m5
29  character*5 p0,p1,p2,p3,p4,p5,p6,p8,p10,p11,p12
30  character*8 lakonf(*),date,newclock,fmat
31  character*10 clock
32  character*20 newdate
33  character*80 matname(*)
34  character*87 filab(*)
35  character*132 text
36 !
37  integer konf(*),nk,nef,kode,i,j,ipkonf(*),indexe,inum(*),mi(*),
38  & one,ielmat(mi(3),*),null,inotr(2,*),ntrans,nout,istep,
39  & nactdohinv(*)
40 !
41  real*8 co(3,*),vold(0:mi(2),*),time,pi,oner,trab(7,*),xturb(2,*),
42  & a(3,3),stn(6,*),qfn(3,*),xmach(*),xkappa(*),physcon(*)
43 !
44  save nout
45 !
46  kode=kode+1
47  pi=4.d0*datan(1.d0)
48 !
49  c='C'
50 !
51  m1=' -1'
52  m2=' -2'
53  m3=' -3'
54  m4=' -4'
55  m5=' -5'
56 !
57  p0=' 0'
58  p1=' 1'
59  p2=' 2'
60  p3=' 3'
61  p4=' 4'
62  p5=' 5'
63  p6=' 6'
64  p8=' 8'
65  p10=' 10'
66  p11=' 11'
67  p12=' 12'
68 !
69  fmat(1:8)='(e12.5) '
70 !
71  null=0
72  one=1
73  oner=1.d0
74 !
75  if(kode.eq.1) then
76 !
77  write(13,'(a5,a1)') p1,c
78  call date_and_time(date,clock)
79  newdate(1:20)=' '
80  newdate(1:2)=date(7:8)
81  newdate(3:3)='.'
82  if(date(5:6).eq.'01') then
83  newdate(4:11)='january.'
84  newdate(12:15)=date(1:4)
85  elseif(date(5:6).eq.'02') then
86  newdate(4:12)='february.'
87  newdate(13:16)=date(1:4)
88  elseif(date(5:6).eq.'03') then
89  newdate(4:9)='march.'
90  newdate(10:13)=date(1:4)
91  elseif(date(5:6).eq.'04') then
92  newdate(4:9)='april.'
93  newdate(10:13)=date(1:4)
94  elseif(date(5:6).eq.'05') then
95  newdate(4:7)='may.'
96  newdate(8:11)=date(1:4)
97  elseif(date(5:6).eq.'06') then
98  newdate(4:8)='june.'
99  newdate(9:12)=date(1:4)
100  elseif(date(5:6).eq.'07') then
101  newdate(4:8)='july.'
102  newdate(9:12)=date(1:4)
103  elseif(date(5:6).eq.'08') then
104  newdate(4:10)='august.'
105  newdate(11:14)=date(1:4)
106  elseif(date(5:6).eq.'09') then
107  newdate(4:13)='september.'
108  newdate(14:17)=date(1:4)
109  elseif(date(5:6).eq.'10') then
110  newdate(4:11)='october.'
111  newdate(12:15)=date(1:4)
112  elseif(date(5:6).eq.'11') then
113  newdate(4:12)='november.'
114  newdate(13:16)=date(1:4)
115  elseif(date(5:6).eq.'12') then
116  newdate(4:12)='december.'
117  newdate(13:16)=date(1:4)
118  endif
119  newclock(1:2)=clock(1:2)
120  newclock(3:3)=':'
121  newclock(4:5)=clock(3:4)
122  newclock(6:6)=':'
123  newclock(7:8)=clock(5:6)
124  write(13,'(a5,''UUSER'')') p1
125  write(13,'(a5,''UDATE'',14x,a20)') p1,newdate
126  write(13,'(a5,''UTIME'',14x,a8)') p1,newclock
127  write(13,'(a5,''UHOST'')') p1
128  write(13,'(a5,''UPGM CalculiX'')') p1
129  write(13,'(a5,''UDIR'')') p1
130  write(13,'(a5,''UDBN'')') p1
131 !
132 ! storing the coordinates of the nodes
133 !
134  write(13,'(a5,a1,67x,i1)') p2,c,one
135 !
136  nout=0
137  do i=1,nk
138  if(inum(i).le.0) cycle
139  nout=nout+1
140  write(13,100) m1,i,(co(j,i),j=1,3)
141  enddo
142 !
143  write(13,'(a3)') m3
144 !
145 ! storing the element topology
146 !
147  write(13,'(a5,a1,67x,i1)') p3,c,one
148 !
149  do i=1,nef
150 !
151  if(ipkonf(i).lt.0) cycle
152  indexe=ipkonf(i)
153  if(lakonf(i)(4:4).eq.'2') then
154  if((lakonf(i)(7:7).eq.' ').or.
155  & (lakonf(i)(7:7).eq.'H')) then
156  write(13,'(a3,i10,3a5)') m1,nactdohinv(i),p4,p0,
157  & matname(ielmat(1,i))(1:5)
158  write(13,'(a3,10i10)') m2,(konf(indexe+j),j=1,10)
159  write(13,'(a3,10i10)') m2,(konf(indexe+j),j=11,12),
160  & (konf(indexe+j),j=17,19),konf(indexe+20),
161  & (konf(indexe+j),j=13,16)
162  elseif(lakonf(i)(7:7).eq.'B') then
163  write(13,'(a3,i10,3a5)')m1,nactdohinv(i),p12,p0,
164  & matname(ielmat(1,i))(1:5)
165  write(13,'(a3,3i10)') m2,konf(indexe+21),konf(indexe+23),
166  & konf(indexe+22)
167  else
168  write(13,'(a3,i10,3a5)')m1,nactdohinv(i),p10,p0,
169  & matname(ielmat(1,i))(1:5)
170  write(13,'(a3,8i10)') m2,(konf(indexe+20+j),j=1,8)
171  endif
172  elseif(lakonf(i)(4:4).eq.'8') then
173  write(13,'(a3,i10,3a5)') m1,nactdohinv(i),p1,p0,
174  & matname(ielmat(1,i))(1:5)
175  write(13,'(a3,8i10)') m2,(konf(indexe+j),j=1,8)
176  elseif(lakonf(i)(4:5).eq.'10') then
177  write(13,'(a3,i10,3a5)') m1,nactdohinv(i),p6,p0,
178  & matname(ielmat(1,i))(1:5)
179  write(13,'(a3,10i10)') m2,(konf(indexe+j),j=1,10)
180  elseif(lakonf(i)(4:4).eq.'4') then
181  write(13,'(a3,i10,3a5)') m1,nactdohinv(i),p3,p0,
182  & matname(ielmat(1,i))(1:5)
183  write(13,'(a3,4i10)') m2,(konf(indexe+j),j=1,4)
184  elseif(lakonf(i)(4:5).eq.'15') then
185  if((lakonf(i)(7:7).eq.' ')) then
186  write(13,'(a3,i10,3a5)') m1,nactdohinv(i),p5,p0,
187  & matname(ielmat(1,i))(1:5)
188  write(13,'(a3,10i10)') m2,(konf(indexe+j),j=1,9),
189  & konf(indexe+13)
190  write(13,'(a3,5i10)') m2,(konf(indexe+j),j=14,15),
191  & (konf(indexe+j),j=10,12)
192  else
193  write(13,'(a3,i10,3a5)') m1,nactdohinv(i),p8,p0,
194  & matname(ielmat(1,i))(1:5)
195  write(13,'(a3,6i10)') m2,(konf(indexe+15+j),j=1,6)
196  endif
197  elseif(lakonf(i)(4:4).eq.'6') then
198  write(13,'(a3,i10,3a5)') m1,nactdohinv(i),p2,p0,
199  & matname(ielmat(1,i))(1:5)
200  write(13,'(a3,6i10)') m2,(konf(indexe+j),j=1,6)
201  elseif(lakonf(i)(1:1).eq.'D') then
202  if((konf(indexe+1).eq.0).or.(konf(indexe+3).eq.0)) cycle
203  write(13,'(a3,i10,3a5)')m1,nactdohinv(i),p12,p0,
204  & matname(ielmat(1,i))(1:5)
205  write(13,'(a3,3i10)') m2,konf(indexe+1),konf(indexe+3),
206  & konf(indexe+2)
207  elseif(lakonf(i)(1:1).eq.'E') then
208  write(13,'(a3,i10,3a5)')m1,nactdohinv(i),p11,p0,
209  & matname(ielmat(1,i))(1:5)
210  write(13,'(a3,2i10)') m2,(konf(indexe+j),j=1,2)
211  endif
212 !
213  enddo
214 !
215  write(13,'(a3)') m3
216 !
217  endif
218 !
219  if(filab(34)(1:4).eq.'VF ') then
220  text=' 1PSTEP'
221  write(text(25:36),'(i12)') kode
222  write(13,'(a132)') text
223 !
224  text=
225  & ' 100CL .00000E+00 3 1'
226  text(75:75)='1'
227  write(text(25:36),'(i12)') nout
228  write(text(8:12),'(i5)') 100+kode
229  write(text(13:24),fmat) time
230  write(text(59:63),'(i5)') kode
231  write(13,'(a132)') text
232  text=' -4 V3DF 4 1'
233  write(13,'(a132)') text
234  text=' -5 V1 1 2 1 0'
235  write(13,'(a132)') text
236  text=' -5 V2 1 2 2 0'
237  write(13,'(a132)') text
238  text=' -5 V3 1 2 3 0'
239  write(13,'(a132)') text
240  text=' -5 ALL 1 2 0 0 1ALL'
241  write(13,'(a132)') text
242 !
243  if((ntrans.eq.0).or.(filab(21)(6:6).eq.'G')) then
244  do i=1,nk
245  if(inum(i).le.0) cycle
246  write(13,100) m1,i,(vold(j,i),j=1,3)
247  enddo
248  else
249  do i=1,nk
250  if(inum(i).le.0) cycle
251  if(inotr(1,i).eq.0) then
252  write(13,100) m1,i,(vold(j,i),j=1,3)
253  else
254  call transformatrix(trab(1,inotr(1,i)),co(1,i),a)
255  write(13,100) m1,i,
256  & vold(1,i)*a(1,1)+vold(2,i)*a(2,1)+vold(3,i)*a(3,1),
257  & vold(1,i)*a(1,2)+vold(2,i)*a(2,2)+vold(3,i)*a(3,2),
258  & vold(1,i)*a(1,3)+vold(2,i)*a(2,3)+vold(3,i)*a(3,3)
259  endif
260  enddo
261  endif
262 !
263  write(13,'(a3)') m3
264  endif
265 !
266  if(filab(35)(1:4).eq.'PSF ') then
267  text=' 1PSTEP'
268  write(text(25:36),'(i12)') kode
269  write(13,'(a132)') text
270 !
271  text=
272  & ' 100CL .00000E+00 3 1'
273  text(75:75)='1'
274  write(text(25:36),'(i12)') nout
275  write(text(8:12),'(i5)') 100+kode
276  write(text(13:24),fmat) time
277  write(text(59:63),'(i5)') kode
278  write(13,'(a132)') text
279  text=' -4 PS3DF 1 1'
280  write(13,'(a132)') text
281  text=' -5 PS 1 1 0 0'
282  write(13,'(a132)') text
283 !
284  do i=1,nk
285  if(inum(i).le.0) cycle
286  write(13,100) m1,i,vold(4,i)
287  enddo
288 !
289  write(13,'(a3)') m3
290  endif
291 !
292  if(filab(36)(1:4).eq.'TSF ') then
293  text=' 1PSTEP'
294  write(text(25:36),'(i12)') kode
295  write(13,'(a132)') text
296 !
297  text=
298  & ' 100CL .00000E+00 3 1'
299  text(75:75)='1'
300  write(text(25:36),'(i12)') nout
301  write(text(8:12),'(i5)') 100+kode
302  write(text(13:24),fmat) time
303  write(text(59:63),'(i5)') kode
304  write(13,'(a132)') text
305  text=' -4 TS3DF 1 1'
306  write(13,'(a132)') text
307  text=' -5 TS 1 1 0 0'
308  write(13,'(a132)') text
309 !
310  do i=1,nk
311  if(inum(i).le.0) cycle
312  write(13,100) m1,i,vold(0,i)
313  enddo
314 !
315  write(13,'(a3)') m3
316  endif
317 !
318 ! xkappa(i) contains kappa (cp/cv)
319 ! xmach(i) contains the Mach number
320 !
321  if(filab(23)(1:4).eq.'MACH') then
322  text=' 1PSTEP'
323  write(text(25:36),'(i12)') kode
324  write(13,'(a132)') text
325 !
326  text=
327  & ' 100CL .00000E+00 3 1'
328  text(75:75)='1'
329  write(text(25:36),'(i12)') nout
330  write(text(8:12),'(i5)') 100+kode
331  write(text(13:24),fmat) time
332  write(text(59:63),'(i5)') kode
333  write(13,'(a132)') text
334  text=' -4 M3DF 1 1'
335  write(13,'(a132)') text
336  text=' -5 MACH 1 1 0 0'
337  write(13,'(a132)') text
338 !
339  do i=1,nk
340  if(inum(i).le.0) cycle
341  write(13,100) m1,i,xmach(i)
342  enddo
343 !
344  write(13,'(a3)') m3
345  endif
346 !
347  if(filab(38)(1:4).eq.'TTF ') then
348  text=' 1PSTEP'
349  write(text(25:36),'(i12)') kode
350  write(13,'(a132)') text
351 !
352  text=
353  & ' 100CL .00000E+00 3 1'
354  text(75:75)='1'
355  write(text(25:36),'(i12)') nout
356  write(text(8:12),'(i5)') 100+kode
357  write(text(13:24),fmat) time
358  write(text(59:63),'(i5)') kode
359  write(13,'(a132)') text
360  text=' -4 TT3DF 1 1'
361  write(13,'(a132)') text
362  text=' -5 TT 1 1 0 0'
363  write(13,'(a132)') text
364 !
365  do i=1,nk
366  if(inum(i).le.0) cycle
367  write(13,100) m1,i,
368  & vold(0,i)*(1.d0+(xkappa(i)-1.d0)/2*xmach(i)**2)
369  enddo
370 !
371  write(13,'(a3)') m3
372  endif
373 !
374  if(filab(37)(1:4).eq.'PTF ') then
375  text=' 1PSTEP'
376  write(text(25:36),'(i12)') kode
377  write(13,'(a132)') text
378 !
379  text=
380  & ' 100CL .00000E+00 3 1'
381  text(75:75)='1'
382  write(text(25:36),'(i12)') nout
383  write(text(8:12),'(i5)') 100+kode
384  write(text(13:24),fmat) time
385  write(text(59:63),'(i5)') kode
386  write(13,'(a132)') text
387  text=' -4 PT3DF 1 1'
388  write(13,'(a132)') text
389  text=' -5 PT 1 1 0 0'
390  write(13,'(a132)') text
391 !
392  do i=1,nk
393  if(inum(i).le.0) cycle
394  write(13,100) m1,i,vold(4,i)*
395  & (1.d0+(xkappa(i)-1.d0)/2*xmach(i)**2)
396  & **(xkappa(i)/(xkappa(i)-1.d0))
397  enddo
398 !
399  write(13,'(a3)') m3
400  endif
401 !
402 ! storing the total stresses in the nodes
403 !
404  if(filab(39)(1:4).eq.'SF ') then
405  text=' 1PSTEP'
406  write(text(25:36),'(i12)') kode
407  write(text(49:60),'(i12)') istep
408  write(13,'(a132)') text
409 !
410  text=
411  & ' 100CL .00000E+00 3 1'
412  text(75:75)='1'
413  write(text(25:36),'(i12)') nout
414  write(text(8:12),'(i5)') 100+kode
415  write(text(13:24),fmat) time
416  write(text(59:63),'(i5)') kode
417  write(13,'(a132)') text
418  text=' -4 STRESS 6 1'
419  write(13,'(a132)') text
420  text=' -5 SXX 1 4 1 1'
421  write(13,'(a132)') text
422  text=' -5 SYY 1 4 2 2'
423  write(13,'(a132)') text
424  text=' -5 SZZ 1 4 3 3'
425  write(13,'(a132)') text
426  text=' -5 SXY 1 4 1 2'
427  write(13,'(a132)') text
428  text=' -5 SYZ 1 4 2 3'
429  write(13,'(a132)') text
430  text=' -5 SZX 1 4 3 1'
431  write(13,'(a132)') text
432  do i=1,nk
433  if(inum(i).le.0) cycle
434  write(13,100) m1,i,(stn(j,i)-vold(4,i),j=1,3),
435  & stn(4,i),stn(6,i),stn(5,i)
436  enddo
437  write(13,'(a3)') m3
438  endif
439 !
440 ! storing the viscous stresses in the nodes
441 !
442  if(filab(41)(1:4).eq.'SVF ') then
443  text=' 1PSTEP'
444  write(text(25:36),'(i12)') kode
445  write(13,'(a132)') text
446 !
447  text=
448  & ' 100CL .00000E+00 3 1'
449  text(75:75)='1'
450  write(text(25:36),'(i12)') nout
451  write(text(8:12),'(i5)') 100+kode
452  write(text(13:24),fmat) time
453  write(text(59:63),'(i5)') kode
454  write(13,'(a132)') text
455  text=' -4 VSTRES 6 1'
456  write(13,'(a132)') text
457  text=' -5 SXX 1 4 1 1'
458  write(13,'(a132)') text
459  text=' -5 SYY 1 4 2 2'
460  write(13,'(a132)') text
461  text=' -5 SZZ 1 4 3 3'
462  write(13,'(a132)') text
463  text=' -5 SXY 1 4 1 2'
464  write(13,'(a132)') text
465  text=' -5 SYZ 1 4 2 3'
466  write(13,'(a132)') text
467  text=' -5 SZX 1 4 3 1'
468  write(13,'(a132)') text
469  do i=1,nk
470  if(inum(i).le.0) cycle
471  write(13,100) m1,i,(stn(j,i),j=1,4),
472  & stn(6,i),stn(5,i)
473  enddo
474  write(13,'(a3)') m3
475  endif
476 !
477 ! storing the heat flux in the nodes
478 !
479  if(filab(40)(1:4).eq.'HFLF') then
480  text=' 1PSTEP'
481  write(text(25:36),'(i12)') kode
482  write(13,'(a132)') text
483 !
484  text=
485  & ' 100CL .00000E+00 3 1'
486  text(75:75)='1'
487  write(text(25:36),'(i12)') nout
488  write(text(8:12),'(i5)') 100+kode
489  write(text(13:24),fmat) time
490  write(text(59:63),'(i5)') kode
491  write(13,'(a132)') text
492  text=' -4 FLUX 4 1'
493  write(13,'(a132)') text
494  text=' -5 F1 1 2 1 0'
495  write(13,'(a132)') text
496  text=' -5 F2 1 2 2 0'
497  write(13,'(a132)') text
498  text=' -5 F3 1 2 3 0'
499  write(13,'(a132)') text
500  text=' -5 ALL 1 2 0 0 1ALL'
501  write(13,'(a132)') text
502  do i=1,nk
503  if(inum(i).le.0) cycle
504  write(13,100) m1,i,(qfn(j,i),j=1,3)
505  enddo
506  write(13,'(a3)') m3
507  endif
508 !
509  if(filab(24)(1:4).eq.'CP ') then
510  text=' 1PSTEP'
511  write(text(25:36),'(i12)') kode
512  write(13,'(a132)') text
513 !
514  text=
515  & ' 100CL .00000E+00 3 1'
516  text(75:75)='1'
517  write(text(25:36),'(i12)') nout
518  write(text(8:12),'(i5)') 100+kode
519  write(text(13:24),fmat) time
520  write(text(59:63),'(i5)') kode
521  write(13,'(a132)') text
522  text=' -4 CP3DF 1 1'
523  write(13,'(a132)') text
524  text=' -5 CP 1 1 0 0'
525  write(13,'(a132)') text
526 !
527  do i=1,nk
528  if(inum(i).le.0) cycle
529  write(13,100) m1,i,(vold(4,i)-physcon(6))*2.d0/
530  & (physcon(7)*physcon(5)**2)
531  enddo
532 !
533  write(13,'(a3)') m3
534  endif
535 !
536  if(filab(25)(1:4).eq.'TURB') then
537  text=' 1PSTEP'
538  write(text(25:36),'(i12)') kode
539  write(13,'(a132)') text
540 !
541  text=
542  & ' 100CL .00000E+00 3 1'
543  text(75:75)='1'
544  write(text(25:36),'(i12)') nout
545  write(text(8:12),'(i5)') 100+kode
546  write(text(13:24),fmat) time
547  write(text(59:63),'(i5)') kode
548  write(13,'(a132)') text
549  text=' -4 TURB3DF 4 1'
550  write(13,'(a132)') text
551  text=' -5 K 1 1 0 0'
552  write(13,'(a132)') text
553  text=' -5 OM 1 1 0 0'
554  write(13,'(a132)') text
555  text=' -5 NU_T 1 1 0 0'
556  write(13,'(a132)') text
557  text=' -5 EPS 1 1 0 0'
558  write(13,'(a132)') text
559 !
560  do i=1,nk
561  if(inum(i).le.0) cycle
562  write(13,100) m1,i,xturb(1,i),xturb(2,i),
563  & xturb(1,i)/xturb(2,i),xturb(1,i)*xturb(2,i)
564  enddo
565 !
566  write(13,'(a3)') m3
567  endif
568 !
569  100 format(a3,i10,1p,6e12.5)
570 !
571  return
transformatrix
subroutine transformatrix(xab, p, a)
Definition: transformatrix.f:20
Hosted by OpenAircraft.com, (Michigan UAV, LLC)