OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
merge_cnod_cnod.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| merge_cnod_cnod ../starter/source/model/submodel/merge_cnod_cnod.F
25!||--- called by ------------------------------------------------------
26!|| merge ../starter/source/model/submodel/merge.F
27!||--- calls -----------------------------------------------------
28!|| usrtos ../starter/source/system/sysfus.F
29!|| usrtosc ../starter/source/model/submodel/merge.F
30!||--- uses -----------------------------------------------------
31!|| message_mod ../starter/share/message_module/message_mod.F
32!||====================================================================
33 SUBROUTINE merge_cnod_cnod(X ,ITAB ,ITABM1 ,CMERGE ,IMERGE,
34 . IMERGE2,IADMERGE2,IMERGE0,NMERGE_TOT)
35 USE message_mod
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C G l o b a l P a r a m e t e r s
42C-----------------------------------------------
43#include "units_c.inc"
44#include "com04_c.inc"
45#include "titr_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER ITAB(NUMNOD), ITABM1(2*NUMNOD),IMERGE(*),
50 . imerge2(numnod+1),iadmerge2(numnod+1),imerge0(numcnod),nmerge_tot
51 TARGET itab
52 my_real
53 . x(3,numnod),cmerge(*)
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 INTEGER I,J,K,M,N,I1,IB,IG,JG,J1,JK,KK,KP,N1,N2,NC,NS,NN,NM,
58 . ibz1,ibz,iby1,iby,ibx1,ibx,ks,numnod1,numcnod1,
59 . nbox,nboy,nboz,nbx,nby,nbz,nband,iboite,nmerged_old
60C
61 INTEGER
62 . nobx(numnod),noby(numnod),nobz(numnod),
63 . nobcx(numcnod),nobcy(numcnod),nobcz(numcnod),
64 . lbuf(numnod),iadmerge2tmp(numnod+1)
65C
66 INTEGER, DIMENSION(:),POINTER :: ITABC
67 INTEGER, DIMENSION(:),ALLOCATABLE ::
68 . npx,ipx,npy,ipy,npz,ipz,npcx,ipcx,npcy,ipcy,npcz,ipcz,
69 . imergetmp
70C
71 my_real
72 . xi, yi, zi, xj, yj, zj, dk,
73 . dist2,dvois,dbuc,eps,xmin,xmax,ymin,ymax,zmin,
74 . zmax,dmx,dmy,dmz,dmerge,ddd(numcnod)
75C-----------------------------------------------
76 INTEGER
77 . usrtos,usrtosc
78 EXTERNAL usrtos,usrtosc
79C=======================================================================
80C=======================================================================
81C=======================================================================
82! CNODE to CNODE (for the remaining unmerged CNODE)
83C=======================================================================
84C=======================================================================
85C=======================================================================
86!
87!---
88 IF (numcnod <= 1) RETURN
89!---
90 numnod1 = numnod0-numcnod
91 itabc => itab(numnod1+1:numnod0)
92 dbuc = zero
93 DO n=1,numcnod
94 nn = usrtosc(itabc(n),itabm1)
95 dbuc = max(dbuc,cmerge(n))
96 ENDDO
97!
98 dbuc = two*dbuc
99 eps = em3*dbuc
100 xmin = ep30
101 xmax =-ep30
102 ymin = ep30
103 ymax =-ep30
104 zmin = ep30
105 zmax =-ep30
106!
107 DO n=1,numcnod
108 nn = usrtosc(itabc(n),itabm1)
109 xmin= min(xmin,x(1,nn))
110 ymin= min(ymin,x(2,nn))
111 zmin= min(zmin,x(3,nn))
112 xmax= max(xmax,x(1,nn))
113 ymax= max(ymax,x(2,nn))
114 zmax= max(zmax,x(3,nn))
115 ENDDO
116!
117 xmin=xmin-eps
118 ymin=ymin-eps
119 zmin=zmin-eps
120 xmax=xmax+eps
121 ymax=ymax+eps
122 zmax=zmax+eps
123!
124 dmx=xmax-xmin
125 dmy=ymax-ymin
126 dmz=zmax-zmin
127!
128 nbx =max(1,int(dmx/dbuc))
129 nby =max(1,int(dmy/dbuc))
130 nbz =max(1,int(dmz/dbuc))
131!
132 DO n=1,numcnod
133 nn = usrtosc(itabc(n),itabm1)
134 nobx(n) = (x(1,nn)-xmin)/dbuc
135 noby(n) = (x(2,nn)-ymin)/dbuc
136 nobz(n) = (x(3,nn)-zmin)/dbuc
137 ENDDO
138!-------
139 DO n=1,numcnod
140 nn = usrtosc(itabc(n),itabm1)
141 nobcx(n) = (x(1,nn)-xmin)/dbuc
142 nobcy(n) = (x(2,nn)-ymin)/dbuc
143 nobcz(n) = (x(3,nn)-zmin)/dbuc
144 ENDDO
145C
146 nband = max(nbx, nby,nbz) + 1
147C
148 ALLOCATE(npx(0:numcnod+nband) , npy(0:3*(numcnod+nband)),
149 . npz(0:9*(numcnod+nband)) , ipx(numcnod+nband) ,
150 . ipy(numcnod+nband) , ipz(numcnod+nband) ,
151 . npcx(0:numcnod+nband) , npcy(0:numcnod+nband) ,
152 . npcz(0:numcnod+nband) , ipcx(numcnod+nband) ,
153 . ipcy(numcnod+nband) , ipcz(numcnod+nband) ,
154 . imergetmp(numcnod))
155!
156 npx(0:numcnod+nband) = 0
157 npy(0:3*(numcnod+nband)) = 0
158 npz(0:9*(numcnod+nband)) = 0
159 ipx(numcnod+nband) = 0
160 ipy(numcnod+nband) = 0
161 ipz(numcnod+nband) = 0
162 npcx(0:numcnod+nband) = 0
163 npcy(0:numcnod+nband) = 0
164 npcz(0:numcnod+nband) = 0
165 ipcx(numcnod+nband) = 0
166 ipcy(numcnod+nband) = 0
167 ipcz(numcnod+nband) = 0
168 imergetmp(1:numcnod) = 0
169C--------------------------------------------------
170C CLASSEMENT DES BUCKETS X
171C--------------------------------------------------
172C
173C--- bande NBX uniquement.
174C
175 DO ib=0,nbx+1
176 npx(ib)=0
177 ENDDO
178!
179 DO n=1,numcnod
180 nbox=nobx(n)+1
181 IF(nbox >= 1.AND.nbox <= nbx+1)THEN
182 npx(nbox)=npx(nbox)+1
183 ENDIF
184 ENDDO
185 DO ib=1,nbx+1
186 npx(ib)=npx(ib)+npx(ib-1)
187 ENDDO
188 DO ib=nbx+1,1,-1
189 npx(ib)=npx(ib-1)
190 ENDDO
191!
192 DO n=1,numcnod
193 nbox=nobx(n)+1
194C bande NBX uniquement.
195 IF(nbox >= 1.AND.nbox <= nbx+1)THEN
196 npx(nbox)=npx(nbox)+1
197 ipx(npx(nbox))=n
198 ENDIF
199 ENDDO
200C
201C Cnode bande nbx
202C
203 DO ib=0,nbx+1
204 npcx(ib)=0
205 ENDDO
206 DO n=1,numcnod
207 nbox=nobcx(n)+1
208 IF(nbox >= 1.AND.nbox <= nbx+1)THEN
209 npcx(nbox)=npcx(nbox)+1
210 ENDIF
211 ENDDO
212 DO ib=1,nbx+1
213 npcx(ib)=npcx(ib)+npcx(ib-1)
214 ENDDO
215 DO ib=nbx+1,1,-1
216 npcx(ib)=npcx(ib-1)
217 ENDDO
218 DO n=1,numcnod
219 nbox=nobcx(n)+1
220C bande NBX uniquement.
221 IF(nbox >= 1.AND.nbox <= nbx+1)THEN
222 npcx(nbox)=npcx(nbox)+1
223 ipcx(npcx(nbox))=n
224 ENDIF
225 ENDDO
226C-----
227 DO ibx=1,nbx+1
228 iboite = 0
229 DO kp= npcx(ibx-1)+1,npcx(ibx)
230 IF(ipcx(kp)> 0)iboite =1
231 ENDDO
232C
233 IF(iboite > 0) THEN
234 DO iby=0,nby+1
235 npy(iby)=0
236 ENDDO
237 DO ks=npx(max(ibx-2,0))+1,npx(min(ibx+1,nbx+1))
238 n =ipx(ks)
239 nboy=noby(n)+1
240C bande NBY uniquement.
241 IF(nboy >= 1 .AND. nboy <= nby+1)THEN
242 npy(nboy)=npy(nboy)+1
243 ENDIF
244 ENDDO
245 DO iby=1,nby+1
246 npy(iby)=npy(iby)+npy(iby-1)
247 ENDDO
248 DO iby=nby+1,1,-1
249 npy(iby)=npy(iby-1)
250 ENDDO
251 DO ks=npx(max(ibx-2,0))+1,npx(min(ibx+1,nbx+1))
252 n =ipx(ks)
253 nboy=noby(n)+1
254C bande NBY uniquement.
255 IF(nboy >= 1 .AND. nboy <= nby+1)THEN
256 npy(nboy)=npy(nboy)+1
257 ipy(npy(nboy))=n
258 ENDIF
259 ENDDO
260C
261C Cnode Bande Y
262C
263 DO iby=0,nby+1
264 npcy(iby)=0
265 ENDDO
266 DO ks=npcx(ibx-1)+1,npcx(ibx)
267 n =ipcx(ks)
268 nboy=nobcy(n)+1
269C bande NBY uniquement.
270 IF(nboy >= 1.AND.nboy <= nby+1)THEN
271 npcy(nboy)=npcy(nboy)+1
272 ENDIF
273 ENDDO
274C
275 DO iby=1,nby+1
276 npcy(iby)=npcy(iby)+npcy(iby-1)
277 ENDDO
278C
279 DO iby=nby+1,1,-1
280 npcy(iby)=npcy(iby-1)
281 ENDDO
282 DO ks=npcx(ibx-1)+1,npcx(ibx)
283 n =ipcx(ks)
284 nboy=nobcy(n)+1
285C bande NBY uniquement.
286 IF(nboy >= 1.AND. nboy <= nby+1)THEN
287 npcy(nboy)=npcy(nboy)+1
288 ipcy(npcy(nboy))=n
289 ENDIF
290 ENDDO
291C
292C -- les boites suivantes z
293C
294 DO iby=1,nby+1
295 iboite = 0
296 DO kp= npcy(iby-1)+1,npcy(iby)
297 IF(ipcy(kp) > 0)iboite = 1
298 ENDDO
299C
300 IF(iboite > 0) THEN
301 DO ibz=0,nbz+1
302 npz(ibz)=0
303 ENDDO
304 DO ks=npy(max(iby-2,0))+1,npy(min(iby+1, nby+1))
305 n =ipy(ks)
306 nboz=nobz(n)+1
307C bande NBZ uniquement.
308 IF(nboz >= 1.AND.nboz <= nbz+1)THEN
309 npz(nboz)=npz(nboz)+1
310 ENDIF
311 ENDDO
312 DO ibz=1,nbz+1
313 npz(ibz)=npz(ibz)+npz(ibz-1)
314 ENDDO
315 DO ibz=nbz+1,1,-1
316 npz(ibz)=npz(ibz-1)
317 ENDDO
318 DO ks=npy(max(iby-2,0))+1,npy(min(iby+1, nby+1))
319 n =ipy(ks)
320 nboz=nobz(n)+1
321C bande NBZ uniquement.
322 IF(nboz >= 1 .AND. nboz <= nbz+1)THEN
323 npz(nboz)=npz(nboz)+1
324 ipz(npz(nboz))=n
325 ENDIF
326 ENDDO
327C
328C Cnode Bande Z
329C
330 DO ibz=0,nbz+1
331 npcz(ibz)=0
332 ENDDO
333 DO ks=npcy(iby-1)+1,npcy(iby)
334 n =ipcy(ks)
335 nboz=nobcz(n)+1
336 IF(nboz >= 1.AND.nboz <= nbz+1)THEN
337 npcz(nboz)=npcz(nboz)+1
338 ENDIF
339 ENDDO
340 DO ibz=1,nbz+1
341 npcz(ibz)=npcz(ibz)+npcz(ibz-1)
342 ENDDO
343 DO ibz=nbz+1,1,-1
344 npcz(ibz)=npcz(ibz-1)
345 ENDDO
346 DO ks=npcy(iby-1)+1,npcy(iby)
347 n =ipcy(ks)
348 nboz=nobcz(n)+1
349 IF(nboz >= 1.AND. nboz <= nbz+1)THEN
350 npcz(nboz)=npcz(nboz)+1
351 ipcz(npcz(nboz))=n
352 ENDIF
353 ENDDO
354C
355C ---recherche cnode par boite tt d'abord
356C
357 DO ibz=1,nbz+1
358 DO kp= npcz(ibz-1)+1,npcz(ibz)
359 nc =ipcz(kp)
360 IF (nc > 0) THEN
361 DO ks=npz(max(ibz-2,0))+1,npz(min(ibz+1,nbz+1))
362 ns =ipz(ks)
363!---
364 IF (nc /= ns .AND. (imergetmp(nc) == 0 .and.
365 . imergetmp(ns) == 0)) THEN
366!---
367 ig = usrtosc(itabc(nc),itabm1)
368 xi =x(1,ig)
369 yi =x(2,ig)
370 zi =x(3,ig)
371 dmerge = cmerge(nc)*cmerge(nc)
372 jg=usrtosc(itabc(ns),itabm1) ! target
373 xj =(x(1,jg)-xi)
374 yj =(x(2,jg)-yi)
375 zj =(x(3,jg)-zi)
376 dist2=xj**2 + yj**2 + zj**2
377 ddd(nc) = dist2
378 IF(itabc(nc)/=itabc(ns).AND.dist2<=dmerge)THEN
379 IF(imergetmp(nc) == 0) THEN
380 imergetmp(nc) = itabc(ns)
381 dvois = dist2
382 ddd(nc) = dist2
383 ELSEIF(dist2 < dvois)THEN
384 imergetmp(nc) = itabc(ns)
385 dvois = dist2
386 ddd(nc) = dist2
387 ENDIF
388 ENDIF
389!---
390 ENDIF ! if (NC /= NS) then
391!---
392 ENDDO
393 ENDIF
394 ENDDO
395 ENDDO ! DO IBZ=1,NBZ+1
396!
397 ENDIF ! IF(IBOITE > 0) - Y -
398 ENDDO ! DO IBY=1,NBY+1
399 ENDIF ! IF(IBOITE > 0) - X -
400 ENDDO ! DO IBX=1,NBX+1
401!---
402C--------------------------------------------------
403C COMPACT IMERGE -> No systeme
404C--------------------------------------------------
405 nmerged_old = nmerged
406 nm = nmerged_old
407!
408 DO i= 1,numcnod
409 IF (imergetmp(i) > 0 .AND. imerge0(i) == 0) THEN
410 nm = nm+1
411 imerge(nmerge_tot+nm) = usrtosc(imergetmp(i),itabm1)
412 imerge(nm) = usrtosc(itabc(i) ,itabm1)
413! ELSE IF (IMERGETMP(I) == 0 .AND. IMERGE0(I) == 0) THEN
414! CALL ANCMSG(MSGID=1587,
415! . MSGTYPE=MSGWARNING,
416! . ANMODE=ANINFO_BLIND_1,
417! . I1=ITABC(I))
418 ENDIF
419 ENDDO
420 nmerged = nm
421C--------------------------------------------------
422C TAB ID_NODE systeme -> ID_CNODE systeme
423C--------------------------------------------------
424 IF (nmerged - nmerged_old > 0) THEN
425 lbuf = 0
426 DO i = 1,numcnod
427 IF (imerge(nmerge_tot+i) > 0) THEN
428 n = imerge(nmerge_tot+i)
429 lbuf(n) = lbuf(n) + 1
430 ENDIF
431 ENDDO
432!
433!! IADMERGE2(1) = 1 ! --- already done merge.F
434 iadmerge2tmp(1) = 1
435 DO i = 2,numnod+1
436!! IADMERGE2(I) = IADMERGE2(I-1) + LBUF(I-1) ! --- already done merge.F
437 iadmerge2tmp(i) = iadmerge2tmp(i-1) + lbuf(i-1)
438 ENDDO
439!
440 DO i = nmerged_old+1,numcnod
441 IF (imerge(nmerge_tot+i) > 0) THEN
442 n = imerge(nmerge_tot+i)
443 imerge2(iadmerge2tmp(n)) = imerge(i)
444 iadmerge2tmp(n)=iadmerge2tmp(n)+1
445 ENDIF
446 ENDDO
447 ENDIF
448C--------------------------------------------------
449 WRITE(iout,'(//A/A//A/)')titre(207),titre(115),titre(208)
450!
451 j=nmerged_old
452 DO n=nmerged_old+1,nmerged,50
453 j=j+50
454 j=min(j,nmerged)
455 DO i=n,j
456 WRITE(iout,'(5X,I10,8X,I10)')
457 . itab(imerge(i)),itab(imerge(nmerge_tot+i))
458 ENDDO
459 ENDDO
460 !
461 ! print out the list of all CNODE, not merged, but finally transformed
462 ! into NODE
463!
464 WRITE(iout,'(//A/A//A/)')titre(209),titre(115),titre(210)
465!
466 DO i= 1,numcnod
467 IF (imergetmp(i) == 0 .AND. imerge0(i) == 0) THEN
468 WRITE(iout,'(5X,I10)') itabc(i)
469 ENDIF
470 ENDDO
471C--------
472 DEALLOCATE(npx ,npy ,npz ,ipx ,ipy ,ipz ,
473 . npcx ,npcy ,npcz ,ipcx ,ipcy ,ipcz ,
474 . imergetmp)
475C--------
476 RETURN
477 END
my_real
#define my_real
Definition cppsort.cpp:32
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:272
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_cnod_cnod
subroutine merge_cnod_cnod(x, itab, itabm1, cmerge, imerge, imerge2, iadmerge2, imerge0, nmerge_tot)
Definition merge_cnod_cnod.F:35
message_mod
Definition message_mod.F:1249
usrtos
integer function usrtos(iu, itabm1)
Definition sysfus.F:255