CalculiX  2.13
A Free Software Three-Dimensional Structural Finite Element Program
createmdelem.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine createmdelem (imdnode, nmdnode, xforc, ikmpc, ilmpc, ipompc, nodempc, nmpc, imddof, nmddof, nactdof, mi, imdmpc, nmdmpc, imdboun, nmdboun, ikboun, nboun, ilboun, ithermal, imdelem, nmdelem, iponoel, inoel, prlab, prset, nprint, lakon, set, nset, ialset, ipkon, kon, istartset, iendset, nforc, ikforc, ilforc)
 

Function/Subroutine Documentation

◆ createmdelem()

subroutine createmdelem ( integer, dimension(*)  imdnode,
integer  nmdnode,
real*8, dimension(*)  xforc,
integer, dimension(*)  ikmpc,
integer, dimension(*)  ilmpc,
integer, dimension(*)  ipompc,
integer, dimension(3,*)  nodempc,
integer  nmpc,
integer, dimension(*)  imddof,
integer  nmddof,
integer, dimension(0:mi(2),*)  nactdof,
integer, dimension(*)  mi,
integer, dimension(*)  imdmpc,
integer  nmdmpc,
integer, dimension(*)  imdboun,
integer  nmdboun,
integer, dimension(*)  ikboun,
integer  nboun,
integer, dimension(*)  ilboun,
integer  ithermal,
integer, dimension(*)  imdelem,
integer  nmdelem,
integer, dimension(*)  iponoel,
integer, dimension(2,*)  inoel,
character*6, dimension(*)  prlab,
character*81, dimension(*)  prset,
integer  nprint,
character*8, dimension(*)  lakon,
character*81, dimension(*)  set,
integer  nset,
integer, dimension(*)  ialset,
integer, dimension(*)  ipkon,
integer, dimension(*)  kon,
integer, dimension(*)  istartset,
integer, dimension(*)  iendset,
integer  nforc,
integer, dimension(*)  ikforc,
integer, dimension(*)  ilforc 
)
26 !
27 ! stores the elements for which results are requested in at
28 ! least one node
29 !
30  implicit none
31 !
32  character*6 prlab(*)
33  character*8 lakon(*)
34  character*81 prset(*),noset,set(*)
35 !
36  integer iforc,node,imdnode(*),nmdnode,ikmpc(*),
37  & ilmpc(*),ipompc(*),nodempc(3,*),nmpc,imddof(*),nmddof,
38  & mi(*),nactdof(0:mi(2),*),imdmpc(*),nmdmpc,imdboun(*),nmdboun,
39  & ikboun(*),nboun,ilboun(*),ithermal,imdelem(*),nmdelem,
40  & iponoel(*),inoel(2,*),index,id,nprint,i,j,k,l,indexe,
41  & nope,nset,nrset,ialset(*),ipkon(*),kon(*),istartset(*),
42  & iendset(*),idof,m,ikforc(*),ilforc(*),nforc
43 !
44  real*8 xforc(*)
45 !
46 ! storing all elements to which nodes in imdnode belong
47 ! in imdelem
48 !
49  do m=1,nmdnode
50  node=imdnode(m)
51 !
52  index=iponoel(node)
53  do
54  if(index.eq.0) exit
55  i=inoel(1,index)
56  call addimd(imdelem,nmdelem,i)
57 !
58  index=inoel(2,index)
59  enddo
60  enddo
61 !
62 ! storing the elements for which *EL PRINT was selected
63 !
64  do m=1,nprint
65  if((prlab(m)(1:4).eq.'S ').or.
66  & (prlab(m)(1:4).eq.'E ').or.
67  & (prlab(m)(1:4).eq.'PEEQ').or.
68  & (prlab(m)(1:4).eq.'ENER').or.
69  & (prlab(m)(1:4).eq.'SDV ').or.
70  & (prlab(m)(1:4).eq.'ELSE').or.
71  & (prlab(m)(1:4).eq.'ELKE').or.
72  & (prlab(m)(1:4).eq.'EVOL').or.
73  & (prlab(m)(1:4).eq.'HFL ')) then
74  noset=prset(m)
75  nrset=0
76  do k=1,nset
77  if(set(k).eq.noset) then
78  nrset=k
79  exit
80  endif
81  enddo
82 !
83 ! adding the elements belonging to nrset
84 !
85  do j=istartset(nrset),iendset(nrset)
86  if(ialset(j).gt.0) then
87  i=ialset(j)
88  call addimd(imdelem,nmdelem,i)
89 !
90 ! in order to calculate results at the integration
91 ! point of an element the results must have been
92 ! determined at the nodes of this element
93 !
94  indexe=ipkon(i)
95 c Bernhardi start
96  if(lakon(i)(1:5).eq.'C3D8I') then
97  nope=11
98  elseif(lakon(i)(4:4).eq.'2') then
99 c Bernhardi end
100  nope=20
101  elseif(lakon(i)(4:4).eq.'8') then
102  nope=8
103  elseif(lakon(i)(4:5).eq.'10') then
104  nope=10
105  elseif(lakon(i)(4:4).eq.'4') then
106  nope=4
107  elseif(lakon(i)(4:5).eq.'15') then
108  nope=15
109  elseif(lakon(i)(4:4).eq.'6') then
110  nope=6
111  elseif(lakon(i)(1:1).eq.'E') then
112  nope=ichar(lakon(i)(8:8))-47
113  else
114  cycle
115  endif
116 !
117  do l=1,nope
118  node=kon(indexe+l)
119  call addimd(imdnode,nmdnode,node)
120  if(ithermal.ne.2) then
121  do k=1,3
122  call addimdnodedof(node,k,ikmpc,ilmpc,ipompc,
123  & nodempc,nmpc,imdnode,nmdnode,imddof,nmddof,
124  & nactdof,mi,imdmpc,nmdmpc,imdboun,nmdboun,
125  & ikboun,nboun,ilboun)
126  enddo
127  else
128  k=0
129  call addimdnodedof(node,k,ikmpc,ilmpc,ipompc,
130  & nodempc,nmpc,imdnode,nmdnode,imddof,nmddof,
131  & nactdof,mi,imdmpc,nmdmpc,imdboun,nmdboun,
132  & ikboun,nboun,ilboun)
133  endif
134  enddo
135  else
136  i=ialset(j-2)
137  do
138  i=i-ialset(j)
139  if(i.ge.ialset(j-1)) exit
140  call addimd(imdelem,nmdelem,i)
141 !
142 ! in order to calculate results at the integration
143 ! point of an element the results must have been
144 ! determined at the nodes of this element
145 !
146  indexe=ipkon(i)
147 c Bernhardi start
148  if(lakon(i)(1:5).eq.'C3D8I') then
149  nope=11
150  elseif(lakon(i)(4:4).eq.'2') then
151 c Bernhardi end
152  nope=20
153  elseif(lakon(i)(4:4).eq.'8') then
154  nope=8
155  elseif(lakon(i)(4:5).eq.'10') then
156  nope=10
157  elseif(lakon(i)(4:4).eq.'4') then
158  nope=4
159  elseif(lakon(i)(4:5).eq.'15') then
160  nope=15
161  elseif(lakon(i)(4:4).eq.'6') then
162  nope=6
163  elseif(lakon(i)(1:1).eq.'E') then
164  nope=ichar(lakon(i)(8:8))-47
165  else
166  cycle
167  endif
168 !
169  do l=1,nope
170  node=kon(indexe+l)
171  call addimd(imdnode,nmdnode,node)
172  if(ithermal.ne.2) then
173  do k=1,3
174  call addimdnodedof(node,k,ikmpc,ilmpc,
175  & ipompc,nodempc,nmpc,imdnode,nmdnode,
176  & imddof,nmddof,nactdof,mi,imdmpc,
177  & nmdmpc,imdboun,nmdboun,
178  & ikboun,nboun,ilboun)
179  enddo
180  else
181  k=0
182  call addimdnodedof(node,k,ikmpc,ilmpc,ipompc,
183  & nodempc,nmpc,imdnode,nmdnode,imddof,
184  & nmddof,nactdof,mi,imdmpc,nmdmpc,imdboun,
185  & nmdboun,ikboun,
186  & nboun,ilboun)
187  endif
188  enddo
189  enddo
190  endif
191  enddo
192  endif
193  enddo
194 !
195  return
subroutine addimdnodedof(node, k, ikmpc, ilmpc, ipompc, nodempc, nmpc, imdnode, nmdnode, imddof, nmddof, nactdof, mi, imdmpc, nmdmpc, imdboun, nmdboun, ikboun, nboun, ilboun)
Definition: addimdnodedof.f:22
subroutine addimd(imd, nmd, node)
Definition: addimd.f:20
Hosted by OpenAircraft.com, (Michigan UAV, LLC)