OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
merge_node.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine merge_node (x, itab, itabm1, imerge, imerge2, iadmerge2, nmerge_tot, merge_node_tab, merge_node_tol, nmerge_node_cand, nmerge_node_dest, ixs, ixs10, ixs20, ixs16, ixq, ixc, ixt, ixp, ixr, ixtg, eani, igrnod)

Function/Subroutine Documentation

◆ merge_node()

subroutine merge_node ( x,
integer, dimension(numnod), target itab,
integer, dimension(2*numnod) itabm1,
integer, dimension(*) imerge,
integer, dimension(numnod+1) imerge2,
integer, dimension(numnod+1) iadmerge2,
integer nmerge_tot,
integer, dimension(4,*) merge_node_tab,
merge_node_tol,
integer nmerge_node_cand,
integer nmerge_node_dest,
integer, dimension(nixs,*) ixs,
integer, dimension(6,*) ixs10,
integer, dimension(12,*) ixs20,
integer, dimension(8,*) ixs16,
integer, dimension(nixq,*) ixq,
integer, dimension(nixc,*) ixc,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(nixtg,*) ixtg,
integer, dimension(*) eani,
type (group_), dimension(ngrnod), target igrnod )

Definition at line 36 of file merge_node.F.

41 USE message_mod
42 USE nod2el_mod
43 USE groupdef_mod
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C G l o b a l P a r a m e t e r s
50C-----------------------------------------------
51#include "units_c.inc"
52#include "com04_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER ITAB(NUMNOD), ITABM1(2*NUMNOD),IMERGE(*),
57 . IMERGE2(NUMNOD+1),IADMERGE2(NUMNOD+1),MERGE_NODE_TAB(4,*),
58 . NMERGE_NODE_CAND,NMERGE_NODE_DEST,NMERGE_TOT
59 INTEGER IXS(NIXS,*),IXS10(6,*),IXS16(8,*),IXS20(12,*),IXQ(NIXQ,*),
60 . IXC(NIXC,*),IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),
61 . IXTG(NIXTG,*),EANI(*)
62 TARGET itab
63 my_real
64 . x(3,numnod),merge_node_tol(*)
65 TYPE (GROUP_) ,TARGET, DIMENSION(NGRNOD) :: IGRNOD
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER I,J,K,M,N,NUMNOD1,NM,FLAG,N_DEST,N_DEST_DEST,NN1,NN2,CUR_ID,GR_IDS,ALL_VS_ALL,
70 . NM_L,ISS
71C
72 INTEGER, DIMENSION(:),ALLOCATABLE :: IMERGE0,IADMERGE2TMP,LIST1,LIST2,LIST1_INV,LIST2_INV
73 INTEGER, DIMENSION(:),ALLOCATABLE :: LIST1_IDMERGE,LIST2_IDMERGE,LIST1_NBMERGE,LIST2_NBMERGE
74 INTEGER, DIMENSION(:),ALLOCATABLE :: TAGNOD_TEMP
75 my_real, DIMENSION(:),ALLOCATABLE :: dist
76C
77 my_real
78 . dbuc
79C-----------------------------------------------
80 INTEGER
81 . USRTOS,USRTOSC
82 EXTERNAL usrtos,usrtosc
83C
84C=======================================================================
85C - MERGING ROUTINE for /MERGE/NODE
86C=======================================================================
87C
88C------- dbuc------------------------------
89C-- Cnodes not taken into account
90C
91 numnod1 = numnod0-numcnod
92 dbuc = zero
93 all_vs_all = 0
94 DO i=1,nb_merge_node
95 dbuc = max(dbuc,merge_node_tol(i))
96 gr_ids = merge_node_tab(2,i)
97 IF (gr_ids == 0) all_vs_all = 1
98 ENDDO
99C
100C-----------------------------------------------------------------------------------
101C BUCKET SEARCH - search of node to merge for each candidate - stored in IMERGE0
102C-----------------------------------------------------------------------------------
103C
104 nn1 = nmerge_node_cand
105 nn2 = nmerge_node_dest
106C
107 ALLOCATE(imerge0(nn1),dist(nn1),list1(nmerge_node_cand),list2(nmerge_node_dest))
108 ALLOCATE(list1_inv(numnod),list2_inv(numnod),iadmerge2tmp(numnod+1))
109 ALLOCATE(list1_idmerge(nmerge_node_cand),list2_idmerge(nmerge_node_dest))
110 ALLOCATE(list1_nbmerge(nmerge_node_cand),list2_nbmerge(nmerge_node_dest))
111 ALLOCATE(tagnod_temp(numnod))
112C
113 imerge0 = 0
114 dist = zero
115 list1 = 0
116 list1_idmerge = 0
117 list1_nbmerge = 0
118 list1_inv = 0
119 list2 = 0
120 list2_idmerge = 0
121 list2_nbmerge = 0
122 list2_inv = 0
123 tagnod_temp = 0
124 iadmerge2tmp = 0
125C
126 flag = 2
127C
128C---- bluid list of candidates
129 IF (all_vs_all == 1) THEN
130C-- all nodes are candidates - only one merge
131 DO i=1,numnod
132 list1(i) = i
133 list1_inv(i) = i
134 list1_nbmerge(i) = 1
135 list1_idmerge(i) = 1
136 ENDDO
137 ELSE
138C-- list filled merge by merge
139 nm = 0
140 DO i=1,nb_merge_node
141 gr_ids = merge_node_tab(2,i)
142 DO j=1,igrnod(gr_ids)%NENTITY
143 IF (list1_inv(igrnod(gr_ids)%ENTITY(j)) == 0) THEN
144C-- new point in list
145 nm = nm + 1
146 list1(nm) = igrnod(gr_ids)%ENTITY(j)
147 list1_inv(igrnod(gr_ids)%ENTITY(j)) = nm
148 list1_nbmerge(nm) = 1
149 list1_idmerge(nm) = i
150 ELSE
151C-- point already in list
152 nm_l = list1_inv(igrnod(gr_ids)%ENTITY(j))
153C-- coding of idmerge in case of several merge
154 list1_nbmerge(nm_l) = list1_nbmerge(nm_l) + 1
155 list1_idmerge(nm_l) = list1_idmerge(nm_l) + i*((2*nb_merge_node)**(list1_nbmerge(nm_l)-1))
156 ENDIF
157 ENDDO
158 ENDDO
159 ENDIF
160C
161C---- bluid list of destination - filled merge by merge
162 IF (all_vs_all == 1) THEN
163C-- all nodes are destination
164 DO i=1,numnod
165 list2(i) = i
166 list2_inv(i) = i
167 list2_nbmerge(i) = 1
168 list2_idmerge(i) = 1
169 ENDDO
170 ELSE
171C-- list filled merge by merge
172 nm = 0
173 DO i=1,nb_merge_node
174 gr_ids = merge_node_tab(2,i)
175 IF (merge_node_tab(1,i) == 1) THEN
176C-- Merge_type = 1 - destination is defined by the grnod
177 DO j=1,igrnod(gr_ids)%NENTITY
178 IF (list2_inv(igrnod(gr_ids)%ENTITY(j)) == 0) THEN
179C-- new point in list
180 nm = nm + 1
181 list2(nm) = igrnod(gr_ids)%ENTITY(j)
182 list2_inv(igrnod(gr_ids)%ENTITY(j)) = nm
183 list2_nbmerge(nm) = 1
184 list2_idmerge(nm) = i
185 ELSE
186C-- point already in list
187 nm_l = list2_inv(igrnod(gr_ids)%ENTITY(j))
188C-- coding of idmerge in case of several merge
189 list2_nbmerge(nm_l) = list2_nbmerge(nm_l) + 1
190 list2_idmerge(nm_l) = list2_idmerge(nm_l) + i*((2*nb_merge_node)**(list2_nbmerge(nm_l)-1))
191 ENDIF
192 ENDDO
193 ELSE
194C-- Merge_type = 2 - destination is all nodes outside of the grnod
195 iss = i+nb_merge_node
196 tagnod_temp(1:numnod) = 0
197 DO j=1,igrnod(gr_ids)%NENTITY
198 tagnod_temp(igrnod(gr_ids)%ENTITY(j)) = 1
199 ENDDO
200 DO j=1,numnod
201 IF (tagnod_temp(j)==0) THEN
202 IF (list2_inv(j) == 0) THEN
203C-- new point in list
204 nm = nm + 1
205 list2(nm) = j
206 list2_inv(j) = nm
207 list2_nbmerge(nm) = 1
208 list2_idmerge(nm) = iss
209 ELSE
210C-- point already in list
211 nm_l = list2_inv(j)
212C-- coding of idmerge in case of several merge
213 list2_nbmerge(nm_l) = list2_nbmerge(nm_l) + 1
214 list2_idmerge(nm_l) = list2_idmerge(nm_l) + iss*((2*nb_merge_node)**(list2_nbmerge(nm_l)-1))
215 ENDIF
216 ENDIF
217 ENDDO
218 ENDIF
219 ENDDO
220 ENDIF
221C
222 CALL merge_bucket_search(x,itab,itabm1,imerge0,merge_node_tol,
223 . dbuc,nn1,nn2,list1,list2,
224 . dist,flag,list1_idmerge,list1_nbmerge,list2_idmerge,
225 . list2_nbmerge)
226C
227C--------------------------------------------------------------------------
228C Remove merge of nodes of one element
229C--------------------------------------------------------------------------
230C
231 DO i= 1,nn1
232 IF (imerge0(i) > 0) THEN
233 n = list1(i)
234 n_dest = usrtos(imerge0(i),itabm1)
235C
236C--- Check of elements
237 flag = 0
238C------------------------> cas des coques <-----------------------C
239 DO j = knod2elc(n)+1,knod2elc(n+1)
240 DO k=2,5
241 IF (ixc(k,nod2elc(j)) == n_dest) flag = 1
242 ENDDO
243 ENDDO
244C------------------------> cas des coques triagnles <--------------C
245 DO j = knod2eltg(n)+1,knod2eltg(n+1)
246 DO k=2,4
247 IF (ixtg(k,nod2eltg(j)) == n_dest) flag = 1
248 ENDDO
249 ENDDO
250C------------------------> cas des solides <-----------------------C
251 DO j = knod2els(n)+1,knod2els(n+1)
252 cur_id = nod2els(j)
253 DO k=2,9
254 IF(ixs(k,nod2els(j)) == n_dest) flag = 1
255 ENDDO
256 IF (eani(cur_id)==10) THEN
257 DO k=1,6
258 IF(ixs10(k,cur_id-numels8) == n_dest) flag = 1
259 ENDDO
260 ELSEIF (eani(cur_id)==20) THEN
261 DO k=1,12
262 IF(ixs20(k,cur_id-numels8-numels10) == n_dest) flag = 1
263 ENDDO
264 ELSEIF (eani(cur_id)==16) THEN
265 DO k=1,8
266 IF(ixs16(k,cur_id-numels8-numels10-numels20) == n) flag = 1
267 ENDDO
268 ENDIF
269 END DO
270C------------------------> cas des elements 1D <-------------------C
271 DO j = knod2el1d(n)+1,knod2el1d(n+1)
272 cur_id = nod2el1d(j)
273 IF (cur_id <= numelt) THEN
274 DO k=2,3
275 IF (ixt(k,nod2el1d(j)) == n_dest) flag = 1
276 ENDDO
277 ELSEIF (cur_id <= numelt + numelp) THEN
278 DO k=2,4
279 IF (ixp(k,cur_id-numelt) == n_dest) flag = 1
280 ENDDO
281 ELSE
282 DO k=2,4
283 IF (ixr(k,cur_id-numelt-numelp) == n_dest) flag = 1
284 ENDDO
285 ENDIF
286 ENDDO
287C------------------------> cas des elements 1D inverse (pour 3e noeud )<---C
288 DO j = knod2el1d(n_dest)+1,knod2el1d(n_dest+1)
289 cur_id = nod2el1d(j)
290 IF (cur_id <= numelt) THEN
291 DO k=2,3
292 IF (ixt(k,nod2el1d(j)) == n) flag = 1
293 ENDDO
294 ELSEIF (cur_id <= numelt + numelp) THEN
295 DO k=2,4
296 IF (ixp(k,cur_id-numelt) == n) flag = 1
297 ENDDO
298 ELSE
299 DO k=2,4
300 IF (ixr(k,cur_id-numelt-numelp) == n) flag = 1
301 ENDDO
302 ENDIF
303 ENDDO
304C------------------------> cas des quad <-----------------------C
305 DO j = knod2elq(n)+1,knod2elq(n+1)
306 DO k=2,5
307 IF (ixq(k,nod2elq(j)) == n_dest) flag = 1
308 ENDDO
309 ENDDO
310C
311 IF (flag == 1) THEN
312C-- connection removed
313 imerge0(i) = 0
314 CALL ancmsg(msgid=2039,
315 . msgtype=msgwarning,
316 . anmode=aninfo_blind_1,
317 . i1=itab(n),i2=itab(n_dest),
318 . r1=dist(i),
319 . prmod=msg_cumu)
320 ENDIF
321C
322 ENDIF
323 ENDDO
324C
325 CALL ancmsg(msgid=2039,
326 . msgtype=msgwarning,
327 . anmode=aninfo_blind_1,
328 . prmod=msg_print )
329C
330C--------------------------------------------------------------------------
331C Ignore merge in case of hierarchy
332C--------------------------------------------------------------------------
333 DO i= 1,nn1
334 IF (imerge0(i) > 0) THEN
335 n = list1(i)
336 n_dest = usrtos(imerge0(i),itabm1)
337 IF (list1_inv(n_dest) > 0) THEN
338 IF (imerge0(list1_inv(n_dest)) > 0) THEN
339 n_dest_dest = usrtos(imerge0(list1_inv(n_dest)),itabm1)
340C-- hierarchy detected - the longest merge is removed
341 IF (dist(list1_inv(n_dest)) > dist(i)) THEN
342 imerge0(list1_inv(n_dest)) = 0
343 CALL ancmsg(msgid=2038,
344 . msgtype=msgwarning,
345 . anmode=aninfo_blind_1,
346 . i1=itab(n_dest),i2=itab(n_dest_dest),
347 . r1=dist(list1_inv(n_dest)),
348 . prmod=msg_cumu)
349C
350 ELSE
351 imerge0(i) = 0
352 CALL ancmsg(msgid=2038,
353 . msgtype=msgwarning,
354 . anmode=aninfo_blind_1,
355 . i1=itab(n),i2=itab(n_dest),
356 . r1=dist(i),
357 . prmod=msg_cumu)
358 ENDIF
359 ENDIF
360 ENDIF
361 ENDIF
362 ENDDO
363C
364 CALL ancmsg(msgid=2038,
365 . msgtype=msgwarning,
366 . anmode=aninfo_blind_1,
367 . prmod=msg_print )
368C
369C--------------------------------------------------------------------------
370C COMPACT IMERGE -> No systeme
371C--------------------------------------------------------------------------
372 nm = 0
373 DO i= 1,nn1
374 IF (imerge0(i) > 0) THEN
375 n = list1(i)
376 nm = nm+1
377 imerge(nmerge_tot+numcnod+nm) = usrtos(imerge0(i),itabm1)
378 imerge(numcnod+nm) = n
379 ENDIF
380 ENDDO
381 nmerged = nmerged + nm
382
383C--------------------------------------------------
384C TAB ID_NODE systeme -> ID_CNODE systeme (done from scratch even with cnodes)
385C--------------------------------------------------
386 IF (nmerged > 0) THEN
387 tagnod_temp(1:numnod) = 0
388 DO i = 1,nmerge_tot
389 IF (imerge(nmerge_tot+i) > 0) THEN
390 n = imerge(nmerge_tot+i)
391 tagnod_temp(n) = tagnod_temp(n) + 1
392 ENDIF
393 ENDDO
394 iadmerge2(1) = 1
395 iadmerge2tmp(1) = 1
396 DO i = 2,numnod+1
397 iadmerge2(i) = iadmerge2(i-1) + tagnod_temp(i-1)
398 iadmerge2tmp(i) = iadmerge2tmp(i-1) + tagnod_temp(i-1)
399 ENDDO
400 DO i = 1,nmerge_tot
401 IF (imerge(nmerge_tot+i) > 0) THEN
402 n = imerge(nmerge_tot+i)
403 imerge2(iadmerge2tmp(n)) = imerge(i)
404 iadmerge2tmp(n)=iadmerge2tmp(n)+1
405 ENDIF
406 ENDDO
407 ENDIF
408
409C--------------------------------------------------
410 IF (numcnod == 0) WRITE(iout,1000)
411 WRITE(iout,1001)
412C
413 j=0
414 DO n=1,nmerged,50
415 j=j+50
416 j=min(j,nmerged)
417 DO i=n,j
418 WRITE(iout,'(5X,I10,8X,I10)')
419 . itab(imerge(numcnod+i)),itab(imerge(numcnod+nmerge_tot+i))
420 ENDDO
421 ENDDO
422C--------
423 DEALLOCATE(imerge0,dist,list1,list2)
424 DEALLOCATE(list1_inv,list2_inv,iadmerge2tmp)
425 DEALLOCATE(list1_idmerge,list2_idmerge)
426 DEALLOCATE(list1_nbmerge,list2_nbmerge)
427 DEALLOCATE(tagnod_temp)
428C--------
429 RETURN
430C
4311000 FORMAT(/
432 . ' MERGE NODES '/
433 . ' --------------------------------------')
4341001 FORMAT(/
435 . ' NODE MERGED TO NODE '/)
436C
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
usrtosc
integer function usrtosc(iu, itabm1)
Definition merge.F:473
merge_bucket_search
subroutine merge_bucket_search(x, itab, itabm1, imerge0, cmerge, dbuc, nn1, nn2, list1, list2, ddd, flag, list1_idmerge, list1_nbmerge, list2_idmerge, list2_nbmerge)
Definition merge_bucket_search.F:38
groupdef_mod
Definition groupdef_mod.F:662
message_mod
Definition message_mod.F:1249
nod2el_mod
Definition nod2el_mod.F:36
nod2el_mod::knod2elc
integer, dimension(:), allocatable knod2elc
Definition nod2el_mod.F:58
nod2el_mod::knod2els
integer, dimension(:), allocatable knod2els
Definition nod2el_mod.F:58
nod2el_mod::knod2el1d
integer, dimension(:), allocatable knod2el1d
Definition nod2el_mod.F:58
nod2el_mod::nod2elq
integer, dimension(:), allocatable nod2elq
Definition nod2el_mod.F:58
nod2el_mod::nod2el1d
integer, dimension(:), allocatable nod2el1d
Definition nod2el_mod.F:58
nod2el_mod::nod2eltg
integer, dimension(:), allocatable nod2eltg
Definition nod2el_mod.F:58
nod2el_mod::nod2elc
integer, dimension(:), allocatable nod2elc
Definition nod2el_mod.F:58
nod2el_mod::nod2els
integer, dimension(:), allocatable nod2els
Definition nod2el_mod.F:58
nod2el_mod::knod2elq
integer, dimension(:), allocatable knod2elq
Definition nod2el_mod.F:58
nod2el_mod::knod2eltg
integer, dimension(:), allocatable knod2eltg
Definition nod2el_mod.F:58
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
usrtos
integer function usrtos(iu, itabm1)
Definition sysfus.F:255