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

Go to the source code of this file.

Functions/Subroutines

subroutine allocation (nload, nforc, nboun, nk, ne, nmpc, nset, nalset, nmat, ntmat, npmat, norien, nam, nprint, mi, ntrans, set, meminset, rmeminset, ncs, namtot, ncmat, memmpc, ne1d, ne2d, nflow, jobnamec, irstrt, ithermal, nener, nstate, irestartstep, inpc, ipoinp, inp, ntie, nbody, nprop, ipoinpc, nevdamp, npt, nslavs, nkon, mcs, mortar, ifacecount, nintpoint, infree, nheading, nobject, iuel)
 

Function/Subroutine Documentation

◆ allocation()

subroutine allocation ( integer  nload,
integer  nforc,
integer  nboun,
integer  nk,
integer  ne,
integer  nmpc,
integer  nset,
integer  nalset,
integer  nmat,
integer  ntmat,
integer  npmat,
integer  norien,
integer  nam,
integer  nprint,
integer, dimension(*)  mi,
integer  ntrans,
character*81, dimension(*)  set,
integer, dimension(*)  meminset,
integer, dimension(*)  rmeminset,
integer  ncs,
integer  namtot,
integer  ncmat,
integer  memmpc,
integer  ne1d,
integer  ne2d,
integer  nflow,
character*132, dimension(*)  jobnamec,
integer  irstrt,
integer, dimension(2)  ithermal,
integer  nener,
integer  nstate,
integer  irestartstep,
character*1, dimension(*)  inpc,
integer, dimension(2,*)  ipoinp,
integer, dimension(3,*)  inp,
integer  ntie,
integer  nbody,
integer  nprop,
integer, dimension(0:*)  ipoinpc,
integer  nevdamp,
integer  npt,
integer  nslavs,
integer  nkon,
integer  mcs,
integer  mortar,
integer  ifacecount,
integer  nintpoint,
integer, dimension(4)  infree,
integer  nheading,
integer  nobject,
integer, dimension(4,*)  iuel 
)
27 !
28 ! calculates a conservative estimate of the size of the
29 ! fields to be allocated
30 !
31 ! the underscores were dropped since they caused problems in the
32 ! DDD debugger.
33 !
34 ! meminset=total # of terms in sets
35 ! rmeminset=total # of reduced terms (due to use of generate) in
36 ! sets
37 !
38 ! nstate needs only be assigned for
39 ! a. restart (read from file)
40 ! b. initial conditions (defined by *depvar)
41 !
42  implicit none
43 !
44  logical igen,lin,frequency,cyclicsymmetry,composite,
45  & tabular,massflow,beamgeneralsection
46 !
47  character*1 selabel,sulabel,inpc(*)
48  character*5 llab
49  character*8 label
50  character*20 mpclabel
51  character*81 set(*),noset,elset,slavset,mastset,noelset,
52  & surface,slavsets,slavsett,mastsets,mastsett
53  character*132 jobnamec(*),textpart(16)
54 !
55  integer nload,nforc,nboun,nk,ne,nmpc,nset,nalset,
56  & nmat,ntmat,npmat,norien,nam,nprint,kode,iline,
57  & istat,n,key,meminset(*),i,js,inoset,mi(*),ii,ipol,inl,
58  & ibounstart,ibounend,ibound,ntrans,ntmatl,npmatl,ityp,l,
59  & ielset,nope,nteller,nterm,ialset(16),ncs,rmeminset(*),
60  & islavset,imastset,namtot,ncmat,nconstants,memmpc,j,ipos,
61  & maxrmeminset,ne1d,ne2d,necper,necpsr,necaxr,nesr,
62  & neb32,nn,nflow,nradiate,irestartread,irestartstep,icntrl,
63  & irstrt,ithermal(2),nener,nstate,ipoinp(2,*),inp(3,*),
64  & ntie,nbody,nprop,ipoinpc(0:*),nevdamp,npt,nentries,
65  & iposs,iposm,nslavs,nlayer,nkon,nopeexp,k,iremove,mcs,
66  & ifacecount,nintpoint,mortar,infree(4),nheading,icfd,
67  & multslav,multmast,nobject,numnodes,iorientation,id,
68  & irotation,itranslation,nuel,iuel(4,*),number,four
69 !
70  real*8 temperature,tempact,xfreq,tpinc,tpmin,tpmax
71 !
72  parameter(nentries=17)
73 !
74 ! icfd=-1: initial value
75 ! =0: pure mechanical analysis
76 ! =1: pure CFD analysis
77 ! =2: mixed mechanical/cfd analysis
78 !
79  icfd=-1
80 !
81 ! in the presence of mechanical steps the highest number
82 ! of DOF is at least 3
83 !
84  if(ithermal(2).ne.2) mi(2)=3
85 !
86 ! initialisation of ipoinp
87 !
88  do i=1,nentries
89  if(ipoinp(1,i).ne.0) then
90  ipol=i
91  inl=ipoinp(1,i)
92  iline=inp(1,inl)-1
93  exit
94  endif
95  enddo
96 !
97  istat=0
98 !
99  nset=0
100  maxrmeminset=0
101  necper=0
102  necpsr=0
103  necaxr=0
104  nesr=0
105  neb32=0
106  nradiate=0
107  nkon=0
108  nuel=0
109 !
110  four=4
111 !
112  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
113  & ipoinp,inp,ipoinpc)
114  do
115  if(istat.lt.0) then
116  exit
117  endif
118 !
119  if(textpart(1)(1:10).eq.'*AMPLITUDE') then
120  nam=nam+1
121  do
122  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
123  & ipoinp,inp,ipoinpc)
124  if((istat.lt.0).or.(key.eq.1)) exit
125  namtot=namtot+4
126  enddo
127  elseif(textpart(1)(1:19).eq.'*BEAMGENERALSECTION') then
128  mi(3)=max(mi(3),2)
129  do
130  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
131  & ipoinp,inp,ipoinpc)
132  if((istat.lt.0).or.(key.eq.1)) then
133 c nprop=nprop-8
134  exit
135  endif
136  nprop=nprop+8
137  enddo
138  elseif(textpart(1)(1:12).eq.'*BEAMSECTION') then
139  mi(3)=max(mi(3),2)
140  beamgeneralsection=.false.
141  do i=2,n
142  if((textpart(i)(1:11).eq.'SECTION=BOX').or.
143  & (textpart(i)(1:11).eq.'SECTION=PIP').or.
144  & (textpart(i)(1:11).eq.'SECTION=GEN')) then
145  beamgeneralsection=.true.
146  exit
147  endif
148  enddo
149  if(beamgeneralsection) then
150  do
151  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
152  & inl,ipoinp,inp,ipoinpc)
153  if((istat.lt.0).or.(key.eq.1)) then
154 c nprop=nprop-8
155  exit
156  endif
157  nprop=nprop+8
158  enddo
159  else
160  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
161  & inl,ipoinp,inp,ipoinpc)
162  endif
163  elseif(textpart(1)(1:10).eq.'*BOUNDARYF') then
164  nam=nam+1
165  namtot=namtot+1
166  do
167  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
168  & ipoinp,inp,ipoinpc)
169  if((istat.lt.0).or.(key.eq.1)) exit
170 !
171  read(textpart(3)(1:10),'(i10)',iostat=istat) ibounstart
172  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
173  &"*BOUNDARYF%")
174 !
175  if(textpart(4)(1:1).eq.' ') then
176  ibounend=ibounstart
177  else
178  read(textpart(4)(1:10),'(i10)',iostat=istat) ibounend
179  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
180  &"*BOUNDARYF%")
181  endif
182  ibound=ibounend-ibounstart+1
183  ibound=max(1,ibound)
184 c ibound=min(3,ibound)
185 !
186  read(textpart(1)(1:10),'(i10)',iostat=istat) l
187  if(istat.eq.0) then
188  nboun=nboun+ibound
189  if(ntrans.gt.0) then
190  nmpc=nmpc+ibound
191  memmpc=memmpc+4*ibound
192  nk=nk+1
193  endif
194  else
195  read(textpart(1)(1:80),'(a80)',iostat=istat) elset
196  elset(81:81)=' '
197  ipos=index(elset,' ')
198 !
199 ! check for element set
200 !
201  elset(ipos:ipos)='E'
202  do i=1,nset
203  if(set(i).eq.elset) then
204  nboun=nboun+ibound*meminset(i)
205  if(ntrans.gt.0)then
206  nmpc=nmpc+ibound*meminset(i)
207  memmpc=memmpc+4*ibound*meminset(i)
208  nk=nk+meminset(i)
209  endif
210  exit
211  endif
212  enddo
213  if(i.gt.nset) then
214 !
215 ! check for facial surface
216 !
217  elset(ipos:ipos)='T'
218  do i=1,nset
219  if(set(i).eq.elset) then
220  nboun=nboun+ibound*meminset(i)
221  if(ntrans.gt.0)then
222  nmpc=nmpc+ibound*meminset(i)
223  memmpc=memmpc+4*ibound*meminset(i)
224  nk=nk+meminset(i)
225  endif
226  exit
227  endif
228  enddo
229  endif
230  endif
231  enddo
232  elseif(textpart(1)(1:9).eq.'*BOUNDARY') then
233  nam=nam+1
234  namtot=namtot+1
235  do
236  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
237  & ipoinp,inp,ipoinpc)
238  if((istat.lt.0).or.(key.eq.1)) exit
239 !
240  read(textpart(2)(1:10),'(i10)',iostat=istat) ibounstart
241  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
242  &"*BOUNDARY%")
243 !
244  if(textpart(3)(1:1).eq.' ') then
245  ibounend=ibounstart
246  else
247  read(textpart(3)(1:10),'(i10)',iostat=istat) ibounend
248  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
249  &"*BOUNDARY%")
250  endif
251  ibound=ibounend-ibounstart+1
252  ibound=max(1,ibound)
253 c ibound=min(mi(2),ibound)
254 !
255  read(textpart(1)(1:10),'(i10)',iostat=istat) l
256  if(istat.eq.0) then
257  nboun=nboun+ibound
258  if(ntrans.gt.0) then
259  nmpc=nmpc+ibound
260  memmpc=memmpc+4*ibound
261  nk=nk+1
262  endif
263  else
264  read(textpart(1)(1:80),'(a80)',iostat=istat) noset
265  noset(81:81)=' '
266  ipos=index(noset,' ')
267  noset(ipos:ipos)='N'
268  do i=1,nset
269  if(set(i).eq.noset) then
270  nboun=nboun+ibound*meminset(i)
271  if(ntrans.gt.0)then
272  nmpc=nmpc+ibound*meminset(i)
273  memmpc=memmpc+4*ibound*meminset(i)
274  nk=nk+meminset(i)
275  endif
276  exit
277  endif
278  enddo
279  endif
280  enddo
281  elseif(textpart(1)(1:6).eq.'*CFLUX') then
282  nam=nam+1
283  namtot=namtot+1
284  do
285  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
286  & ipoinp,inp,ipoinpc)
287  if((istat.lt.0).or.(key.eq.1)) exit
288 !
289  read(textpart(1)(1:10),'(i10)',iostat=istat) l
290  if(istat.eq.0) then
291  nforc=nforc+1
292  else
293  read(textpart(1)(1:80),'(a80)',iostat=istat) noset
294  noset(81:81)=' '
295  ipos=index(noset,' ')
296  noset(ipos:ipos)='N'
297  do i=1,nset
298  if(set(i).eq.noset) then
299  nforc=nforc+meminset(i)
300  exit
301  endif
302  enddo
303  endif
304  enddo
305  elseif(textpart(1)(1:6).eq.'*CLOAD') then
306  nam=nam+1
307  namtot=namtot+1
308  do
309  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
310  & ipoinp,inp,ipoinpc)
311  if((istat.lt.0).or.(key.eq.1)) exit
312 !
313  read(textpart(1)(1:10),'(i10)',iostat=istat) l
314  if(istat.eq.0) then
315  if(ntrans.eq.0) then
316  nforc=nforc+1
317  else
318  nforc=nforc+3
319  endif
320  else
321  read(textpart(1)(1:80),'(a80)',iostat=istat) noset
322  noset(81:81)=' '
323  ipos=index(noset,' ')
324  noset(ipos:ipos)='N'
325  do i=1,nset
326  if(set(i).eq.noset) then
327  if(ntrans.eq.0) then
328  nforc=nforc+meminset(i)
329  else
330  nforc=nforc+3*meminset(i)
331  endif
332  exit
333  endif
334  enddo
335  endif
336  enddo
337  elseif((textpart(1)(1:13).eq.'*CONDUCTIVITY').or.
338  & (textpart(1)(1:8).eq.'*DENSITY').or.
339  & (textpart(1)(1:10).eq.'*EXPANSION').or.
340  & (textpart(1)(1:15).eq.'*FLUIDCONSTANTS').or.
341  & (textpart(1)(1:13).eq.'*SPECIFICHEAT').or.
342  & (textpart(1)(1:23).eq.'*ELECTRICALCONDUCTIVITY')) then
343  ntmatl=0
344  do
345  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
346  & ipoinp,inp,ipoinpc)
347  if((istat.lt.0).or.(key.eq.1)) exit
348  ntmatl=ntmatl+1
349  ntmat=max(ntmatl,ntmat)
350  enddo
351  elseif(textpart(1)(1:11).eq.'*CONSTRAINT') then
352  do
353  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
354  & ipoinp,inp,ipoinpc)
355  if((istat.lt.0).or.(key.eq.1)) exit
356  nobject=nobject+1
357  enddo
358  elseif(textpart(1)(1:15).eq.'*CONTACTDAMPING') then
359  ncmat=max(8,ncmat)
360  ntmat=max(1,ntmat)
361  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
362  & ipoinp,inp,ipoinpc)
363  elseif(textpart(1)(1:12).eq.'*CONTACTPAIR') then
364  do
365  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
366  & ipoinp,inp,ipoinpc)
367  if((istat.lt.0).or.(key.eq.1)) exit
368  ntie=ntie+1
369  enddo
370  elseif(textpart(1)(1:13).eq.'*CONTACTPRINT') then
371  do
372  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
373  & ipoinp,inp,ipoinpc)
374  if((istat.lt.0).or.(key.eq.1)) exit
375  nprint=nprint+n
376  enddo
377  elseif(textpart(1)(1:9).eq.'*COUPLING') then
378  surface(1:1)=' '
379  iorientation=0
380  do i=2,n
381  if(textpart(i)(1:8).eq.'SURFACE=') then
382  surface=textpart(i)(9:88)
383  ipos=index(surface,' ')
384  surface(ipos:ipos)='T'
385  elseif(textpart(i)(1:12).eq.'ORIENTATION=') then
386  iorientation=1
387  endif
388  enddo
389  if(surface(1:1).ne.' ') then
390  do i=1,nset
391  surface(ipos:ipos)='T'
392  if(set(i).eq.surface) then
393  numnodes=8*meminset(i)
394  exit
395  endif
396  surface(ipos:ipos)='S'
397  if(set(i).eq.surface) then
398  numnodes=meminset(i)
399  exit
400  endif
401  enddo
402  endif
403  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
404  & ipoinp,inp,ipoinpc)
405  elseif(textpart(1)(1:6).eq.'*CREEP') then
406  ntmatl=0
407  npmat=max(2,npmat)
408  if(ncmat.le.2) then
409 ! elastic isotropic
410  ncmat=max(9,ncmat)
411  else
412 ! elastic anisotropic
413  ncmat=max(19,ncmat)
414  endif
415  do
416  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
417  & ipoinp,inp,ipoinpc)
418  if((istat.lt.0).or.(key.eq.1)) exit
419  ntmatl=ntmatl+1
420  enddo
421  ntmat=max(ntmatl,ntmat)
422  elseif(textpart(1)(1:16).eq.'*CYCLICHARDENING') then
423  ntmatl=0
424  do
425  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
426  & ipoinp,inp,ipoinpc)
427  if((istat.lt.0).or.(key.eq.1)) exit
428  read(textpart(3)(1:20),'(f20.0)',iostat=istat)
429  & temperature
430  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
431  &"*CYCLIC HARDENING%")
432  if(ntmatl.eq.0) then
433  npmatl=0
434  ntmatl=ntmatl+1
435  ntmat=max(ntmatl,ntmat)
436  tempact=temperature
437  elseif(temperature.ne.tempact) then
438  npmatl=0
439  ntmatl=ntmatl+1
440  ntmat=max(ntmatl,ntmat)
441  tempact=temperature
442  endif
443  npmatl=npmatl+1
444  npmat=max(npmatl,npmat)
445  enddo
446  elseif(textpart(1)(1:20).eq.'*CYCLICSYMMETRYMODEL') then
447 !
448 ! possible MPC's: static temperature, displacements(velocities)
449 ! and static pressure
450 !
451  nk=nk+1
452  nmpc=nmpc+5*ncs
453  memmpc=memmpc+125*ncs
454  ntrans=ntrans+1
455  do
456  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
457  & ipoinp,inp,ipoinpc)
458  if((istat.lt.0).or.(key.eq.1)) exit
459  enddo
460  elseif(textpart(1)(1:8).eq.'*DASHPOT') then
461  nmat=nmat+1
462  frequency=.false.
463  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
464  & ipoinp,inp,ipoinpc)
465  if((istat.lt.0).or.(key.eq.1)) return
466  read(textpart(2)(1:20),'(f20.0)',iostat=istat)
467  & xfreq
468  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
469  &"*DASHPOT%")
470  if(xfreq.gt.0.d0) frequency=.true.
471  iline=iline-1
472  if(.not.frequency) then
473  ntmatl=0
474  ncmat=max(2,ncmat)
475  do
476  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
477  & inl,ipoinp,inp,ipoinpc)
478  if((istat.lt.0).or.(key.eq.1)) exit
479  ntmatl=ntmatl+1
480  ntmat=max(ntmatl,ntmat)
481  enddo
482  else
483  ntmatl=0
484  do
485  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
486  & inl,ipoinp,inp,ipoinpc)
487  if((istat.lt.0).or.(key.eq.1)) exit
488  read(textpart(3)(1:20),'(f20.0)',iostat=istat)
489  & temperature
490  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
491  &"*DASHPOT%")
492  if(ntmatl.eq.0) then
493  npmatl=0
494  ntmatl=ntmatl+1
495  ntmat=max(ntmatl,ntmat)
496  tempact=temperature
497  elseif(temperature.ne.tempact) then
498  npmatl=0
499  ntmatl=ntmatl+1
500  ntmat=max(ntmatl,ntmat)
501  tempact=temperature
502  endif
503  npmatl=npmatl+1
504  npmat=max(npmatl,npmat)
505  enddo
506  if(ncmat.ge.9) ncmat=max(19,ncmat)
507  endif
508  elseif(textpart(1)(1:22).eq.'*DEFORMATIONPLASTICITY') then
509  ncmat=max(5,ncmat)
510  ntmatl=0
511  do
512  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
513  & ipoinp,inp,ipoinpc)
514  if((istat.lt.0).or.(key.eq.1)) exit
515  ntmatl=ntmatl+1
516  ntmat=max(ntmatl,ntmat)
517  enddo
518  elseif(textpart(1)(1:7).eq.'*DEPVAR') then
519  do
520  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
521  & ipoinp,inp,ipoinpc)
522  if((istat.lt.0).or.(key.eq.1)) exit
523  read(textpart(1)(1:10),'(i10)',iostat=istat) l
524  if(istat.lt.0) exit
525  nstate=max(l,nstate)
526  enddo
527  elseif(textpart(1)(1:16).eq.'*DESIGNVARIABLES') then
528  ntie=ntie+1
529  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
530  & ipoinp,inp,ipoinpc)
531  elseif(textpart(1)(1:21).eq.'*DISTRIBUTINGCOUPLING') then
532  nmpc=nmpc+3
533  memmpc=memmpc+3
534  do
535  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
536  & ipoinp,inp,ipoinpc)
537  if((istat.lt.0).or.(key.eq.1)) exit
538 !
539  read(textpart(1)(1:10),'(i10)',iostat=istat) l
540  if(istat.eq.0) then
541  memmpc=memmpc+3
542  else
543  read(textpart(1)(1:80),'(a80)',iostat=istat) noset
544  noset(81:81)=' '
545  ipos=index(noset,' ')
546  noset(ipos:ipos)='N'
547  do i=1,nset
548  if(set(i).eq.noset) then
549  memmpc=memmpc+3*meminset(i)
550  exit
551  endif
552  enddo
553  endif
554  enddo
555  elseif(textpart(1)(2:13).eq.'DISTRIBUTING') then
556  irotation=0
557  itranslation=0
558  do
559  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
560  & ipoinp,inp,ipoinpc)
561  if((istat.lt.0).or.(key.eq.1)) exit
562 !
563  read(textpart(1)(1:10),'(i10)',iostat=istat) ibounstart
564  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
565  &"*BOUNDARY%")
566 !
567  if(textpart(2)(1:1).eq.' ') then
568  ibounend=ibounstart
569  else
570  read(textpart(2)(1:10),'(i10)',iostat=istat) ibounend
571  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
572  &"*BOUNDARY%")
573  endif
574  ibounstart=max(4,ibounstart)
575  ibounend=min(6,ibounend)
576  ibound=max(0,ibounend-ibounstart+1)
577 !
578  if(itranslation.eq.0) then
579 !
580 ! translational dofs 3 MPC's + a two-term MPC for each
581 ! participating node
582 !
583  npt=max(npt,numnodes)
584 !
585  nmpc=nmpc+3*npt+3
586  memmpc=memmpc+6*npt+3*(npt+1)
587  nk=nk+npt
588  itranslation=1
589  endif
590 !
591 ! rotational dofs
592 !
593  if(ibound.gt.0) then
594  if(irotation.eq.0) then
595 !
596 ! a MPC connecting the dofs 4-6 to dofs 1-3 of
597 ! a rotational node; generation of a inhomogeneous
598 ! node
599 !
600  nmpc=nmpc+3
601  memmpc=memmpc+6
602  nk=nk+4
603  irotation=1
604  endif
605  nmpc=nmpc+ibound
606  memmpc=memmpc+ibound*(3*npt+2)
607  nboun=nboun+ibound
608  endif
609  enddo
610  elseif((textpart(1)(1:6).eq.'*DLOAD').or.
611  & (textpart(1)(1:7).eq.'*DSLOAD').or.
612  & (textpart(1)(1:6).eq.'*DFLUX').or.
613  & (textpart(1)(1:9).eq.'*MASSFLOW').or.
614  & (textpart(1)(1:5).eq.'*FILM')) then
615  massflow=.false.
616  if((textpart(1)(1:5).ne.'*FILM').and.
617  & (textpart(1)(1:9).ne.'*MASSFLOW')) then
618  nam=nam+1
619  namtot=namtot+1
620  elseif(textpart(1)(1:9).ne.'*MASSFLOW') then
621  nam=nam+2
622  namtot=namtot+2
623  else
624  massflow=.true.
625  endif
626  do
627  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
628  & ipoinp,inp,ipoinpc)
629  if((istat.lt.0).or.(key.eq.1)) exit
630  read(textpart(2)(1:5),'(a5)',iostat=istat) llab
631  if((llab.eq.'GRAV ').or.(llab.eq.'CENTR').or.
632  & (llab.eq.'NEWTO')) then
633  nbody=nbody+1
634  cycle
635  endif
636  read(textpart(1)(1:10),'(i10)',iostat=istat) l
637  if(istat.eq.0) then
638  nload=nload+1
639  if(massflow) then
640  nmpc=nmpc+1
641  memmpc=memmpc+3
642  endif
643  else
644  read(textpart(1)(1:80),'(a80)',iostat=istat) elset
645  elset(81:81)=' '
646  ipos=index(elset,' ')
647 !
648 ! check for element set
649 !
650  elset(ipos:ipos)='E'
651  do i=1,nset
652  if(set(i).eq.elset) then
653  nload=nload+meminset(i)
654  if(massflow) then
655  nmpc=nmpc+meminset(i)
656  memmpc=memmpc+3*meminset(i)
657  endif
658  exit
659  endif
660  enddo
661  if(i.gt.nset) then
662 !
663 ! check for facial surface
664 !
665  elset(ipos:ipos)='T'
666  do i=1,nset
667  if(set(i).eq.elset) then
668  nload=nload+meminset(i)
669  if(massflow) then
670  nmpc=nmpc+meminset(i)
671  memmpc=memmpc+3*meminset(i)
672  endif
673  exit
674  endif
675  enddo
676  endif
677  endif
678  enddo
679  elseif((textpart(1)(1:8).eq.'*DYNAMIC').or.
680  & (textpart(1)(1:32).eq.'*COUPLEDTEMPERATURE-DISPLACEMENT')
681  & .or.
682  & (textpart(1)(1:34).eq.'*UNCOUPLEDTEMPERATURE-DISPLACEMENT'))
683  & then
684 !
685 ! change of number of integration points except for a pure
686 ! CFD-calculation
687 !
688  if(icfd.ne.1) then
689  if((mi(1).eq.1).or.(mi(1).eq.8).or.(mi(1).eq.27)) then
690  mi(1)=27
691  elseif(mi(1).eq.4) then
692  mi(1)=15
693  else
694 c mi(1)=18
695  mi(1)=9
696  endif
697  endif
698  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
699  & ipoinp,inp,ipoinpc)
700  elseif(textpart(1)(1:8).eq.'*ELPRINT') then
701  do
702  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
703  & ipoinp,inp,ipoinpc)
704  if((istat.lt.0).or.(key.eq.1)) exit
705  nprint=nprint+n
706  enddo
707  elseif(textpart(1)(1:8).eq.'*ELASTIC') then
708  ntmatl=0
709  ityp=2
710  ncmat=max(2,ncmat)
711  do i=2,n
712  if(textpart(i)(1:5).eq.'TYPE=') then
713  if(textpart(i)(6:8).eq.'ISO') then
714  ityp=2
715  ncmat=max(2,ncmat)
716  elseif((textpart(i)(6:10).eq.'ORTHO').or.
717  & (textpart(i)(6:10).eq.'ENGIN')) then
718  ityp=9
719  ncmat=max(9,ncmat)
720  elseif(textpart(i)(6:10).eq.'ANISO') then
721  ityp=21
722  ncmat=max(21,ncmat)
723  endif
724  exit
725  endif
726  enddo
727  if(ityp.eq.2) then
728  do
729  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
730  & inl,ipoinp,inp,ipoinpc)
731  if((istat.lt.0).or.(key.eq.1)) exit
732  ntmatl=ntmatl+1
733  enddo
734  ntmat=max(ntmatl,ntmat)
735  elseif(ityp.eq.9) then
736  do
737  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
738  & inl,ipoinp,inp,ipoinpc)
739  if((istat.lt.0).or.(key.eq.1)) exit
740  ntmatl=ntmatl+1
741  iline=iline+1
742  enddo
743  ntmat=max(ntmatl,ntmat)
744  elseif(ityp.eq.21) then
745  do
746  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
747  & inl,ipoinp,inp,ipoinpc)
748  if((istat.lt.0).or.(key.eq.1)) exit
749  ntmatl=ntmatl+1
750  iline=iline+2
751  enddo
752  ntmat=max(ntmatl,ntmat)
753  endif
754  elseif(textpart(1)(1:17).eq.'*ELECTROMAGNETICS') then
755  mi(2)=max(mi(2),5)
756  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
757  & ipoinp,inp,ipoinpc)
758  elseif((textpart(1)(1:8).eq.'*ELEMENT').and.
759  & (textpart(1)(1:14).ne.'*ELEMENTOUTPUT')) then
760  ielset=0
761 !
762  loop1: do i=2,n
763  if(textpart(i)(1:6).eq.'ELSET=') then
764  elset=textpart(i)(7:86)
765  elset(81:81)=' '
766  ipos=index(elset,' ')
767  elset(ipos:ipos)='E'
768  ielset=1
769  do js=1,nset
770  if(set(js).eq.elset) exit
771  enddo
772  if(js.gt.nset) then
773  nset=nset+1
774  set(nset)=elset
775  endif
776  elseif(textpart(i)(1:5).eq.'TYPE=') then
777  read(textpart(i)(6:13),'(a8)') label
778  if(label.eq.' ') then
779  write(*,*)
780  & '*ERROR in allocation: element type is lacking'
781  write(*,*) ' '
782  call inputerror(inpc,ipoinpc,iline,
783  &"*ELEMENT or *ELEMENT OUTPUT%")
784  call exit(201)
785  endif
786  if((label(1:2).eq.'DC').and.(label(1:7).ne.'DCOUP3D'))
787  & then
788  label(1:7)=label(2:8)
789  label(8:8)=' '
790  endif
791 !
792  nopeexp=0
793 !
794  if(label.eq.'C3D20 ') then
795  mi(1)=max(mi(1),27)
796  nope=20
797  nopeexp=20
798  elseif(label(1:8).eq.'C3D20R ') then
799  mi(1)=max(mi(1),8)
800  nope=20
801  nopeexp=20
802  elseif((label.eq.'C3D8R ').or.(label.eq.'F3D8 '))
803  & then
804  mi(1)=max(mi(1),1)
805  nope=8
806  nopeexp=8
807  elseif((label.eq.'C3D10 ').or.
808  & (label.eq.'C3D10T ')) then
809  mi(1)=max(mi(1),4)
810  nope=10
811  nopeexp=10
812  elseif((label.eq.'C3D4 ').or.
813  & (label.eq.'F3D4 ')) then
814  mi(1)=max(mi(1),1)
815  nope=4
816  nopeexp=4
817  elseif(label.eq.'C3D15 ') then
818  mi(1)=max(mi(1),9)
819  nope=15
820  nopeexp=15
821  elseif(label.eq.'C3D6 ') then
822  mi(1)=max(mi(1),2)
823  nope=6
824  nopeexp=6
825  elseif(label.eq.'F3D6 ') then
826  mi(1)=max(mi(1),1)
827  nope=6
828  nopeexp=6
829  elseif(label.eq.'C3D8 ') then
830  mi(1)=max(mi(1),8)
831  nope=8
832  nopeexp=8
833 c elseif(label.eq.'F3D8 ') then
834 c mi(1)=max(mi(1),1)
835 c nope=8
836 c nopeexp=8
837 c Bernhardi start
838  elseif(label.eq.'C3D8I ') then
839  mi(1)=max(mi(1),8)
840  nope=8
841  nopeexp=11
842 c Bernhardi end
843  elseif((label.eq.'CPE3 ').or.
844  & (label.eq.'CPS3 ').or.
845  & (label.eq.'CAX3 ').or.
846  & (label.eq.'M3D3 ').or.
847  & (label.eq.'S3 ')) then
848  mi(1)=max(mi(1),2)
849  nope=3
850  nopeexp=9
851  elseif((label.eq.'CPE4R ').or.
852  & (label.eq.'CPS4R ').or.
853  & (label.eq.'CAX4R ').or.
854  & (label.eq.'M3D4R ').or.
855  & (label.eq.'S4R ')) then
856  mi(1)=max(mi(1),1)
857  nope=4
858  nopeexp=12
859  elseif((label.eq.'CPE4 ').or.
860  & (label.eq.'CPS4 ').or.
861  & (label.eq.'CAX4 ').or.
862  & (label.eq.'M3D4 ').or.
863  & (label.eq.'S4 ')) then
864  mi(1)=max(mi(1),8)
865  nope=4
866 ! modified into C3D8I (11 nodes)
867  nopeexp=15
868  elseif((label.eq.'CPE6 ').or.
869  & (label.eq.'CPS6 ').or.
870  & (label.eq.'CAX6 ').or.
871  & (label.eq.'M3D6 ').or.
872  & (label.eq.'S6 ')) then
873  mi(1)=max(mi(1),9)
874  nope=6
875  nopeexp=21
876  elseif((label.eq.'CPE8R ').or.
877  & (label.eq.'CPS8R ').or.
878  & (label.eq.'CAX8R ').or.
879  & (label.eq.'M3D8R ').or.
880  & (label.eq.'S8R ')) then
881  mi(1)=max(mi(1),8)
882  nope=8
883  nopeexp=28
884  elseif((label.eq.'CPE8 ').or.
885  & (label.eq.'CPS8 ').or.
886  & (label.eq.'CAX8 ').or.
887  & (label.eq.'M3D8 ').or.
888  & (label.eq.'S8 ')) then
889  mi(1)=max(mi(1),27)
890  nope=8
891  nopeexp=28
892  elseif((label.eq.'B31 ').or.
893  & (label.eq.'B21 ').or.
894  & (label.eq.'T3D2 ').or.
895  & (label.eq.'T2D2 ')) then
896  mi(1)=max(mi(1),8)
897  mi(3)=max(mi(3),2)
898  nope=2
899 ! modified into C3D8I (11 nodes)
900  nopeexp=13
901  elseif(label.eq.'B31R ') then
902  mi(1)=max(mi(1),1)
903  nope=2
904  nopeexp=10
905  elseif((label.eq.'B32 ').or.
906  & (label.eq.'T3D3 ')) then
907  mi(1)=max(mi(1),27)
908  mi(3)=max(mi(3),2)
909  nope=3
910  nopeexp=23
911  elseif(label.eq.'B32R ') then
912 c mi(1)=max(mi(1),8)
913  mi(1)=max(mi(1),50)
914  nope=3
915  nopeexp=23
916  elseif(label(1:8).eq.'DASHPOTA') then
917  label='EDSHPTA1'
918  nope=2
919  nopeexp=2
920  elseif(label(1:7).eq.'DCOUP3D') then
921  nope=1
922  nopeexp=1
923  elseif(label(1:1).eq.'D') then
924  nope=3
925  nopeexp=3
926  mi(2)=max(3,mi(2))
927  elseif(label(1:7).eq.'SPRINGA') then
928  mi(1)=max(mi(1),1)
929  label='ESPRNGA1'
930  nope=2
931  nopeexp=2
932  elseif(label(1:7).eq.'SPRING1') then
933  mi(1)=max(mi(1),1)
934  label='ESPRNG10'
935  nope=1
936  nopeexp=1
937  ncmat=max(3,ncmat)
938  elseif(label(1:7).eq.'SPRING2') then
939  mi(1)=max(mi(1),1)
940  label='ESPRNG21'
941  nope=2
942  nopeexp=2
943  ncmat=max(4,ncmat)
944  elseif(label.eq.'GAPUNI ') then
945  mi(1)=max(mi(1),1)
946  label='ESPGAPA1'
947  nope=2
948  nopeexp=2
949  elseif(label(1:4).eq.'MASS') then
950  nope=1
951  nopeexp=1
952  elseif(label(1:1).eq.'U') then
953 !
954 ! the number uniquely characterizes the
955 ! element name (consisting of 4 freely
956 ! selectable characters in position 2..5)
957 !
958  number=ichar(label(2:2))*256**3+
959  & ichar(label(3:3))*256**2+
960  & ichar(label(4:4))*256+
961  & ichar(label(5:5))
962 c read(label(2:5),'(i4)',iostat=istat) number
963 c if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
964 c &"*ELEMENT%")
965  nope=-1
966  call nidentk(iuel,number,nuel,id,four)
967  if(id.gt.0) then
968  if(iuel(1,id).eq.number) then
969  mi(1)=max(mi(1),iuel(2,id))
970  mi(2)=max(mi(2),iuel(3,id))
971  nope=iuel(4,id)
972  nopeexp=nope
973  endif
974  endif
975  if(nope.eq.-1) then
976  write(*,*) '*ERROR reading *ELEMENT'
977  write(*,*) ' nonexistent element type:'
978  write(*,*) ' ',label
979  call exit(201)
980  endif
981  endif
982  if(label(1:1).eq.'F') then
983  mi(2)=max(mi(2),4)
984  if(icfd.eq.-1) then
985  icfd=1
986  elseif(icfd.eq.0) then
987  icfd=2
988  endif
989  else
990  if(icfd.eq.-1) then
991  icfd=0
992  elseif(icfd.eq.1) then
993  icfd=2
994  endif
995  endif
996  endif
997  enddo loop1
998 !
999  loop2:do
1000  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1001  & ipoinp,inp,ipoinpc)
1002  if((istat.lt.0).or.(key.eq.1)) exit
1003  read(textpart(1)(1:10),'(i10)',iostat=istat) i
1004  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
1005  &"*ELEMENT or *ELEMENT OUTPUT%")
1006 c Bernhardi start
1007 c space for incompatible mode nodes
1008  if(label(1:5).eq.'C3D8I') then
1009  nk=nk+3
1010  endif
1011 c Bernhardi end
1012  if(label(1:2).ne.'C3') then
1013  if(label(1:3).eq.'CPE') then
1014  necper=necper+1
1015  elseif(label(1:2).eq.'CP') then
1016  necpsr=necpsr+1
1017  elseif(label(1:1).eq.'C') then
1018  necaxr=necaxr+1
1019  elseif((label(1:1).eq.'S').or.
1020  & ((label(1:1).eq.'M').and.(label(1:4).ne.'MASS')))
1021  & then
1022  nesr=nesr+1
1023  elseif((label(1:1).eq.'B').or.
1024  & (label(1:1).eq.'T')) then
1025  neb32=neb32+1
1026  elseif(label(1:1).eq.'D') then
1027  nflow=nflow+1
1028  endif
1029  endif
1030  nteller=n-1
1031  if(nteller.lt.nope) then
1032  do
1033  call getnewline(inpc,textpart,istat,n,key,iline,
1034  & ipol,inl,ipoinp,inp,ipoinpc)
1035  if((istat.lt.0).or.(key.eq.1)) exit loop2
1036  if(nteller+n.gt.nope) n=nope-nteller
1037  nteller=nteller+n
1038  if(nteller.eq.nope) exit
1039  enddo
1040  endif
1041  ne=max(ne,i)
1042  nkon=nkon+nopeexp
1043  if(ielset.eq.1) then
1044  meminset(js)=meminset(js)+1
1045  rmeminset(js)=rmeminset(js)+1
1046  endif
1047 c!
1048 c! up to 8 new mpc's with 22 terms in each mpc
1049 c! (21 = 7 nodes x 3 dofs + inhomogeneous term)
1050 c!
1051  enddo loop2
1052  elseif((textpart(1)(1:5).eq.'*NSET').or.
1053  & (textpart(1)(1:6).eq.'*ELSET')) then
1054  if(textpart(1)(1:5).eq.'*NSET')
1055  & then
1056  noelset=textpart(2)(6:85)
1057  noelset(81:81)=' '
1058  ipos=index(noelset,' ')
1059  noelset(ipos:ipos)='N'
1060  kode=0
1061  else
1062  noelset=textpart(2)(7:86)
1063  noelset(81:81)=' '
1064  ipos=index(noelset,' ')
1065  noelset(ipos:ipos)='E'
1066  kode=1
1067  endif
1068 !
1069 ! check whether new set name or old one
1070 !
1071  do js=1,nset
1072  if(set(js).eq.noelset) exit
1073  enddo
1074  if(js.gt.nset) then
1075  nset=nset+1
1076  set(nset)=noelset
1077  nn=nset
1078  else
1079  nn=js
1080  endif
1081 !
1082  if((n.gt.2).and.(textpart(3)(1:8).eq.'GENERATE')) then
1083  igen=.true.
1084  else
1085  igen=.false.
1086  endif
1087  do
1088  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1089  & ipoinp,inp,ipoinpc)
1090  if((istat.lt.0).or.(key.eq.1)) exit
1091  if(igen) then
1092  if(textpart(2)(1:1).eq.' ')
1093  & textpart(2)=textpart(1)
1094  if(textpart(3)(1:1).eq.' ')
1095  & textpart(3)='1 '
1096  do i=1,3
1097  read(textpart(i)(1:10),'(i10)',iostat=istat)
1098  & ialset(i)
1099  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
1100  &"*NSET or *ELSET%")
1101  enddo
1102  meminset(nn)=meminset(nn)+
1103  & (ialset(2)-ialset(1))/ialset(3)+1
1104  rmeminset(nn)=rmeminset(nn)+3
1105  else
1106  do i=1,n
1107  read(textpart(i)(1:10),'(i10)',iostat=istat)
1108  & ialset(i)
1109  if(istat.gt.0) then
1110  noelset=textpart(i)(1:80)
1111  noelset(81:81)=' '
1112  ipos=index(noelset,' ')
1113  if(kode.eq.0) then
1114  noelset(ipos:ipos)='N'
1115  else
1116  noelset(ipos:ipos)='E'
1117  endif
1118  do j=1,nset
1119  if(noelset.eq.set(j)) then
1120  meminset(nn)=meminset(nn)+
1121  & meminset(j)
1122  rmeminset(nn)=rmeminset(nn)+
1123  & rmeminset(j)
1124  exit
1125  endif
1126  enddo
1127  else
1128  meminset(nn)=meminset(nn)+1
1129  rmeminset(nn)=rmeminset(nn)+1
1130  endif
1131  enddo
1132  endif
1133  enddo
1134  elseif((textpart(1)(1:9).eq.'*EQUATION').or.
1135  & (textpart(1)(1:10).eq.'*EQUATIONF')) then
1136  iremove=0
1137  do i=2,n
1138  if(textpart(i)(1:6).eq.'REMOVE') iremove=1
1139  enddo
1140  do
1141  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1142  & ipoinp,inp,ipoinpc)
1143  if(iremove.eq.1) exit
1144  if((istat.lt.0).or.(key.eq.1)) exit
1145  read(textpart(1)(1:10),'(i10)',iostat=istat) nterm
1146  if(ntrans.eq.0) then
1147  nmpc=nmpc+1
1148  memmpc=memmpc+nterm
1149  else
1150  nmpc=nmpc+3
1151  memmpc=memmpc+3*nterm
1152  endif
1153  ii=0
1154  do
1155  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
1156  & inl,ipoinp,inp,ipoinpc)
1157  if((istat.lt.0).or.(key.eq.1)) exit
1158  ii=ii+n/3
1159  if(ii.eq.nterm) exit
1160  enddo
1161  enddo
1162  elseif(textpart(1)(1:13).eq.'*FLUIDSECTION') then
1163  nconstants=-1
1164  do i=2,n
1165  if(textpart(i)(1:10).eq.'CONSTANTS=') then
1166  read(textpart(i)(11:20),'(i10)',iostat=istat)
1167  & nconstants
1168  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
1169  &"*FLUID SECTION%")
1170  nprop=nprop+nconstants
1171  exit
1172  endif
1173  enddo
1174  if(nconstants.lt.0) nprop=nprop+41
1175  do
1176  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1177  & ipoinp,inp,ipoinpc)
1178  if((istat.lt.0).or.(key.eq.1)) exit
1179  enddo
1180  elseif(textpart(1)(1:9).eq.'*FRICTION') then
1181 !
1182 ! '8' is for Mortar.
1183 !
1184  ncmat=max(8,ncmat)
1185  ntmat=max(1,ntmat)
1186  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1187  & ipoinp,inp,ipoinpc)
1188  elseif(textpart(1)(1:5).eq.'*GAP ') then
1189  nmat=nmat+1
1190  ncmat=max(6,ncmat)
1191  ntmat=max(1,ntmat)
1192  do
1193  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
1194  & inl,ipoinp,inp,ipoinpc)
1195  if((istat.lt.0).or.(key.eq.1)) exit
1196  enddo
1197  elseif(textpart(1)(1:15).eq.'*GAPCONDUCTANCE') then
1198  ntmatl=0
1199  do
1200  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
1201  & inl,ipoinp,inp,ipoinpc)
1202  if((istat.lt.0).or.(key.eq.1)) exit
1203  read(textpart(3)(1:20),'(f20.0)',iostat=istat)
1204  & temperature
1205  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
1206  &"*GAP CONDUCTANCE%")
1207  if(ntmatl.eq.0) then
1208  npmatl=0
1209  ntmatl=ntmatl+1
1210  ntmat=max(ntmatl,ntmat)
1211  tempact=temperature
1212  elseif(temperature.ne.tempact) then
1213  npmatl=0
1214  ntmatl=ntmatl+1
1215  ntmat=max(ntmatl,ntmat)
1216  tempact=temperature
1217  endif
1218  npmatl=npmatl+1
1219  npmat=max(npmatl,npmat)
1220  enddo
1221  elseif(textpart(1)(1:18).eq.'*GAPHEATGENERATION') then
1222  ncmat=max(11,ncmat)
1223  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1224  & ipoinp,inp,ipoinpc)
1225  elseif(textpart(1)(1:8).eq.'*HEADING') then
1226  if(nheading.ne.0) then
1227  write(*,*) '*ERROR in allocation: more than 1'
1228  write(*,*) ' *HEADING card in the input deck'
1229  call exit(201)
1230  endif
1231  do
1232  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1233  & ipoinp,inp,ipoinpc)
1234  if((istat.lt.0).or.(key.eq.1)) exit
1235  nheading=nheading+1
1236  enddo
1237  elseif(textpart(1)(1:13).eq.'*HYPERELASTIC') then
1238  ntmatl=0
1239  ityp=-7
1240  do i=2,n
1241  if(textpart(i)(1:12).eq.'ARRUDA-BOYCE') then
1242  ityp=-1
1243  ncmat=max(3,ncmat)
1244  elseif(textpart(i)(1:13).eq.'MOONEY-RIVLIN') then
1245  ityp=-2
1246  ncmat=max(3,ncmat)
1247  elseif(textpart(i)(1:8).eq.'NEOHOOKE') then
1248  ityp=-3
1249  ncmat=max(2,ncmat)
1250  elseif(textpart(i)(1:5).eq.'OGDEN') then
1251  ityp=-4
1252  ncmat=max(3,ncmat)
1253  elseif(textpart(i)(1:10).eq.'POLYNOMIAL') then
1254  ityp=-7
1255  ncmat=max(3,ncmat)
1256  elseif(textpart(i)(1:17).eq.'REDUCEDPOLYNOMIAL')
1257  & then
1258  ityp=-10
1259  ncmat=max(2,ncmat)
1260  elseif(textpart(i)(1:11).eq.'VANDERWAALS') then
1261  ityp=-13
1262  ncmat=max(5,ncmat)
1263  elseif(textpart(i)(1:4).eq.'YEOH') then
1264  ityp=-14
1265  ncmat=max(6,ncmat)
1266  elseif(textpart(i)(1:2).eq.'N=') then
1267  if(textpart(i)(3:3).eq.'1') then
1268  elseif(textpart(i)(3:3).eq.'2') then
1269  if(ityp.eq.-4) then
1270  ityp=-5
1271  ncmat=max(6,ncmat)
1272  elseif(ityp.eq.-7) then
1273  ityp=-8
1274  ncmat=max(7,ncmat)
1275  elseif(ityp.eq.-10) then
1276  ityp=-11
1277  ncmat=max(4,ncmat)
1278  endif
1279  elseif(textpart(i)(3:3).eq.'3') then
1280  if(ityp.eq.-4) then
1281  ityp=-6
1282  ncmat=max(9,ncmat)
1283  elseif(ityp.eq.-7) then
1284  ityp=-9
1285  ncmat=max(12,ncmat)
1286  elseif(ityp.eq.-10) then
1287  ityp=-12
1288  ncmat=max(6,ncmat)
1289  endif
1290  endif
1291  endif
1292  enddo
1293  if((ityp.ne.-6).and.(ityp.ne.-9)) then
1294  do
1295  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
1296  & inl,ipoinp,inp,ipoinpc)
1297  if((istat.lt.0).or.(key.eq.1)) exit
1298  ntmatl=ntmatl+1
1299  ntmat=max(ntmat,ntmatl)
1300  enddo
1301  else
1302  do
1303  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
1304  & inl,ipoinp,inp,ipoinpc)
1305  if((istat.lt.0).or.(key.eq.1)) exit
1306  ntmatl=ntmatl+1
1307  ntmat=max(ntmat,ntmatl)
1308  iline=iline+1
1309  enddo
1310  endif
1311  elseif(textpart(1)(1:10).eq.'*HYPERFOAM') then
1312  ntmatl=0
1313  ityp=-15
1314  ncmat=max(3,ncmat)
1315  do i=2,n
1316  if(textpart(i)(1:2).eq.'N=') then
1317  if(textpart(i)(3:3).eq.'1') then
1318  elseif(textpart(i)(3:3).eq.'2') then
1319  ityp=-16
1320  ncmat=max(6,ncmat)
1321  elseif(textpart(i)(3:3).eq.'3') then
1322  ityp=-17
1323  ncmat=max(9,ncmat)
1324  endif
1325  endif
1326  enddo
1327  if(ityp.ne.-17) then
1328  do
1329  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
1330  & inl,ipoinp,inp,ipoinpc)
1331  if((istat.lt.0).or.(key.eq.1)) exit
1332  ntmatl=ntmatl+1
1333  ntmat=max(ntmat,ntmatl)
1334  enddo
1335  else
1336  do
1337  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
1338  & inl,ipoinp,inp,ipoinpc)
1339  if((istat.lt.0).or.(key.eq.1)) exit
1340  ntmatl=ntmatl+1
1341  ntmat=max(ntmat,ntmatl)
1342  iline=iline+1
1343  enddo
1344  endif
1345  elseif(textpart(1)(2:10).eq.'KINEMATIC') then
1346  npt=max(npt,numnodes)
1347 !
1348 ! connection of rotational dofs in refnode to
1349 ! translational dofs in rotational node
1350 !
1351  nk=nk+1
1352  nmpc=nmpc+3
1353  memmpc=memmpc+6
1354 !
1355 ! local system
1356 !
1357  if(iorientation.ne.0) then
1358  nk=nk+2*numnodes
1359  nmpc=nmpc+3*numnodes
1360  memmpc=memmpc+3*6*numnodes
1361  nboun=nboun+3*numnodes
1362  endif
1363 !
1364  do
1365  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1366  & ipoinp,inp,ipoinpc)
1367  if((istat.lt.0).or.(key.eq.1)) exit
1368 !
1369  read(textpart(1)(1:10),'(i10)',iostat=istat) ibounstart
1370  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
1371  &"*BOUNDARY%")
1372 !
1373  if(textpart(2)(1:1).eq.' ') then
1374  ibounend=ibounstart
1375  else
1376  read(textpart(2)(1:10),'(i10)',iostat=istat) ibounend
1377  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
1378  &"*BOUNDARY%")
1379  endif
1380  ibound=ibounend-ibounstart+1
1381  ibound=max(1,ibound)
1382  ibound=min(3,ibound)
1383 !
1384  if(iorientation.eq.0) then
1385  nk=nk+numnodes
1386  nmpc=nmpc+ibound*numnodes
1387  memmpc=memmpc+6*ibound*numnodes
1388  nboun=nboun+ibound*numnodes
1389  else
1390  nmpc=nmpc+ibound*numnodes
1391  memmpc=memmpc+ibound*6*numnodes
1392  endif
1393  enddo
1394  elseif(textpart(1)(1:21).eq.'*MAGNETICPERMEABILITY') then
1395  ntmatl=0
1396  ityp=2
1397  ncmat=max(2,ncmat)
1398  do
1399  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
1400  & inl,ipoinp,inp,ipoinpc)
1401  if((istat.lt.0).or.(key.eq.1)) exit
1402  ntmatl=ntmatl+1
1403  ntmat=max(ntmatl,ntmat)
1404  enddo
1405  elseif(textpart(1)(1:5).eq.'*MASS') then
1406  nmat=nmat+1
1407  ntmat=max(1,ntmat)
1408  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
1409  & inl,ipoinp,inp,ipoinpc)
1410  elseif(textpart(1)(1:9).eq.'*MATERIAL') then
1411  nmat=nmat+1
1412  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1413  & ipoinp,inp,ipoinpc)
1414  elseif(textpart(1)(1:13).eq.'*MODALDAMPING') then
1415  if(textpart(2)(1:8).ne.'RAYLEIGH') then
1416  nevdamp=0
1417  do
1418  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
1419  & inl,ipoinp,inp,ipoinpc)
1420  if((istat.lt.0).or.(key.eq.1)) exit
1421  read(textpart(1)(1:10),'(i10)',iostat=istat) i
1422  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
1423  &"*MODAL DAMPING%")
1424  nevdamp = max(nevdamp,i)
1425  read(textpart(2)(1:10),'(i10)',iostat=istat) i
1426  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
1427  &"*MODAL DAMPING%")
1428  nevdamp = max(nevdamp,i)
1429  enddo
1430  else
1431  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1432  & ipoinp,inp,ipoinpc)
1433  endif
1434  elseif(textpart(1)(1:4).eq.'*MPC') then
1435  mpclabel=' '
1436  do
1437  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1438  & ipoinp,inp,ipoinpc)
1439  if((istat.lt.0).or.(key.eq.1)) exit
1440  do i=1,n
1441  read(textpart(i)(1:10),'(i10)',iostat=istat) ialset(i)
1442  if(mpclabel.eq.' ') then
1443  mpclabel=textpart(i)(1:20)
1444  if((mpclabel(1:8).ne.'STRAIGHT').and.
1445  & (mpclabel(1:4).ne.'PLANE')) then
1446  nk=nk+1
1447  nmpc=nmpc+1
1448  nboun=nboun+1
1449  memmpc=memmpc+1
1450  endif
1451  elseif(istat.gt.0) then
1452  noelset=textpart(i)(1:80)
1453  noelset(81:81)=' '
1454  ipos=index(noelset,' ')
1455  noelset(ipos:ipos)='N'
1456  do j=1,nset
1457  if(noelset.eq.set(j)) then
1458  if(mpclabel(1:8).eq.'STRAIGHT') then
1459  nk=nk+2*meminset(j)
1460  nmpc=nmpc+2*meminset(j)
1461  nboun=nboun+2*meminset(j)
1462  memmpc=memmpc+14*meminset(j)
1463  elseif(mpclabel(1:5).eq.'PLANE') then
1464  nk=nk+meminset(j)
1465  nmpc=nmpc+meminset(j)
1466  nboun=nboun+meminset(j)
1467  memmpc=memmpc+13*meminset(j)
1468  elseif(mpclabel(1:4).eq.'BEAM') then
1469  memmpc=memmpc+3*meminset(j)
1470  else
1471  memmpc=memmpc+meminset(j)
1472  endif
1473  exit
1474  endif
1475  enddo
1476  else
1477  if(mpclabel(1:8).eq.'STRAIGHT') then
1478  nk=nk+2
1479  nmpc=nmpc+2
1480  nboun=nboun+2
1481  memmpc=memmpc+14
1482  elseif(mpclabel(1:5).eq.'PLANE') then
1483  nk=nk+1
1484  nmpc=nmpc+1
1485  nboun=nboun+1
1486  memmpc=memmpc+13
1487  elseif(mpclabel(1:4).eq.'BEAM') then
1488  memmpc=memmpc+3
1489  else
1490  memmpc=memmpc+1
1491  endif
1492  endif
1493  enddo
1494  enddo
1495  elseif(textpart(1)(1:11).eq.'*NETWORKMPC') then
1496  do
1497  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1498  & ipoinp,inp,ipoinpc)
1499  if((istat.lt.0).or.(key.eq.1)) exit
1500  read(textpart(1)(1:10),'(i10)',iostat=istat) nterm
1501  if(ntrans.eq.0) then
1502  nmpc=nmpc+1
1503  memmpc=memmpc+nterm
1504  else
1505  nmpc=nmpc+3
1506  memmpc=memmpc+3*nterm
1507  endif
1508  ii=0
1509  do
1510  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
1511  & inl,ipoinp,inp,ipoinpc)
1512  if((istat.lt.0).or.(key.eq.1)) exit
1513  ii=ii+n/3
1514  if(ii.eq.nterm) exit
1515  enddo
1516  enddo
1517  elseif((textpart(1)(1:5).eq.'*NODE').and.
1518  & (textpart(1)(1:10).ne.'*NODEPRINT').and.
1519  & (textpart(1)(1:9).ne.'*NODEFILE').and.
1520  & (textpart(1)(1:11).ne.'*NODEOUTPUT')) then
1521  inoset=0
1522  loop3: do i=2,n
1523  if(textpart(i)(1:5).eq.'NSET=') then
1524  noset=textpart(i)(6:85)
1525  noset(81:81)=' '
1526  ipos=index(noset,' ')
1527  noset(ipos:ipos)='N'
1528  inoset=1
1529  do js=1,nset
1530  if(set(js).eq.noset) exit
1531  enddo
1532  if(js.gt.nset) then
1533  nset=nset+1
1534  set(nset)=noset
1535  endif
1536  endif
1537  enddo loop3
1538 !
1539  do
1540  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1541  & ipoinp,inp,ipoinpc)
1542  if((istat.lt.0).or.(key.eq.1)) exit
1543  read(textpart(1)(1:10),'(i10)',iostat=istat) i
1544  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
1545  &"*NODE or *NODE PRINT or *NODE FILE or *NODE OUTPUT%")
1546  nk=max(nk,i)
1547  if(inoset.eq.1) then
1548  meminset(js)=meminset(js)+1
1549  rmeminset(js)=rmeminset(js)+1
1550  endif
1551  enddo
1552  elseif(textpart(1)(1:10).eq.'*NODEPRINT') then
1553  do
1554  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1555  & ipoinp,inp,ipoinpc)
1556  if((istat.lt.0).or.(key.eq.1)) exit
1557  nprint=nprint+n
1558  enddo
1559  elseif(textpart(1)(1:10).eq.'*OBJECTIVE') then
1560  do
1561  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1562  & ipoinp,inp,ipoinpc)
1563  if((istat.lt.0).or.(key.eq.1)) exit
1564  nobject=nobject+1
1565  enddo
1566  elseif(textpart(1)(1:12).eq.'*ORIENTATION') then
1567  norien=norien+1
1568  do
1569  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1570  & ipoinp,inp,ipoinpc)
1571  if((istat.lt.0).or.(key.eq.1)) exit
1572  enddo
1573  elseif(textpart(1)(1:8).eq.'*PLASTIC') then
1574  ntmatl=0
1575  do
1576  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1577  & ipoinp,inp,ipoinpc)
1578  if((istat.lt.0).or.(key.eq.1)) exit
1579  read(textpart(3)(1:20),'(f20.0)',iostat=istat)
1580  & temperature
1581  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
1582  &"*PLASTIC%")
1583  if(ntmatl.eq.0) then
1584  npmatl=0
1585  ntmatl=ntmatl+1
1586  ntmat=max(ntmatl,ntmat)
1587  tempact=temperature
1588  elseif(temperature.ne.tempact) then
1589  npmatl=0
1590  ntmatl=ntmatl+1
1591  ntmat=max(ntmatl,ntmat)
1592  tempact=temperature
1593  endif
1594  npmatl=npmatl+1
1595  npmat=max(npmatl,npmat)
1596  enddo
1597  if(ncmat.ge.9) ncmat=max(19,ncmat)
1598  elseif(textpart(1)(1:19).eq.'*PRE-TENSIONSECTION') then
1599  surface(1:1)=' '
1600  do i=2,n
1601  if(textpart(i)(1:8).eq.'SURFACE=') then
1602  surface=textpart(i)(9:88)
1603  ipos=index(surface,' ')
1604  surface(ipos:ipos)='T'
1605  exit
1606  elseif(textpart(i)(1:8).eq.'ELEMENT=') then
1607  nmpc=nmpc+1
1608  memmpc=memmpc+7
1609  exit
1610  endif
1611  enddo
1612  if(surface(1:1).ne.' ') then
1613  do i=1,nset
1614  if(set(i).eq.surface) then
1615 !
1616 ! worst case: 8 nodes per element face
1617 !
1618  nk=nk+8*meminset(i)
1619  npt=npt+8*meminset(i)
1620 !
1621 c! 2 MPC's per node perpendicular to tension direction
1622 c! + 1 thermal MPC per node
1623 c! + 1 MPC in tension direction
1624 ! 2 MPC's per node perpendicular to tension direction
1625 ! + 1 thermal MPC per node
1626 ! + 1 MPC per node in tension direction (the total of
1627 ! which is divided into one global tension MPC and the
1628 ! rest are MPC's specifying that the distance in tension
1629 ! direction in all nodes should be the same)
1630 !
1631 c nmpc=nmpc+24*meminset(i)+1
1632  nmpc=nmpc+32*meminset(i)+1
1633 !
1634 ! 6 terms per MPC perpendicular to tension direction
1635 ! + 2 thermal terms per MPC
1636 ! + 6 terms * # of nodes +1 parallel to tension
1637 ! direction
1638 ! + 12 terms per MPC parallel to tension direction
1639 !
1640 c memmpc=memmpc+96*meminset(i)
1641 c & +16*meminset(i)
1642 c & +48*meminset(i)+1
1643  memmpc=memmpc+96*meminset(i)
1644  & +16*meminset(i)
1645  & +48*meminset(i)+1
1646  & +12*(8*meminset(i)-1)
1647  exit
1648 !
1649  endif
1650  enddo
1651  endif
1652  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1653  & ipoinp,inp,ipoinpc)
1654  elseif(textpart(1)(1:8).eq.'*RADIATE') then
1655  nam=nam+2
1656  namtot=namtot+2
1657  do
1658  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1659  & ipoinp,inp,ipoinpc)
1660  if((istat.lt.0).or.(key.eq.1)) exit
1661  read(textpart(2)(1:5),'(a5)',iostat=istat) llab
1662  if((llab.eq.'GRAV ').or.(llab.eq.'CENTR')) exit
1663  read(textpart(1)(1:10),'(i10)',iostat=istat) l
1664  if(istat.eq.0) then
1665  nload=nload+1
1666  nradiate=nradiate+1
1667  else
1668  read(textpart(1)(1:80),'(a80)',iostat=istat) elset
1669  elset(81:81)=' '
1670  ipos=index(elset,' ')
1671  elset(ipos:ipos)='E'
1672  do i=1,nset
1673  if(set(i).eq.elset) then
1674  nload=nload+meminset(i)
1675  nradiate=nradiate+meminset(i)
1676  exit
1677  endif
1678  enddo
1679  endif
1680  enddo
1681  elseif(textpart(1)(1:8).eq.'*RESTART') then
1682  irestartread=0
1683  irestartstep=0
1684  do i=1,n
1685  if(textpart(i)(1:4).eq.'READ') then
1686  irestartread=1
1687  endif
1688  if(textpart(i)(1:5).eq.'STEP=') then
1689  read(textpart(i)(6:15),'(i10)',iostat=istat)
1690  & irestartstep
1691  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
1692  &"*RESTART%")
1693  endif
1694  enddo
1695  if(irestartread.eq.1) then
1696  icntrl=1
1697  call restartshort(nset,nload,nbody,nforc,nboun,nk,ne,
1698  & nmpc,nalset,nmat,ntmat,npmat,norien,nam,nprint,
1699  & mi,ntrans,ncs,namtot,ncmat,memmpc,
1700  & ne1d,ne2d,nflow,set,meminset,rmeminset,jobnamec,
1701  & irestartstep,icntrl,ithermal,nener,nstate,ntie,
1702  & nslavs,nkon,mcs,nprop,mortar,ifacecount,nintpoint,
1703  & infree)
1704  irstrt=-1
1705  else
1706  endif
1707  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1708  & ipoinp,inp,ipoinpc)
1709  elseif(textpart(1)(1:18).eq.'*RETAINEDNODALDOFS') then
1710  do
1711  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1712  & ipoinp,inp,ipoinpc)
1713  if((istat.lt.0).or.(key.eq.1)) exit
1714 !
1715  read(textpart(2)(1:10),'(i10)',iostat=istat) ibounstart
1716  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
1717  &"*BOUNDARY%")
1718 !
1719  if(textpart(3)(1:1).eq.' ') then
1720  ibounend=ibounstart
1721  else
1722  read(textpart(3)(1:10),'(i10)',iostat=istat) ibounend
1723  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
1724  &"*BOUNDARY%")
1725  endif
1726  ibound=ibounend-ibounstart+1
1727  ibound=max(1,ibound)
1728  ibound=min(3,ibound)
1729 !
1730  read(textpart(1)(1:10),'(i10)',iostat=istat) l
1731  if(istat.eq.0) then
1732  nboun=nboun+ibound
1733  else
1734  read(textpart(1)(1:80),'(a80)',iostat=istat) noset
1735  noset(81:81)=' '
1736  ipos=index(noset,' ')
1737  noset(ipos:ipos)='N'
1738  do i=1,nset
1739  if(set(i).eq.noset) then
1740  nboun=nboun+ibound*meminset(i)
1741  exit
1742  endif
1743  enddo
1744  endif
1745  enddo
1746  elseif(textpart(1)(1:10).eq.'*RIGIDBODY') then
1747  noset='
1748  & '
1749  elset='
1750  & '
1751  do i=2,n
1752  if(textpart(i)(1:5).eq.'NSET=')
1753  & then
1754  noset=textpart(i)(6:85)
1755  noset(81:81)=' '
1756  ipos=index(noset,' ')
1757  noset(ipos:ipos)='N'
1758  exit
1759  elseif(textpart(i)(1:6).eq.'ELSET=')
1760  & then
1761  elset=textpart(i)(7:86)
1762  elset(81:81)=' '
1763  ipos=index(elset,' ')
1764  elset(ipos:ipos)='E'
1765  exit
1766  endif
1767  enddo
1768  if(noset(1:1).ne.' ') then
1769  do i=1,nset
1770  if(set(i).eq.noset) then
1771  nk=nk+2+meminset(i)
1772  nmpc=nmpc+3*meminset(i)
1773  memmpc=memmpc+18*meminset(i)
1774  nboun=nboun+3*meminset(i)
1775  endif
1776  enddo
1777  elseif(elset(1:1).ne.' ') then
1778  do i=1,nset
1779  if(set(i).eq.elset) then
1780  nk=nk+2+20*meminset(i)
1781  nmpc=nmpc+60*meminset(i)
1782  memmpc=memmpc+360*meminset(i)
1783  nboun=nboun+60*meminset(i)
1784  endif
1785  enddo
1786  endif
1787  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1788  & ipoinp,inp,ipoinpc)
1789  elseif(textpart(1)(1:16).eq.'*SECTIONPRINT') then
1790  do
1791  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1792  & ipoinp,inp,ipoinpc)
1793  if((istat.lt.0).or.(key.eq.1)) exit
1794  nprint=nprint+n
1795  enddo
1796  elseif(textpart(1)(1:13).eq.'*SHELLSECTION') then
1797  composite=.false.
1798  do i=2,n
1799  if(textpart(i)(1:9).eq.'COMPOSITE') then
1800  composite=.true.
1801  nlayer=0
1802  elseif(textpart(i)(1:6).eq.'ELSET=') then
1803  elset=textpart(i)(7:86)
1804  elset(81:81)=' '
1805  ipos=index(elset,' ')
1806  elset(ipos:ipos)='E'
1807  do js=1,nset
1808  if(set(js).eq.elset) exit
1809  enddo
1810  endif
1811  enddo
1812  if(composite) then
1813  do
1814  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
1815  & inl,ipoinp,inp,ipoinpc)
1816  if((istat.lt.0).or.(key.eq.1)) then
1817  if(label(2:2).eq.'8') then
1818  mi(1)=max(mi(1),8*nlayer)
1819  mi(3)=max(mi(3),nlayer)
1820  if(js.le.nset) then
1821  nk=nk+20*nlayer*meminset(js)
1822  nkon=nkon+20*nlayer*meminset(js)
1823  endif
1824  exit
1825  else
1826  mi(1)=max(mi(1),6*nlayer)
1827  mi(3)=max(mi(3),nlayer)
1828  if(js.le.nset) then
1829  nk=nk+15*nlayer*meminset(js)
1830  nkon=nkon+15*nlayer*meminset(js)
1831  endif
1832  exit
1833  endif
1834  endif
1835  nlayer=nlayer+1
1836  enddo
1837  else
1838  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
1839  & inl,ipoinp,inp,ipoinpc)
1840  endif
1841  elseif(textpart(1)(1:7).eq.'*SPRING') then
1842  nmat=nmat+1
1843  lin=.true.
1844  do i=2,n
1845  if(textpart(i)(1:9).eq.'NONLINEAR') then
1846  lin=.false.
1847  exit
1848  endif
1849  enddo
1850  if(lin) then
1851  ntmatl=0
1852  ncmat=max(2,ncmat)
1853  do
1854  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
1855  & inl,ipoinp,inp,ipoinpc)
1856  if((istat.lt.0).or.(key.eq.1)) exit
1857  ntmatl=ntmatl+1
1858  ntmat=max(ntmatl,ntmat)
1859  enddo
1860  else
1861  ntmatl=0
1862  do
1863  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
1864  & inl,ipoinp,inp,ipoinpc)
1865  if((istat.lt.0).or.(key.eq.1)) exit
1866  read(textpart(3)(1:20),'(f20.0)',iostat=istat)
1867  & temperature
1868  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
1869  &"*SPRING%")
1870  if(ntmatl.eq.0) then
1871  npmatl=0
1872  ntmatl=ntmatl+1
1873  ntmat=max(ntmatl,ntmat)
1874  tempact=temperature
1875  elseif(temperature.ne.tempact) then
1876  npmatl=0
1877  ntmatl=ntmatl+1
1878  ntmat=max(ntmatl,ntmat)
1879  tempact=temperature
1880  endif
1881  npmatl=npmatl+1
1882  npmat=max(npmatl,npmat)
1883  enddo
1884  if(ncmat.ge.9) ncmat=max(19,ncmat)
1885  endif
1886  elseif(textpart(1)(1:9).eq.'*SUBMODEL') then
1887  ntie=ntie+1
1888  nam=nam+1
1889  namtot=namtot+4
1890 !
1891 ! global element set
1892 !
1893  do j=2,n
1894  if(textpart(j)(1:12).eq.'GLOBALELSET=')
1895  & then
1896  mastset(1:80)=textpart(j)(13:92)
1897  mastset(81:81)=' '
1898  ipos=index(mastset,' ')
1899  mastset(ipos:ipos)='E'
1900  do i=1,nset
1901  if(set(i).eq.mastset) exit
1902  enddo
1903  if(i.le.nset) then
1904  nset=nset+1
1905  do k=1,81
1906  set(nset)(k:k)=' '
1907  enddo
1908  meminset(nset)=meminset(nset)+meminset(i)
1909  rmeminset(nset)=rmeminset(nset)+meminset(i)
1910  endif
1911  elseif(textpart(j)(1:5).eq.'TYPE=') then
1912  if(textpart(j)(6:12).eq.'SURFACE') then
1913  selabel='T'
1914  else
1915  selabel='N'
1916  endif
1917  endif
1918  enddo
1919 !
1920 ! local node or element face set
1921 !
1922  nset=nset+1
1923  set(nset)(1:1)=' '
1924  do
1925  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1926  & ipoinp,inp,ipoinpc)
1927  if((istat.lt.0).or.(key.eq.1)) exit
1928  read(textpart(1)(1:10),'(i10)',iostat=istat) ialset(1)
1929  if(istat.gt.0) then
1930  noset=textpart(1)(1:80)
1931  noset(81:81)=' '
1932  ipos=index(noset,' ')
1933  noset(ipos:ipos)=selabel
1934  do i=1,nset-1
1935  if(set(i).eq.noset) then
1936  meminset(nset)=meminset(nset)+meminset(i)
1937 !
1938 ! surfaces are stored in expanded form
1939 ! (no equivalent to generate)
1940 !
1941  rmeminset(nset)=rmeminset(nset)+meminset(i)
1942  endif
1943  enddo
1944  else
1945  meminset(nset)=meminset(nset)+1
1946  rmeminset(nset)=rmeminset(nset)+1
1947  endif
1948  enddo
1949  elseif(textpart(1)(1:9).eq.'*SURFACE ') then
1950  nset=nset+1
1951  sulabel='T'
1952  do i=2,n
1953  if(textpart(i)(1:5).eq.'NAME=')
1954  & then
1955  set(nset)=textpart(i)(6:85)
1956  set(nset)(81:81)=' '
1957  elseif(textpart(i)(1:9).eq.'TYPE=NODE') then
1958  sulabel='S'
1959  endif
1960  enddo
1961  ipos=index(set(nset),' ')
1962  set(nset)(ipos:ipos)=sulabel
1963  if(sulabel.eq.'S') then
1964  selabel='N'
1965  else
1966  selabel='E'
1967  endif
1968  do
1969  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
1970  & ipoinp,inp,ipoinpc)
1971  if((istat.lt.0).or.(key.eq.1)) exit
1972  read(textpart(1)(1:10),'(i10)',iostat=istat) ialset(1)
1973  if(istat.gt.0) then
1974  noset=textpart(1)(1:80)
1975  noset(81:81)=' '
1976  ipos=index(noset,' ')
1977  noset(ipos:ipos)=selabel
1978  do i=1,nset-1
1979  if(set(i).eq.noset) then
1980  meminset(nset)=meminset(nset)+meminset(i)
1981 !
1982 ! surfaces are stored in expanded form
1983 ! (no equivalent to generate)
1984 !
1985  rmeminset(nset)=rmeminset(nset)+meminset(i)
1986  endif
1987  enddo
1988  else
1989  meminset(nset)=meminset(nset)+1
1990  rmeminset(nset)=rmeminset(nset)+1
1991  endif
1992  enddo
1993 !
1994 ! for CFD-calculations: local coordinate systems are
1995 ! stored as distributed load
1996 !
1997  if(icfd>0) nload=nload+rmeminset(nset)
1998  elseif(textpart(1)(1:16).eq.'*SURFACEBEHAVIOR') then
1999  ncmat=max(4,ncmat)
2000  ntmat=max(1,ntmat)
2001  tabular=.false.
2002  do i=1,n
2003  if(textpart(i)(1:38).eq.'PRESSURE-OVERCLOSURE=TABULAR')
2004  & tabular=.true.
2005  enddo
2006  if(tabular) then
2007  ntmatl=0
2008  do
2009  call getnewline(inpc,textpart,istat,n,key,iline,
2010  & ipol,inl,ipoinp,inp,ipoinpc)
2011  if((istat.lt.0).or.(key.eq.1)) exit
2012  read(textpart(3)(1:20),'(f20.0)',iostat=istat)
2013  & temperature
2014  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
2015  &"*SURFACE BEHAVIOR%")
2016  if(ntmatl.eq.0) then
2017  npmatl=0
2018  ntmatl=ntmatl+1
2019  ntmat=max(ntmatl,ntmat)
2020  tempact=temperature
2021  elseif(temperature.ne.tempact) then
2022  npmatl=0
2023  ntmatl=ntmatl+1
2024  ntmat=max(ntmatl,ntmat)
2025  tempact=temperature
2026  endif
2027  npmatl=npmatl+1
2028  npmat=max(npmatl,npmat)
2029  enddo
2030  else
2031  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
2032  & ipoinp,inp,ipoinpc)
2033  endif
2034  elseif(textpart(1)(1:19).eq.'*SURFACEINTERACTION') then
2035  nmat=nmat+1
2036  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
2037  & ipoinp,inp,ipoinpc)
2038  elseif(textpart(1)(1:12).eq.'*TEMPERATURE') then
2039  nam=nam+1
2040  namtot=namtot+1
2041  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
2042  & ipoinp,inp,ipoinpc)
2043  elseif(textpart(1)(1:4).eq.'*TIE') then
2044  ntie=ntie+1
2045  cyclicsymmetry=.false.
2046  do i=1,n
2047  if((textpart(i)(1:14).eq.'CYCLICSYMMETRY').or.
2048  & (textpart(i)(1:10).eq.'MULTISTAGE')) then
2049  cyclicsymmetry=.true.
2050  endif
2051  enddo
2052  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
2053  & ipoinp,inp,ipoinpc)
2054  if(.not.cyclicsymmetry) cycle
2055  if((istat.lt.0).or.(key.eq.1)) cycle
2056 !
2057  slavset=textpart(1)(1:80)
2058  slavset(81:81)=' '
2059  iposs=index(slavset,' ')
2060  slavsets=slavset
2061  slavsets(iposs:iposs)='S'
2062  slavsett=slavset
2063  slavsett(iposs:iposs)='T'
2064 !
2065  mastset=textpart(2)(1:80)
2066  mastset(81:81)=' '
2067  iposm=index(mastset,' ')
2068  mastsets=mastset
2069  mastsets(iposm:iposm)='S'
2070  mastsett=mastset
2071  mastsett(iposm:iposm)='T'
2072 !
2073  islavset=0
2074  imastset=0
2075 !
2076  do i=1,nset
2077  if(set(i).eq.slavsets) then
2078  islavset=i
2079  multslav=1
2080  elseif(set(i).eq.slavsett) then
2081  islavset=i
2082  multslav=8
2083  elseif(set(i).eq.mastsets) then
2084  imastset=i
2085  multmast=1
2086  elseif(set(i).eq.mastsett) then
2087  imastset=i
2088  multmast=8
2089  endif
2090  enddo
2091  if((islavset.ne.0).and.(imastset.ne.0)) then
2092  ncs=ncs+max(multslav*meminset(islavset),
2093  & multmast*meminset(imastset))
2094  else
2095  write(*,*) '*ERROR in allocation: either the slave'
2096  write(*,*) ' surface or the master surface in a'
2097  write(*,*) ' cyclic symmetry *TIE option or both'
2098  write(*,*) ' do not exist or are no nodal surfaces'
2099  write(*,*) ' slave set:',slavset(1:iposs-1)
2100  write(*,*) ' master set:',mastset(1:iposm-1)
2101  call exit(201)
2102  endif
2103  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
2104  & ipoinp,inp,ipoinpc)
2105  elseif(textpart(1)(1:11).eq.'*TIMEPOINTS') then
2106  igen=.false.
2107  nam=nam+1
2108  do i=2,n
2109  if(textpart(i)(1:8).eq.'GENERATE') then
2110  igen=.true.
2111  exit
2112  endif
2113  enddo
2114  do
2115  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
2116  & ipoinp,inp,ipoinpc)
2117  if((istat.lt.0).or.(key.eq.1)) exit
2118  if(igen)then
2119  if(n.lt.3)then
2120  write(*,*)'*ERROR in allocation: *TIMEPOINTS'
2121  call inputerror(inpc,ipoinpc,iline,
2122  &"*TIME POINTS%")
2123  call exit(201)
2124  else
2125  read(textpart(1)(1:20),'(f20.0)',iostat=istat)
2126  & tpmin
2127  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
2128  &"*TIME POINTS%")
2129  read(textpart(2)(1:20),'(f20.0)',iostat=istat)
2130  & tpmax
2131  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
2132  &"*TIME POINTS%")
2133  read(textpart(3)(1:20),'(f20.0)',iostat=istat)
2134  & tpinc
2135  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
2136  &"*TIME POINTS%")
2137 !
2138  if((tpinc.le.0).or.(tpmin.ge.tpmax)) then
2139  write(*,*) '*ERROR in allocation: *TIMEPOINTS'
2140  call inputerror(inpc,ipoinpc,iline,
2141  &"*TIME POINTS%")
2142  call exit(201)
2143  else
2144  namtot=namtot+2+int((tpmax-tpmin)/tpinc)
2145  endif
2146 
2147  endif
2148  else
2149  namtot=namtot+8
2150  endif
2151  enddo
2152  elseif(textpart(1)(1:10).eq.'*TRANSFORM') then
2153  ntrans=ntrans+1
2154  do
2155  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
2156  & ipoinp,inp,ipoinpc)
2157  if((istat.lt.0).or.(key.eq.1)) exit
2158  enddo
2159  elseif(textpart(1)(1:11).eq.'*TRANSFORMF') then
2160  ntrans=ntrans+1
2161  surface(1:1)=' '
2162  do i=2,n
2163  if(textpart(i)(1:8).eq.'SURFACE=') then
2164  surface=textpart(i)(9:88)
2165  ipos=index(surface,' ')
2166  surface(ipos:ipos)='T'
2167  exit
2168  endif
2169  enddo
2170  if(surface(1:1).ne.' ') then
2171  do i=1,nset
2172  if(set(i).eq.surface) then
2173  nload=nload+meminset(i)
2174  exit
2175  endif
2176  enddo
2177  endif
2178  do
2179  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
2180  & ipoinp,inp,ipoinpc)
2181  if((istat.lt.0).or.(key.eq.1)) exit
2182  enddo
2183  elseif(textpart(1)(1:12).eq.'*USERELEMENT') then
2184  call userelements(textpart,n,iuel,nuel,inpc,ipoinpc,iline)
2185  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
2186  & ipoinp,inp,ipoinpc)
2187  elseif(textpart(1)(1:13).eq.'*USERMATERIAL') then
2188  ntmatl=0
2189  do i=2,n
2190  if(textpart(i)(1:10).eq.'CONSTANTS=') then
2191  read(textpart(i)(11:20),'(i10)',iostat=istat)
2192  & nconstants
2193  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
2194  &"*USER MATERIAL%")
2195  ncmat=max(nconstants,ncmat)
2196  exit
2197  endif
2198  enddo
2199  do
2200  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
2201  & ipoinp,inp,ipoinpc)
2202  if((istat.lt.0).or.(key.eq.1)) exit
2203  ntmatl=ntmatl+1
2204  ntmat=max(ntmatl,ntmat)
2205 c do i=2,(nconstants-1)/8+1
2206  do i=2,nconstants/8+1
2207  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
2208  & inl,ipoinp,inp,ipoinpc)
2209  enddo
2210  enddo
2211  else
2212  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
2213  & ipoinp,inp,ipoinpc)
2214  endif
2215  enddo
2216 !
2217  do i=1,nset
2218  nalset=nalset+rmeminset(i)
2219  maxrmeminset=max(maxrmeminset,rmeminset(i))
2220  enddo
2221 !
2222 ! extra space needed for rearrangement in elements.f and
2223 ! noelsets.f
2224 !
2225  nalset=nalset+maxrmeminset
2226 !
2227  nmpc=nmpc+1
2228  memmpc=memmpc+1
2229 !
2230  if(irstrt.eq.0) then
2231  ne1d=neb32
2232  ne2d=necper+necpsr+necaxr+nesr
2233  endif
2234 !
2235 ! introducing a fake tie for axisymmetric elements
2236 ! (needed for cavity radiation)
2237 !
2238  if(necaxr.gt.0) ntie=max(1,ntie)
2239 !
2240 ! providing space for the expansion of shell and beam elements
2241 ! to genuine volume elements (no distinction is made between
2242 ! linear and quadratic elements. The worst case (quadratic)
2243 ! is taken
2244 !
2245  nk=nk+3*8*ne2d+8*3*ne1d
2246  if(ne1d.gt.0) then
2247  nboun=nboun*9
2248  nforc=nforc*9
2249  elseif(ne2d.gt.0) then
2250  nboun=nboun*4
2251  nforc=nforc*4
2252  endif
2253 !
2254 ! providing for rigid nodes (knots)
2255 !
2256 ! number of knots: 8*ne2d+3*ne1d
2257 ! number of expanded nodes: 3*8*ne2d+8*3*ne1d
2258 !
2259 ! number of extra nodes (1 rotational node and
2260 ! 1 expansion node per knot
2261 ! and one inhomogeneous term node per expanded node)
2262 !
2263  nk=nk+(2+3)*8*ne2d+(2+8)*3*ne1d
2264 !
2265 ! number of equations (3 per expanded node)
2266 !
2267  nmpc=nmpc+3*(3*8*ne2d+8*3*ne1d)
2268 !
2269 ! number of terms: 9 per equation
2270 !
2271  memmpc=memmpc+9*3*(3*8*ne2d+8*3*ne1d)
2272 !
2273 ! number of SPC's: 1 per DOF per expanded node
2274 !
2275  nboun=nboun+3*(3*8*ne2d+8*3*ne1d)
2276 !
2277 ! temperature DOF in knots
2278 !
2279  nmpc=nmpc+(3*8*ne2d+8*3*ne1d)
2280  memmpc=memmpc+2*(3*8*ne2d+8*3*ne1d)
2281 !
2282 ! extra MPCs to avoid undefinid rotation of rigid body nodes
2283 ! lying on a line
2284 !
2285  nmpc=nmpc+3*8*ne2d+8*3*ne1d
2286  memmpc=memmpc+3*(3*8*ne2d+8*3*ne1d)
2287 !
2288 ! expanding the MPCs: 2-node MPC link (2D elements) or
2289 ! 5-node MPC link (1D elements) between nodes defined by
2290 ! the user and generated mid-nodes
2291 !
2292 c nmpc=nmpc+3*ne1d+8*ne2d
2293 c memmpc=memmpc+15*ne1d+24*ne2d
2294 !
2295 ! extra nodes for the radiation boundary conditions
2296 !
2297  nk=nk+nradiate
2298 !
2299 ! each layer in each shell has a local orientation
2300 !
2301  norien=norien+nesr*mi(3)
2302 !
2303  write(*,*)
2304  write(*,*) ' The numbers below are estimated upper bounds'
2305  write(*,*)
2306  write(*,*) ' number of:'
2307  write(*,*)
2308  write(*,*) ' nodes: ',nk
2309  write(*,*) ' elements: ',ne
2310  write(*,*) ' one-dimensional elements: ',ne1d
2311  write(*,*) ' two-dimensional elements: ',ne2d
2312  write(*,*) ' integration points per element: ',mi(1)
2313  write(*,*) ' degrees of freedom per node: ',mi(2)
2314  write(*,*) ' layers per element: ',mi(3)
2315  write(*,*)
2316  write(*,*) ' distributed facial loads: ',nload
2317  write(*,*) ' distributed volumetric loads: ',nbody
2318  write(*,*) ' concentrated loads: ',nforc
2319  write(*,*) ' single point constraints: ',nboun
2320  write(*,*) ' multiple point constraints: ',nmpc
2321  write(*,*) ' terms in all multiple point constraints: ',memmpc
2322  write(*,*) ' tie constraints: ',ntie
2323  write(*,*) ' dependent nodes tied by cyclic constraints: ',ncs
2324  write(*,*) ' dependent nodes in pre-tension constraints: ',npt
2325  write(*,*)
2326  write(*,*) ' sets: ',nset
2327  write(*,*) ' terms in all sets: ',nalset
2328  write(*,*)
2329  write(*,*) ' materials: ',nmat
2330  write(*,*) ' constants per material and temperature: ',ncmat
2331  write(*,*) ' temperature points per material: ',ntmat
2332  write(*,*) ' plastic data points per material: ',npmat
2333  write(*,*)
2334  write(*,*) ' orientations: ',norien
2335  write(*,*) ' amplitudes: ',nam
2336  write(*,*) ' data points in all amplitudes: ',namtot
2337  write(*,*) ' print requests: ',nprint
2338  write(*,*) ' transformations: ',ntrans
2339  write(*,*) ' property cards: ',nprop
2340  write(*,*)
2341 !
2342  return
max
#define max(a, b)
Definition: cascade.c:32
min
#define min(a, b)
Definition: cascade.c:31
restartshort
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)
Definition: restartshort.f:25
getnewline
subroutine getnewline(inpc, textpart, istat, n, key, iline, ipol, inl, ipoinp, inp, ipoinpc)
Definition: getnewline.f:21
userelements
subroutine userelements(textpart, n, iuel, nuel, inpc, ipoinpc, iline)
Definition: userelements.f:21
inputerror
subroutine inputerror(inpc, ipoinpc, iline, text)
Definition: inputerror.f:20
nidentk
subroutine nidentk(x, px, n, id, k)
Definition: nidentk.f:27
Hosted by OpenAircraft.com, (Michigan UAV, LLC)