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

Go to the source code of this file.

Functions/Subroutines

subroutine springforc_f2f_th (xl, vl, imat, elcon, nelcon, tnl, ncmat_, ntmat_, nope, lakonl, kode, elconloc, plicon, nplicon, npmat_, mi, springarea, nmethod, reltime, jfaces, igauss, pslavsurf, pmastsurf, clearini, timeend, istep, iinc, plkcon, nplkcon, node, noel, matname)
 

Function/Subroutine Documentation

◆ springforc_f2f_th()

subroutine springforc_f2f_th ( real*8, dimension(3,19)  xl,
real*8, dimension(0:mi(2),19)  vl,
integer  imat,
real*8, dimension(0:ncmat_,ntmat_,*)  elcon,
integer, dimension(2,*)  nelcon,
real*8, dimension(19)  tnl,
integer  ncmat_,
integer  ntmat_,
integer  nope,
character*8  lakonl,
integer  kode,
real*8, dimension(21)  elconloc,
real*8, dimension(0:2*npmat_,ntmat_,*)  plicon,
integer, dimension(0:ntmat_,*)  nplicon,
integer  npmat_,
integer, dimension(*)  mi,
real*8, dimension(2)  springarea,
integer  nmethod,
real*8  reltime,
integer  jfaces,
integer  igauss,
real*8, dimension(3,*)  pslavsurf,
real*8, dimension(6,*)  pmastsurf,
real*8, dimension(3,9,*)  clearini,
real*8, dimension(2)  timeend,
integer  istep,
integer  iinc,
real*8, dimension(0:2*npmat_,ntmat_,*)  plkcon,
integer, dimension(0:ntmat_,*)  nplkcon,
integer  node,
integer  noel,
character*80, dimension(*)  matname 
)
25 !
26 ! calculates the heat flux across a contact area
27 !
28  implicit none
29 !
30  character*8 lakonl
31 !
32  character*80 matname(*),slname,msname
33 !
34  integer i,j,k,imat,ncmat_,ntmat_,nope,iflag,mi(*),noel,
35  & kode,niso,id,nplicon(0:ntmat_,*),npmat_,nelcon(2,*),
36  & nmethod,jfaces,istep,iinc,npred,node,
37  & igauss,nopes,nopem,nopep,nplkcon(0:ntmat_,*)
38 !
39  real*8 xl(3,19),al(3),vl(0:mi(2),19),conductance,
40  & pl(3,19),xn(3),alpha,beta,
41  & elcon(0:ncmat_,ntmat_,*),pproj(3),clear,
42  & xi,et,elconloc(21),plconloc(802),xk,xiso(20),yiso(20),
43  & plicon(0:2*npmat_,ntmat_,*),coords(3),
44  & springarea(2),overlap,clearini(3,9,*),
45  & reltime,weight,xsj2m(3),xs2m(3,7),shp2m(7,9),
46  & xsj2s(3),xs2s(3,7),shp2s(7,9),pslavsurf(3,*),pmastsurf(6,*),
47  & t1ls,t1lm,tmean,pressure,temp(2),timeend(2),ak(5),d(2),tnl(19),
48  & constant,dtemp,flowm(2),predef(2),plkcon(0:2*npmat_,ntmat_,*)
49 !
50  include "gauss.f"
51 !
52  iflag=2
53 !
54 ! # of master nodes
55 !
56  nopem=ichar(lakonl(8:8))-48
57 !
58 ! # of slave nodes
59 !
60  nopes=nope-nopem
61 !
62 ! actual positions of the master nodes belonging to the contact spring
63 !
64  do i=1,nopem
65  do j=1,3
66  pl(j,i)=xl(j,i)+vl(j,i)
67  enddo
68  enddo
69 !
70 ! actual positions of the slave nodes belonging to the contact spring
71 !
72  do i=nopem+1,nope
73  do j=1,3
74  pl(j,i)=xl(j,i)+clearini(j,i-nopem,jfaces)*reltime
75  & +vl(j,i)
76  enddo
77  enddo
78 !
79 ! location of integration point in slave face
80 !
81  xi=pslavsurf(1,igauss)
82  et=pslavsurf(2,igauss)
83  weight=pslavsurf(3,igauss)
84 !
85  iflag=1
86  if(nopes.eq.9) then
87  call shape9q(xi,et,pl(1,nopem+1),xsj2s,xs2s,shp2s,iflag)
88  elseif(nopes.eq.8) then
89  call shape8q(xi,et,pl(1,nopem+1),xsj2s,xs2s,shp2s,iflag)
90  elseif(nopes.eq.4) then
91  call shape4q(xi,et,pl(1,nopem+1),xsj2s,xs2s,shp2s,iflag)
92  elseif(nopes.eq.6) then
93  call shape6tri(xi,et,pl(1,nopem+1),xsj2s,xs2s,shp2s,iflag)
94  elseif(nopes.eq.7) then
95  call shape7tri(xi,et,pl(1,nopem+1),xsj2s,xs2s,shp2s,iflag)
96  else
97  call shape3tri(xi,et,pl(1,nopem+1),xsj2s,xs2s,shp2s,iflag)
98  endif
99 !
100  nopep=nope+1
101 !
102  do k=1,3
103  pl(k,nopep)=0.d0
104  enddo
105  t1ls=0.d0
106  do j=1,nopes
107  do k=1,3
108  pl(k,nopep)=pl(k,nopep)+shp2s(4,j)*pl(k,nopem+j)
109  enddo
110  t1ls=t1ls+shp2s(4,j)*vl(0,nopem+j)
111  enddo
112 !
113 ! corresponding location in the master face
114 !
115  xi=pmastsurf(1,igauss)
116  et=pmastsurf(2,igauss)
117 !
118 ! determining the jacobian vector on the surface
119 !
120  iflag=2
121  if(nopem.eq.9) then
122  call shape9q(xi,et,pl,xsj2m,xs2m,shp2m,iflag)
123  elseif(nopem.eq.8) then
124  call shape8q(xi,et,pl,xsj2m,xs2m,shp2m,iflag)
125  elseif(nopem.eq.4) then
126  call shape4q(xi,et,pl,xsj2m,xs2m,shp2m,iflag)
127  elseif(nopem.eq.6) then
128  call shape6tri(xi,et,pl,xsj2m,xs2m,shp2m,iflag)
129  elseif(nopem.eq.7) then
130  call shape7tri(xi,et,pl,xsj2m,xs2m,shp2m,iflag)
131  else
132  call shape3tri(xi,et,pl,xsj2m,xs2m,shp2m,iflag)
133  endif
134 !
135  t1lm=0.d0
136  do i=1,3
137  pproj(i)=0.d0
138  enddo
139  do j=1,nopem
140  do i=1,3
141  pproj(i)=pproj(i)+shp2m(4,j)*pl(i,j)
142  enddo
143  t1lm=t1lm+shp2m(4,j)*vl(0,j)
144  enddo
145 !
146 ! distance vector between both
147 !
148  do i=1,3
149  al(i)=pl(i,nopep)-pproj(i)
150  enddo
151 !
152 ! normal on the master face
153 !
154  xn(1)=pmastsurf(4,igauss)
155  xn(2)=pmastsurf(5,igauss)
156  xn(3)=pmastsurf(6,igauss)
157 !
158 ! distance from surface along normal (= clearance)
159 !
160  clear=al(1)*xn(1)+al(2)*xn(2)+al(3)*xn(3)
161 !
162 ! check for a reduction of the initial penetration, if any
163 !
164  if(nmethod.eq.1) then
165  clear=clear-springarea(2)*(1.d0-reltime)
166  endif
167 !
168 ! pressure-overclosure relationship
169 !
170  if(int(elcon(3,1,imat)).eq.1) then
171 !
172 ! exponential overclosure
173 !
174  if(dabs(elcon(2,1,imat)).lt.1.d-30) then
175  pressure=0.d0
176  beta=1.d0
177  else
178 !
179  alpha=elcon(2,1,imat)
180  beta=elcon(1,1,imat)
181  if(-beta*clear.gt.23.d0-dlog(alpha)) then
182  beta=(dlog(alpha)-23.d0)/clear
183  endif
184  pressure=dexp(-beta*clear+dlog(alpha))
185  endif
186  elseif((int(elcon(3,1,imat)).eq.2).or.
187  & (int(elcon(3,1,imat)).eq.4)) then
188 !
189 ! linear overclosure
190 !
191  pressure=-elcon(2,1,imat)*clear
192  elseif(int(elcon(3,1,imat)).eq.3) then
193 !
194 ! tabular overclosure
195 !
196 ! interpolating the material data
197 !
198  call materialdata_sp(elcon,nelcon,imat,ntmat_,i,tmean,
199  & elconloc,kode,plicon,nplicon,npmat_,plconloc,ncmat_)
200  overlap=-clear
201  niso=int(plconloc(81))
202  do i=1,niso
203  xiso(i)=plconloc(2*i-1)
204  yiso(i)=plconloc(2*i)
205  enddo
206  call ident(xiso,overlap,niso,id)
207  if(id.eq.0) then
208  pressure=yiso(1)
209  elseif(id.eq.niso) then
210  pressure=yiso(niso)
211  else
212  xk=(yiso(id+1)-yiso(id))/(xiso(id+1)-xiso(id))
213  pressure=yiso(id)+xk*(overlap-xiso(id))
214  endif
215  endif
216 !
217 ! calculating the temperature difference across the contact
218 ! area and the mean temperature for the determination of the
219 ! conductance
220 !
221  dtemp=t1lm-t1ls
222  tmean=(t1lm+t1ls)/2.d0
223 !
224 ! interpolating the material data according to temperature
225 !
226  call materialdata_sp(elcon,nelcon,imat,ntmat_,i,tmean,
227  & elconloc,kode,plkcon,nplkcon,npmat_,plconloc,ncmat_)
228 !
229 ! interpolating the material data according to pressure
230 !
231  niso=int(plconloc(801))
232 !
233  if(niso.eq.0) then
234  d(1)=clear
235  d(2)=pressure
236  temp(1)=t1ls
237  temp(2)=t1lm
238  do k=1,3
239  coords(k)=0.d0
240  do j=1,nopes
241  coords(k)=coords(k)+shp2s(4,j)*xl(k,nopem+j)
242  enddo
243  enddo
244  call gapcon(ak,d,flowm,temp,predef,timeend,matname(imat),
245  & slname,msname,coords,noel,node,npred,istep,iinc,
246  & springarea)
247  conductance=ak(1)
248  else
249  do i=1,niso
250  xiso(i)=plconloc(2*i-1)
251  yiso(i)=plconloc(2*i)
252  enddo
253  call ident(xiso,pressure,niso,id)
254  if(id.eq.0) then
255  xk=0.d0
256  conductance=yiso(1)
257  elseif(id.eq.niso) then
258  xk=0.d0
259  conductance=yiso(niso)
260  else
261  xk=(yiso(id+1)-yiso(id))/(xiso(id+1)-xiso(id))
262  conductance=yiso(id)+xk*(pressure-xiso(id))
263  endif
264  endif
265 !
266 ! calculating the concentrated heat flow
267 !
268  constant=springarea(1)*conductance*dtemp
269 !
270 ! master nodes
271 !
272  do j=1,nopem
273  tnl(j)=shp2m(4,j)*constant
274  enddo
275 !
276 ! slave nodes
277 !
278  do j=1,nopes
279  tnl(nopem+j)=-shp2s(4,j)*constant
280  enddo
281 !
282  return
subroutine ident(x, px, n, id)
Definition: ident.f:26
subroutine shape9q(xi, et, xl, xsj, xs, shp, iflag)
Definition: shape9q.f:20
subroutine shape8q(xi, et, xl, xsj, xs, shp, iflag)
Definition: shape8q.f:20
subroutine shape3tri(xi, et, xl, xsj, xs, shp, iflag)
Definition: shape3tri.f:20
subroutine shape7tri(xi, et, xl, xsj, xs, shp, iflag)
Definition: shape7tri.f:20
subroutine gapcon(ak, d, flowm, temp, predef, time, ciname, slname, msname, coords, noel, node, npred, kstep, kinc, area)
Definition: gapcon.f:21
subroutine shape4q(xi, et, xl, xsj, xs, shp, iflag)
Definition: shape4q.f:20
subroutine materialdata_sp(elcon, nelcon, imat, ntmat_, i, t1l, elconloc, kode, plicon, nplicon, npmat_, plconloc, ncmat_)
Definition: materialdata_sp.f:20
subroutine shape6tri(xi, et, xl, xsj, xs, shp, iflag)
Definition: shape6tri.f:20
Hosted by OpenAircraft.com, (Michigan UAV, LLC)