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

Go to the source code of this file.

Functions/Subroutines

subroutine beamsections (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, nelcon)
 

Function/Subroutine Documentation

◆ beamsections()

subroutine beamsections ( 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(2,*)  nelcon 
)
24 !
25 ! reading the input deck: *BEAM SECTION
26 !
27  implicit none
28 !
29  character*1 inpc(*)
30  character*4 section
31  character*8 lakon(*)
32  character*80 matname(*),orname(*),material,orientation
33  character*81 set(*),elset
34  character*132 textpart(16)
35 !
36  integer istartset(*),iendset(*),ialset(*),mi(*),ielmat(mi(3),*),
37  & ipoinpc(0:*),
38  & ielorien(mi(3),*),ipkon(*),iline,ipol,inl,ipoinp(2,*),
39  & inp(3,*),nset,nmat,norien,istep,istat,n,key,i,j,k,l,imaterial,
40  & iorientation,ipos,m,iponor(2,*),ixfree,
41  & indexx,indexe,irstrt,nelcon(2,*)
42 !
43  real*8 thicke(mi(3),*),thickness1,thickness2,p(3),xnor(*),
44  & offset(2,*),
45  & offset1,offset2,dd
46 !
47  if((istep.gt.0).and.(irstrt.ge.0)) then
48  write(*,*)
49  & '*ERROR reading *BEAM SECTION: *BEAM SECTION should'
50  write(*,*) ' be placed before all step definitions'
51  call exit(201)
52  endif
53 !
54  offset1=0.d0
55  offset2=0.d0
56  orientation='
57  & '
58  section=' '
59  ipos=1
60 !
61  do i=2,n
62  if(textpart(i)(1:9).eq.'MATERIAL=') then
63  material=textpart(i)(10:89)
64  elseif(textpart(i)(1:12).eq.'ORIENTATION=') then
65  orientation=textpart(i)(13:92)
66  elseif(textpart(i)(1:6).eq.'ELSET=') then
67  elset=textpart(i)(7:86)
68  elset(21:21)=' '
69  ipos=index(elset,' ')
70  elset(ipos:ipos)='E'
71  elseif(textpart(i)(1:8).eq.'SECTION=') then
72  if(textpart(i)(9:12).eq.'CIRC') then
73  section='CIRC'
74  elseif(textpart(i)(9:12).eq.'RECT') then
75  section='RECT'
76  else
77  write(*,*)
78  & '*ERROR reading *BEAM SECTION: unknown section'
79  call exit(201)
80  endif
81  elseif(textpart(i)(1:8).eq.'OFFSET1=') then
82  read(textpart(i)(9:28),'(f20.0)',iostat=istat) offset1
83  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
84  &"*BEAM SECTION%")
85  elseif(textpart(i)(1:8).eq.'OFFSET2=') then
86  read(textpart(i)(9:28),'(f20.0)',iostat=istat) offset2
87  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
88  &"*BEAM SECTION%")
89  else
90  write(*,*)
91  & '*WARNING reading *BEAM SECTION: parameter not recognized:'
92  write(*,*) ' ',
93  & textpart(i)(1:index(textpart(i),' ')-1)
94  call inputwarning(inpc,ipoinpc,iline,
95  &"*BEAM SECTION%")
96  endif
97  enddo
98 !
99 ! check whether a sections was defined
100 !
101  if(section.eq.' ') then
102  write(*,*) '*ERROR reading *BEAM SECTION: no section defined'
103  call exit(201)
104  endif
105 !
106 ! check for the existence of the set,the material and orientation
107 !
108  do i=1,nmat
109  if(matname(i).eq.material) exit
110  enddo
111  if(i.gt.nmat) then
112  write(*,*) '*ERROR reading *BEAM SECTION: nonexistent material'
113  write(*,*) ' '
114  call inputerror(inpc,ipoinpc,iline,
115  &"*BEAM SECTION%")
116  call exit(201)
117  endif
118  imaterial=i
119 !
120  if(orientation.eq.'
121  & ') then
122  iorientation=0
123  elseif(nelcon(1,i).eq.2) then
124  write(*,*) '*INFO reading *SOLID SECTION: an orientation'
125  write(*,*) ' is for isotropic materials irrelevant'
126  call inputinfo(inpc,ipoinpc,iline,
127  &"*SOLID SECTION%")
128  iorientation=0
129  else
130  do i=1,norien
131  if(orname(i).eq.orientation) exit
132  enddo
133  if(i.gt.norien) then
134  write(*,*)
135  & '*ERROR reading *BEAM SECTION: nonexistent orientation'
136  write(*,*) ' '
137  call inputerror(inpc,ipoinpc,iline,
138  &"*BEAM SECTION%")
139  call exit(201)
140  endif
141  iorientation=i
142  endif
143 !
144  do i=1,nset
145  if(set(i).eq.elset) exit
146  enddo
147  if(i.gt.nset) then
148  elset(ipos:ipos)=' '
149  write(*,*) '*ERROR reading *BEAM SECTION: element set ',
150  & elset(1:ipos)
151  write(*,*) ' has not yet been defined. '
152  call inputerror(inpc,ipoinpc,iline,
153  &"*BEAM SECTION%")
154  call exit(201)
155  endif
156 !
157 ! assigning the elements of the set the appropriate material,
158 ! orientation number, section and offset(s)
159 !
160  do j=istartset(i),iendset(i)
161  if(ialset(j).gt.0) then
162  if(lakon(ialset(j))(1:1).ne.'B') then
163  write(*,*)
164  & '*ERROR reading *BEAM SECTION: *BEAM SECTION can'
165  write(*,*) ' only be used for beam elements.'
166  write(*,*) ' Element ',ialset(j),' is not a beam el
167  &ement.'
168  call exit(201)
169  endif
170  ielmat(1,ialset(j))=imaterial
171  ielorien(1,ialset(j))=iorientation
172  offset(1,ialset(j))=offset1
173  offset(2,ialset(j))=offset2
174  if(section.eq.'RECT') then
175  lakon(ialset(j))(8:8)='R'
176  else
177  lakon(ialset(j))(8:8)='C'
178  endif
179  else
180  k=ialset(j-2)
181  do
182  k=k-ialset(j)
183  if(k.ge.ialset(j-1)) exit
184  if(lakon(k)(1:1).ne.'B') then
185  write(*,*)
186  & '*ERROR reading *BEAM SECTION: *BEAM SECTION can'
187  write(*,*) ' only be used for beam elements.'
188  write(*,*) ' Element ',k,' is not a beam element
189  &.'
190  call exit(201)
191  endif
192  ielmat(1,k)=imaterial
193  ielorien(1,k)=iorientation
194  offset(1,k)=offset1
195  offset(2,k)=offset2
196  if(section.eq.'RECT') then
197  lakon(k)(8:8)='R'
198  else
199  lakon(k)(8:8)='C'
200  endif
201  enddo
202  endif
203  enddo
204 !
205  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
206  & ipoinp,inp,ipoinpc)
207 !
208 ! assigning a thickness to the elements
209 !
210  read(textpart(1)(1:20),'(f20.0)',iostat=istat) thickness1
211  if(istat.gt.0) then
212  write(*,*)
213  & '*ERROR reading *BEAM SECTION: first beam thickness is lacking'
214  call inputerror(inpc,ipoinpc,iline,
215  &"*BEAM SECTION%")
216  endif
217  if(n.gt.1) then
218  read(textpart(2)(1:20),'(f20.0)',iostat=istat) thickness2
219  if(istat.gt.0) then
220  write(*,*)
221  & '*ERROR reading *BEAM SECTION: ',
222  & 'second beam thickness is lacking'
223  call inputerror(inpc,ipoinpc,iline,
224  &"*BEAM SECTION%")
225  endif
226  else
227  thickness2=thickness1
228  endif
229  do j=istartset(i),iendset(i)
230  if(ialset(j).gt.0) then
231  indexe=ipkon(ialset(j))
232  do l=1,8
233  thicke(1,indexe+l)=thickness1
234  thicke(2,indexe+l)=thickness2
235  enddo
236  else
237  k=ialset(j-2)
238  do
239  k=k-ialset(j)
240  if(k.ge.ialset(j-1)) exit
241  indexe=ipkon(k)
242  do l=1,8
243  thicke(1,indexe+l)=thickness1
244  thicke(2,indexe+l)=thickness2
245  enddo
246  enddo
247  endif
248  enddo
249 !
250  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
251  & ipoinp,inp,ipoinpc)
252  if((istat.lt.0).or.(key.eq.1)) return
253 !
254 ! assigning normal direction 1 for the beam
255 !
256  indexx=-1
257  read(textpart(1)(1:20),'(f20.0)',iostat=istat) p(1)
258  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
259  &"*BEAM SECTION%")
260  read(textpart(2)(1:20),'(f20.0)',iostat=istat) p(2)
261  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
262  &"*BEAM SECTION%")
263  read(textpart(3)(1:20),'(f20.0)',iostat=istat) p(3)
264  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
265  &"*BEAM SECTION%")
266  dd=dsqrt(p(1)*p(1)+p(2)*p(2)+p(3)*p(3))
267  if(dd.lt.1.d-10) then
268  write(*,*)
269  & '*ERROR reading *BEAM SECTION: normal in direction 1'
270  write(*,*) ' has zero size'
271  call exit(201)
272  endif
273  do j=1,3
274  p(j)=p(j)/dd
275  enddo
276  do j=istartset(i),iendset(i)
277  if(ialset(j).gt.0) then
278  indexe=ipkon(ialset(j))
279  do l=1,8
280  if(indexx.eq.-1) then
281  indexx=ixfree
282  do m=1,3
283  xnor(indexx+m)=p(m)
284  enddo
285  ixfree=ixfree+6
286  endif
287  iponor(1,indexe+l)=indexx
288  enddo
289  else
290  k=ialset(j-2)
291  do
292  k=k-ialset(j)
293  if(k.ge.ialset(j-1)) exit
294  indexe=ipkon(k)
295  do l=1,8
296  if(indexx.eq.-1) then
297  indexx=ixfree
298  do m=1,3
299  xnor(indexx+m)=p(m)
300  enddo
301  ixfree=ixfree+6
302  endif
303  iponor(1,indexe+l)=indexx
304  enddo
305  enddo
306  endif
307  enddo
308 !
309  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
310  & ipoinp,inp,ipoinpc)
311 !
312  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)