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

Go to the source code of this file.

Functions/Subroutines

subroutine frditeration (co, nk, kon, ipkon, lakon, ne, v, time, ielmat, matname, mi, istep, iinc, ithermal)
 

Function/Subroutine Documentation

◆ frditeration()

subroutine frditeration ( real*8, dimension(3,*)  co,
integer  nk,
integer, dimension(*)  kon,
integer, dimension(*)  ipkon,
character*8, dimension(*)  lakon,
integer  ne,
real*8, dimension(0:mi(2),*)  v,
real*8  time,
integer, dimension(mi(3),*)  ielmat,
character*80, dimension(*)  matname,
integer, dimension(*)  mi,
integer  istep,
integer  iinc,
integer  ithermal 
)
21 !
22 ! stores the results in frd format
23 !
24  implicit none
25 !
26  character*1 c
27  character*3 m1,m2,m3,m4,m5
28  character*5 p0,p1,p2,p3,p4,p5,p6,p8,p10,p11,p12
29  character*8 lakon(*),date,newclock,fmat
30  character*10 clock
31  character*20 newdate
32  character*28 cfile
33  character*80 matname(*)
34  character*132 text
35 !
36  integer kon(*),nk,ne,iteller,i,j,ipkon(*),indexe,ithermal,
37  & one,mi(*),ielmat(mi(3),*),null,istep,iinc,istep0,iinc0
38 !
39  real*8 co(3,*),v(0:mi(2),*),time,pi,oner
40 !
41  data istep0 /-1/
42  data iinc0 /-1/
43 !
44  save iteller,istep0,iinc0
45 !
46  cfile(1:28)='ResultsForLastIterations.frd'
47  if((istep.eq.istep0).and.(iinc.eq.iinc0)) then
48  open(27,file=cfile,status='unknown',position='append')
49  iteller=iteller+1
50  else
51  open(27,file=cfile,status='unknown')
52  istep0=istep
53  iinc0=iinc
54  iteller=1
55  endif
56 !
57  pi=4.d0*datan(1.d0)
58 !
59  c='C'
60 !
61  m1=' -1'
62  m2=' -2'
63  m3=' -3'
64  m4=' -4'
65  m5=' -5'
66 !
67  p0=' 0'
68  p1=' 1'
69  p2=' 2'
70  p3=' 3'
71  p4=' 4'
72  p5=' 5'
73  p6=' 6'
74  p8=' 8'
75  p10=' 10'
76  p11=' 11'
77  p12=' 12'
78 !
79  if(time.le.0.d0) then
80  fmat(1:8)='(e12.5) '
81  elseif((dlog10(time).ge.0.d0).and.(dlog10(time).lt.11.d0)) then
82  fmat(1:5)='(f12.'
83  write(fmat(6:7),'(i2)') 11-int(dlog10(time)+1.d0)
84  fmat(8:8)=')'
85  else
86  fmat(1:8)='(e12.5) '
87  endif
88 !
89  null=0
90  one=1
91  oner=1.d0
92 !
93  if(iteller.eq.1) then
94 !
95  write(27,'(a5,a1)') p1,c
96  call date_and_time(date,clock)
97  newdate(1:20)=' '
98  newdate(1:2)=date(7:8)
99  newdate(3:3)='.'
100  if(date(5:6).eq.'01') then
101  newdate(4:11)='january.'
102  newdate(12:15)=date(1:4)
103  elseif(date(5:6).eq.'02') then
104  newdate(4:12)='february.'
105  newdate(13:16)=date(1:4)
106  elseif(date(5:6).eq.'03') then
107  newdate(4:9)='march.'
108  newdate(10:13)=date(1:4)
109  elseif(date(5:6).eq.'04') then
110  newdate(4:9)='april.'
111  newdate(10:13)=date(1:4)
112  elseif(date(5:6).eq.'05') then
113  newdate(4:7)='may.'
114  newdate(8:11)=date(1:4)
115  elseif(date(5:6).eq.'06') then
116  newdate(4:8)='june.'
117  newdate(9:12)=date(1:4)
118  elseif(date(5:6).eq.'07') then
119  newdate(4:8)='july.'
120  newdate(9:12)=date(1:4)
121  elseif(date(5:6).eq.'08') then
122  newdate(4:10)='august.'
123  newdate(11:14)=date(1:4)
124  elseif(date(5:6).eq.'09') then
125  newdate(4:13)='september.'
126  newdate(14:17)=date(1:4)
127  elseif(date(5:6).eq.'10') then
128  newdate(4:11)='october.'
129  newdate(12:15)=date(1:4)
130  elseif(date(5:6).eq.'11') then
131  newdate(4:12)='november.'
132  newdate(13:16)=date(1:4)
133  elseif(date(5:6).eq.'12') then
134  newdate(4:12)='december.'
135  newdate(13:16)=date(1:4)
136  endif
137  newclock(1:2)=clock(1:2)
138  newclock(3:3)=':'
139  newclock(4:5)=clock(3:4)
140  newclock(6:6)=':'
141  newclock(7:8)=clock(5:6)
142  write(27,'(a5,''UUSER'')') p1
143  write(27,'(a5,''UDATE'',14x,a20)') p1,newdate
144  write(27,'(a5,''UTIME'',14x,a8)') p1,newclock
145  write(27,'(a5,''UHOST'')') p1
146  write(27,'(a5,''UPGM CalculiX'')') p1
147  write(27,'(a5,''UDIR'')') p1
148  write(27,'(a5,''UDBN'')') p1
149 !
150 ! storing the coordinates of the nodes
151 !
152  write(27,'(a5,a1,67x,i1)') p2,c,one
153 !
154  do i=1,nk
155  write(27,100) m1,i,(co(j,i),j=1,3)
156  enddo
157 !
158  write(27,'(a3)') m3
159 !
160 ! storing the element topology
161 !
162  write(27,'(a5,a1,67x,i1)') p3,c,one
163 !
164  do i=1,ne
165 !
166  if(ipkon(i).lt.0) cycle
167  indexe=ipkon(i)
168  if(lakon(i)(4:4).eq.'2') then
169  if((lakon(i)(7:7).eq.' ').or.
170  & (lakon(i)(7:7).eq.'H')) then
171  write(27,'(a3,i10,3a5)') m1,i,p4,p0,
172  & matname(ielmat(1,i))(1:5)
173  write(27,'(a3,10i10)') m2,(kon(indexe+j),j=1,10)
174  write(27,'(a3,10i10)') m2,(kon(indexe+j),j=11,12),
175  & (kon(indexe+j),j=17,19),kon(indexe+20),
176  & (kon(indexe+j),j=13,16)
177  elseif(lakon(i)(7:7).eq.'B') then
178  write(27,'(a3,i10,3a5)')m1,i,p12,p0,
179  & matname(ielmat(1,i))(1:5)
180  write(27,'(a3,3i10)') m2,kon(indexe+21),kon(indexe+23),
181  & kon(indexe+22)
182  else
183  write(27,'(a3,i10,3a5)')m1,i,p10,p0,
184  & matname(ielmat(1,i))(1:5)
185  write(27,'(a3,8i10)') m2,(kon(indexe+20+j),j=1,8)
186  endif
187  elseif(lakon(i)(4:4).eq.'8') then
188  write(27,'(a3,i10,3a5)') m1,i,p1,p0,
189  & matname(ielmat(1,i))(1:5)
190  write(27,'(a3,8i10)') m2,(kon(indexe+j),j=1,8)
191  elseif(lakon(i)(4:5).eq.'10') then
192  write(27,'(a3,i10,3a5)') m1,i,p6,p0,
193  & matname(ielmat(1,i))(1:5)
194  write(27,'(a3,10i10)') m2,(kon(indexe+j),j=1,10)
195  elseif(lakon(i)(4:4).eq.'4') then
196  write(27,'(a3,i10,3a5)') m1,i,p3,p0,
197  & matname(ielmat(1,i))(1:5)
198  write(27,'(a3,4i10)') m2,(kon(indexe+j),j=1,4)
199  elseif(lakon(i)(4:5).eq.'15') then
200  if((lakon(i)(7:7).eq.' ')) then
201  write(27,'(a3,i10,3a5)') m1,i,p5,p0,
202  & matname(ielmat(1,i))(1:5)
203  write(27,'(a3,10i10)') m2,(kon(indexe+j),j=1,9),
204  & kon(indexe+13)
205  write(27,'(a3,5i10)') m2,(kon(indexe+j),j=14,15),
206  & (kon(indexe+j),j=10,12)
207  else
208  write(27,'(a3,i10,3a5)') m1,i,p8,p0,
209  & matname(ielmat(1,i))(1:5)
210  write(27,'(a3,6i10)') m2,(kon(indexe+15+j),j=1,6)
211  endif
212  elseif(lakon(i)(4:4).eq.'6') then
213  write(27,'(a3,i10,3a5)') m1,i,p2,p0,
214  & matname(ielmat(1,i))(1:5)
215  write(27,'(a3,6i10)') m2,(kon(indexe+j),j=1,6)
216  elseif(lakon(i)(1:1).eq.'D') then
217  if((kon(indexe+1).eq.0).or.(kon(indexe+3).eq.0)) cycle
218  write(27,'(a3,i10,3a5)')m1,i,p12,p0,
219  & matname(ielmat(1,i))(1:5)
220  write(27,'(a3,3i10)') m2,kon(indexe+1),kon(indexe+3),
221  & kon(indexe+2)
222  elseif(lakon(i)(1:1).eq.'E') then
223  write(27,'(a3,i10,3a5)')m1,i,p11,p0,
224  & matname(ielmat(1,i))(1:5)
225  write(27,'(a3,2i10)') m2,(kon(indexe+j),j=1,2)
226  endif
227 !
228  enddo
229 !
230  write(27,'(a3)') m3
231  endif
232 !
233  if(ithermal.ne.2) then
234 !
235 ! storing the displacements in the nodes
236 !
237  text=' 1PSTEP'
238  write(text(25:36),'(i12)') iteller
239  write(text(25:27),'(a3)') 'STP'
240  write(text(28:29),'(i2)') istep
241  write(text(30:32),'(a3)') 'INC'
242  write(text(33:36),'(i4)') iinc
243  write(27,'(a132)') text
244 !
245  text=
246  &' 100CL .00000E+00 3 1'
247  text(75:75)='1'
248  write(text(25:36),'(i12)') nk
249  write(text(8:12),'(i5)') 100+iteller
250  write(text(13:24),fmat) time
251  write(text(59:63),'(i5)') iteller
252  write(27,'(a132)') text
253  text=' -4 DISP 4 1'
254  write(27,'(a132)') text
255  text=' -5 D1 1 2 1 0'
256  write(27,'(a132)') text
257  text=' -5 D2 1 2 2 0'
258  write(27,'(a132)') text
259  text=' -5 D3 1 2 3 0'
260  write(27,'(a132)') text
261  text=' -5 ALL 1 2 0 0 1ALL'
262  write(27,'(a132)') text
263 !
264  do i=1,nk
265  write(27,100) m1,i,(v(j,i),j=1,3)
266  enddo
267 !
268  write(27,'(a3)') m3
269  endif
270 !
271  if(ithermal.ge.2) then
272 !
273 ! storing the temperatures in the nodes
274 !
275  text=' 1PSTEP'
276  write(text(25:36),'(i12)') iteller
277  write(text(25:27),'(a3)') 'STP'
278  write(text(28:29),'(i2)') istep
279  write(text(30:32),'(a3)') 'INC'
280  write(text(33:36),'(i4)') iinc
281  write(27,'(a132)') text
282 !
283  text=
284  & ' 100CL .00000E+00 3 1'
285  text(75:75)='1'
286  write(text(25:36),'(i12)') nk
287  write(text(8:12),'(i5)') 100+iteller
288  write(text(13:24),fmat) time
289  write(text(59:63),'(i5)') iteller
290  write(27,'(a132)') text
291  text=' -4 NDTEMP 1 1'
292  write(27,'(a132)') text
293  text=' -5 NT 1 1 0 0'
294  write(27,'(a132)') text
295 !
296  do i=1,nk
297  write(27,100) m1,i,v(0,i)
298  enddo
299 !
300  write(27,'(a3)') m3
301  endif
302 !
303  100 format(a3,i10,1p,6e12.5)
304 !
305  close(27)
306 !
307  return
Hosted by OpenAircraft.com, (Michigan UAV, LLC)