10 integer,
parameter,
private :: kreal = kind(0.0d0)
11 integer,
parameter,
private :: l_max_surface_node = 20
12 integer,
parameter,
private :: l_max_elem_node = 100
33 real(kind=kreal) :: distance
34 real(kind=kreal) :: wkdist
35 real(kind=kreal) :: lpos(3)
36 real(kind=kreal) :: gpos(3)
37 real(kind=kreal) :: direction(3)
38 real(kind=kreal) :: multiplier(3)
40 real(kind=kreal) :: tangentforce(3)
41 real(kind=kreal) :: tangentforce1(3)
42 real(kind=kreal) :: tangentforce_trial(3)
43 real(kind=kreal) :: tangentforce_final(3)
44 real(kind=kreal) :: reldisp(3)
46 real(kind=kreal) :: shrink_factor
47 real(kind=kreal) :: time_factor
48 real(kind=kreal) :: init_pos
49 real(kind=kreal) :: end_pos
50 integer :: interference_flag
71 integer,
intent(in) :: fnum
73 write(fnum, *)
"--Contact state=",cstate%state
74 write(fnum, *) cstate%surface, cstate%distance
75 write(fnum, *) cstate%lpos
76 write(fnum, *) cstate%direction
77 write(fnum, *) cstate%multiplier
83 integer,
intent(in) :: etype
84 integer,
intent(in) :: nnode
85 real(kind=kreal),
intent(out) :: mpcval(nnode*3 + 4)
88 real(kind=kreal) :: shapefunc(nnode)
91 mpcval(1:3) = cstate%direction(1:3)
94 mpcval( i*3+j ) = -cstate%direction(j)*shapefunc(i)
97 mpcval( 3*nnode+4 )=cstate%distance
102 fcoeff, symm, stiff, force )
103 integer,
intent(in) :: flag
105 integer,
intent(in) :: etype
106 integer,
intent(in) :: nnode
107 real(kind=kreal),
intent(in) :: ele(3,nnode)
108 real(kind=kreal),
intent(in) :: mu
109 real(kind=kreal),
intent(in) :: mut
110 real(kind=kreal),
intent(in) :: fcoeff
111 logical,
intent(in) :: symm
112 real(kind=kreal),
intent(out) :: stiff(:,:)
113 real(kind=kreal),
intent(out) :: force(:)
116 real(kind=kreal) :: shapefunc(nnode)
117 real(kind=kreal) :: n(nnode*3+3), dispmat(2,nnode*3+3)
118 real(kind=kreal) :: metric(2,2)
119 real(kind=kreal) :: det, inverse(2,2), ff(2), cff(2)
120 real(kind=kreal) :: dum11(nnode*3+3,nnode*3+3), dum12(nnode*3+3,nnode*3+3)
121 real(kind=kreal) :: dum21(nnode*3+3,nnode*3+3), dum22(nnode*3+3,nnode*3+3)
122 real(kind=kreal) :: tangent(3,2)
125 n(1:3) = cstate%direction(1:3)
127 n( i*3+1:i*3+3 ) = -shapefunc(i)*cstate%direction(1:3)
131 stiff(i,j) = mu* n(i)*n(j)
134 force(1:nnode*3+3) = n(:)
137 call dispincrematrix( cstate%lpos(1:2), etype, nnode, ele, tangent, metric, dispmat )
140 if( fcoeff/=0.d0 )
then
141 forall(i=1:nnode*3+3, j=1:nnode*3+3)
142 dum11(i,j) = mut*dispmat(1,i)*dispmat(1,j)
143 dum12(i,j) = mut*dispmat(1,i)*dispmat(2,j)
144 dum21(i,j) = mut*dispmat(2,i)*dispmat(1,j)
145 dum22(i,j) = mut*dispmat(2,i)*dispmat(2,j)
147 stiff(1:nnode*3+3,1:nnode*3+3) &
148 = stiff(1:nnode*3+3,1:nnode*3+3) &
149 + metric(1,1)*dum11 + metric(1,2)*dum12 &
150 + metric(2,1)*dum21 + metric(2,2)*dum22
153 det = metric(1,1)*metric(2,2)-metric(1,2)*metric(2,1)
154 if( det==0.d0 ) stop
"Math error in contact stiff calculation"
155 inverse(1,1) = metric(2,2)/det
156 inverse(2,1) = -metric(2,1)/det
157 inverse(1,2) = -metric(1,2)/det
158 inverse(2,2) = metric(1,1)/det
159 ff(:) = cstate%multiplier(2:3)
160 cff(:) = matmul( inverse, ff )
161 ff(:) = ff(:)/dsqrt( ff(1)*ff(1)+ff(2)*ff(2) )
162 cff(:) = cff(:)/dsqrt( cff(1)*cff(1)+cff(2)*cff(2) )
163 stiff(1:nnode*3+3,1:nnode*3+3) = stiff(1:nnode*3+3,1:nnode*3+3) - &
164 ( cff(1)*ff(1)*metric(1,1)+ cff(2)*ff(1)*metric(1,2) )*dum11 - &
165 ( cff(2)*ff(2)*metric(1,2)+ cff(1)*ff(2)*metric(1,1) )*dum21 - &
166 ( cff(1)*ff(1)*metric(1,2)+ cff(2)*ff(1)*metric(2,2) )*dum12 - &
167 ( cff(2)*ff(2)*metric(2,2)+ cff(1)*ff(2)*metric(1,2) )*dum22
174 subroutine tied2stiff( flag, cstate, etype, nnode, mu, mut, stiff, force )
175 integer,
intent(in) :: flag
177 integer,
intent(in) :: etype
178 integer,
intent(in) :: nnode
179 real(kind=kreal),
intent(in) :: mu
180 real(kind=kreal),
intent(in) :: mut
181 real(kind=kreal),
intent(out) :: stiff(:,:)
182 real(kind=kreal),
intent(out) :: force(:)
185 real(kind=kreal) :: shapefunc(nnode)
186 real(kind=kreal) :: n(nnode*3+3)
192 n(2:nnode+1) = -shapefunc(1:nnode)
197 stiff(3*k-3+i,3*j-3+i) = mu*n(k)*n(j)
201 force(1:nnode*3+3) = n(:)
207 real(kind=kreal),
intent(in) :: pos(2)
208 integer,
intent(in) :: etype
209 real(kind=kreal),
intent(in) :: ele(:,:)
210 real(kind=kreal),
intent(out) :: tensor(2,2)
213 real(kind=kreal) :: tangent(3,2)
216 tensor(1,1)= dot_product( tangent(:,1), tangent(:,1) )
217 tensor(1,2)= dot_product( tangent(:,1), tangent(:,2) )
218 tensor(2,1)= dot_product( tangent(:,2), tangent(:,1) )
219 tensor(2,2)= dot_product( tangent(:,2), tangent(:,2) )
225 real(kind=kreal),
intent(in) :: pos(2)
226 integer,
intent(in) :: etype
227 integer,
intent(in) :: nnode
228 real(kind=kreal),
intent(in) :: ele(3,nnode)
229 real(kind=kreal),
intent(out) :: tangent(3,2)
230 real(kind=kreal),
intent(out) :: tensor(2,2)
231 real(kind=kreal),
intent(out) :: matrix(2,nnode*3+3)
234 real(kind=kreal) :: det
235 real(kind=kreal) :: shapefunc(nnode), t1(nnode*3+3), t2(nnode*3+3)
236 call tangentbase( etype, nnode, pos, ele, tangent )
237 tensor(1,1)= dot_product( tangent(:,1), tangent(:,1) )
238 tensor(1,2)= dot_product( tangent(:,1), tangent(:,2) )
239 tensor(2,1)= dot_product( tangent(:,2), tangent(:,1) )
240 tensor(2,2)= dot_product( tangent(:,2), tangent(:,2) )
241 det = tensor(1,1)*tensor(2,2)-tensor(1,2)*tensor(2,1)
242 if( det==0.d0 ) stop
"Error in calculate DispIncreMatrix"
250 t1( j ) = tangent(j,1)
251 t2( j ) = tangent(j,2)
253 forall( i=1:nnode, j=1:3 )
254 t1( i*3+j ) = -tangent(j,1)*shapefunc(i)
255 t2( i*3+j ) = -tangent(j,2)*shapefunc(i)
258 matrix(1,:) = (tensor(2,2)*t1(:)-tensor(1,2)*t2(:))/det
259 matrix(2,:) = (tensor(1,1)*t2(:)-tensor(2,1)*t1(:))/det
260 tangent(:,1) = tangent(:,1)/dsqrt(dot_product(tangent(:,1),tangent(:,1)))
261 tangent(:,2) = tangent(:,2)/dsqrt(dot_product(tangent(:,2),tangent(:,2)))
266 real(kind=kreal),
intent(in) :: xyz(3)
267 integer,
intent(in) :: etype
268 integer,
intent(in) :: nn
269 real(kind=kreal),
intent(in) :: elemt(:,:)
270 real(kind=kreal),
intent(in) :: reflen
272 logical,
intent(out) :: isin
273 real(kind=kreal),
intent(in) :: distclr
274 real(kind=kreal),
optional :: ctpos(2)
275 real(kind=kreal),
optional :: localclr
277 integer :: count,order, initstate
278 real(kind=kreal) :: determ, inverse(2,2)
279 real(kind=kreal) :: sfunc(nn), curv(3,2,2)
280 real(kind=kreal) :: r(2), dr(2), r_tmp(2)
281 real(kind=kreal) :: xyz_out(3)
282 real(kind=kreal) :: dist_last,dist_now, dxyz(3)
283 real(kind=kreal) :: tangent(3,2)
284 real(kind=kreal) :: df(2),d2f(2,2),normal(3)
285 real(kind=kreal),
parameter :: eps = 1.0d-8
286 real(kind=kreal) :: clr, tol, factor
288 initstate = cstate%state
290 if(
present( localclr ) ) clr=localclr
291 if(
present( ctpos ) )
then
300 xyz_out = matmul( elemt(1:3,1:nn), sfunc )
301 dxyz(1:3) = xyz_out(1:3) - xyz(1:3)
302 dist_last = dot_product( dxyz, dxyz(:) )
304 call tangentbase( etype, nn, r, elemt(1:3,1:nn), tangent )
305 call curvature( etype, nn, r, elemt(1:3,1:nn), curv )
308 df(1:2) = -matmul( dxyz(:), tangent(:,:) )
310 d2f(1,1)= dot_product( tangent(:,1), tangent(:,1) ) - dot_product( dxyz, curv(:,1,1) )
311 d2f(1,2)= dot_product( tangent(:,1), tangent(:,2) ) - dot_product( dxyz, curv(:,1,2) )
312 d2f(2,1)= dot_product( tangent(:,2), tangent(:,1) ) - dot_product( dxyz, curv(:,2,1) )
313 d2f(2,2)= dot_product( tangent(:,2), tangent(:,2) ) - dot_product( dxyz, curv(:,2,2) )
316 determ = d2f(1,1)*d2f(2,2) - d2f(1,2)*d2f(2,1)
317 if( determ==0.d0 ) stop
"Math error in contact searching"
318 inverse(1,1) = d2f(2,2) / determ
319 inverse(2,2) = d2f(1,1) / determ
320 inverse(1,2) = -d2f(1,2) / determ
321 inverse(2,1) = -d2f(2,1) / determ
322 dr=matmul(inverse,df)
324 tol=dot_product(dr,dr)
325 if( dsqrt(tol)> 3.d0 )
then
331 r_tmp(1:2) = r(1:2) + factor*dr(1:2)
333 xyz_out(1:3) = matmul( elemt(1:3,1:nn), sfunc(:) )
334 dxyz(1:3) = xyz(1:3)-xyz_out(:)
335 dist_now = dot_product( dxyz, dxyz )
336 if(dist_now <= dist_last)
exit
337 factor = factor*0.7d0
347 dxyz(:)=xyz_out(:)-xyz(:)
349 normal(:) = normal(:)/dsqrt( dot_product(normal, normal) )
351 if( dabs(normal(count))<1.d-10 ) normal(count) =0.d0
352 if( dabs(1.d0-dabs(normal(count)))<1.d-10 ) normal(count) =sign(1.d0, normal(count))
354 cstate%distance = dot_product( dxyz, normal )
356 if( cstate%interference_flag ==
c_if_slave)
then
357 if( cstate%init_pos == 0.d0 .and. cstate%distance < cstate%end_pos)
then
358 cstate%init_pos = cstate%distance
359 cstate%time_factor = (cstate%end_pos - cstate%distance) / cstate%time_factor
360 cstate%shrink_factor = cstate%distance
364 if( cstate%interference_flag == 0)
then
365 if( cstate%distance < distclr*reflen .and. cstate%distance > -5.0d-01*reflen ) isin = .true.
367 if( cstate%distance < cstate%shrink_factor + distclr*reflen ) isin = .true.
374 cstate%state = initstate
376 cstate%gpos(:)=xyz_out(:)
377 cstate%lpos(1:2)=r(:)
378 cstate%direction(:) = normal(:)
379 cstate%wkdist = cstate%distance
387 real(kind=kreal),
intent(in) :: xyz(3)
388 integer,
intent(in) :: etype
389 integer,
intent(in) :: nn
390 real(kind=kreal),
intent(in) :: elemt(:,:)
391 real(kind=kreal),
intent(in) :: reflen
393 logical,
intent(out) :: isin
394 real(kind=kreal),
intent(in) :: distclr
395 real(kind=kreal),
optional :: ctpos(3)
396 real(kind=kreal),
optional :: localclr
398 integer :: count,order, initstate
399 real(kind=kreal) :: determ, inverse(3,3)
400 real(kind=kreal) :: sfunc(nn), deriv(nn,3)
401 real(kind=kreal) :: r(3), dr(3), r_tmp(3)
402 real(kind=kreal) :: xyz_out(3)
403 real(kind=kreal) :: dist_last,dist_now, dxyz(3)
404 real(kind=kreal) :: tangent(3,2)
405 real(kind=kreal) :: df(2),d2f(2,2),normal(3)
406 real(kind=kreal),
parameter :: eps = 1.0d-8
407 real(kind=kreal) :: clr, tol, factor
409 initstate = cstate%state
411 if(
present( localclr ) ) clr=localclr
412 if(
present( ctpos ) )
then
421 xyz_out = matmul( elemt(1:3,1:nn), sfunc(1:nn) )
422 dxyz(1:3) = xyz_out(1:3) - xyz(1:3)
423 dist_last = dot_product( dxyz, dxyz(:) )
426 inverse(1:3,1:3) = matmul(elemt(1:3,1:nn),deriv(1:nn,1:3))
428 dr(1:3) = -matmul(inverse(1:3,1:3),dxyz(1:3))
430 tol=dot_product(dr,dr)
431 if( count > 1 .and. dsqrt(tol)> 3.d0 )
then
437 r_tmp(1:3) = r(1:3) + factor*dr(1:3)
439 xyz_out(1:3) = matmul( elemt(1:3,1:nn), sfunc(1:nn) )
440 dxyz(1:3) = xyz(1:3)-xyz_out(1:3)
441 dist_now = dot_product( dxyz, dxyz )
442 if(dist_now <= dist_last)
exit
443 factor = factor*0.7d0
453 dxyz(:)=xyz_out(:)-xyz(:)
454 cstate%distance = dsqrt(dot_product( dxyz, dxyz ))
456 if( cstate%distance < distclr ) isin = .true.
462 cstate%state = initstate
464 cstate%gpos(:)=xyz_out(:)
465 cstate%direction(:) = (/1.d0,0.d0,0.d0/)
466 cstate%lpos(1:3)=r(:)
473 integer,
intent(in) :: etype
474 integer,
intent(in) :: nn
475 real(kind=kreal),
intent(in) :: elemt0(3,nn)
476 real(kind=kreal),
intent(in) :: elemt(3,nn)
480 real(kind=kreal) :: tangent0(3,2), tangent(3,2)
481 real(kind=kreal) :: coeff(2), norm, norm_tmp
482 real(kind=kreal) :: tangentforce_tmp(3)
484 call tangentbase( etype, nn, cstate%lpos(1:2), elemt0, tangent0 )
485 call tangentbase( etype, nn, cstate%lpos(1:2), elemt, tangent )
489 coeff(i) = dot_product(cstate%tangentForce(1:3),tangent0(1:3,i))
490 coeff(i) = coeff(i)/dot_product(tangent0(1:3,i),tangent0(1:3,i))
492 tangentforce_tmp(1:3) = coeff(1)*tangent0(1:3,1) + coeff(2)*tangent0(1:3,2)
493 norm_tmp = dsqrt(dot_product(tangentforce_tmp,tangentforce_tmp))
495 if( norm_tmp > 1.d-6 )
then
496 norm = dsqrt(dot_product(cstate%tangentForce,cstate%tangentForce))
497 coeff(1:2) = (norm/norm_tmp)*coeff(1:2)
501 cstate%tangentForce1(1:3) = coeff(1)*tangent(1:3,1) + coeff(2)*tangent(1:3,2)
506 real(kind=kreal),
intent(in) :: ctime, etime
508 integer,
intent(in) :: if_type
510 if (if_type ==
c_if_slave .and. cstate%init_pos == 0.d0)
then
511 cstate%shrink_factor = 0.0d0;
return
513 cstate%shrink_factor = cstate%time_factor*ctime + cstate%init_pos
514 if(ctime >= etime) cstate%shrink_factor = cstate%end_pos
This module encapsulate the basic functions of all elements provide by this software.
subroutine getshapefunc(fetype, localcoord, func)
Calculate the shape function in natural coordinate system.
integer(kind=kind(2)) function getnumberofnodes(etype)
Obtain number of nodes of the element.
integer function isinside3delement(fetype, localcoord, clearance)
if a point is inside a surface element -1: No; 0: Yes; >0: Node's (vertex) number
subroutine getelementcenter(fetype, localcoord)
Return natural coordinate of the center of surface element.
subroutine getshapederiv(fetype, localcoord, shapederiv)
Calculate derivatives of shape function in natural coordinate system.
subroutine tangentbase(fetype, nn, localcoord, elecoord, tangent)
Calculate base vector of tangent space of 3d surface.
integer function isinsideelement(fetype, localcoord, clearance)
if a point is inside a surface element -1: No; 0: Yes; >0: Node's (vertex) number
real(kind=kreal) function, dimension(3) surfacenormal(fetype, nn, localcoord, elecoord)
Calculate normal of 3d-surface.
subroutine curvature(fetype, nn, localcoord, elecoord, l2ndderiv, normal, curv)
Calculate curvature tensor at a point along 3d surface.
This module provides aux functions.
subroutine calinverse(NN, A)
calculate inverse of matrix a