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

Go to the source code of this file.

Functions/Subroutines

subroutine restartshort (nset, nload, nbody, nforc, nboun, nk, ne, nmpc, nalset, nmat, ntmat, npmat, norien, nam, nprint, mi, ntrans, ncs, namtot, ncmat, memmpc, ne1d, ne2d, nflow, set, meminset, rmeminset, jobnamec, irestartstep, icntrl, ithermal, nener, nstate_, ntie, nslavs, nkon, mcs, nprop, mortar, ifacecount, nintpoint, infree)
 

Function/Subroutine Documentation

◆ restartshort()

subroutine restartshort ( integer  nset,
integer  nload,
integer  nbody,
integer  nforc,
integer  nboun,
integer  nk,
integer  ne,
integer  nmpc,
integer  nalset,
integer  nmat,
integer  ntmat,
integer  npmat,
integer  norien,
integer  nam,
integer  nprint,
integer, dimension(*)  mi,
integer  ntrans,
integer  ncs,
integer  namtot,
integer  ncmat,
integer  memmpc,
integer  ne1d,
integer  ne2d,
integer  nflow,
character*81, dimension(*)  set,
integer, dimension(*)  meminset,
integer, dimension(*)  rmeminset,
character*132, dimension(*)  jobnamec,
integer  irestartstep,
integer  icntrl,
integer  ithermal,
integer  nener,
integer  nstate_,
integer  ntie,
integer  nslavs,
integer  nkon,
integer  mcs,
integer  nprop,
integer  mortar,
integer  ifacecount,
integer  nintpoint,
integer, dimension(4)  infree 
)
25 !
26 ! istartset := meminset
27 ! iendset := rmeminset
28 !
29  implicit none
30 !
31  character*80 version
32  character*81 set(*)
33  character*132 fnrstrt,jobnamec(*)
34 !
35  integer istep,nset,nload,nforc,nboun,nk,ne,nmpc,nalset,nmat,
36  & ntmat,npmat,norien,nam,nprint,mi(*),ntrans,ncs,nprop,
37  & namtot,ncmat,memmpc,ne1d,ne2d,nflow,infree(4),mortar,
38  & nmethod,iperturb(2),meminset(*),rmeminset(*),nintpoint,
39  & i,j,k,ipos,icntrl,nener,irestartstep,im0,im1,im2,mem,iact,
40  & istat,nkon,nlabel,iplas,ithermal,nstate_,iprestr,maxlenmpc,
41  & mcs,ntie,nbody,nslavs,ifacecount,iversion
42 !
43  if(icntrl.eq.0) then
44 !
45 ! this branch is called from readinput.c
46 ! its purpose is to read the value of nset
47 !
48 ! determining the name of the restart file
49 !
50  ipos=index(jobnamec(1),char(0))
51  fnrstrt(1:ipos-1)=jobnamec(1)(1:ipos-1)
52  fnrstrt(ipos:ipos+3)=".rin"
53  do i=ipos+4,132
54  fnrstrt(i:i)=' '
55  enddo
56 !
57 ! opening the restart file
58 !
59  open(15,file=fnrstrt,access='SEQUENTIAL',form='UNFORMATTED',
60  & err=15)
61 !
62  iversion=0
63 !
64  do
65 !
66  read(15,iostat=istat) version
67  if(istat.lt.0) then
68  if(irestartstep.eq.0) then
69 !
70 ! reading the last step
71 !
72  irestartstep=istep
73  close(15)
74  open(15,file=fnrstrt,access='SEQUENTIAL',
75  & form='UNFORMATTED',err=15)
76  read(15) version
77  else
78  write(*,*) '*ERROR in restartshort: requested step'
79  write(*,*) ' is not in the restart file'
80  call exit(201)
81  endif
82  endif
83 !
84  if(iversion.eq.0) then
85  write(*,*)
86  write(*,*) '*INFO: restart file ',fnrstrt
87  write(*,*) ' has been opened for reading.'
88  write(*,*) ' it was created with CalculiX ',version
89  iversion=1
90  endif
91 !
92  read(15)istep
93 !
94 ! reading the number of sets
95 !
96  read(15)nset
97 !
98  if(istep.eq.irestartstep) exit
99 !
100  read(15)nalset
101 !
102 ! load size
103 !
104  read(15)nload
105  read(15)nbody
106  read(15)nforc
107  read(15)nboun
108  read(15)nflow
109 !
110 ! mesh size
111 !
112  read(15)nk
113  read(15)ne
114  read(15)nkon
115  read(15)(mi(i),i=1,3)
116 !
117 ! constraint size
118 !
119  read(15)nmpc
120  read(15)memmpc
121  read(15)maxlenmpc
122 !
123 ! material size
124 !
125  read(15)nmat
126  read(15)ntmat
127  read(15)npmat
128  read(15)ncmat
129 !
130 ! property info
131 !
132  read(15)nprop
133 !
134 ! transformation size
135 !
136  read(15)norien
137  read(15)ntrans
138 !
139 ! amplitude size
140 !
141  read(15)nam
142  read(15)namtot
143 !
144 ! print size
145 !
146  read(15)nprint
147  read(15)nlabel
148 !
149 ! tie size
150 !
151  read(15)ntie
152 !
153 ! cyclic symmetry size
154 !
155  read(15)ncs
156  read(15)mcs
157 !
158 ! 1d and 2d element size
159 !
160  read(15)ne1d
161  read(15)ne2d
162  read(15)(infree(i),i=1,4)
163 !
164 ! procedure info
165 !
166  read(15)nmethod
167  read(15)(iperturb(i),i=1,2)
168  read(15)nener
169  read(15)iplas
170  read(15)ithermal
171  read(15)nstate_
172  read(15)nslavs
173  read(15)iprestr
174  read(15)mortar
175  if(mortar.eq.1) then
176  read(15)ifacecount
177  read(15)nintpoint
178  endif
179 !
180 ! skipping the next entries
181 !
182  call skip(nset,nalset,nload,nbody,
183  & nforc,nboun,nk,ne,nkon,
184  & mi,nmpc,memmpc,nmat,ntmat,npmat,ncmat,norien,
185  & ntrans,nam,nprint,nlabel,ncs,ne1d,ne2d,infree,
186  & nmethod,iperturb,nener,ithermal,nstate_,iprestr,
187  & mcs,ntie,nslavs,nprop,mortar,ifacecount,nintpoint)
188 !
189  enddo
190 !
191  close(15)
192 !
193  return
194  endif
195 !
196 ! determining the name of the restart file
197 !
198  ipos=index(jobnamec(1),char(0))
199  fnrstrt(1:ipos-1)=jobnamec(1)(1:ipos-1)
200  fnrstrt(ipos:ipos+3)=".rin"
201  do i=ipos+4,132
202  fnrstrt(i:i)=' '
203  enddo
204 !
205 ! opening the restart file
206 !
207  open(15,file=fnrstrt,access='SEQUENTIAL',form='UNFORMATTED',
208  & err=15)
209 !
210  do
211 !
212  read(15,iostat=istat) version
213  if(istat.lt.0) then
214  if(irestartstep.eq.0) then
215 !
216 ! reading the last step
217 !
218  irestartstep=istep
219  close(15)
220  open(15,file=fnrstrt,access='SEQUENTIAL',
221  & form='UNFORMATTED',err=15)
222  read(15) version
223  else
224  write(*,*) '*ERROR in restartshort: requested step'
225  write(*,*) ' is not in the restart file'
226  call exit(201)
227  endif
228  endif
229  read(15)istep
230 !
231 ! set size
232 !
233  read(15)nset
234  read(15)nalset
235 !
236 ! load size
237 !
238  read(15)nload
239  read(15)nbody
240  read(15)nforc
241  read(15)nboun
242  read(15)nflow
243 !
244 ! mesh size
245 !
246  read(15)nk
247  read(15)ne
248  read(15)nkon
249  read(15)(mi(i),i=1,3)
250 !
251 ! constraint size
252 !
253  read(15)nmpc
254  read(15)memmpc
255  read(15)maxlenmpc
256 !
257 ! material size
258 !
259  read(15)nmat
260  read(15)ntmat
261  read(15)npmat
262  read(15)ncmat
263 !
264 ! property info
265 !
266  read(15)nprop
267 !
268 ! transformation size
269 !
270  read(15)norien
271  read(15)ntrans
272 !
273 ! amplitude size
274 !
275  read(15)nam
276  read(15)namtot
277 !
278 ! print size
279 !
280  read(15)nprint
281  read(15)nlabel
282 !
283 ! tie size
284 !
285  read(15)ntie
286 !
287 ! cyclic symmetry size
288 !
289  read(15)ncs
290  read(15)mcs
291 !
292 ! 1d and 2d element size
293 !
294  read(15)ne1d
295  read(15)ne2d
296  read(15)(infree(i),i=1,4)
297 !
298 ! procedure info
299 !
300  read(15)nmethod
301  read(15)(iperturb(i),i=1,2)
302  read(15)nener
303  read(15)iplas
304  read(15)ithermal
305  read(15)nstate_
306  read(15)nslavs
307  read(15)iprestr
308  read(15)mortar
309  if(mortar.eq.1) then
310  read(15)ifacecount
311  read(15)nintpoint
312  endif
313 !
314  if(istep.eq.irestartstep) exit
315 !
316 ! skipping the next entries
317 !
318  call skip(nset,nalset,nload,nbody,nforc,nboun,nk,ne,nkon,
319  & mi,nmpc,memmpc,nmat,ntmat,npmat,ncmat,norien,ntrans,
320  & nam,nprint,nlabel,ncs,ne1d,ne2d,infree,nmethod,
321  & iperturb,nener,ithermal,nstate_,iprestr,mcs,ntie,
322  & nslavs,nprop,mortar,ifacecount,nintpoint)
323 !
324  enddo
325 !
326 ! sets
327 !
328  read(15)(set(i),i=1,nset)
329 !
330 ! the contents of istartset is temporarily stored in meminset
331 !
332  read(15)(meminset(i),i=1,nset)
333 !
334 ! the contents of iendset is temporarily stored in rmeminset
335 !
336  read(15)(rmeminset(i),i=1,nset)
337 !
338 ! reordering the information of istartset, iendset and ialset
339 ! into meminset and rmeminset
340 !
341  iact=0
342  do j=1,nalset
343  if(iact.eq.0) then
344  do k=1,nset
345  if(meminset(k).eq.j) then
346  meminset(k)=0
347  mem=0
348  iact=1
349  exit
350  endif
351  enddo
352  if(k.gt.nset) cycle
353  endif
354  mem=mem+1
355  im2=im1
356  im1=im0
357  read(15) im0
358  if(im0.gt.0) then
359  meminset(k)=meminset(k)+1
360  else
361 !
362 ! im0<0 and two elements are already stored
363 !
364  meminset(k)=meminset(k)+(im2-im1)/im0-1
365  endif
366  if(rmeminset(k).eq.j) then
367  iact=0
368  rmeminset(k)=mem
369 !
370 ! make set k ineligible in further iterations
371 !
372  meminset(k)=-meminset(k)
373  endif
374  enddo
375 !
376 ! restore the sign of meminset
377 !
378  do k=1,nset
379  meminset(k)=-meminset(k)
380  enddo
381 !
382  close(15)
383 !
384  return
385 !
386  15 write(*,*) '*ERROR in restartshort: could not open file ',fnrstrt
387  call exit(201)
skip
subroutine skip(nset, nalset, nload, nbody, nforc, nboun, nk, ne, nkon, mi, nmpc, memmpc_, nmat, ntmat_, npmat_, ncmat_, norien, ntrans, nam, nprint, nlabel, ncs_, ne1d, ne2d, infree, nmethod, iperturb, nener, ithermal, nstate_, iprestr, mcs, ntie, nslavs, nprop, mortar, ifacecount, nintpoint)
Definition: skip.f:25
Hosted by OpenAircraft.com, (Michigan UAV, LLC)