19 integer(kind=kint) :: num_node = 0, num_lagrange = 0
20 integer(kind=kint),
pointer :: id_node(:) => null()
21 integer(kind=kint),
pointer :: id_lagrange(:) => null()
27 integer(kind=kint) :: num_lagrange = 0
28 integer(kind=kint) :: numl_lagrange = 0, numu_lagrange = 0
30 integer(kind=kint),
pointer :: indexl_lagrange(:) => null(), &
31 indexu_lagrange(:) => null()
32 integer(kind=kint),
pointer :: iteml_lagrange(:) => null(), &
33 itemu_lagrange(:) => null()
34 real(kind=kreal),
pointer :: al_lagrange(:) => null(), &
35 au_lagrange(:) => null()
36 real(kind=kreal),
pointer :: lagrange(:) => null()
46 private :: insert_lagrange, insert_node, find_locationinarray, reallocate_memory
54 type(hecmwst_matrix) :: hecMAT
56 integer(kind=kint) :: numL, numU, num_nodeRelated
57 integer(kind=kint) :: i, j
58 integer(kind=kint) :: ierr
64 if( ierr /= 0) stop
" Allocation error, list_nodeRelated_org "
68 numl = hecmat%indexL(i) - hecmat%indexL(i-1)
69 numu = hecmat%indexU(i) - hecmat%indexU(i-1)
71 num_noderelated = numl + numu + 1
74 if( ierr /= 0) stop
" Allocation error, list_nodeRelated_org%id_node "
94 integer(kind=kint) :: cstep
95 type(hecmwst_matrix) :: hecMAT
98 type(fstr_info_contactchange) :: infoCTChange
100 integer(kind=kint) :: num_lagrange
101 integer(kind=kint) :: countNon0LU_node, countNon0LU_lagrange
102 integer(kind=kint) :: numNon0_node, numNon0_lagrange
104 type (hecmwST_matrix),
optional :: conMAT
106 num_lagrange = infoctchange%contactNode_current
107 fstrmat%num_lagrange = num_lagrange
114 countnon0lu_lagrange = 0
119 numnon0_node = countnon0lu_node/2
120 numnon0_lagrange = countnon0lu_lagrange/2
137 integer(kind=kint) :: np, num_lagrange
138 integer(kind=kint) :: num_nodeRelated_org
139 integer(kind=kint) :: i, ierr
142 if( ierr /= 0) stop
" Allocation error, list_nodeRelated "
147 if( ierr /= 0) stop
" Allocation error, list_nodeRelated%id_node "
153 do i = np+1, np+num_lagrange
155 if( ierr /= 0) stop
" Allocation error, list_nodeRelated%id_lagrange "
169 integer(kind=kint) :: cstep
170 integer(kind=kint) :: np
171 integer(kind=kint) :: countNon0LU_node, countNon0LU_lagrange
172 integer(kind=kint) :: grpid
173 integer(kind=kint) :: count_lagrange
174 integer(kind=kint) :: ctsurf, etype, nnode, ndLocal(l_max_surface_node + 1)
175 integer(kind=kint) :: i, j, k, l, num, num_nodeRelated_org, ierr
176 real(kind=kreal) :: fcoeff
179 do i = 1,
size(fstrsolid%contacts)
181 grpid = fstrsolid%contacts(i)%group
184 fcoeff = fstrsolid%contacts(i)%fcoeff
186 do j = 1,
size(fstrsolid%contacts(i)%slave)
188 if( fstrsolid%contacts(i)%states(j)%state == contactfree ) cycle
189 ctsurf = fstrsolid%contacts(i)%states(j)%surface
190 etype = fstrsolid%contacts(i)%master(ctsurf)%etype
192 stop
" ##Error: This element type is not supported in contact analysis !!! "
193 nnode =
size(fstrsolid%contacts(i)%master(ctsurf)%nodes)
194 ndlocal(1) = fstrsolid%contacts(i)%slave(j)
195 ndlocal(2:nnode+1) = fstrsolid%contacts(i)%master(ctsurf)%nodes(1:nnode)
197 count_lagrange = count_lagrange + 1
205 if( ierr /= 0) stop
" Allocation error, list_nodeRelated%id_lagrange "
210 if( fcoeff /= 0.0d0 )
then
219 call insert_lagrange(k,count_lagrange,
list_noderelated(ndlocal(k)),countnon0lu_lagrange)
222 if( fcoeff /= 0.0d0 )
then
236 call insert_lagrange(0,ndlocal(l),
list_noderelated(np+count_lagrange),countnon0lu_lagrange)
252 type(hecmwst_matrix) :: hecmat
255 integer(kind=kint) :: numNon0_node, numNon0_lagrange
256 integer(kind=kint) :: countNon0L_node, countNon0U_node, countNon0U_lagrange, countNon0L_lagrange
257 integer(kind=kint) :: i, j, ierr
258 integer(kind=kint) :: numI_node, numI_lagrange
259 integer(kind=kint) :: ndof, nn
260 type(hecmwst_matrix),
optional :: conMAT
265 conmat%NP = hecmat%NP
266 conmat%ndof = hecmat%ndof
267 if(
associated(conmat%indexL).and.
associated(conmat%indexU))
deallocate(conmat%indexL,conmat%indexU)
268 allocate(conmat%indexL(0:conmat%NP), conmat%indexU(0:conmat%NP), stat=ierr)
269 if ( ierr /= 0) stop
" Allocation error, conMAT%indexL-conMAT%indexU "
270 conmat%indexL = 0 ; conmat%indexU = 0
271 if(
associated(conmat%itemL).and.
associated(conmat%itemU))
deallocate(conmat%itemL,conmat%itemU)
272 allocate(conmat%itemL(numnon0_node), conmat%itemU(numnon0_node), stat=ierr)
273 if ( ierr /= 0) stop
" Allocation error, conMAT%itemL-conMAT%itemU "
274 conmat%itemL = 0 ; conmat%itemU = 0
276 conmat%NPL = numnon0_node
277 conmat%NPU = numnon0_node
280 if(
associated(hecmat%indexL).and.
associated(hecmat%indexU))
deallocate(hecmat%indexL,hecmat%indexU)
281 allocate(hecmat%indexL(0:hecmat%NP), hecmat%indexU(0:hecmat%NP), stat=ierr)
282 if ( ierr /= 0) stop
" Allocation error, hecMAT%indexL-hecMAT%indexU "
283 hecmat%indexL = 0 ; hecmat%indexU = 0
284 if(
associated(hecmat%itemL).and.
associated(hecmat%itemU))
deallocate(hecmat%itemL,hecmat%itemU)
285 allocate(hecmat%itemL(numnon0_node), hecmat%itemU(numnon0_node), stat=ierr)
286 if ( ierr /= 0) stop
" Allocation error, hecMAT%itemL-hecMAT%itemU "
287 hecmat%itemL = 0 ; hecmat%itemU = 0
289 if(
associated(fstrmat%indexL_lagrange).and.
associated(fstrmat%indexU_lagrange)) &
290 deallocate(fstrmat%indexL_lagrange,fstrmat%indexU_lagrange)
291 if(
associated(fstrmat%itemL_lagrange).and.
associated(fstrmat%itemU_lagrange)) &
292 deallocate(fstrmat%itemL_lagrange,fstrmat%itemU_lagrange)
294 allocate(fstrmat%indexL_lagrange(0:fstrmat%num_lagrange), fstrmat%indexU_lagrange(0:hecmat%NP), stat=ierr)
295 if ( ierr /= 0) stop
" Allocation error, fstrMAT%indexL_lagrange-fstrMAT%indexU_lagrange "
296 fstrmat%indexL_lagrange = 0 ; fstrmat%indexU_lagrange = 0
297 allocate(fstrmat%itemL_lagrange(numnon0_lagrange), fstrmat%itemU_lagrange(numnon0_lagrange), stat=ierr)
298 if ( ierr /= 0) stop
" Allocation error, fstrMAT%itemL_lagrange-fstrMAT%itemU_lagrange "
299 fstrmat%itemL_lagrange = 0 ; fstrmat%itemU_lagrange = 0
302 hecmat%NPL = numnon0_node
303 hecmat%NPU = numnon0_node
305 fstrmat%numL_lagrange = numnon0_lagrange
306 fstrmat%numU_lagrange = numnon0_lagrange
310 countnon0u_lagrange = 0
320 countnon0l_node = countnon0l_node + 1
323 countnon0u_node = countnon0u_node + 1
327 hecmat%indexL(i) = countnon0l_node
328 hecmat%indexU(i) = countnon0u_node
331 do j = 1, numi_lagrange
332 countnon0u_lagrange = countnon0u_lagrange + 1
333 fstrmat%itemU_lagrange(countnon0u_lagrange) =
list_noderelated(i)%id_lagrange(j)
335 fstrmat%indexU_lagrange(i) = countnon0u_lagrange
345 conmat%itemL(:) = hecmat%itemL(:)
346 conmat%indexL(:) = hecmat%indexL(:)
347 conmat%itemU(:) = hecmat%itemU(:)
348 conmat%indexU(:) = hecmat%indexU(:)
352 countnon0l_lagrange = 0
353 do i = 1, fstrmat%num_lagrange
355 do j = 1, numi_lagrange
356 countnon0l_lagrange = countnon0l_lagrange + 1
357 fstrmat%itemL_lagrange(countnon0l_lagrange) =
list_noderelated(hecmat%NP+i)%id_lagrange(j)
359 fstrmat%indexL_lagrange(i) = countnon0l_lagrange
368 if(
associated(hecmat%AL))
deallocate(hecmat%AL)
369 allocate(hecmat%AL(nn*hecmat%NPL), stat=ierr)
370 if ( ierr /= 0 ) stop
" Allocation error, hecMAT%AL "
373 if(
associated(hecmat%AU))
deallocate(hecmat%AU)
374 allocate(hecmat%AU(nn*hecmat%NPU), stat=ierr)
375 if ( ierr /= 0 ) stop
" Allocation error, hecMAT%AU "
378 if(
associated(fstrmat%AL_lagrange))
deallocate(fstrmat%AL_lagrange)
379 if(
associated(fstrmat%AU_lagrange))
deallocate(fstrmat%AU_lagrange)
380 if(
associated(fstrmat%Lagrange))
deallocate(fstrmat%Lagrange)
383 allocate(fstrmat%AL_lagrange(ndof*fstrmat%numL_lagrange), stat=ierr)
384 if ( ierr /= 0 ) stop
" Allocation error, fstrMAT%AL_lagrange "
385 fstrmat%AL_lagrange = 0.0d0
386 allocate(fstrmat%AU_lagrange(ndof*fstrmat%numU_lagrange), stat=ierr)
387 if ( ierr /= 0 ) stop
" Allocation error, fstrMAT%AU_lagrange "
388 fstrmat%AU_lagrange = 0.0d0
389 allocate(fstrmat%Lagrange(fstrmat%num_lagrange))
390 fstrmat%Lagrange = 0.0d0
393 if(
associated(hecmat%B))
deallocate(hecmat%B)
394 allocate(hecmat%B(hecmat%NP*ndof+fstrmat%num_lagrange))
397 if(
associated(hecmat%X))
deallocate(hecmat%X)
398 allocate(hecmat%X(hecmat%NP*ndof+fstrmat%num_lagrange))
401 if(
associated(hecmat%D))
deallocate(hecmat%D)
402 allocate(hecmat%D(hecmat%NP*ndof**2+fstrmat%num_lagrange))
407 if(
associated(conmat%AL))
deallocate(conmat%AL)
408 allocate(conmat%AL(nn*conmat%NPL), stat=ierr)
409 if ( ierr /= 0 ) stop
" Allocation error, conMAT%AL "
412 if(
associated(conmat%AU))
deallocate(conmat%AU)
413 allocate(conmat%AU(nn*conmat%NPU), stat=ierr)
414 if ( ierr /= 0 ) stop
" Allocation error, conMAT%AU "
417 if(
associated(conmat%B))
deallocate(conmat%B)
418 allocate(conmat%B(conmat%NP*ndof+fstrmat%num_lagrange))
421 if(
associated(conmat%X))
deallocate(conmat%X)
422 allocate(conmat%X(conmat%NP*ndof+fstrmat%num_lagrange))
425 if(
associated(conmat%D))
deallocate(conmat%D)
426 allocate(conmat%D(conmat%NP*ndof**2+fstrmat%num_lagrange))
434 subroutine insert_lagrange(i,id_lagrange,list_node,countNon0_lagrange)
437 integer(kind=kint) :: i, id_lagrange
439 integer(kind=kint) :: countNon0_lagrange
441 integer(kind=kint) :: ierr, num_lagrange, location
442 integer(kind=kint) :: id_lagrange_save(1000)
444 character(len=1) :: answer
448 num_lagrange = count(list_node%id_lagrange /= 0 )
451 if( i == 1 .and. num_lagrange /= 0 .and. .not.
permission)
then
452 1
write(*,*)
'##Error: node is both slave and master node simultaneously !'
453 write(*,*)
' Please check contact surface definition !'
454 write(*,
'('' Do you want to continue(y/n)):'',$)')
455 read(*,
'(A1)',err=1) answer
456 if(answer ==
'Y' .OR. answer ==
'y')
then
463 if (num_lagrange == 0)
then
464 list_node%num_lagrange = 1
465 list_node%id_lagrange(1) = id_lagrange
466 countnon0_lagrange = countnon0_lagrange + 1
468 id_lagrange_save(1:num_lagrange) = list_node%id_lagrange(1:num_lagrange)
469 location = find_locationinarray(id_lagrange,num_lagrange,list_node%id_lagrange)
470 if(location /= 0)
then
471 num_lagrange = num_lagrange + 1
472 if( num_lagrange >
size(list_node%id_lagrange))
then
473 deallocate(list_node%id_lagrange)
474 allocate(list_node%id_lagrange(num_lagrange),stat=ierr)
475 if( ierr /= 0 ) stop
" Allocation error, list_nodeRelated%id_lagrange "
477 list_node%num_lagrange = num_lagrange
478 list_node%id_lagrange(location) = id_lagrange
479 if(location /= 1) list_node%id_lagrange(1:location-1) = id_lagrange_save(1:location-1)
480 if(location /= num_lagrange) list_node%id_lagrange(location+1:num_lagrange) = id_lagrange_save(location:num_lagrange-1)
481 countnon0_lagrange = countnon0_lagrange + 1
485 end subroutine insert_lagrange
488 subroutine insert_node(id_node,list_node,countNon0_node)
491 integer(kind=kint) :: id_node
493 integer(kind=kint) :: countNon0_node
494 integer(kind=kint) :: ierr, num_node, location
495 integer(kind=kint) :: id_node_save(1000)
499 num_node = list_node%num_node
501 id_node_save(1:num_node) = list_node%id_node(1:num_node)
502 location = find_locationinarray(id_node,num_node,list_node%id_node)
503 if(location /= 0)
then
504 num_node = num_node + 1
505 if( num_node >
size(list_node%id_node))
then
506 deallocate(list_node%id_node)
507 allocate(list_node%id_node(num_node),stat=ierr)
508 if( ierr /= 0) stop
" Allocation error, list_nodeRelated%id_node "
510 list_node%num_node = num_node
511 list_node%id_node(location) = id_node
512 if(location /= 1) list_node%id_node(1:location-1) = id_node_save(1:location-1)
513 if(location /= num_node) list_node%id_node(location+1:num_node) = id_node_save(location:num_node-1)
514 countnon0_node = countnon0_node + 1
517 end subroutine insert_node
521 integer function find_locationinarray(item,n,a)
523 integer(kind=kint) :: item, n
524 integer(kind=kint),
pointer :: a(:)
525 integer(kind=kint) :: l, r, m
527 find_locationinarray = 0
529 l = 1 ; r = n ; m = (l+r)/2
530 if( item == a(l) .or. item == a(r) )
then
532 elseif( item < a(l) )
then
533 find_locationinarray = 1
535 elseif( item > a(r) )
then
536 find_locationinarray = n + 1
541 if( item > a(m) )
then
544 elseif( item < a(m) )
then
547 elseif( item == a(m) )
then
552 find_locationinarray = m + 1
554 end function find_locationinarray
558 subroutine reallocate_memory(num,list_node)
561 integer(kind=kint) :: num
562 integer(kind=kint) :: num_node_org
564 integer(kind=kint) :: id_save(1000)
565 integer(kind=kint) :: ierr
567 num_node_org =
size(list_node%id_node)
568 id_save(1:num_node_org) = list_node%id_node(1:num_node_org)
569 deallocate(list_node%id_node)
570 allocate(list_node%id_node(num_node_org+num),stat=ierr)
571 if( ierr /= 0) stop
" reAllocation error, list_nodeRelated%id_node "
572 list_node%id_node = 0
573 list_node%id_node(1:num_node_org) = id_save(1:num_node_org)
575 end subroutine reallocate_memory
583 integer (kind=kint) :: id_lagrange, i, j
587 do i = 1,
size(fstrsolid%contacts)
588 do j = 1,
size(fstrsolid%contacts(i)%slave)
589 if( fstrsolid%contacts(i)%states(j)%state == contactfree ) cycle
590 id_lagrange = id_lagrange + 1
591 fstrmat%Lagrange(id_lagrange)=fstrsolid%contacts(i)%states(j)%multiplier(1)
602 type(hecmwst_local_mesh) :: hecmesh
603 integer (kind=kint) :: is_in_contact
606 if( any(fstrsolid%contacts(:)%fcoeff /= 0.0d0) ) &
608 call hecmw_allreduce_i1(hecmesh, is_in_contact, hecmw_max)
This module encapsulate the basic functions of all elements provide by this software.
integer, parameter fe_tri3n
integer, parameter fe_quad4n
This module defined coomon data and basic structures for analysis.
logical function fstr_iscontactactive(fstrSOLID, nbc, cstep)
logical paracontactflag
PARALLEL CONTACT FLAG.