9 use hecmw,
only: kint, kreal
20 integer(kind=kint) :: eid
21 integer(kind=kint) :: etype
22 integer(kind=kint),
pointer :: nodes(:)=>null()
23 integer(kind=kint) :: n_neighbor
24 integer(kind=kint) :: n_neighbor_max
25 integer(kind=kint),
pointer :: neighbor(:)=>null()
26 real(kind=kreal) :: reflen
27 real(kind=kreal) :: xavg(3)
28 real(kind=kreal) :: dmax
29 integer(kind=kint) :: bktid
32 integer(kind=kint),
parameter,
private :: debug = 0
39 integer(kind=kint),
intent(in) :: eid
40 integer(kind=kint),
intent(in) :: etype
41 integer(kind=kint),
intent(in) :: nsurf
43 integer(kind=kint) :: i, n, outtype, nodes(100)
47 call getsubface( etype, nsurf, outtype, nodes )
57 allocate( surf%nodes(n) )
58 surf%nodes(1:n)=nodes(1:n)
60 surf%n_neighbor_max = 0
70 if(
associated(surf%nodes) )
deallocate( surf%nodes )
71 if(
associated(surf%neighbor) )
deallocate( surf%neighbor )
76 integer(kind=kint),
intent(in) :: file
78 integer(kind=kint) :: i
79 write(file,*)
"Element:",surf%eid,
"Surface type=",surf%etype
80 if(
associated( surf%nodes ) ) &
81 write(file,*) ( surf%nodes(i),i=1,
size(surf%nodes) )
82 if(
associated( surf%neighbor ) ) &
83 write(file,*) ( surf%neighbor(i),i=1,surf%n_neighbor )
92 type(bucketdb),
intent(in) :: bktDB
93 integer(kind=kint) :: i, j, ii,jj, nd1, nd2, nsurf
94 integer(kind=kint) :: k, oldsize, newsize
95 integer(kind=kint),
pointer :: dumarray(:) => null()
96 integer(kind=kint) :: bktID, ncand, js
97 integer(kind=kint),
allocatable :: indexSurf(:)
98 if (debug >= 1)
write(0,*)
'DEBUG: find_surface_neighbor: start'
108 if (ncand == 0) cycle
109 allocate(indexsurf(ncand))
114 if(
associated(surf(i)%neighbor) )
then
115 if ( any( surf(i)%neighbor(1:surf(i)%n_neighbor)==j ) ) cycle
117 do ii=1,
size(surf(i)%nodes)
118 nd1 = surf(i)%nodes(ii)
119 do jj=1,
size(surf(j)%nodes)
120 nd2 = surf(j)%nodes(jj)
122 surf(i)%n_neighbor = surf(i)%n_neighbor+1
124 if( .not.
associated(surf(i)%neighbor) )
then
127 surf(i)%neighbor(1) = j
128 else if( surf(i)%n_neighbor > surf(i)%n_neighbor_max )
then
129 oldsize = surf(i)%n_neighbor_max
130 newsize = oldsize * 2
131 dumarray => surf(i)%neighbor
132 allocate( surf(i)%neighbor(newsize) )
133 surf(i)%n_neighbor_max = newsize
135 surf(i)%neighbor(k) = dumarray(k)
137 surf(i)%neighbor(oldsize+1) = j
138 deallocate( dumarray )
140 surf(i)%neighbor(surf(i)%n_neighbor) = j
148 deallocate(indexsurf)
152 if (debug >= 1)
write(0,*)
'DEBUG: find_surface_neighbor: end'
159 real(kind=kreal),
intent(in) :: cpos(2)
161 integer(kind=kint) :: i
162 real(kind=kreal) :: maxv(3)
164 if( .not.
associated(surf%neighbor) )
return
166 select case(surf%etype)
168 if( all(cpos>0.d0) .and. all(cpos<1.d0) )
return
169 if(
size(surf%neighbor)<3 )
return
170 if( all(cpos(:)>0.d0) )
return
172 if( cpos(i)< 0.d0 ) maxv(i) = -cpos(i)
176 if( all(cpos>-1.d0) .and. all(cpos<1.d0) )
return
177 if(
size(surf%neighbor)<4 )
return
178 if( cpos(1)<-1.d0 .and. dabs(cpos(2))<1.d0 )
then
180 elseif( cpos(1)>1.d0 .and. dabs(cpos(2))<1.d0 )
then
182 elseif( dabs(cpos(1))<1.d0 .and. cpos(2)<-1.d0 )
then
184 elseif( dabs(cpos(1))<1.d0 .and. cpos(2)>1.d0 )
then
186 elseif( cpos(1)<-1.d0 .and. cpos(2)<-1.d0 )
then
187 if( cpos(1)>cpos(2) )
then
192 elseif( cpos(1)<-1.d0 .and. cpos(2)>1.d0 )
then
193 if( dabs(cpos(1))>cpos(2) )
then
198 elseif( cpos(1)>1.d0 .and. cpos(2)<-1.d0 )
then
199 if( cpos(1)>dabs(cpos(2)) )
then
204 elseif( cpos(1)>1.d0 .and. cpos(2)>1.d0 )
then
205 if( cpos(1)>cpos(2) )
then
212 stop
"type of surface element not defined"
222 real(kind=kreal),
intent(in) :: coord(:)
224 integer(kind=kint) :: nn, i, j, iss
227 nn =
size(surf(j)%nodes)
229 iss = surf(j)%nodes(i)
230 elem(1:3,i) = coord(3*iss-2:3*iss)
241 real(kind=kreal),
intent(in) :: currpos(:)
242 integer(kind=kint) :: nn, i, j, iss
246 nn =
size(surf(j)%nodes)
248 iss = surf(j)%nodes(i)
249 elem(1:3,i) = currpos(3*iss-2:3*iss)
252 xmin(i) = minval(elem(i,1:nn))
253 xmax(i) = maxval(elem(i,1:nn))
254 xsum(i) = sum(elem(i,1:nn))
256 surf(j)%xavg(:) = xsum(:) / nn
257 lx(:) = xmax(:) - xmin(:)
258 surf(j)%dmax = maxval(lx) * 0.5d0
266 real(kind=kreal),
intent(in) :: x0(3)
267 real(kind=kreal),
intent(in) :: exp_rate
268 real(kind=kreal) :: dist(3), er
269 er = max(exp_rate, 1.d0)
270 dist(:) = abs(x0(:) - surf%xavg(:))
271 if ( maxval(dist(:)) < surf%dmax * er )
then
282 type(bucketdb),
intent(inout) :: bktDB
283 real(kind=kreal) :: x_min(3), x_max(3), d_max
284 integer(kind=kint) :: nsurf, i, j
285 if (debug >= 1)
write(0,*)
'DEBUG: update_surface_bucket_info: start'
287 if (nsurf == 0)
return
288 x_min(:) = surf(1)%xavg(:)
289 x_max(:) = surf(1)%xavg(:)
290 d_max = surf(1)%dmax*2.d0
293 if (surf(i)%xavg(j) < x_min(j)) x_min(j) = surf(i)%xavg(j)
294 if (surf(i)%xavg(j) > x_max(j)) x_max(j) = surf(i)%xavg(j)
295 if (surf(i)%dmax > d_max) d_max = surf(i)%dmax
299 x_min(j) = x_min(j) - d_max
300 x_max(j) = x_max(j) + d_max
313 if (debug >= 1)
write(0,*)
'DEBUG: update_surface_bucket_info: end'
This module provides bucket-search functionality It provides definition of bucket info and its access...
subroutine, public bucketdb_allocate(bktdb)
Allocate memory before actually registering members Before allocating memory, bucketDB_registerPre ha...
subroutine, public bucketdb_registerpre(bktdb, bid)
Pre-register for just counting members to be actually registered Bucket ID has to be obtained with bu...
integer(kind=kint) function, public bucketdb_getbucketid(bktdb, x)
Get bucket ID that includes given point.
subroutine, public bucketdb_register(bktdb, bid, sid)
Register member Before actually register, bucketDB_allocate has to be called.
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_getcand(bktdb, bid, ncand, cand)
Get candidates within neighboring buckets of a given bucket Number of candidates has to be obtained w...
subroutine, public bucketdb_setup(bktdb, x_min, x_max, dmin, n_tot)
Setup basic info of buckets.
This module encapsulate the basic functions of all elements provide by this software.
integer(kind=kind(2)) function getnumberofnodes(etype)
Obtain number of nodes of the element.
subroutine getelementcenter(fetype, localcoord)
Return natural coordinate of the center of surface element.
integer, parameter fe_tri6n
subroutine getsubface(intype, innumber, outtype, nodes)
Find the definition of surface of the element.
integer, parameter fe_tri3n
integer, parameter fe_quad4n
real(kind=kreal) function getreferencelength(fetype, nn, localcoord, elecoord)
This function calculates reference length at a point in surface.
integer, parameter fe_quad8n
This module provides aux functions.
This module manages surface elements in 3D It provides basic definition of surface elements (triangla...
subroutine initialize_surf(eid, etype, nsurf, surf)
Initializer.
integer(kind=kint), parameter l_max_elem_node
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.
integer(kind=kint), parameter l_max_elem_surf
subroutine find_surface_neighbor(surf, bktDB)
Find neighboring surface elements.
integer(kind=kint), parameter n_neighbor_max_init
subroutine update_surface_bucket_info(surf, bktDB)
Update bucket info for searching surface elements.
integer(kind=kint), parameter l_max_surface_node
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.
integer(kind=kint) function next_position(surf, cpos)
Tracing next contact position.
Structure to define surface group.