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

Go to the source code of this file.

Functions/Subroutines

subroutine applyboun (ifaext, nfaext, ielfa, ikboun, ilboun, nboun, typeboun, nelemload, nload, sideload, isolidsurf, nsolidsurf, ifabou, nfabou, nface, nodeboun, ndirboun, ikmpc, ilmpc, labmpc, nmpc, nactdohinv, compressible, iatleastonepressurebc, ipkonf, kon, konf, nblk)
 

Function/Subroutine Documentation

◆ applyboun()

subroutine applyboun ( integer, dimension(*)  ifaext,
integer  nfaext,
integer, dimension(4,*)  ielfa,
integer, dimension(*)  ikboun,
integer, dimension(*)  ilboun,
integer  nboun,
character*1, dimension(*)  typeboun,
integer, dimension(2,*)  nelemload,
integer  nload,
character*20, dimension(*)  sideload,
integer, dimension(*)  isolidsurf,
integer  nsolidsurf,
integer, dimension(*)  ifabou,
integer  nfabou,
integer  nface,
integer, dimension(*)  nodeboun,
integer, dimension(*)  ndirboun,
integer, dimension(*)  ikmpc,
integer, dimension(*)  ilmpc,
character*20, dimension(*)  labmpc,
integer  nmpc,
integer, dimension(*)  nactdohinv,
integer  compressible,
integer  iatleastonepressurebc,
integer, dimension(*)  ipkonf,
integer, dimension(*)  kon,
integer, dimension(*)  konf,
integer  nblk 
)
24 !
25 ! stores pointers to ifabou in ielfa(2,*) at those locations
26 ! which are zero (external faces)
27 ! stores pointers to the boundary conditions in field ifabou
28 !
29  implicit none
30 !
31  character*1 typeboun(*)
32  character*20 sideload(*),labmpc(*)
33 !
34  integer nfabou,ifaext(*),nfaext,ielem,ielfa(4,*),ifa,jface,
35  & j,idof,ikboun(*),nboun,id,ilboun(*),iboun,nelemload(2,*),
36  & nload,isolidsurf(*),nsolidsurf,ifabou(*),i,nface,indexb,
37  & nodeboun(*),ndirboun(*),jsum,ig,ikmpc(*),ilmpc(*),nmpc,mpc,
38  & nactdohinv(*),compressible,iatleastonepressurebc,iface,
39  & ifaceblk,ipkonf(*),kon(*),konf(*),nblk,indexe
40 !
41  nfabou=1
42  iatleastonepressurebc=0
43 !
44  do i=1,nfaext
45 !
46 ! number of the face in field ielfa
47 !
48  ifa=ifaext(i)
49 !
50 ! adjacent element number (global number)
51 !
52  ielem=nactdohinv(ielfa(1,ifa))
53 !
54 ! face label used to apply the SPC
55 !
56  if(nblk.gt.0) then
57 !
58 ! retrieving the original face number in case the
59 ! element was reordered
60 !
61  ifaceblk=ielfa(4,ifa)
62  indexe=ipkonf(ielfa(1,ifa))
63  call identifyface(konf(indexe+1),kon(indexe+1),
64  & ifaceblk,iface)
65  else
66  iface=ielfa(4,ifa)
67  endif
68 !
69  jface=10*ielem+iface
70 !
71 ! SPC's: loop over the degrees of freedom
72 !
73  jsum=0
74  do j=0,4
75  idof=-(8*(jface-1)+j)
76  call nident(ikboun,idof,nboun,id)
77  if(id.gt.0) then
78  if(ikboun(id).eq.idof) then
79  iboun=ilboun(id)
80  if(typeboun(iboun).ne.'F') cycle
81  if(ielfa(2,ifa).eq.0) then
82  ielfa(2,ifa)=-nfabou
83 c write(*,*) 'applyboun bc',ielfa(2,ifa)
84  nfabou=nfabou+7
85  endif
86 !
87 ! if all velocity components are known no pressure
88 ! should be defined (only for incompressible fluids)
89 !
90  if(compressible.eq.0) then
91  if(j.eq.4) then
92  if(jsum.eq.6) then
93  write(*,*) '*WARNING in applyboun: a pressure
94  & SPC is being applied to'
95  write(*,*) ' face ',iface,
96  & 'of element ',ielem,'for which all'
97  write(*,*) ' velocities are known (by
98  & SPCs or MPCs). The pressure'
99  write(*,*) ' SPC is discarded'
100  write(*,*)
101  exit
102  endif
103  iatleastonepressurebc=1
104  endif
105  endif
106  jsum=jsum+j
107 !
108  ifabou(-ielfa(2,ifa)+j)=iboun
109  endif
110  endif
111 !
112 ! MPC's: loop over the degrees of freedom
113 !
114  call nident(ikmpc,idof,nmpc,id)
115  if(id.gt.0) then
116  if(ikmpc(id).eq.idof) then
117  mpc=ilmpc(id)
118  if(labmpc(mpc)(1:5).ne.'FLUID') cycle
119  if(ielfa(2,ifa).eq.0) then
120  ielfa(2,ifa)=-nfabou
121  nfabou=nfabou+7
122  else if(ifabou(-ielfa(2,ifa)+j).ne.0) then
123  write(*,*) '*ERROR in applyboun: MPC is applied'
124  write(*,*) ' to degree of freedom ',j
125  write(*,*) ' in face ',iface
126  write(*,*) ' of element ',ielem,'.'
127  write(*,*) ' To this degree of freedom '
128  write(*,*) ' another SPC or MPC has already'
129  write(*,*) ' been applied'
130  call exit(201)
131  endif
132 !
133 ! if all velocity components are known no pressure
134 ! should be defined (only for incompressible fluids)
135 !
136  if(compressible.eq.0) then
137  if(j.eq.4) then
138  if(jsum.eq.6) then
139  write(*,*) '*WARNING in applyboun: a pressure
140  & MPC is being applied to'
141  write(*,*) ' face ',iface,
142  & 'of element ',ielem,'for which all'
143  write(*,*) ' velocities are known (by
144  & SPCs or MPCs). The pressure'
145  write(*,*) ' MPC is discarded'
146  exit
147  endif
148  endif
149  endif
150  jsum=jsum+j
151 !
152  ifabou(-ielfa(2,ifa)+j)=-mpc
153  endif
154  endif
155  enddo
156 !
157 ! heat flux
158 !
159  call nident2(nelemload,ielem,nload,id)
160 !
161  do
162  if(id.gt.0) then
163  if(nelemload(1,id).eq.ielem) then
164  if(sideload(id)(1:1).eq.'S') then
165  read(sideload(id)(2:2),'(i1)') ig
166  if(ig.eq.iface) then
167  if(ielfa(2,ifa).eq.0) then
168  ielfa(2,ifa)=-nfabou
169  nfabou=nfabou+7
170  endif
171  ifabou(-ielfa(2,ifa)+6)=id
172  endif
173  endif
174  id=id-1
175  cycle
176  else
177  exit
178  endif
179  else
180  exit
181  endif
182  enddo
183 !
184 ! sliding conditions
185 !
186  call nident2(nelemload,ielem,nload,id)
187 !
188  do
189  if(id.gt.0) then
190 c write(*,*) 'applyboun ',nelemload(1,id),sideload(id)
191  if(nelemload(1,id).eq.ielem) then
192  if(sideload(id)(1:1).eq.'M') then
193  read(sideload(id)(2:2),'(i1)') ig
194  if(ig.eq.iface) then
195 c write(*,*) 'store '
196  if(ielfa(2,ifa).eq.0) then
197  ielfa(2,ifa)=-nfabou
198  nfabou=nfabou+7
199  endif
200 c ifabou(-ielfa(2,ifa)+5)=2
201  ifabou(-ielfa(2,ifa)+5)=-1
202  endif
203  endif
204  id=id-1
205  cycle
206  else
207  exit
208  endif
209  else
210  exit
211  endif
212  enddo
213 !
214 ! wall
215 !
216  call nident(isolidsurf,jface,nsolidsurf,id)
217  if(id.gt.0) then
218  if(isolidsurf(id).eq.jface) then
219  if(ielfa(2,ifa).eq.0) then
220  ielfa(2,ifa)=-nfabou
221  nfabou=nfabou+7
222  endif
223  indexb=-ielfa(2,ifa)
224  if((ifabou(indexb+1).eq.0).or.
225  & (ifabou(indexb+2).eq.0).or.
226  & (ifabou(indexb+3).eq.0)) then
227  write(*,*) '*ERROR in applyboun: face',iface
228  write(*,*) ' of element ',ielem,'is defined'
229  write(*,*) ' as solid surface but not all'
230  write(*,*) ' velocity components are defined'
231  write(*,*) ' as boundary conditions'
232  call exit(201)
233  endif
234 c ifabou(indexb+5)=1
235  ifabou(indexb+5)=id
236  endif
237  endif
238 !
239 ! checking for:
240 ! - absent boundary conditions
241 ! - absent velocity boundary conditions without
242 ! sliding conditions
243 ! -> zero velocity gradient and zero temperature gradient
244 !
245 ! tagged by negative ielfa(3,ifa) (more than one layer) or
246 ! by zero ielfa(3,ifa) (one layer)
247 !
248  if(ielfa(2,ifa).eq.0) then
249 !
250 ! no boundary conditions
251 !
252  ielfa(3,ifa)=-ielfa(3,ifa)
253  elseif(ifabou(-ielfa(2,ifa)+5).ne.-1) then
254 !
255 ! no sliding conditions
256 !
257  if((jsum.eq.0).or.(jsum.eq.4)) then
258 !
259 ! no velocity boundary conditions
260 !
261  ielfa(3,ifa)=-ielfa(3,ifa)
262  endif
263  endif
264  enddo
265 !
266 ! dimension of field ifabou containing the pointers to the
267 ! boundary conditions
268 !
269  nfabou=nfabou-1
270 !
271 c write(*,*)
272 c do i=1,nface
273 c write(*,*) 'applyboun ielfa ',i,(ielfa(j,i),j=1,4)
274 c enddo
275 c do i=1,nfabou
276 c write(*,*) 'applyboun ifabou',i,ifabou(i)
277 c enddo
278 c do i=1,nboun
279 c write(*,*) 'applyboun nodeboun',i,nodeboun(i),ndirboun(i)
280 c enddo
281 c write(*,*)
282 !
283  return
nident2
subroutine nident2(x, px, n, id)
Definition: nident2.f:27
nident
subroutine nident(x, px, n, id)
Definition: nident.f:26
identifyface
subroutine identifyface(konl1, konl2, iface1, iface2)
Definition: identifyface.f:20
Hosted by OpenAircraft.com, (Michigan UAV, LLC)