27 character(len=HECMW_NAME_LEN) :: name
30 character(len=HECMW_NAME_LEN) :: pair_name
31 integer :: surf_id1, surf_id2
32 integer :: surf_id1_sgrp
34 integer,
pointer :: slave(:)=>null()
35 real(kind=kreal) :: fcoeff
36 real(kind=kreal) :: tpenalty
38 real(kind=kreal) :: ctime
39 integer(kind=kint) :: if_type
40 real(kind=kreal) :: if_etime
41 real(kind=kreal) :: initial_pos
42 real(kind=kreal) :: end_pos
57 type(hecmwst_contact_comm) :: comm
58 type(bucketdb) :: master_bktdb
60 type(tcontactparam),
pointer :: cparam=>null()
65 integer(kind=kint) :: contact2free
66 integer(kind=kint) :: contact2neighbor
67 integer(kind=kint) :: contact2difflpos
68 integer(kind=kint) :: free2contact
69 integer(kind=kint) :: contactnode_previous
70 integer(kind=kint) :: contactnode_current
73 private :: is_mpc_available
74 private :: is_active_contact
75 private :: cal_node_normal
76 private :: track_contact_position
77 private :: reset_contact_force
82 logical function is_mpc_available( contact )
83 type(
tcontact),
intent(in) :: contact
84 is_mpc_available = .true.
85 if( contact%fcoeff/=0.d0 ) is_mpc_available = .false.
90 integer(kind=kint),
intent(in) :: file
91 type(
tcontact),
intent(in) :: contact
93 write(file,*)
"CONTACT:", contact%ctype,contact%group,trim(contact%pair_name),contact%fcoeff
94 write(file,*)
"---Slave----"
95 write(file,*)
"num.slave",
size(contact%slave)
96 if(
associated(contact%slave) )
then
97 do i=1,
size(contact%slave)
98 write(file, *) contact%slave(i)
101 write(file,*)
"----master---"
102 write(file,*)
"num.master",
size(contact%master)
103 if(
associated(contact%master) )
then
104 do i=1,
size(contact%master)
112 type(
tcontact),
intent(inout) :: contact
114 if(
associated( contact%slave ) )
deallocate(contact%slave)
115 if(
associated( contact%master ) )
then
116 do i=1,
size( contact%master )
119 deallocate(contact%master)
121 if(
associated(contact%states) )
deallocate(contact%states)
128 type(
tcontact),
intent(inout) :: contact
129 type(hecmwst_local_mesh),
pointer :: hecmesh
138 do i=1,hecmesh%contact_pair%n_pair
139 if( hecmesh%contact_pair%name(i) == contact%pair_name )
then
140 contact%ctype = hecmesh%contact_pair%type(i)
141 contact%surf_id1 = hecmesh%contact_pair%slave_grp_id(i)
142 contact%surf_id2 = hecmesh%contact_pair%master_grp_id(i)
143 contact%surf_id1_sgrp = hecmesh%contact_pair%slave_orisgrp_id(i)
147 if( .not. isfind ) return;
148 if( contact%fcoeff<=0.d0 ) contact%fcoeff=0.d0
149 if( contact%ctype < 1 .and. contact%ctype > 3 )
return
150 if( contact%group<=0 )
return
157 type(
tcontact),
intent(inout) :: contact
158 type(hecmwst_local_mesh),
pointer :: hecmesh
159 type(tcontactparam),
target :: cparam
160 integer(kint),
intent(in),
optional :: myrank
162 integer :: i, j, is, ie, cgrp, nsurf, nslave, ic, ic_type, iss, nn, ii
163 integer :: count,nodeid
167 contact%cparam => cparam
170 cgrp = contact%surf_id2
172 is= hecmesh%surf_group%grp_index(cgrp-1) + 1
173 ie= hecmesh%surf_group%grp_index(cgrp )
175 if(
present(myrank))
then
179 ic = hecmesh%surf_group%grp_item(2*i-1)
180 if(hecmesh%elem_ID(ic*2) /= myrank) cycle
183 allocate( contact%master(count) )
186 ic = hecmesh%surf_group%grp_item(2*i-1)
187 if(hecmesh%elem_ID(ic*2) /= myrank) cycle
189 nsurf = hecmesh%surf_group%grp_item(2*i)
190 ic_type = hecmesh%elem_type(ic)
192 iss = hecmesh%elem_node_index(ic-1)
193 do j=1,
size( contact%master(count)%nodes )
194 nn = contact%master(count)%nodes(j)
195 contact%master(count)%nodes(j) = hecmesh%elem_node_item( iss+nn )
201 allocate( contact%master(ie-is+1) )
203 ic = hecmesh%surf_group%grp_item(2*i-1)
204 nsurf = hecmesh%surf_group%grp_item(2*i)
205 ic_type = hecmesh%elem_type(ic)
207 iss = hecmesh%elem_node_index(ic-1)
208 do j=1,
size( contact%master(i-is+1)%nodes )
209 nn = contact%master(i-is+1)%nodes(j)
210 contact%master(i-is+1)%nodes(j) = hecmesh%elem_node_item( iss+nn )
218 cgrp = contact%surf_id1
220 is= hecmesh%node_group%grp_index(cgrp-1) + 1
221 ie= hecmesh%node_group%grp_index(cgrp )
224 nodeid = hecmesh%global_node_ID(hecmesh%node_group%grp_item(i))
225 if(
present(myrank))
then
230 if( hecmesh%node_group%grp_item(i) <= hecmesh%nn_internal)
then
235 allocate( contact%slave(nslave) )
236 allocate( contact%states(nslave) )
239 if(.not.
present(myrank))
then
241 if( hecmesh%node_group%grp_item(i) > hecmesh%nn_internal) cycle
244 contact%slave(ii) = hecmesh%node_group%grp_item(i)
245 contact%states(ii)%state = -1
246 contact%states(ii)%multiplier(:) = 0.d0
247 contact%states(ii)%tangentForce(:) = 0.d0
248 contact%states(ii)%tangentForce1(:) = 0.d0
249 contact%states(ii)%tangentForce_trial(:) = 0.d0
250 contact%states(ii)%tangentForce_final(:) = 0.d0
251 contact%states(ii)%reldisp(:) = 0.d0
252 contact%states(ii)%time_factor = 0.d0
253 contact%states(ii)%interference_flag = 0
272 contact%symmetric = .true.
278 type(
tcontact),
intent(inout) :: embed
279 type(hecmwst_local_mesh),
pointer :: hecmesh
280 type(tcontactparam),
target :: cparam
281 integer(kint),
intent(in),
optional :: myrank
283 integer :: i, j, is, ie, cgrp, nsurf, nslave, ic, ic_type, iss, nn, ii
284 integer :: count,nodeid
288 embed%cparam => cparam
291 cgrp = embed%surf_id2
293 is= hecmesh%elem_group%grp_index(cgrp-1) + 1
294 ie= hecmesh%elem_group%grp_index(cgrp )
296 if(
present(myrank))
then
300 ic = hecmesh%elem_group%grp_item(i)
301 if(hecmesh%elem_ID(ic*2) /= myrank) cycle
304 allocate( embed%master(count) )
307 ic = hecmesh%elem_group%grp_item(i)
308 if(hecmesh%elem_ID(ic*2) /= myrank) cycle
310 ic_type = hecmesh%elem_type(ic)
312 iss = hecmesh%elem_node_index(ic-1)
313 do j=1,
size( embed%master(count)%nodes )
314 nn = embed%master(count)%nodes(j)
315 embed%master(count)%nodes(j) = hecmesh%elem_node_item( iss+nn )
321 allocate( embed%master(ie-is+1) )
323 ic = hecmesh%elem_group%grp_item(i)
324 ic_type = hecmesh%elem_type(ic)
326 iss = hecmesh%elem_node_index(ic-1)
327 do j=1,
size( embed%master(i-is+1)%nodes )
328 nn = embed%master(i-is+1)%nodes(j)
329 embed%master(i-is+1)%nodes(j) = hecmesh%elem_node_item( iss+nn )
339 cgrp = embed%surf_id1
341 is= hecmesh%node_group%grp_index(cgrp-1) + 1
342 ie= hecmesh%node_group%grp_index(cgrp )
345 nodeid = hecmesh%global_node_ID(hecmesh%node_group%grp_item(i))
346 if(
present(myrank))
then
351 if( hecmesh%node_group%grp_item(i) <= hecmesh%nn_internal)
then
356 allocate( embed%slave(nslave) )
357 allocate( embed%states(nslave) )
360 if(.not.
present(myrank))
then
362 if( hecmesh%node_group%grp_item(i) > hecmesh%nn_internal) cycle
365 embed%slave(ii) = hecmesh%node_group%grp_item(i)
366 embed%states(ii)%state = -1
367 embed%states(ii)%multiplier(:) = 0.d0
368 embed%states(ii)%tangentForce(:) = 0.d0
369 embed%states(ii)%tangentForce1(:) = 0.d0
370 embed%states(ii)%tangentForce_trial(:) = 0.d0
371 embed%states(ii)%tangentForce_final(:) = 0.d0
372 embed%states(ii)%reldisp(:) = 0.d0
391 embed%symmetric = .true.
396 type(tcontactinterference),
intent(inout) :: contact_if
406 do i = 1,
size(contacts)
407 if( contacts(i)%pair_name == contact_if%cp_name )
then
408 contacts(i)%if_type = contact_if%if_type
409 contacts(i)%if_etime = contact_if%etime
410 contacts(i)%initial_pos = contact_if%initial_pos
411 contacts(i)%end_pos = contact_if%end_pos
412 do j = 1,
size(contacts(i)%states)
413 contacts(i)%states(j)%interference_flag = contact_if%if_type
414 contacts(i)%states(j)%init_pos = contact_if%initial_pos
415 contacts(i)%states(j)%end_pos = contact_if%end_pos
417 contacts(i)%states(j)%time_factor = (contact_if%end_pos - contact_if%initial_pos) / contact_if%etime
419 contacts(i)%states(j)%time_factor = contact_if%etime
426 if( .not. isfind ) return;
433 type(
tcontact),
intent(inout) :: contact
435 if( .not.
associated(contact%states) )
return
436 do i=1,
size( contact%states )
437 contact%states(i)%state = -1
442 logical function is_active_contact( acgrp, contact )
443 integer,
intent(in) :: acgrp(:)
444 type(
tcontact),
intent(in) :: contact
445 if( any( acgrp==contact%group ) )
then
446 is_active_contact = .true.
448 is_active_contact = .false.
456 nodeID, elemID, is_init, active, mu, B )
457 character(len=9),
intent(in) :: flag_ctAlgo
458 type(
tcontact ),
intent(inout) :: contact
460 real(kind=kreal),
intent(in) :: currpos(:)
461 real(kind=kreal),
intent(in) :: currdisp(:)
462 real(kind=kreal),
intent(in) :: ndforce(:)
463 integer(kind=kint),
intent(in) :: nodeID(:)
464 integer(kind=kint),
intent(in) :: elemID(:)
465 logical,
intent(in) :: is_init
466 logical,
intent(out) :: active
467 real(kind=kreal),
intent(in) :: mu
468 real(kind=kreal),
optional,
target :: b(:)
470 real(kind=kreal) :: distclr
471 integer(kind=kint) :: slave, id, etype
472 integer(kind=kint) :: nn, i, j, iSS, nactive
473 real(kind=kreal) :: coord(3), elem(3, l_max_elem_node )
474 real(kind=kreal) :: nlforce, slforce(3)
476 integer(kind=kint),
allocatable :: contact_surf(:), states_prev(:)
478 integer,
pointer :: indexMaster(:),indexCand(:)
479 integer :: nMaster,idm,nMasterMax,bktID,nCand
480 logical :: is_cand, is_present_B
481 real(kind=kreal),
pointer :: bp(:)
484 distclr = contact%cparam%DISTCLR_INIT
486 distclr = contact%cparam%DISTCLR_FREE
489 do i= 1,
size(contact%slave)
498 allocate(contact_surf(
size(nodeid)))
499 allocate(states_prev(
size(contact%slave)))
500 contact_surf(:) = huge(0)
501 do i = 1,
size(contact%slave)
502 states_prev(i) = contact%states(i)%state
509 is_present_b =
present(b)
510 if( is_present_b ) bp => b
520 do i= 1,
size(contact%slave)
521 if(contact%if_type /= 0)
call set_shrink_factor(contact%ctime, contact%states(i), contact%if_etime, contact%if_type)
522 slave = contact%slave(i)
524 slforce(1:3)=ndforce(3*slave-2:3*slave)
525 id = contact%states(i)%surface
526 nlforce = contact%states(i)%multiplier(1)
531 if (.not.is_init) cycle
534 if( nlforce < contact%cparam%TENSILE_FORCE )
then
536 contact%states(i)%multiplier(:) = 0.d0
537 write(*,
'(A,i10,A,i10,A,e12.3)')
"Node",nodeid(slave),
" free from contact with element", &
538 elemid(contact%master(id)%eid),
" with tensile force ", nlforce
541 if( contact%algtype /=
contactfslid .or. (.not. is_present_b) )
then
542 contact_surf(contact%slave(i)) = -elemid(contact%master(id)%eid)
544 call track_contact_position( flag_ctalgo, i, contact, currpos, currdisp, mu, infoctchange, nodeid, elemid, bp )
546 id = contact%states(i)%surface
547 contact_surf(contact%slave(i)) = -elemid(contact%master(id)%eid)
551 else if( contact%states(i)%state==
contactfree )
then
552 if( contact%algtype ==
contacttied .and. .not. is_init ) cycle
553 coord(:) = currpos(3*slave-2:3*slave)
558 if (ncand == 0) cycle
559 allocate(indexcand(ncand))
563 allocate(indexmaster(nmastermax))
569 if (.not.
is_in_surface_box( contact%master(id), coord(1:3), contact%cparam%BOX_EXP_RATE )) cycle
570 nmaster = nmaster + 1
571 indexmaster(nmaster) = id
573 deallocate(indexcand)
575 if(nmaster == 0)
then
576 deallocate(indexmaster)
581 id = indexmaster(idm)
582 etype = contact%master(id)%etype
583 nn =
size( contact%master(id)%nodes )
585 iss = contact%master(id)%nodes(j)
586 elem(1:3,j)=currpos(3*iss-2:3*iss)
589 isin,distclr,localclr=contact%cparam%CLEARANCE )
590 if( .not. isin ) cycle
591 contact%states(i)%surface = id
592 contact%states(i)%multiplier(:) = 0.d0
593 iss = isinsideelement( etype, contact%states(i)%lpos(1:2), contact%cparam%CLR_CAL_NORM )
595 call cal_node_normal( id, iss, contact%master, currpos, contact%states(i)%lpos(1:2), &
596 contact%states(i)%direction(:) )
597 contact_surf(contact%slave(i)) = elemid(contact%master(id)%eid)
598 write(*,
'(A,i10,A,i10,A,f7.3,A,2f7.3,A,3f7.3,A,i6)')
"Node",nodeid(slave),
" contact with element", &
599 elemid(contact%master(id)%eid), &
600 " with distance ", contact%states(i)%distance,
" at ",contact%states(i)%lpos(1:2), &
601 " along direction ", contact%states(i)%direction,
" rank=",hecmw_comm_get_rank()
604 deallocate(indexmaster)
609 if( contact%algtype ==
contacttied .and. .not. is_init )
then
610 deallocate(contact_surf)
611 deallocate(states_prev)
617 do i = 1,
size(contact%slave)
619 id = contact%states(i)%surface
620 if (abs(contact_surf(contact%slave(i))) /= elemid(contact%master(id)%eid))
then
622 write(*,
'(A,i10,A,i10,A,i6,A,i6,A)')
"Node",nodeid(contact%slave(i)),
" contact with element", &
623 & elemid(contact%master(id)%eid),
" in rank",hecmw_comm_get_rank(),
" freed due to duplication"
625 nactive = nactive + 1
629 infoctchange%free2contact = infoctchange%free2contact + 1
631 infoctchange%contact2free = infoctchange%contact2free + 1
634 active = (nactive > 0)
635 deallocate(contact_surf)
636 deallocate(states_prev)
642 subroutine scan_embed_state( flag_ctAlgo, embed, currpos, currdisp, ndforce, infoCTChange, &
643 nodeID, elemID, is_init, active, mu, B )
644 character(len=9),
intent(in) :: flag_ctAlgo
645 type(
tcontact ),
intent(inout) :: embed
647 real(kind=kreal),
intent(in) :: currpos(:)
648 real(kind=kreal),
intent(in) :: currdisp(:)
649 real(kind=kreal),
intent(in) :: ndforce(:)
650 integer(kind=kint),
intent(in) :: nodeID(:)
651 integer(kind=kint),
intent(in) :: elemID(:)
652 logical,
intent(in) :: is_init
653 logical,
intent(out) :: active
654 real(kind=kreal),
intent(in) :: mu
655 real(kind=kreal),
optional,
target :: b(:)
657 real(kind=kreal) :: distclr
658 integer(kind=kint) :: slave, id, etype
659 integer(kind=kint) :: nn, i, j, iSS, nactive
660 real(kind=kreal) :: coord(3), elem(3, l_max_elem_node )
661 real(kind=kreal) :: nlforce, slforce(3)
663 integer(kind=kint),
allocatable :: contact_surf(:), states_prev(:)
665 integer,
pointer :: indexMaster(:),indexCand(:)
666 integer :: nMaster,idm,nMasterMax,bktID,nCand
667 logical :: is_cand, is_present_B
668 real(kind=kreal),
pointer :: bp(:)
671 distclr = embed%cparam%DISTCLR_INIT
673 distclr = embed%cparam%DISTCLR_FREE
675 do i= 1,
size(embed%slave)
684 allocate(contact_surf(
size(nodeid)))
685 allocate(states_prev(
size(embed%slave)))
686 contact_surf(:) = huge(0)
687 do i = 1,
size(embed%slave)
688 states_prev(i) = embed%states(i)%state
695 is_present_b =
present(b)
696 if( is_present_b ) bp => b
706 do i= 1,
size(embed%slave)
707 slave = embed%slave(i)
709 coord(:) = currpos(3*slave-2:3*slave)
714 if (ncand == 0) cycle
715 allocate(indexcand(ncand))
719 allocate(indexmaster(nmastermax))
725 if (.not.
is_in_surface_box( embed%master(id), coord(1:3), embed%cparam%BOX_EXP_RATE )) cycle
726 nmaster = nmaster + 1
727 indexmaster(nmaster) = id
729 deallocate(indexcand)
731 if(nmaster == 0)
then
732 deallocate(indexmaster)
737 id = indexmaster(idm)
738 etype = embed%master(id)%etype
739 if( mod(etype,10) == 2 ) etype = etype - 1
740 nn = getnumberofnodes(etype)
742 iss = embed%master(id)%nodes(j)
743 elem(1:3,j)=currpos(3*iss-2:3*iss)
746 isin,distclr,localclr=embed%cparam%CLEARANCE )
747 if( .not. isin ) cycle
748 embed%states(i)%surface = id
749 embed%states(i)%multiplier(:) = 0.d0
750 contact_surf(embed%slave(i)) = elemid(embed%master(id)%eid)
751 write(*,
'(A,i10,A,i10,A,3f7.3,A,i6)')
"Node",nodeid(slave),
" embeded to element", &
752 elemid(embed%master(id)%eid),
" at ",embed%states(i)%lpos(:),
" rank=",hecmw_comm_get_rank()
755 deallocate(indexmaster)
762 do i = 1,
size(embed%slave)
764 id = embed%states(i)%surface
765 if (abs(contact_surf(embed%slave(i))) /= elemid(embed%master(id)%eid))
then
767 write(*,
'(A,i10,A,i10,A,i6,A,i6,A)')
"Node",nodeid(embed%slave(i)),
" contact with element", &
768 & elemid(embed%master(id)%eid),
" in rank",hecmw_comm_get_rank(),
" freed due to duplication"
770 nactive = nactive + 1
774 infoctchange%free2contact = infoctchange%free2contact + 1
776 infoctchange%contact2free = infoctchange%contact2free + 1
779 active = (nactive > 0)
780 deallocate(contact_surf)
781 deallocate(states_prev)
786 subroutine cal_node_normal( csurf, isin, surf, currpos, lpos, normal )
788 integer,
intent(in) :: csurf
789 integer,
intent(in) :: isin
791 real(kind=kreal),
intent(in) :: currpos(:)
792 real(kind=kreal),
intent(in) :: lpos(:)
793 real(kind=kreal),
intent(out) :: normal(3)
794 integer(kind=kint) :: cnode, i, j, cnt, nd1, gn, etype, iSS, nn,cgn
795 real(kind=kreal) :: cnpos(2), elem(3, l_max_elem_node )
796 integer(kind=kint) :: cnode1, cnode2, gn1, gn2, nsurf, cgn1, cgn2, isin_n
797 real(kind=kreal) :: x=0, normal_n(3), lpos_n(2)
799 if( 1 <= isin .and. isin <= 4 )
then
801 gn = surf(csurf)%nodes(cnode)
802 etype = surf(csurf)%etype
804 nn =
size( surf(csurf)%nodes )
806 iss = surf(csurf)%nodes(j)
807 elem(1:3,j)=currpos(3*iss-2:3*iss)
811 do i=1,surf(csurf)%n_neighbor
812 nd1 = surf(csurf)%neighbor(i)
813 nn =
size( surf(nd1)%nodes )
814 etype = surf(nd1)%etype
817 iss = surf(nd1)%nodes(j)
818 elem(1:3,j)=currpos(3*iss-2:3*iss)
825 normal = normal+normal_n
830 elseif( 12 <= isin .and. isin <= 41 )
then
832 cnode2 = mod(isin, 10)
833 gn1 = surf(csurf)%nodes(cnode1)
834 gn2 = surf(csurf)%nodes(cnode2)
835 etype = surf(csurf)%etype
836 nn =
size( surf(csurf)%nodes )
838 iss = surf(csurf)%nodes(j)
839 elem(1:3,j)=currpos(3*iss-2:3*iss)
843 case (fe_tri3n, fe_tri6n, fe_tri6nc)
844 if ( isin==12 ) then; x=lpos(2)-lpos(1)
845 elseif( isin==23 ) then; x=1.d0-2.d0*lpos(2)
846 elseif( isin==31 ) then; x=2.d0*lpos(1)-1.d0
847 else; stop
"Error: cal_node_normal: invalid isin"
849 case (fe_quad4n, fe_quad8n)
850 if ( isin==12 ) then; x=lpos(1)
851 elseif( isin==23 ) then; x=lpos(2)
852 elseif( isin==34 ) then; x=-lpos(1)
853 elseif( isin==41 ) then; x=-lpos(2)
854 else; stop
"Error: cal_node_normal: invalid isin"
859 neib_loop:
do i=1, surf(csurf)%n_neighbor
860 nd1 = surf(csurf)%neighbor(i)
861 nn =
size( surf(nd1)%nodes )
862 etype = surf(nd1)%etype
866 iss = surf(nd1)%nodes(j)
867 elem(1:3,j)=currpos(3*iss-2:3*iss)
868 if( iss==gn1 ) cgn1=j
869 if( iss==gn2 ) cgn2=j
871 if( cgn1>0 .and. cgn2>0 )
then
873 isin_n = 10*cgn2 + cgn1
876 case (fe_tri3n, fe_tri6n, fe_tri6nc)
877 if ( isin_n==12 ) then; lpos_n(1)=0.5d0*(1.d0-x); lpos_n(2)=0.5d0*(1.d0+x)
878 elseif( isin_n==23 ) then; lpos_n(1)=0.d0; lpos_n(2)=0.5d0*(1.d0-x)
879 elseif( isin_n==31 ) then; lpos_n(1)=0.5d0*(1.d0+x); lpos_n(2)=0.d0
880 else; stop
"Error: cal_node_normal: invalid isin_n"
882 case (fe_quad4n, fe_quad8n)
883 if ( isin_n==12 ) then; lpos_n(1)= x; lpos_n(2)=-1.d0
884 elseif( isin_n==23 ) then; lpos_n(1)= 1.d0; lpos_n(2)= x
885 elseif( isin_n==34 ) then; lpos_n(1)=-x; lpos_n(2)= 1.d0
886 elseif( isin_n==41 ) then; lpos_n(1)=-1.d0; lpos_n(2)=-x
887 else; stop
"Error: cal_node_normal: invalid isin_n"
892 normal = normal+normal_n
899 normal = normal/ dsqrt( dot_product( normal, normal ) )
900 end subroutine cal_node_normal
903 subroutine track_contact_position( flag_ctAlgo, nslave, contact, currpos, currdisp, mu, infoCTChange, nodeID, elemID, B )
904 character(len=9),
intent(in) :: flag_ctAlgo
905 integer,
intent(in) :: nslave
906 type(
tcontact ),
intent(inout) :: contact
908 real(kind=kreal),
intent(in) :: currpos(:)
909 real(kind=kreal),
intent(in) :: currdisp(:)
910 real(kind=kreal),
intent(in) :: mu
911 integer(kind=kint),
intent(in) :: nodeID(:)
912 integer(kind=kint),
intent(in) :: elemID(:)
913 real(kind=kreal),
intent(inout) :: b(:)
915 integer(kind=kint) :: slave, sid0, sid, etype
916 integer(kind=kint) :: nn, i, j, iSS
917 real(kind=kreal) :: coord(3), elem(3, l_max_elem_node ), elem0(3, l_max_elem_node )
919 real(kind=kreal) :: opos(2), odirec(3)
920 integer(kind=kint) :: bktID, nCand, idm
921 integer(kind=kint),
allocatable :: indexCand(:)
925 slave = contact%slave(nslave)
926 coord(:) = currpos(3*slave-2:3*slave)
928 sid0 = contact%states(nslave)%surface
929 opos = contact%states(nslave)%lpos(1:2)
930 odirec = contact%states(nslave)%direction
931 etype = contact%master(sid0)%etype
932 nn = getnumberofnodes( etype )
934 iss = contact%master(sid0)%nodes(j)
935 elem(1:3,j)=currpos(3*iss-2:3*iss)
936 elem0(1:3,j)=currpos(3*iss-2:3*iss)-currdisp(3*iss-2:3*iss)
938 call project_point2element( coord,etype,nn,elem,contact%master(sid0)%reflen,contact%states(nslave), &
939 isin,contact%cparam%DISTCLR_NOCHECK,contact%states(nslave)%lpos(1:2),contact%cparam%CLR_SAME_ELEM )
940 if( .not. isin )
then
941 do i=1, contact%master(sid0)%n_neighbor
942 sid = contact%master(sid0)%neighbor(i)
943 etype = contact%master(sid)%etype
944 nn = getnumberofnodes( etype )
946 iss = contact%master(sid)%nodes(j)
947 elem(1:3,j)=currpos(3*iss-2:3*iss)
950 isin,contact%cparam%DISTCLR_NOCHECK,localclr=contact%cparam%CLEARANCE )
952 contact%states(nslave)%surface = sid
958 if( .not. isin )
then
959 write(*,*)
'Warning: contact moved beyond neighbor elements'
964 allocate(indexcand(ncand))
968 if( sid==sid0 ) cycle
969 if(
associated(contact%master(sid0)%neighbor) )
then
970 if( any(sid==contact%master(sid0)%neighbor(:)) ) cycle
972 if (.not.
is_in_surface_box( contact%master(sid), coord(1:3), contact%cparam%BOX_EXP_RATE )) cycle
973 etype = contact%master(sid)%etype
974 nn =
size( contact%master(sid)%nodes )
976 iss = contact%master(sid)%nodes(j)
977 elem(1:3,j)=currpos(3*iss-2:3*iss)
980 isin,contact%cparam%DISTCLR_NOCHECK,localclr=contact%cparam%CLEARANCE )
982 contact%states(nslave)%surface = sid
986 deallocate(indexcand)
991 if( contact%states(nslave)%surface==sid0 )
then
992 if(any(dabs(contact%states(nslave)%lpos(1:2)-opos(:)) >= contact%cparam%CLR_DIFFLPOS))
then
994 infoctchange%contact2difflpos = infoctchange%contact2difflpos + 1
997 write(*,
'(A,i10,A,i10,A,f7.3,A,2f7.3)')
"Node",nodeid(slave),
" move to contact with", &
998 elemid(contact%master(sid)%eid),
" with distance ", &
999 contact%states(nslave)%distance,
" at ",contact%states(nslave)%lpos(1:2)
1001 infoctchange%contact2neighbor = infoctchange%contact2neighbor + 1
1002 if( flag_ctalgo==
'ALagrange' ) &
1003 call reset_contact_force( contact, currpos, nslave, sid0, opos, odirec, b )
1005 if( flag_ctalgo==
'SLagrange' )
call update_tangentforce(etype,nn,elem0,elem,contact%states(nslave))
1006 iss = isinsideelement( etype, contact%states(nslave)%lpos(1:2), contact%cparam%CLR_CAL_NORM )
1008 call cal_node_normal( contact%states(nslave)%surface, iss, contact%master, currpos, &
1009 contact%states(nslave)%lpos(1:2), contact%states(nslave)%direction(:) )
1010 else if( .not. isin )
then
1011 write(*,
'(A,i10,A)')
"Node",nodeid(slave),
" move out of contact"
1013 contact%states(nslave)%multiplier(:) = 0.d0
1016 end subroutine track_contact_position
1020 integer,
intent(in) :: nslave
1021 type(
tcontact ),
intent(inout) :: contact
1022 real(kind=kreal),
intent(in) :: currpos(:)
1024 integer(kind=kint) :: slave, sid0, sid, etype
1025 integer(kind=kint) :: nn, i, j, iSS
1026 real(kind=kreal) :: coord(3), elem(3, l_max_elem_node ), elem0(3, l_max_elem_node )
1028 real(kind=kreal) :: opos(2), odirec(3)
1029 integer(kind=kint) :: bktID, nCand, idm
1030 integer(kind=kint),
allocatable :: indexCand(:)
1035 slave = contact%slave(nslave)
1036 coord(:) = currpos(3*slave-2:3*slave)
1038 sid0 = contact%states(nslave)%surface
1039 opos = contact%states(nslave)%lpos(1:2)
1040 odirec = contact%states(nslave)%direction
1041 etype = contact%master(sid0)%etype
1042 nn = getnumberofnodes( etype )
1044 iss = contact%master(sid0)%nodes(j)
1045 elem(1:3,j)=currpos(3*iss-2:3*iss)
1048 cstate_tmp%state = contact%states(nslave)%state
1049 cstate_tmp%surface = sid0
1051 isin,contact%cparam%DISTCLR_NOCHECK,contact%states(nslave)%lpos,contact%cparam%CLR_SAME_ELEM )
1054 iss = isinsideelement( etype, cstate_tmp%lpos, contact%cparam%CLR_CAL_NORM )
1056 call cal_node_normal( cstate_tmp%surface, iss, contact%master, currpos, &
1057 cstate_tmp%lpos, cstate_tmp%direction(:) )
1060 contact%states(nslave)%direction = cstate_tmp%direction
1067 subroutine reset_contact_force( contact, currpos, lslave, omaster, opos, odirec, B )
1068 type(
tcontact ),
intent(inout) :: contact
1069 real(kind=kreal),
intent(in) :: currpos(:)
1070 integer,
intent(in) :: lslave
1071 integer,
intent(in) :: omaster
1072 real(kind=kreal),
intent(in) :: opos(2)
1073 real(kind=kreal),
intent(in) :: odirec(3)
1074 real(kind=kreal),
intent(inout) :: b(:)
1076 integer(kind=kint) :: slave, etype, master
1077 integer(kind=kint) :: nn, j, iSS
1078 real(kind=kreal) :: nrlforce, fcoeff, tangent(3,2)
1079 real(kind=kreal) :: elemcrd(3, l_max_elem_node )
1080 real(kind=kreal) :: shapefunc(l_max_surface_node)
1081 real(kind=kreal) :: metric(2,2), dispmat(2,l_max_elem_node*3+3)
1082 real(kind=kreal) :: fric(2), f3(l_max_elem_node*3+3)
1083 integer(kind=kint) :: i, idx0
1085 slave = contact%slave(lslave)
1086 fcoeff = contact%fcoeff
1088 nrlforce = contact%states(lslave)%multiplier(1)
1089 b(3*slave-2:3*slave) = b(3*slave-2:3*slave)+nrlforce*odirec
1090 nn =
size( contact%master(omaster)%nodes )
1091 etype = contact%master(omaster)%etype
1092 call getshapefunc( etype, opos(:), shapefunc )
1094 iss = contact%master(omaster)%nodes(j)
1099 b(idx0+i) = b(idx0+i)-nrlforce*shapefunc(j)*odirec(i)
1102 if( fcoeff/=0.d0 )
then
1104 iss = contact%master(omaster)%nodes(j)
1105 elemcrd(:,j) = currpos(3*iss-2:3*iss)
1109 fric(1:2) = contact%states(lslave)%multiplier(2:3)
1110 f3(:) = fric(1)*dispmat(1,:)+fric(2)*dispmat(2,:)
1111 b(3*slave-2:3*slave) = b(3*slave-2:3*slave)+f3(1:3)
1113 iss = contact%master(omaster)%nodes(j)
1118 b(idx0+i) = b(idx0+i)+f3(3*j+i)
1124 master = contact%states(lslave)%surface
1125 nn =
size( contact%master(master)%nodes )
1126 etype = contact%master(master)%etype
1127 call getshapefunc( etype, contact%states(lslave)%lpos(1:2), shapefunc )
1128 b(3*slave-2:3*slave) = b(3*slave-2:3*slave)-nrlforce*contact%states(lslave)%direction
1130 iss = contact%master(master)%nodes(j)
1136 b(idx0+i) = b(idx0+i)+nrlforce* &
1137 shapefunc(j)*contact%states(lslave)%direction(i)
1140 if( fcoeff/=0.d0 )
then
1142 iss = contact%master(master)%nodes(j)
1143 elemcrd(:,j) = currpos(3*iss-2:3*iss)
1145 call dispincrematrix( contact%states(lslave)%lpos(1:2), etype, nn, elemcrd, tangent, &
1147 fric(1:2) = contact%states(lslave)%multiplier(2:3)
1148 f3(:) = fric(1)*dispmat(1,:)+fric(2)*dispmat(2,:)
1149 b(3*slave-2:3*slave) = b(3*slave-2:3*slave)-f3(1:3)
1151 iss = contact%master(master)%nodes(j)
1156 b(idx0+i) = b(idx0+i)-f3(3*j+i)
1161 end subroutine reset_contact_force
1168 type(
tcontact ),
intent(inout) :: contact
1169 real(kind=kreal),
intent(in) :: coord(:)
1170 real(kind=kreal),
intent(in) :: disp(:)
1171 real(kind=kreal),
intent(in) :: ddisp(:)
1172 real(kind=kreal),
intent(in) :: fcoeff
1173 real(kind=kreal),
intent(in) :: mu, mut
1174 real(kind=kreal),
intent(inout) :: b(:)
1176 integer(kind=kint) :: slave, etype, master
1177 integer(kind=kint) :: nn, i, j, iSS
1178 real(kind=kreal) :: nrlforce, elemdisp(3,l_max_elem_node), tangent(3,2)
1179 real(kind=kreal) :: dg(3), elemg(3), elemcrd(3, l_max_elem_node )
1180 real(kind=kreal) :: dgn, dxi(2), dxy(2), shapefunc(l_max_surface_node)
1181 real(kind=kreal) :: metric(2,2), dispmat(2,l_max_elem_node*3+3)
1182 real(kind=kreal) :: fric(2), f3(3*l_max_elem_node+3), edisp(3*l_max_elem_node+3)
1184 do i= 1,
size(contact%slave)
1186 slave = contact%slave(i)
1187 edisp(1:3) = ddisp(3*slave-2:3*slave)
1188 master = contact%states(i)%surface
1190 nn =
size( contact%master(master)%nodes )
1191 etype = contact%master(master)%etype
1193 iss = contact%master(master)%nodes(j)
1194 elemdisp(:,j) = ddisp(3*iss-2:3*iss)
1195 edisp(3*j+1:3*j+3) = ddisp(3*iss-2:3*iss)
1196 elemcrd(:,j) = coord(3*iss-2:3*iss)+disp(3*iss-2:3*iss)
1198 call getshapefunc( etype, contact%states(i)%lpos(1:2), shapefunc )
1203 elemg(:) = elemg(:)+shapefunc(j)*elemdisp(:,j)
1205 dg(:) = ddisp(3*slave-2:3*slave) - elemg(:)
1206 dgn = dot_product( contact%states(i)%direction, dg )
1207 nrlforce = contact%states(i)%multiplier(1)- mu*(contact%states(i)%wkdist-dgn)
1208 b(3*slave-2:3*slave) = b(3*slave-2:3*slave)-nrlforce*contact%states(i)%direction
1211 iss = contact%master(master)%nodes(j)
1212 b(3*iss-2:3*iss) = b(3*iss-2:3*iss)+nrlforce* &
1213 shapefunc(j)*contact%states(i)%direction
1216 if( fcoeff==0.d0 ) cycle
1218 call dispincrematrix( contact%states(i)%lpos(1:2), etype, nn, elemcrd, tangent, &
1220 dxi(1) = dot_product( dispmat(1,1:nn*3+3), edisp(1:nn*3+3) )
1221 dxi(2) = dot_product( dispmat(2,1:nn*3+3), edisp(1:nn*3+3) )
1222 dxy(:) = matmul( metric, dxi )
1223 fric(1:2) = contact%states(i)%multiplier(2:3) + mut*dxy(1:2)
1224 f3(:) = fric(1)*dispmat(1,:)+fric(2)*dispmat(2,:)
1227 dgn = dsqrt( f3(1)*f3(1)+f3(2)*f3(2)+f3(3)*f3(3) )
1228 f3(:) = f3(:)*fcoeff*contact%states(i)%multiplier(1)/dgn
1230 b(3*slave-2:3*slave) = b(3*slave-2:3*slave)-f3(1:3)
1232 iss = contact%master(master)%nodes(j)
1233 b(3*iss-2:3*iss) = b(3*iss-2:3*iss)-f3(3*j+1:3*j+3)
1242 type(
tcontact ),
intent(inout) :: contact
1243 real(kind=kreal),
intent(in) :: disp(:)
1244 real(kind=kreal),
intent(in) :: ddisp(:)
1245 real(kind=kreal),
intent(in) :: mu
1246 real(kind=kreal),
intent(inout) :: b(:)
1248 integer(kind=kint) :: slave, etype, master
1249 integer(kind=kint) :: nn, i, j, iss
1250 real(kind=kreal) :: nrlforce(3)
1251 real(kind=kreal) :: dg(3)
1252 real(kind=kreal) :: shapefunc(l_max_surface_node)
1253 real(kind=kreal) :: edisp(3*l_max_elem_node+3)
1255 do i= 1,
size(contact%slave)
1257 slave = contact%slave(i)
1258 edisp(1:3) = disp(3*slave-2:3*slave)+ddisp(3*slave-2:3*slave)
1259 master = contact%states(i)%surface
1261 nn =
size( contact%master(master)%nodes )
1262 etype = contact%master(master)%etype
1264 iss = contact%master(master)%nodes(j)
1265 edisp(3*j+1:3*j+3) = disp(3*iss-2:3*iss)+ddisp(3*iss-2:3*iss)
1267 call getshapefunc( etype, contact%states(i)%lpos(1:2), shapefunc )
1270 dg(1:3) = edisp(1:3)
1272 dg(1:3) = dg(1:3)-shapefunc(j)*edisp(3*j+1:3*j+3)
1275 nrlforce(1:3) = contact%states(i)%multiplier(1:3)+mu*dg(1:3)
1277 b(3*slave-2:3*slave) = b(3*slave-2:3*slave)-nrlforce(1:3)
1279 iss = contact%master(master)%nodes(j)
1280 b(3*iss-2:3*iss) = b(3*iss-2:3*iss) + shapefunc(j)*nrlforce(1:3)
1290 type(
tcontact ),
intent(inout) :: contact
1291 real(kind=kreal),
intent(in) :: coord(:)
1292 real(kind=kreal),
intent(in) :: disp(:)
1293 real(kind=kreal),
intent(in) :: ddisp(:)
1294 real(kind=kreal),
intent(in) :: fcoeff
1295 real(kind=kreal),
intent(in) :: mu, mut
1296 real(kind=kreal),
intent(out) :: gnt(2)
1297 logical,
intent(inout) :: ctchanged
1299 integer(kind=kint) :: slave, etype, master
1300 integer(kind=kint) :: nn, i, j, iss, cnt
1301 real(kind=kreal) :: elemdisp(3,l_max_elem_node), tangent(3,2)
1302 real(kind=kreal) :: dg(3), elemg(3), elemcrd(3, l_max_elem_node )
1303 real(kind=kreal) :: dgn, dxi(2), dxy(2), shapefunc(l_max_surface_node)
1304 real(kind=kreal) :: metric(2,2), dispmat(2,l_max_elem_node*3+3)
1305 real(kind=kreal) :: lgnt(2), fric(2), f3(3*l_max_elem_node+3), edisp(3*l_max_elem_node+3)
1307 cnt =0; lgnt(:)=0.d0
1308 do i= 1,
size(contact%slave)
1310 slave = contact%slave(i)
1311 edisp(1:3) = ddisp(3*slave-2:3*slave)
1312 master = contact%states(i)%surface
1314 nn =
size( contact%master(master)%nodes )
1315 etype = contact%master(master)%etype
1317 iss = contact%master(master)%nodes(j)
1318 elemdisp(:,j) = ddisp(3*iss-2:3*iss)
1319 edisp(3*j+1:3*j+3) = ddisp(3*iss-2:3*iss)
1320 elemcrd(:,j) = coord(3*iss-2:3*iss)+disp(3*iss-2:3*iss)
1322 call getshapefunc( etype, contact%states(i)%lpos(1:2), shapefunc )
1327 elemg(:) = elemg(:)+shapefunc(j)*elemdisp(:,j)
1329 dg(:) = ddisp(3*slave-2:3*slave) - elemg(:)
1330 dgn = dot_product( contact%states(i)%direction, dg )
1331 contact%states(i)%wkdist = contact%states(i)%wkdist-dgn
1332 contact%states(i)%multiplier(1) = contact%states(i)%multiplier(1)- mu*contact%states(i)%wkdist
1333 contact%states(i)%distance = contact%states(i)%distance - dgn
1335 lgnt(1) = lgnt(1)- contact%states(i)%wkdist
1337 if( fcoeff==0.d0 ) cycle
1339 call dispincrematrix( contact%states(i)%lpos(1:2), etype, nn, elemcrd, tangent, &
1341 dxi(1) = dot_product( dispmat(1,1:nn*3+3), edisp(1:nn*3+3) )
1342 dxi(2) = dot_product( dispmat(2,1:nn*3+3), edisp(1:nn*3+3) )
1343 dxy(:) = matmul( metric, dxi )
1344 fric(1:2) = contact%states(i)%multiplier(2:3) + mut*dxy(1:2)
1345 f3(:) = fric(1)*dispmat(1,:)+fric(2)*dispmat(2,:)
1346 dgn = dsqrt( f3(1)*f3(1)+f3(2)*f3(2)+f3(3)*f3(3) )
1347 if( contact%states(i)%multiplier(1)>0.d0 )
then
1348 if( dgn > fcoeff*contact%states(i)%multiplier(1) )
then
1351 print *,
"Node", slave,
"to slip state",dgn, fcoeff*contact%states(i)%multiplier(1)
1354 fric(:) = fric(:)*fcoeff*contact%states(i)%multiplier(1)/dgn
1358 print *,
"Node", slave,
"to stick state",dgn, fcoeff*contact%states(i)%multiplier(1)
1363 contact%states(i)%multiplier(2:3) = fric(:)
1364 dxy(:) = matmul( dg, tangent )
1365 lgnt(2) = lgnt(2)+dsqrt( dxy(1)*dxy(1)+dxy(2)*dxy(2) )
1367 if(cnt>0) lgnt(:) = lgnt(:)/cnt
1374 type(
tcontact ),
intent(inout) :: contact
1375 real(kind=kreal),
intent(in) :: disp(:)
1376 real(kind=kreal),
intent(in) :: ddisp(:)
1377 real(kind=kreal),
intent(in) :: mu
1378 logical,
intent(inout) :: ctchanged
1380 integer(kind=kint) :: slave, etype, master
1381 integer(kind=kint) :: nn, i, j, iss, cnt
1382 real(kind=kreal) :: dg(3), dgmax
1383 real(kind=kreal) :: shapefunc(l_max_surface_node)
1384 real(kind=kreal) :: edisp(3*l_max_elem_node+3)
1386 do i= 1,
size(contact%slave)
1388 slave = contact%slave(i)
1389 edisp(1:3) = disp(3*slave-2:3*slave)+ddisp(3*slave-2:3*slave)
1390 master = contact%states(i)%surface
1392 nn =
size( contact%master(master)%nodes )
1393 etype = contact%master(master)%etype
1395 iss = contact%master(master)%nodes(j)
1396 edisp(3*j+1:3*j+3) = disp(3*iss-2:3*iss)+ddisp(3*iss-2:3*iss)
1398 call getshapefunc( etype, contact%states(i)%lpos(1:2), shapefunc )
1401 dg(1:3) = edisp(1:3)
1403 dg(1:3) = dg(1:3)-shapefunc(j)*edisp(3*j+1:3*j+3)
1406 contact%states(i)%multiplier(1:3) = contact%states(i)%multiplier(1:3) + mu*dg(1:3)
1411 dgmax = dgmax + dabs(edisp(j))
1413 dgmax = dgmax/dble((nn+1)*3)
1415 if( dabs(dg(j))/dmax1(1.d0,dgmax) > 1.d-3 ) ctchanged = .true.
1423 type(
tcontact ),
intent(in) :: contact
1424 real(kind=kreal),
intent(in) :: coord(:)
1425 real(kind=kreal),
intent(in) :: disp(:)
1426 real(kind=kreal),
intent(inout) :: b(:)
1428 integer(kind=kint) :: slave, etype, master
1429 integer(kind=kint) :: nn, i, j, iss
1430 real(kind=kreal) :: fcoeff, nrlforce, tangent(3,2)
1431 real(kind=kreal) :: elemcrd(3, l_max_elem_node )
1432 real(kind=kreal) :: shapefunc(l_max_surface_node)
1433 real(kind=kreal) :: metric(2,2), dispmat(2,l_max_elem_node*3+3)
1434 real(kind=kreal) :: fric(2), f3(l_max_elem_node*3+3)
1435 fcoeff = contact%fcoeff
1436 do i= 1,
size(contact%slave)
1438 slave = contact%slave(i)
1439 master = contact%states(i)%surface
1441 nn =
size( contact%master(master)%nodes )
1442 etype = contact%master(master)%etype
1443 call getshapefunc( etype, contact%states(i)%lpos(1:2), shapefunc )
1446 nrlforce = contact%states(i)%multiplier(1)
1447 b(3*slave-2:3*slave) = b(3*slave-2:3*slave)-nrlforce*contact%states(i)%direction
1450 iss = contact%master(master)%nodes(j)
1451 b(3*iss-2:3*iss) = b(3*iss-2:3*iss)+nrlforce* &
1452 shapefunc(j)*contact%states(i)%direction
1455 if( fcoeff==0.d0 ) cycle
1458 iss = contact%master(master)%nodes(j)
1459 elemcrd(:,j) = coord(3*iss-2:3*iss)+disp(3*iss-2:3*iss)
1461 call dispincrematrix( contact%states(i)%lpos(1:2), etype, nn, elemcrd, tangent, &
1464 fric(1:2) = contact%states(i)%multiplier(2:3)
1465 f3(:) = fric(1)*dispmat(1,:)+fric(2)*dispmat(2,:)
1466 b(3*slave-2:3*slave) = b(3*slave-2:3*slave)-f3(1:3)
1468 iss = contact%master(master)%nodes(j)
1469 b(3*iss-2:3*iss) = b(3*iss-2:3*iss)-f3(3*j+1:3*j+3)
1477 type(
tcontact ),
intent(in) :: contact
1478 real(kind=kreal),
intent(in) :: dt
1479 real(kind=kreal),
intent(inout) :: relvel_vec(:)
1480 real(kind=kreal),
intent(inout) :: state_vec(:)
1482 integer(kind=kint) :: i, slave
1484 do i= 1,
size(contact%slave)
1485 slave = contact%slave(i)
1486 if( state_vec(slave) < 0.1d0 .or. contact%states(i)%state > 0 ) &
1487 & state_vec(slave) = dble(contact%states(i)%state)
1490 if( dt < 1.d-16 ) cycle
1491 relvel_vec(3*slave-2:3*slave) = contact%states(i)%reldisp(1:3)/dt
1497 type(
tcontact ),
intent(inout) :: contact
1499 integer(kind=kint) :: i
1501 do i= 1,
size(contact%slave)
1503 contact%states(i)%tangentForce(1:3) = 0.d0
1504 contact%states(i)%tangentForce_trial(1:3) = 0.d0
1505 contact%states(i)%tangentForce_final(1:3) = 0.d0
1507 contact%states(i)%tangentForce(1:3) = contact%states(i)%tangentForce_final(1:3)
1509 contact%states(i)%tangentForce1(1:3) = contact%states(i)%tangentForce(1:3)
1515 integer,
intent(in) :: nslave
1516 type(
tcontact ),
intent(inout) :: contact
1518 real(kind=kreal),
intent(in) :: currpos(:)
1519 real(kind=kreal),
intent(in) :: currdisp(:)
1520 integer(kind=kint),
intent(in) :: nodeID(:)
1521 integer(kind=kint),
intent(in) :: elemID(:)
1523 integer(kind=kint) :: slave, sid0, sid, etype
1524 integer(kind=kint) :: nn, i, j, iSS
1525 real(kind=kreal) :: coord(3), elem(3, l_max_elem_node ), elem0(3, l_max_elem_node )
1527 real(kind=kreal) :: opos(2), odirec(3)
1528 integer(kind=kint) :: bktID, nCand, idm
1529 integer(kind=kint),
allocatable :: indexCand(:)
1533 slave = contact%slave(nslave)
1534 coord(:) = currpos(3*slave-2:3*slave)
1536 sid0 = contact%states(nslave)%surface
1537 opos = contact%states(nslave)%lpos(1:2)
1538 odirec = contact%states(nslave)%direction
1539 etype = contact%master(sid0)%etype
1540 nn = getnumberofnodes( etype )
1542 iss = contact%master(sid0)%nodes(j)
1543 elem(1:3,j)=currpos(3*iss-2:3*iss)
1544 elem0(1:3,j)=currpos(3*iss-2:3*iss)-currdisp(3*iss-2:3*iss)
1546 call project_point2element( coord,etype,nn,elem,contact%master(sid0)%reflen,contact%states(nslave), &
1547 isin,contact%cparam%DISTCLR_NOCHECK,contact%states(nslave)%lpos(1:2),contact%cparam%CLR_SAME_ELEM )
1548 if( .not. isin )
then
1549 do i=1, contact%master(sid0)%n_neighbor
1550 sid = contact%master(sid0)%neighbor(i)
1551 etype = contact%master(sid)%etype
1552 nn = getnumberofnodes( etype )
1554 iss = contact%master(sid)%nodes(j)
1555 elem(1:3,j)=currpos(3*iss-2:3*iss)
1557 call project_point2element( coord,etype,nn,elem,contact%master(sid)%reflen,contact%states(nslave), &
1558 isin,contact%cparam%DISTCLR_NOCHECK,localclr=contact%cparam%CLEARANCE )
1560 contact%states(nslave)%surface = sid
1566 if( .not. isin )
then
1567 write(*,*)
'Warning: contact moved beyond neighbor elements'
1572 allocate(indexcand(ncand))
1575 sid = indexcand(idm)
1576 if( sid==sid0 ) cycle
1577 if( any(sid==contact%master(sid0)%neighbor(:)) ) cycle
1578 if (.not.
is_in_surface_box( contact%master(sid), coord(1:3), contact%cparam%BOX_EXP_RATE )) cycle
1579 etype = contact%master(sid)%etype
1580 nn =
size( contact%master(sid)%nodes )
1582 iss = contact%master(sid)%nodes(j)
1583 elem(1:3,j)=currpos(3*iss-2:3*iss)
1585 call project_point2element( coord,etype,nn,elem,contact%master(sid)%reflen,contact%states(nslave), &
1586 isin,contact%cparam%DISTCLR_NOCHECK,localclr=contact%cparam%CLEARANCE )
1588 contact%states(nslave)%surface = sid
1592 deallocate(indexcand)
1597 if( contact%states(nslave)%surface==sid0 )
then
1598 if(any(dabs(contact%states(nslave)%lpos(1:2)-opos(:)) >= contact%cparam%CLR_DIFFLPOS))
then
1600 infoctchange%contact2difflpos = infoctchange%contact2difflpos + 1
1603 write(*,
'(A,i10,A,i10,A,f7.3,A,2f7.3)')
"Node",nodeid(slave),
" move to contact with", &
1604 elemid(contact%master(sid)%eid),
" with distance ", &
1605 contact%states(nslave)%distance,
" at ",contact%states(nslave)%lpos(1:2)
1607 infoctchange%contact2neighbor = infoctchange%contact2neighbor + 1
1609 iss = isinsideelement( etype, contact%states(nslave)%lpos(1:2), contact%cparam%CLR_CAL_NORM )
1611 call cal_node_normal( contact%states(nslave)%surface, iss, contact%master, currpos, &
1612 contact%states(nslave)%lpos(1:2), contact%states(nslave)%direction(:) )
1614 else if( .not. isin )
then
1615 write(*,
'(A,i10,A)')
"Node",nodeid(slave),
" move out of contact"
1617 contact%states(nslave)%multiplier(:) = 0.d0
1626 nodeID, elemID, is_init, active )
1627 type(
tcontact ),
intent(inout) :: contact
1629 real(kind=kreal),
intent(in) :: currpos(:)
1630 real(kind=kreal),
intent(in) :: currdisp(:)
1631 integer(kind=kint),
intent(in) :: nodeID(:)
1632 integer(kind=kint),
intent(in) :: elemID(:)
1633 logical,
intent(in) :: is_init
1634 logical,
intent(out) :: active
1636 real(kind=kreal) :: distclr
1637 integer(kind=kint) :: slave, id, etype
1638 integer(kind=kint) :: nn, i, j, iSS, nactive
1639 real(kind=kreal) :: coord(3), elem(3, l_max_elem_node )
1640 real(kind=kreal) :: nlforce
1642 integer(kind=kint),
allocatable :: contact_surf(:), states_prev(:)
1644 integer,
pointer :: indexMaster(:),indexCand(:)
1645 integer :: nMaster,idm,nMasterMax,bktID,nCand
1649 distclr = contact%cparam%DISTCLR_INIT
1651 distclr = contact%cparam%DISTCLR_FREE
1654 do i= 1,
size(contact%slave)
1664 allocate(contact_surf(
size(nodeid)))
1665 allocate(states_prev(
size(contact%slave)))
1666 contact_surf(:) =
size(elemid)+1
1667 do i = 1,
size(contact%slave)
1668 states_prev(i) = contact%states(i)%state
1682 do i= 1,
size(contact%slave)
1683 slave = contact%slave(i)
1687 contact_surf(contact%slave(i)) = -contact%states(i)%surface
1689 else if( contact%states(i)%state==
contactfree )
then
1690 coord(:) = currpos(3*slave-2:3*slave)
1695 if (ncand == 0) cycle
1696 allocate(indexcand(ncand))
1700 allocate(indexmaster(nmastermax))
1706 if (.not.
is_in_surface_box( contact%master(id), coord(1:3), contact%cparam%BOX_EXP_RATE )) cycle
1707 nmaster = nmaster + 1
1708 indexmaster(nmaster) = id
1710 deallocate(indexcand)
1712 if(nmaster == 0)
then
1713 deallocate(indexmaster)
1718 id = indexmaster(idm)
1719 etype = contact%master(id)%etype
1720 nn =
size( contact%master(id)%nodes )
1722 iss = contact%master(id)%nodes(j)
1723 elem(1:3,j)=currpos(3*iss-2:3*iss)
1726 isin,distclr,localclr=contact%cparam%CLEARANCE )
1727 if( .not. isin ) cycle
1728 contact%states(i)%surface = id
1729 contact%states(i)%multiplier(:) = 0.d0
1730 iss = isinsideelement( etype, contact%states(i)%lpos(1:2), contact%cparam%CLR_CAL_NORM )
1732 call cal_node_normal( id, iss, contact%master, currpos, contact%states(i)%lpos(1:2), &
1733 contact%states(i)%direction(:) )
1734 contact_surf(contact%slave(i)) = id
1735 write(*,
'(A,i10,A,i10,A,f7.3,A,2f7.3,A,3f7.3)')
"Node",nodeid(slave),
" contact with element", &
1736 elemid(contact%master(id)%eid), &
1737 " with distance ", contact%states(i)%distance,
" at ",contact%states(i)%lpos(1:2), &
1738 " along direction ", contact%states(i)%direction
1741 deallocate(indexmaster)
1748 do i = 1,
size(contact%slave)
1750 if (abs(contact_surf(contact%slave(i))) /= contact%states(i)%surface)
then
1752 write(*,
'(A,i10,A,i6,A,i6,A)')
"Node",nodeid(contact%slave(i)), &
1753 " in rank",hecmw_comm_get_rank(),
" freed due to duplication"
1755 nactive = nactive + 1
1759 infoctchange%free2contact = infoctchange%free2contact + 1
1761 infoctchange%contact2free = infoctchange%contact2free + 1
1764 active = (nactive > 0)
1765 deallocate(contact_surf)
1766 deallocate(states_prev)
This module provides bucket-search functionality It provides definition of bucket info and its access...
integer(kind=kint) function, public bucketdb_getbucketid(bktdb, x)
Get bucket ID that includes given point.
subroutine, public bucketdb_finalize(bktdb)
Finalizer.
integer(kind=kint) function, public bucketdb_getnumcand(bktdb, bid)
Get number of candidates within neighboring buckets of a given bucket Bucket ID has to be obtained wi...
subroutine, public bucketdb_init(bktdb)
Initializer.
subroutine, public bucketdb_getcand(bktdb, bid, ncand, cand)
Get candidates within neighboring buckets of a given bucket Number of candidates has to be obtained w...
This module encapsulate the basic functions of all elements provide by this software.
subroutine getvertexcoord(fetype, cnode, localcoord)
Get the natural coord of a vertex node.
real(kind=kreal) function, dimension(3) surfacenormal(fetype, nn, localcoord, elecoord)
Calculate normal of 3d-surface.
This module manages surface elements in 3D It provides basic definition of surface elements (triangla...
subroutine initialize_surf(eid, etype, nsurf, surf)
Initializer.
subroutine update_surface_reflen(surf, coord)
Compute reference length of surface elements.
subroutine write_surf(file, surf)
Write out elemental surface.
subroutine update_surface_box_info(surf, currpos)
Update info of cubic box including surface elements.
subroutine find_surface_neighbor(surf, bktDB)
Find neighboring surface elements.
subroutine update_surface_bucket_info(surf, bktDB)
Update bucket info for searching surface elements.
subroutine finalize_surf(surf)
Memory management subroutine.
logical function is_in_surface_box(surf, x0, exp_rate)
Check if given point is within cubic box including surface element.
Structure to define surface group.