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

Go to the source code of this file.

Functions/Subroutines

subroutine beamgeneralsections (inpc, textpart, set, istartset, iendset, ialset, nset, ielmat, matname, nmat, ielorien, orname, norien, thicke, ipkon, iponor, xnor, ixfree, offset, lakon, irstrt, istep, istat, n, iline, ipol, inl, ipoinp, inp, ipoinpc, mi, ielprop, nprop, nprop_, prop, nelcon)
 

Function/Subroutine Documentation

◆ beamgeneralsections()

subroutine beamgeneralsections ( character*1, dimension(*)  inpc,
character*132, dimension(16)  textpart,
character*81, dimension(*)  set,
integer, dimension(*)  istartset,
integer, dimension(*)  iendset,
integer, dimension(*)  ialset,
integer  nset,
integer, dimension(mi(3),*)  ielmat,
character*80, dimension(*)  matname,
integer  nmat,
integer, dimension(mi(3),*)  ielorien,
character*80, dimension(*)  orname,
integer  norien,
real*8, dimension(mi(3),*)  thicke,
integer, dimension(*)  ipkon,
integer, dimension(2,*)  iponor,
real*8, dimension(*)  xnor,
integer  ixfree,
real*8, dimension(2,*)  offset,
character*8, dimension(*)  lakon,
integer  irstrt,
integer  istep,
integer  istat,
integer  n,
integer  iline,
integer  ipol,
integer  inl,
integer, dimension(2,*)  ipoinp,
integer, dimension(3,*)  inp,
integer, dimension(0:*)  ipoinpc,
integer, dimension(*)  mi,
integer, dimension(*)  ielprop,
integer  nprop,
integer  nprop_,
real*8, dimension(*)  prop,
integer, dimension(2,*)  nelcon 
)
24 !
25 ! reading the input deck: *BEAM SECTION
26 ! for sections of type PIPE, BOX and GENERAL
27 !
28 ! this routine is used for sections which cannot be described
29 ! by two thicknesses alone -> prop array must be used
30 !
31  implicit none
32 !
33  character*1 inpc(*)
34  character*4 section
35  character*8 lakon(*)
36  character*80 matname(*),orname(*),material,orientation
37  character*81 set(*),elset
38  character*132 textpart(16)
39 !
40  integer istartset(*),iendset(*),ialset(*),mi(*),ielmat(mi(3),*),
41  & ipoinpc(0:*),ielorien(mi(3),*),ipkon(*),iline,ipol,inl,lprop,
42  & ipoinp(2,*),inp(3,*),nset,nmat,norien,istep,istat,n,key,i,j,k,l,
43  & imaterial,iorientation,ipos,m,iponor(2,*),ixfree,indexx,indexe,
44  & irstrt,ielprop(*),nprop_,nprop,npropstart,ndprop,ndpropread,
45  & nelcon(2,*)
46 !
47  real*8 thicke(mi(3),*),thickness1,thickness2,p(3),xnor(*),
48  & offset(2,*),offset1,offset2,dd,prop(*)
49 !
50  if((istep.gt.0).and.(irstrt.ge.0)) then
51  write(*,*) '*ERROR reading *BEAM SECTION:'
52  write(*,*) ' *BEAM SECTION should'
53  write(*,*) ' be placed before all step definitions'
54  call exit(201)
55  endif
56 !
57  offset1=0.d0
58  offset2=0.d0
59  orientation='
60  & '
61  section=' '
62  ipos=1
63  npropstart=nprop
64 !
65  do i=2,n
66  if(textpart(i)(1:9).eq.'MATERIAL=') then
67  material=textpart(i)(10:89)
68  elseif(textpart(i)(1:12).eq.'ORIENTATION=') then
69  orientation=textpart(i)(13:92)
70  elseif(textpart(i)(1:6).eq.'ELSET=') then
71  elset=textpart(i)(7:86)
72  elset(21:21)=' '
73  ipos=index(elset,' ')
74  elset(ipos:ipos)='E'
75  elseif(textpart(i)(1:8).eq.'SECTION=') then
76  if(textpart(i)(9:12).eq.'PIPE') then
77  section='PIPE'
78  ndprop=2
79  elseif(textpart(i)(9:11).eq.'BOX') then
80  section='BOX'
81  ndprop=6
82  elseif(textpart(i)(9:15).eq.'GENERAL') then
83  section='GENE'
84  ndprop=5
85  else
86  write(*,*)
87  & '*ERROR reading *BEAM SECTION: unknown section'
88  call exit(201)
89  endif
90  elseif(textpart(i)(1:8).eq.'OFFSET1=') then
91  read(textpart(i)(9:28),'(f20.0)',iostat=istat) offset1
92  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
93  &"*BEAM SECTION%")
94  elseif(textpart(i)(1:8).eq.'OFFSET2=') then
95  read(textpart(i)(9:28),'(f20.0)',iostat=istat) offset2
96  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
97  &"*BEAM SECTION%")
98  else
99  write(*,*) '*WARNING reading *BEAM SECTION:'
100  write(*,*) ' parameter not recognized:'
101  write(*,*) ' ',
102  & textpart(i)(1:index(textpart(i),' ')-1)
103  call inputwarning(inpc,ipoinpc,iline,
104  &"*BEAM SECTION%")
105  endif
106  enddo
107 !
108 ! check whether a sections was defined
109 !
110  if(section.eq.' ') then
111  write(*,*) '*ERROR reading *BEAM SECTION:'
112  write(*,*) ' no section defined'
113  call exit(201)
114  endif
115 !
116 ! check for the existence of the set,the material and orientation
117 !
118  do i=1,nmat
119  if(matname(i).eq.material) exit
120  enddo
121  if(i.gt.nmat) then
122  write(*,*) '*ERROR reading *BEAM SECTION:'
123  write(*,*) ' nonexistent material'
124  write(*,*) ' '
125  call inputerror(inpc,ipoinpc,iline,
126  &"*BEAM SECTION%")
127  call exit(201)
128  endif
129  imaterial=i
130 !
131  if(orientation.eq.'
132  & ') then
133  iorientation=0
134  elseif(nelcon(1,i).eq.2) then
135  write(*,*) '*INFO reading *SOLID SECTION: an orientation'
136  write(*,*) ' is for isotropic materials irrelevant'
137  call inputinfo(inpc,ipoinpc,iline,
138  &"*SOLID SECTION%")
139  iorientation=0
140  else
141  do i=1,norien
142  if(orname(i).eq.orientation) exit
143  enddo
144  if(i.gt.norien) then
145  write(*,*)
146  & '*ERROR reading *BEAM SECTION: nonexistent orientation'
147  write(*,*) ' '
148  call inputerror(inpc,ipoinpc,iline,
149  &"*BEAM SECTION%")
150  call exit(201)
151  endif
152  iorientation=i
153  endif
154 !
155  do i=1,nset
156  if(set(i).eq.elset) exit
157  enddo
158  if(i.gt.nset) then
159  elset(ipos:ipos)=' '
160  write(*,*)'*ERROR reading *BEAM SECTION: element set ',
161  & elset(1:ipos)
162  write(*,*) ' has not yet been defined. '
163  call inputerror(inpc,ipoinpc,iline,
164  &"*BEAM SECTION%")
165  call exit(201)
166  endif
167 !
168 ! assigning the elements of the set the appropriate material,
169 ! orientation number, section and offset(s)
170 !
171  if(section.ne.'GENE') then
172  do j=istartset(i),iendset(i)
173  if(ialset(j).gt.0) then
174  if(lakon(ialset(j))(1:4).ne.'B32R') then
175  write(*,*) '*ERROR reading *BEAM SECTION:'
176  write(*,*) ' *BEAM SECTION can'
177  write(*,*) ' only be used for B32R elements.'
178  write(*,*) ' Element ',ialset(j),' is not a B32R
179  & element.'
180  call exit(201)
181  endif
182  ielmat(1,ialset(j))=imaterial
183  ielorien(1,ialset(j))=iorientation
184  offset(1,ialset(j))=offset1
185  offset(2,ialset(j))=offset2
186  if(section.eq.'PIPE') then
187  lakon(ialset(j))(8:8)='P'
188  elseif(section.eq.'BOX') then
189  lakon(ialset(j))(8:8)='B'
190  endif
191  else
192  k=ialset(j-2)
193  do
194  k=k-ialset(j)
195  if(k.ge.ialset(j-1)) exit
196  if(lakon(k)(1:1).ne.'B') then
197  write(*,*) '*ERROR reading *BEAM SECTION:'
198  write(*,*) ' *BEAM SECTION can'
199  write(*,*) ' only be used for beam elements.'
200  write(*,*) ' Element ',k,' is not a beam elem
201  &ent.'
202  call exit(201)
203  endif
204  ielmat(1,k)=imaterial
205  ielorien(1,k)=iorientation
206  offset(1,k)=offset1
207  offset(2,k)=offset2
208  if(section.eq.'PIPE') then
209  lakon(k)(8:8)='P'
210  elseif(section.eq.'BOX') then
211  lakon(k)(8:8)='B'
212  endif
213  enddo
214  endif
215  enddo
216  else
217 !
218 ! general section
219 !
220  do j=istartset(i),iendset(i)
221  if(ialset(j).gt.0) then
222  if(lakon(ialset(j))(1:2).ne.'U1') then
223  write(*,*) '*ERROR reading *BEAM SECTION:'
224  write(*,*) ' *BEAM SECTION of type GENERAL can'
225  write(*,*) ' only be used for U1 elements.'
226  write(*,*) ' Element ',ialset(j),' is not a U1
227  & element.'
228  call exit(201)
229  endif
230  ielmat(1,ialset(j))=imaterial
231  ielorien(1,ialset(j))=iorientation
232  else
233  k=ialset(j-2)
234  do
235  k=k-ialset(j)
236  if(k.ge.ialset(j-1)) exit
237  if(lakon(k)(1:2).ne.'U1') then
238  write(*,*) '*ERROR reading *BEAM SECTION:'
239  write(*,*) ' *BEAM SECTION of type GENERAL'
240  write(*,*) ' can only be used for beam'
241  write(*,*) ' elements.'
242  write(*,*) ' Element ',k,' is not a beam elem
243  &ent.'
244  call exit(201)
245  endif
246  ielmat(1,k)=imaterial
247  ielorien(1,k)=iorientation
248  enddo
249  endif
250  enddo
251  endif
252 !
253 ! reading the properties
254 !
255  lprop=0
256  ndpropread=ndprop
257  do j=1,(ndpropread-1)/8+1
258  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
259  & ipoinp,inp,ipoinpc)
260  do k=1,8
261  lprop=lprop+1
262  if(lprop.gt.ndpropread) exit
263  read(textpart(k),'(f40.0)',iostat=istat)
264  & prop(nprop+lprop)
265  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
266  &"*BEAM SECTION%")
267  enddo
268  enddo
269  nprop=nprop+ndprop
270 !
271  if(section.eq.'GENE') then
272 !
273  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
274  & ipoinp,inp,ipoinpc)
275  if((istat.lt.0).or.(key.eq.1)) then
276 !
277 ! default 1-direction
278 !
279  prop(nprop+1)=0.d0
280  prop(nprop+2)=0.d0
281  prop(nprop+3)=-1.d0
282  else
283 !
284 ! 1-direction specified by the user
285 !
286  read(textpart(1)(1:20),'(f20.0)',iostat=istat) p(1)
287  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
288  & "*BEAM SECTION%")
289  read(textpart(2)(1:20),'(f20.0)',iostat=istat) p(2)
290  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
291  & "*BEAM SECTION%")
292  read(textpart(3)(1:20),'(f20.0)',iostat=istat) p(3)
293  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
294  & "*BEAM SECTION%")
295  dd=dsqrt(p(1)*p(1)+p(2)*p(2)+p(3)*p(3))
296  if(dd.lt.1.d-10) then
297  write(*,*)
298  & '*ERROR reading *BEAM SECTION: normal in direction 1'
299  write(*,*) ' has zero size'
300  call exit(201)
301  endif
302  do j=1,3
303  prop(nprop+j)=p(j)/dd
304  enddo
305  endif
306  nprop=nprop+3
307 !
308  prop(nprop+1)=offset1
309  prop(nprop+2)=offset2
310  nprop=nprop+2
311  endif
312 !
313  if(nprop.gt.nprop_) then
314  write(*,*)
315  & '*ERROR reading *BEAM SECTION: increase nprop_'
316  call exit(201)
317  endif
318 !
319 ! calculating the dimensions of the rectangular parent beam
320 !
321  if(section.eq.'PIPE') then
322  thickness1=2.d0*prop(npropstart+1)
323  thickness2=thickness1
324  elseif(section.eq.'BOX') then
325  thickness1=prop(npropstart+1)
326  thickness2=prop(npropstart+2)
327  endif
328 !
329 ! assigning the thickness and the properties to the elements
330 !
331  if(section.ne.'GENE') then
332  do j=istartset(i),iendset(i)
333  if(ialset(j).gt.0) then
334  indexe=ipkon(ialset(j))
335  do l=1,8
336  thicke(1,indexe+l)=thickness1
337  thicke(2,indexe+l)=thickness2
338  enddo
339  ielprop(ialset(j))=npropstart
340  else
341  k=ialset(j-2)
342  do
343  k=k-ialset(j)
344  if(k.ge.ialset(j-1)) exit
345  indexe=ipkon(k)
346  do l=1,8
347  thicke(1,indexe+l)=thickness1
348  thicke(2,indexe+l)=thickness2
349  enddo
350  ielprop(k)=npropstart
351  enddo
352  endif
353  enddo
354  else
355  do j=istartset(i),iendset(i)
356  if(ialset(j).gt.0) then
357  ielprop(ialset(j))=npropstart
358  else
359  k=ialset(j-2)
360  do
361  k=k-ialset(j)
362  if(k.ge.ialset(j-1)) exit
363  ielprop(k)=npropstart
364  enddo
365  endif
366  enddo
367  endif
368 !
369  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
370  & ipoinp,inp,ipoinpc)
371  if((istat.lt.0).or.(key.eq.1)) return
372 !
373 ! assigning normal direction 1 for the beam
374 !
375  indexx=-1
376  read(textpart(1)(1:20),'(f20.0)',iostat=istat) p(1)
377  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
378  &"*BEAM SECTION%")
379  read(textpart(2)(1:20),'(f20.0)',iostat=istat) p(2)
380  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
381  &"*BEAM SECTION%")
382  read(textpart(3)(1:20),'(f20.0)',iostat=istat) p(3)
383  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
384  &"*BEAM SECTION%")
385  dd=dsqrt(p(1)*p(1)+p(2)*p(2)+p(3)*p(3))
386  if(dd.lt.1.d-10) then
387  write(*,*)
388  & '*ERROR reading *BEAM SECTION: normal in direction 1'
389  write(*,*) ' has zero size'
390  call exit(201)
391  endif
392  do j=1,3
393  p(j)=p(j)/dd
394  enddo
395  do j=istartset(i),iendset(i)
396  if(ialset(j).gt.0) then
397  indexe=ipkon(ialset(j))
398  do l=1,8
399  if(indexx.eq.-1) then
400  indexx=ixfree
401  do m=1,3
402  xnor(indexx+m)=p(m)
403  enddo
404  ixfree=ixfree+6
405  endif
406  iponor(1,indexe+l)=indexx
407  enddo
408  else
409  k=ialset(j-2)
410  do
411  k=k-ialset(j)
412  if(k.ge.ialset(j-1)) exit
413  indexe=ipkon(k)
414  do l=1,8
415  if(indexx.eq.-1) then
416  indexx=ixfree
417  do m=1,3
418  xnor(indexx+m)=p(m)
419  enddo
420  ixfree=ixfree+6
421  endif
422  iponor(1,indexe+l)=indexx
423  enddo
424  enddo
425  endif
426  enddo
427 !
428  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
429  & ipoinp,inp,ipoinpc)
430 !
431  return
inputwarning
subroutine inputwarning(inpc, ipoinpc, iline, text)
Definition: inputwarning.f:20
inputinfo
subroutine inputinfo(inpc, ipoinpc, iline, text)
Definition: inputinfo.f:20
getnewline
subroutine getnewline(inpc, textpart, istat, n, key, iline, ipol, inl, ipoinp, inp, ipoinpc)
Definition: getnewline.f:21
inputerror
subroutine inputerror(inpc, ipoinpc, iline, text)
Definition: inputerror.f:20
Hosted by OpenAircraft.com, (Michigan UAV, LLC)