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

Go to the source code of this file.

Functions/Subroutines

subroutine initialconditionss (inpc, textpart, set, istartset, iendset, ialset, nset, t0, t1, prestr, iprestr, ithermal, veold, inoelfree, nk_, mi, istep, istat, n, iline, ipol, inl, ipoinp, inp, lakon, kon, co, ne, ipkon, vold, ipoinpc, xstate, nstate_, nk, t0g, t1g, iaxial, ielprop, prop)
 

Function/Subroutine Documentation

◆ initialconditionss()

subroutine initialconditionss ( character*1, dimension(*)  inpc,
character*132, dimension(16)  textpart,
character*81, dimension(*)  set,
integer, dimension(*)  istartset,
integer, dimension(*)  iendset,
integer, dimension(*)  ialset,
integer  nset,
real*8, dimension(*)  t0,
real*8, dimension(*)  t1,
real*8, dimension(6,mi(1),*)  prestr,
integer  iprestr,
integer  ithermal,
real*8, dimension(0:mi(2),*)  veold,
integer  inoelfree,
integer  nk_,
integer, dimension(*)  mi,
integer  istep,
integer  istat,
integer  n,
integer  iline,
integer  ipol,
integer  inl,
integer, dimension(2,*)  ipoinp,
integer, dimension(3,*)  inp,
character*8, dimension(*)  lakon,
integer, dimension(*)  kon,
real*8, dimension(3,*)  co,
integer  ne,
integer, dimension(*)  ipkon,
real*8, dimension(0:mi(2),*)  vold,
integer, dimension(0:*)  ipoinpc,
real*8, dimension(nstate_,mi(1),*)  xstate,
integer  nstate_,
integer  nk,
real*8, dimension(2,*)  t0g,
real*8, dimension(2,*)  t1g,
integer  iaxial,
integer, dimension(*)  ielprop,
real*8, dimension(*)  prop 
)
24 !
25 ! reading the input deck: *INITIAL CONDITIONS
26 !
27  implicit none
28 !
29  logical user
30 !
31  character*1 inpc(*)
32  character*8 lakon(*)
33  character*80 rebarn
34  character*81 set(*),noset
35  character*132 textpart(16)
36 !
37  integer istartset(*),iendset(*),ialset(*),nset,iprestr,ithermal,
38  & istep,istat,n,i,j,k,l,ii,key,idir,ipos,inoelfree,nk_,mi(*),
39  & iline,ipol,inl,ipoinp(2,*),inp(3,*),ij,jj,ntens,ncrds,layer,
40  & kspt,lrebar,iflag,i1,mint3d,nope,kon(*),konl(20),indexe,
41  & ipkon(*),ne,ipoinpc(0:*),nstate_,nk,jmax,ntot,numberoflines,
42  & iaxial,null,ielprop(*)
43 !
44  real*8 t0(*),t1(*),beta(8),prestr(6,mi(1),*),veold(0:mi(2),*),
45  & temperature,velocity,tempgrad1,tempgrad2,pgauss(3),
46  & shp(4,20),xsj,xl(3,20),xi,et,ze,weight,co(3,*),pressure,
47  & vold(0:mi(2),*),xstate(nstate_,mi(1),*),dispvelo,totpres,
48  & xmassflow,t0g(2,*),t1g(2,*),prop(*)
49 !
50  include "gauss.f"
51 !
52  null=0
53 !
54  if(istep.gt.0) then
55  write(*,*)
56  & '*ERROR reading *INITIAL CONDITIONS: *INITIAL CONDITIONS'
57  write(*,*) ' should be placed before all step definitions'
58  call exit(201)
59  endif
60 !
61  do ij=2,n
62  if(textpart(ij)(1:16).eq.'TYPE=TEMPERATURE') then
63 !
64  ithermal=1
65  do
66  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
67  & ipoinp,inp,ipoinpc)
68  if((istat.lt.0).or.(key.eq.1)) return
69  read(textpart(2)(1:20),'(f20.0)',iostat=istat)
70  & temperature
71  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
72  &"*INITIAL CONDITIONS%")
73  temperature=1.d-6*int(1.d6*temperature+0.5d0)
74 !
75  if(inoelfree.ne.0) then
76  tempgrad1=0.d0
77  tempgrad2=0.d0
78  if(n.gt.2) then
79  read(textpart(3)(1:20),'(f20.0)',iostat=istat)
80  & tempgrad1
81  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
82  &"*INITIAL CONDITIONS%")
83  endif
84  if(n.gt.3) then
85  read(textpart(4)(1:20),'(f20.0)',iostat=istat)
86  & tempgrad2
87  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
88  &"*INITIAL CONDITIONS%")
89  endif
90  endif
91 !
92  read(textpart(1)(1:10),'(i10)',iostat=istat) l
93  if(istat.eq.0) then
94  if(l.gt.nk) then
95  write(*,*)
96  & '*WARNING reading *INITIAL CONDITIONS: node ',l
97  write(*,*)' exceeds the largest defined ',
98  & 'node number'
99  cycle
100  endif
101  t0(l)=temperature
102  t1(l)=temperature
103  vold(0,l)=temperature
104  if(inoelfree.ne.0) then
105  t0g(1,l)=tempgrad1
106  t0g(2,l)=tempgrad2
107  t1g(1,l)=tempgrad1
108  t1g(2,l)=tempgrad2
109  endif
110  else
111  read(textpart(1)(1:80),'(a80)',iostat=istat) noset
112  noset(81:81)=' '
113  ipos=index(noset,' ')
114  noset(ipos:ipos)='N'
115  do ii=1,nset
116  if(set(ii).eq.noset) exit
117  enddo
118  if(ii.gt.nset) then
119  noset(ipos:ipos)=' '
120  write(*,*)
121  & '*ERROR reading *INITIAL CONDITIONS: node set '
122  & ,noset
123  write(*,*)' has not yet been defined. '
124  call inputerror(inpc,ipoinpc,iline,
125  &"*INITIAL CONDITIONS%")
126  call exit(201)
127  endif
128  do j=istartset(ii),iendset(ii)
129  if(ialset(j).gt.0) then
130  t0(ialset(j))=temperature
131  t1(ialset(j))=temperature
132  vold(0,ialset(j))=temperature
133  if(inoelfree.ne.0) then
134  t0g(1,ialset(j))=tempgrad1
135  t0g(2,ialset(j))=tempgrad2
136  t1g(1,ialset(j))=tempgrad1
137  t1g(2,ialset(j))=tempgrad2
138  endif
139  else
140  k=ialset(j-2)
141  do
142  k=k-ialset(j)
143  if(k.ge.ialset(j-1)) exit
144  t0(k)=temperature
145  t1(k)=temperature
146  vold(0,k)=temperature
147  if(inoelfree.ne.0) then
148  t0g(1,k)=tempgrad1
149  t0g(2,k)=tempgrad2
150  t1g(1,k)=tempgrad1
151  t1g(2,k)=tempgrad2
152  endif
153  enddo
154  endif
155  enddo
156  endif
157  enddo
158  return
159  elseif(textpart(ij)(1:11).eq.'TYPE=STRESS') then
160 !
161  iprestr=1
162  do jj=1,n
163  if(textpart(jj)(1:4).eq.'USER') then
164 !
165 ! residual stresses are defined by user subroutine
166 ! sigini
167 !
168  iflag=1
169  ntens=6
170  ncrds=3
171  lrebar=0
172  do i=1,ne
173  indexe=ipkon(i)
174  if(lakon(i)(4:4).eq.'2') then
175  nope=20
176  elseif(lakon(i)(4:4).eq.'8') then
177  nope=8
178  elseif(lakon(i)(4:5).eq.'10') then
179  nope=10
180  elseif(lakon(i)(4:4).eq.'4') then
181  nope=4
182  elseif(lakon(i)(4:5).eq.'15') then
183  nope=15
184  elseif(lakon(i)(4:4).eq.'6') then
185  nope=6
186  else
187  cycle
188  endif
189 !
190  if(lakon(i)(4:5).eq.'8R') then
191  mint3d=1
192  elseif(lakon(i)(4:7).eq.'20RB') then
193  if((lakon(i)(8:8).eq.'R').or.
194  & (lakon(i)(8:8).eq.'C')) then
195  mint3d=50
196  else
197  call beamintscheme(lakon(i),mint3d,
198  & ielprop(i),prop,
199  & null,xi,et,ze,weight)
200  endif
201  elseif((lakon(i)(4:4).eq.'8').or.
202  & (lakon(i)(4:6).eq.'20R')) then
203  mint3d=8
204  elseif(lakon(i)(4:4).eq.'2') then
205  mint3d=27
206  elseif(lakon(i)(4:5).eq.'10') then
207  mint3d=4
208  elseif(lakon(i)(4:4).eq.'4') then
209  mint3d=1
210  elseif(lakon(i)(4:5).eq.'15') then
211  mint3d=9
212  elseif(lakon(i)(4:4).eq.'6') then
213  mint3d=2
214  endif
215 !
216  do j=1,nope
217  konl(j)=kon(indexe+j)
218  do k=1,3
219  xl(k,j)=co(k,konl(j))
220  enddo
221  enddo
222 !
223  do j=1,mint3d
224  if(lakon(i)(4:5).eq.'8R') then
225  xi=gauss3d1(1,j)
226  et=gauss3d1(2,j)
227  ze=gauss3d1(3,j)
228  weight=weight3d1(j)
229  elseif(lakon(i)(4:7).eq.'20RB') then
230  if((lakon(i)(8:8).eq.'R').or.
231  & (lakon(i)(8:8).eq.'C')) then
232  xi=gauss3d13(1,j)
233  et=gauss3d13(2,j)
234  ze=gauss3d13(3,j)
235  weight=weight3d13(j)
236  else
237  call beamintscheme(lakon(i),mint3d,
238  & ielprop(i),prop,
239  & j,xi,et,ze,weight)
240  endif
241  elseif((lakon(i)(4:4).eq.'8').or.
242  & (lakon(i)(4:6).eq.'20R'))
243  & then
244  xi=gauss3d2(1,j)
245  et=gauss3d2(2,j)
246  ze=gauss3d2(3,j)
247  weight=weight3d2(j)
248  elseif(lakon(i)(4:4).eq.'2') then
249  xi=gauss3d3(1,j)
250  et=gauss3d3(2,j)
251  ze=gauss3d3(3,j)
252  weight=weight3d3(j)
253  elseif(lakon(i)(4:5).eq.'10') then
254  xi=gauss3d5(1,j)
255  et=gauss3d5(2,j)
256  ze=gauss3d5(3,j)
257  weight=weight3d5(j)
258  elseif(lakon(i)(4:4).eq.'4') then
259  xi=gauss3d4(1,j)
260  et=gauss3d4(2,j)
261  ze=gauss3d4(3,j)
262  weight=weight3d4(j)
263  elseif(lakon(i)(4:5).eq.'15') then
264  xi=gauss3d8(1,j)
265  et=gauss3d8(2,j)
266  ze=gauss3d8(3,j)
267  weight=weight3d8(j)
268  elseif(lakon(i)(4:4).eq.'6') then
269  xi=gauss3d7(1,j)
270  et=gauss3d7(2,j)
271  ze=gauss3d7(3,j)
272  weight=weight3d7(j)
273  endif
274 !
275  if(nope.eq.20) then
276  call shape20h(xi,et,ze,xl,xsj,shp,iflag)
277  elseif(nope.eq.8) then
278  call shape8h(xi,et,ze,xl,xsj,shp,iflag)
279  elseif(nope.eq.10) then
280  call shape10tet(xi,et,ze,xl,xsj,shp,iflag)
281  elseif(nope.eq.4) then
282  call shape4tet(xi,et,ze,xl,xsj,shp,iflag)
283  elseif(nope.eq.15) then
284  call shape15w(xi,et,ze,xl,xsj,shp,iflag)
285  else
286  call shape6w(xi,et,ze,xl,xsj,shp,iflag)
287  endif
288 !
289  do k=1,3
290  pgauss(k)=0.d0
291  do i1=1,nope
292  pgauss(k)=pgauss(k)+
293  & shp(4,i1)*co(k,konl(i1))
294  enddo
295  enddo
296 !
297  call sigini(prestr(1,j,i),pgauss,ntens,ncrds,
298  & i,j,layer,kspt,lrebar,rebarn)
299 !
300  enddo
301  enddo
302  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
303  & inl,ipoinp,inp,ipoinpc)
304  return
305  endif
306  enddo
307 !
308 ! residual stresses are written explicitly in the input deck
309 !
310  do
311  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
312  & ipoinp,inp,ipoinpc)
313  if((istat.lt.0).or.(key.eq.1)) return
314  do j=1,6
315  read(textpart(j+2)(1:20),'(f20.0)',iostat=istat)
316  & beta(j)
317  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
318  &"*INITIAL CONDITIONS%")
319  enddo
320  read(textpart(1)(1:10),'(i10)',iostat=istat) l
321  if(istat.ne.0) call inputerror(inpc,ipoinpc,iline,
322  &"*INITIAL CONDITIONS%")
323  if(l.gt.ne) then
324  write(*,*)
325  & '*WARNING reading *INITIAL CONDITIONS: element ',l
326  write(*,*)' exceeds the largest defined ',
327  & 'element number'
328  cycle
329  endif
330  read(textpart(2)(1:10),'(i10)',iostat=istat) k
331  if(istat.eq.0) then
332  do j=1,6
333  prestr(j,k,l)=beta(j)
334  enddo
335  else
336  call inputerror(inpc,ipoinpc,iline,
337  &"*INITIAL CONDITIONS%")
338  endif
339  enddo
340  return
341  elseif(textpart(ij)(1:18).eq.'TYPE=PLASTICSTRAIN') then
342 !
343  iprestr=2
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)) return
348  do j=1,6
349  read(textpart(j+2)(1:20),'(f20.0)',iostat=istat)
350  & beta(j)
351  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
352  &"*INITIAL CONDITIONS%")
353  enddo
354  read(textpart(1)(1:10),'(i10)',iostat=istat) l
355  if(istat.ne.0) call inputerror(inpc,ipoinpc,iline,
356  &"*INITIAL CONDITIONS%")
357  if(l.gt.ne) then
358  write(*,*)
359  & '*WARNING reading *INITIAL CONDITIONS: element ',l
360  write(*,*)' exceeds the largest defined ',
361  & 'element number'
362  cycle
363  endif
364  read(textpart(2)(1:10),'(i10)',iostat=istat) k
365  if(istat.eq.0) then
366  do j=1,6
367  prestr(j,k,l)=beta(j)
368  enddo
369  else
370  call inputerror(inpc,ipoinpc,iline,
371  &"*INITIAL CONDITIONS%")
372  endif
373  enddo
374  return
375  elseif((textpart(ij)(1:17).eq.'TYPE=DISPLACEMENT').or.
376  & (textpart(ij)(1:18).eq.'TYPE=FLUIDVELOCITY')) then
377 !
378  do
379  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
380  & ipoinp,inp,ipoinpc)
381  if((istat.lt.0).or.(key.eq.1)) return
382  read(textpart(2)(1:10),'(i10)',iostat=istat) idir
383  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
384  &"*INITIAL CONDITIONS%")
385  read(textpart(3)(1:20),'(f20.0)',iostat=istat) dispvelo
386  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
387  &"*INITIAL CONDITIONS%")
388  read(textpart(1)(1:10),'(i10)',iostat=istat) l
389  if(istat.eq.0) then
390  if(l.gt.nk) then
391  write(*,*)
392  & '*WARNING reading *INITIAL CONDITIONS: node ',l
393  write(*,*)' exceeds the largest defined ',
394  & 'node number'
395  cycle
396  endif
397  vold(idir,l)=dispvelo
398  else
399  read(textpart(1)(1:80),'(a80)',iostat=istat) noset
400  noset(81:81)=' '
401  ipos=index(noset,' ')
402  noset(ipos:ipos)='N'
403  do ii=1,nset
404  if(set(ii).eq.noset) exit
405  enddo
406  if(ii.gt.nset) then
407  noset(ipos:ipos)=' '
408  write(*,*)
409  & '*ERROR reading *INITIAL CONDITIONS: node set '
410  & ,noset
411  write(*,*)' has not yet been defined. '
412  call inputerror(inpc,ipoinpc,iline,
413  &"*INITIAL CONDITIONS%")
414  call exit(201)
415  endif
416  do j=istartset(ii),iendset(ii)
417  if(ialset(j).gt.0) then
418  vold(idir,ialset(j))=dispvelo
419  else
420  k=ialset(j-2)
421  do
422  k=k-ialset(j)
423  if(k.ge.ialset(j-1)) exit
424  vold(idir,k)=dispvelo
425  enddo
426  endif
427  enddo
428  endif
429  enddo
430  return
431  elseif(textpart(ij)(1:13).eq.'TYPE=VELOCITY') then
432 !
433  do
434  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
435  & ipoinp,inp,ipoinpc)
436  if((istat.lt.0).or.(key.eq.1)) return
437  read(textpart(2)(1:10),'(i10)',iostat=istat) idir
438  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
439  &"*INITIAL CONDITIONS%")
440  read(textpart(3)(1:20),'(f20.0)',iostat=istat) velocity
441  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
442  &"*INITIAL CONDITIONS%")
443  read(textpart(1)(1:10),'(i10)',iostat=istat) l
444  if(istat.eq.0) then
445  if(l.gt.nk) then
446  write(*,*)
447  & '*WARNING reading *INITIAL CONDITIONS: node ',l
448  write(*,*)' exceeds the largest defined ',
449  & 'node number'
450  cycle
451  endif
452  veold(idir,l)=velocity
453  else
454  read(textpart(1)(1:80),'(a80)',iostat=istat) noset
455  noset(81:81)=' '
456  ipos=index(noset,' ')
457  noset(ipos:ipos)='N'
458  do ii=1,nset
459  if(set(ii).eq.noset) exit
460  enddo
461  if(ii.gt.nset) then
462  noset(ipos:ipos)=' '
463  write(*,*)
464  & '*ERROR reading *INITIAL CONDITIONS: node set '
465  & ,noset
466  write(*,*)' has not yet been defined. '
467  call inputerror(inpc,ipoinpc,iline,
468  &"*INITIAL CONDITIONS%")
469  call exit(201)
470  endif
471  do j=istartset(ii),iendset(ii)
472  if(ialset(j).gt.0) then
473  veold(idir,ialset(j))=velocity
474  else
475  k=ialset(j-2)
476  do
477  k=k-ialset(j)
478  if(k.ge.ialset(j-1)) exit
479  veold(idir,k)=velocity
480  enddo
481  endif
482  enddo
483  endif
484  enddo
485  return
486  elseif(textpart(ij)(1:13).eq.'TYPE=PRESSURE') then
487 !
488  do
489  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
490  & ipoinp,inp,ipoinpc)
491  if((istat.lt.0).or.(key.eq.1)) return
492  read(textpart(2)(1:20),'(f20.0)',iostat=istat) pressure
493  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
494  &"*INITIAL CONDITIONS%")
495  read(textpart(1)(1:10),'(i10)',iostat=istat) l
496  if(istat.eq.0) then
497  if(l.gt.nk) then
498  write(*,*)
499  & '*WARNING reading *INITIAL CONDITIONS: node ',l
500  write(*,*)' exceeds the largest defined ',
501  & 'node number'
502  cycle
503  endif
504  vold(4,l)=pressure
505  else
506  read(textpart(1)(1:80),'(a80)',iostat=istat) noset
507  noset(81:81)=' '
508  ipos=index(noset,' ')
509  noset(ipos:ipos)='N'
510  do ii=1,nset
511  if(set(ii).eq.noset) exit
512  enddo
513  if(ii.gt.nset) then
514  noset(ipos:ipos)=' '
515  write(*,*)
516  & '*ERROR reading *INITIAL CONDITIONS: node set '
517  & ,noset
518  write(*,*)' has not yet been defined. '
519  call inputerror(inpc,ipoinpc,iline,
520  &"*INITIAL CONDITIONS%")
521  call exit(201)
522  endif
523  do j=istartset(ii),iendset(ii)
524  if(ialset(j).gt.0) then
525  vold(4,ialset(j))=pressure
526  else
527  k=ialset(j-2)
528  do
529  k=k-ialset(j)
530  if(k.ge.ialset(j-1)) exit
531  vold(4,k)=pressure
532  enddo
533  endif
534  enddo
535  endif
536  enddo
537  return
538  elseif(textpart(ij)(1:18).eq.'TYPE=TOTALPRESSURE') then
539 !
540  do
541  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
542  & ipoinp,inp,ipoinpc)
543  if((istat.lt.0).or.(key.eq.1)) return
544  read(textpart(2)(1:20),'(f20.0)',iostat=istat) totpres
545  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
546  &"*INITIAL CONDITIONS%")
547  read(textpart(1)(1:10),'(i10)',iostat=istat) l
548  if(istat.eq.0) then
549  if(l.gt.nk) then
550  write(*,*)
551  & '*WARNING reading *INITIAL CONDITIONS: node ',l
552  write(*,*)' exceeds the largest defined ',
553  & 'node number'
554  cycle
555  endif
556  vold(2,l)=totpres
557  else
558  read(textpart(1)(1:80),'(a80)',iostat=istat) noset
559  noset(81:81)=' '
560  ipos=index(noset,' ')
561  noset(ipos:ipos)='N'
562  do ii=1,nset
563  if(set(ii).eq.noset) exit
564  enddo
565  if(ii.gt.nset) then
566  noset(ipos:ipos)=' '
567  write(*,*)
568  & '*ERROR reading *INITIAL CONDITIONS: node set '
569  & ,noset
570  write(*,*)' has not yet been defined. '
571  call inputerror(inpc,ipoinpc,iline,
572  &"*INITIAL CONDITIONS%")
573  call exit(201)
574  endif
575  do j=istartset(ii),iendset(ii)
576  if(ialset(j).gt.0) then
577  vold(2,ialset(j))=totpres
578  else
579  k=ialset(j-2)
580  do
581  k=k-ialset(j)
582  if(k.ge.ialset(j-1)) exit
583  vold(2,k)=totpres
584  enddo
585  endif
586  enddo
587  endif
588  enddo
589  return
590  elseif(textpart(ij)(1:13).eq.'TYPE=MASSFLOW') then
591 !
592  do
593  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
594  & ipoinp,inp,ipoinpc)
595  if((istat.lt.0).or.(key.eq.1)) return
596  read(textpart(2)(1:20),'(f20.0)',iostat=istat) xmassflow
597  if(iaxial.eq.180) xmassflow=xmassflow/iaxial
598  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
599  &"*INITIAL CONDITIONS%")
600  read(textpart(1)(1:10),'(i10)',iostat=istat) l
601  if(istat.eq.0) then
602  if(l.gt.nk) then
603  write(*,*)
604  & '*WARNING reading *INITIAL CONDITIONS: node ',l
605  write(*,*)' exceeds the largest defined ',
606  & 'node number'
607  cycle
608  endif
609  vold(1,l)=xmassflow
610  else
611  read(textpart(1)(1:80),'(a80)',iostat=istat) noset
612  noset(81:81)=' '
613  ipos=index(noset,' ')
614  noset(ipos:ipos)='N'
615  do ii=1,nset
616  if(set(ii).eq.noset) exit
617  enddo
618  if(ii.gt.nset) then
619  noset(ipos:ipos)=' '
620  write(*,*)
621  & '*ERROR reading *INITIAL CONDITIONS: node set '
622  & ,noset
623  write(*,*)' has not yet been defined. '
624  call inputerror(inpc,ipoinpc,iline,
625  &"*INITIAL CONDITIONS%")
626  call exit(201)
627  endif
628  do j=istartset(ii),iendset(ii)
629  if(ialset(j).gt.0) then
630  vold(1,ialset(j))=xmassflow
631  else
632  k=ialset(j-2)
633  do
634  k=k-ialset(j)
635  if(k.ge.ialset(j-1)) exit
636  vold(1,k)=xmassflow
637  enddo
638  endif
639  enddo
640  endif
641  enddo
642  return
643 !
644  elseif(textpart(ij)(1:13).eq.'TYPE=SOLUTION') then
645  user=.false.
646  do j=2,n
647  if(textpart(j)(1:4).eq.'USER') user=.true.
648  enddo
649 c if(.not.user) then
650 c write(*,*)
651 c & '*ERROR reading *INITIAL CONDITIONS: TYPE=SOLUTION'
652 c write(*,*) ' can only be used in combination with'
653 c write(*,*) ' USER'
654 c call exit(201)
655 c endif
656  if(user) then
657 !
658 ! internal state variables are read in file sdvini.f
659 !
660  iflag=1
661  ncrds=3
662  do i=1,ne
663  indexe=ipkon(i)
664  if(lakon(i)(4:4).eq.'2') then
665  nope=20
666  elseif(lakon(i)(4:4).eq.'8') then
667  nope=8
668  elseif(lakon(i)(4:5).eq.'10') then
669  nope=10
670  elseif(lakon(i)(4:4).eq.'4') then
671  nope=4
672  elseif(lakon(i)(4:5).eq.'15') then
673  nope=15
674  elseif(lakon(i)(4:4).eq.'6') then
675  nope=6
676  else
677  cycle
678  endif
679 !
680  if(lakon(i)(4:5).eq.'8R') then
681  mint3d=1
682  elseif((lakon(i)(4:4).eq.'8').or.
683  & (lakon(i)(4:6).eq.'20R')) then
684  mint3d=8
685  elseif(lakon(i)(4:4).eq.'2') then
686  mint3d=27
687  elseif(lakon(i)(4:5).eq.'10') then
688  mint3d=4
689  elseif(lakon(i)(4:4).eq.'4') then
690  mint3d=1
691  elseif(lakon(i)(4:5).eq.'15') then
692  mint3d=9
693  elseif(lakon(i)(4:4).eq.'6') then
694  mint3d=2
695  endif
696 !
697  do j=1,nope
698  konl(j)=kon(indexe+j)
699  do k=1,3
700  xl(k,j)=co(k,konl(j))
701  enddo
702  enddo
703 !
704  do j=1,mint3d
705  if(lakon(i)(4:5).eq.'8R') then
706  xi=gauss3d1(1,j)
707  et=gauss3d1(2,j)
708  ze=gauss3d1(3,j)
709  weight=weight3d1(j)
710  elseif((lakon(i)(4:4).eq.'8').or.
711  & (lakon(i)(4:6).eq.'20R'))
712  & then
713  xi=gauss3d2(1,j)
714  et=gauss3d2(2,j)
715  ze=gauss3d2(3,j)
716  weight=weight3d2(j)
717  elseif(lakon(i)(4:4).eq.'2') then
718  xi=gauss3d3(1,j)
719  et=gauss3d3(2,j)
720  ze=gauss3d3(3,j)
721  weight=weight3d3(j)
722  elseif(lakon(i)(4:5).eq.'10') then
723  xi=gauss3d5(1,j)
724  et=gauss3d5(2,j)
725  ze=gauss3d5(3,j)
726  weight=weight3d5(j)
727  elseif(lakon(i)(4:4).eq.'4') then
728  xi=gauss3d4(1,j)
729  et=gauss3d4(2,j)
730  ze=gauss3d4(3,j)
731  weight=weight3d4(j)
732  elseif(lakon(i)(4:5).eq.'15') then
733  xi=gauss3d8(1,j)
734  et=gauss3d8(2,j)
735  ze=gauss3d8(3,j)
736  weight=weight3d8(j)
737  elseif(lakon(i)(4:4).eq.'6') then
738  xi=gauss3d7(1,j)
739  et=gauss3d7(2,j)
740  ze=gauss3d7(3,j)
741  weight=weight3d7(j)
742  endif
743 !
744  if(nope.eq.20) then
745  call shape20h(xi,et,ze,xl,xsj,shp,iflag)
746  elseif(nope.eq.8) then
747  call shape8h(xi,et,ze,xl,xsj,shp,iflag)
748  elseif(nope.eq.10) then
749  call shape10tet(xi,et,ze,xl,xsj,shp,iflag)
750  elseif(nope.eq.4) then
751  call shape4tet(xi,et,ze,xl,xsj,shp,iflag)
752  elseif(nope.eq.15) then
753  call shape15w(xi,et,ze,xl,xsj,shp,iflag)
754  else
755  call shape6w(xi,et,ze,xl,xsj,shp,iflag)
756  endif
757 !
758  do k=1,3
759  pgauss(k)=0.d0
760  do i1=1,nope
761  pgauss(k)=pgauss(k)+
762  & shp(4,i1)*co(k,konl(i1))
763  enddo
764  enddo
765 !
766  call sdvini(xstate(1,j,i),pgauss,nstate_,ncrds,
767  & i,j,layer,kspt)
768 !
769  enddo
770  enddo
771  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
772  & inl,ipoinp,inp,ipoinpc)
773  return
774  else
775 !
776 ! internal variables are written explicitly in the input deck
777 !
778  do
779  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
780  & inl,ipoinp,inp,ipoinpc)
781  if((istat.lt.0).or.(key.eq.1)) return
782 !
783  if(nstate_.lt.6) then
784  ntot=nstate_
785  else
786  ntot=6
787  endif
788 !
789  do j=1,ntot
790  read(textpart(j+2)(1:20),'(f20.0)',iostat=istat)
791  & beta(j)
792  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
793  &"*INITIAL CONDITIONS%")
794  enddo
795  read(textpart(1)(1:10),'(i10)',iostat=istat) l
796  if(istat.ne.0) call inputerror(inpc,ipoinpc,iline,
797  &"*INITIAL CONDITIONS%")
798  if(l.gt.ne) then
799  write(*,*)
800  & '*WARNING reading *INITIAL CONDITIONS: element ',l
801  write(*,*)' exceeds the largest defined ',
802  & 'element number'
803  cycle
804  endif
805  read(textpart(2)(1:10),'(i10)',iostat=istat) k
806  if(istat.eq.0) then
807  do j=1,ntot
808  xstate(j,k,l)=beta(j)
809  enddo
810  else
811  call inputerror(inpc,ipoinpc,iline,
812  &"*INITIAL CONDITIONS%")
813  endif
814 !
815  if(nstate_.gt.6) then
816  numberoflines=(nstate_-7)/8+1
817  do ii=1,numberoflines
818  if(ii.lt.numberoflines) then
819  jmax=8
820  else
821  jmax=nstate_-ntot
822  endif
823  call getnewline(inpc,textpart,istat,n,key,iline,
824  & ipol,inl,ipoinp,inp,ipoinpc)
825  if((istat.lt.0).or.(key.eq.1)) return
826  do j=1,jmax
827  read(textpart(j+2)(1:20),'(f20.0)',
828  & iostat=istat) beta(j)
829  if(istat.gt.0)
830  & call inputerror(inpc,ipoinpc,iline,
831  &"*INITIAL CONDITIONS%")
832  xstate(ntot+j,k,l)=beta(j)
833  enddo
834  ntot=ntot+jmax
835  enddo
836  endif
837 !
838  enddo
839  return
840  endif
841 !
842  else
843  write(*,*)
844  & '*WARNING reading *INITIAL CONDITIONS: parameter not recognized:'
845  write(*,*) ' ',
846  & textpart(ij)(1:index(textpart(ij),' ')-1)
847  call inputwarning(inpc,ipoinpc,iline,
848  &"*INITIAL CONDITIONS%")
849  endif
850  enddo
851 !
852  write(*,*) '*ERROR reading *INITIAL CONDITIONS: unknown type'
853  write(*,*) ' '
854  call inputerror(inpc,ipoinpc,iline,
855  &"*INITIAL CONDITIONS%")
856 !
857  return
shape6w
subroutine shape6w(xi, et, ze, xl, xsj, shp, iflag)
Definition: shape6w.f:20
sdvini
subroutine sdvini(statev, coords, nstatv, ncrds, noel, npt, layer, kspt)
Definition: sdvini.f:21
inputwarning
subroutine inputwarning(inpc, ipoinpc, iline, text)
Definition: inputwarning.f:20
shape10tet
subroutine shape10tet(xi, et, ze, xl, xsj, shp, iflag)
Definition: shape10tet.f:20
shape8h
subroutine shape8h(xi, et, ze, xl, xsj, shp, iflag)
Definition: shape8h.f:20
shape15w
subroutine shape15w(xi, et, ze, xl, xsj, shp, iflag)
Definition: shape15w.f:20
sigini
subroutine sigini(sigma, coords, ntens, ncrds, noel, npt, layer, kspt, lrebar, rebarn)
Definition: sigini.f:21
shape20h
subroutine shape20h(xi, et, ze, xl, xsj, shp, iflag)
Definition: shape20h.f:20
getnewline
subroutine getnewline(inpc, textpart, istat, n, key, iline, ipol, inl, ipoinp, inp, ipoinpc)
Definition: getnewline.f:21
beamintscheme
subroutine beamintscheme(lakonl, mint3d, npropstart, prop, kk, xi, et, ze, weight)
Definition: beamintscheme.f:21
shape4tet
subroutine shape4tet(xi, et, ze, xl, xsj, shp, iflag)
Definition: shape4tet.f:20
inputerror
subroutine inputerror(inpc, ipoinpc, iline, text)
Definition: inputerror.f:20
Hosted by OpenAircraft.com, (Michigan UAV, LLC)