OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rebuild_ig3d.F File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine rebuild_ig3d (ixig3d, kxig3d, dir, deg, degtang1, degtang2, knotlocpc, knotlocel, tab_elcut, l_tab_elcut, tab_newel, l_tab_newel, tab_fctcut, l_tab_fctcut, tab_remove, tab_newfct, el_connect, tabconpatch, idfils, flag_pre, flag_debug)

Function/Subroutine Documentation

◆ rebuild_ig3d()

subroutine rebuild_ig3d ( integer, dimension(*) ixig3d,
integer, dimension(nixig3d,*) kxig3d,
integer dir,
integer deg,
integer degtang1,
integer degtang2,
knotlocpc,
knotlocel,
integer, dimension(*) tab_elcut,
integer l_tab_elcut,
integer, dimension(*) tab_newel,
integer l_tab_newel,
integer, dimension(*) tab_fctcut,
integer l_tab_fctcut,
integer, dimension(*) tab_remove,
integer, dimension(*) tab_newfct,
integer, dimension(*) el_connect,
type(tabconpatch_ig3d_) tabconpatch,
integer, dimension(nbfilsmax,*) idfils,
integer flag_pre,
integer flag_debug )

Definition at line 30 of file rebuild_ig3d.F.

37C----------------------------------------------------------------------
38C ROUTINE QUI ENLEVE DES TABLES DE CONNECTIVITE LES POINTS SUPPRIMES
39C ET Y INSERE LES NOUVEAUX POINTS
40C LA ROUTINE NE REMET PAS CETTE CONNECTIVITE DANS LE BON ORDRE :
41C C'EST LE ROLE DE REORDER_IG3D.F
42C----------------------------------------------------------------------
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE meshsurfig3d_mod
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "com04_c.inc"
55#include "param_c.inc"
56#include "ige3d_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER IXIG3D(*),KXIG3D(NIXIG3D,*),TAB_NEWFCT(*),TAB_REMOVE(*),
61 . TAB_ELCUT(*),TAB_NEWEL(*),
62 . TAB_FCTCUT(*),EL_CONNECT(*),
63 . IDFILS(NBFILSMAX,*)
64 TYPE(TABCONPATCH_IG3D_) TABCONPATCH
65 INTEGER L_TAB_FCTCUT,L_TAB_NEWEL,L_TAB_ELCUT,
66 . DEG,DEGTANG1,DEGTANG2,DIR,FLAG_PRE,FLAG_DEBUG
67 my_real knotlocpc(deg_max,3,*),knotlocel(2,3,*)
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER I,J,K,L,IAD_IXIG3D,OFFSET_KNOT,DIRTANG1,DIRTANG2,
72 . INCTRL,IOUT,DECALGEO,ITNCTRL,IEL,JEL,ITFILS
73 my_real tol
74C=======================================================================
75c
76 tol = em06
77c
78 IF(dir==1) THEN
79 dirtang1 = 2
80 dirtang2 = 3
81 ELSEIF(dir==2) THEN
82 dirtang1 = 3
83 dirtang2 = 1
84 ELSEIF(dir==3) THEN
85 dirtang1 = 1
86 dirtang2 = 2
87 ENDIF
88cc
89CC----------------------------------------------------------------------------------------------
90cc SUPPRESSION DES FONCTIONS RAFFINEES DES TABLES DE CONNECTIVITE DES ELEMENTS DU PATCH
91cc ET DES FILS QU'ON RAFFINE : 0 A LA PLACE
92CC----------------------------------------------------------------------------------------------
93cc
94 DO i= 1,l_tab_fctcut
95 inctrl=tab_fctcut(i)
96 DO j=1,tabconpatch%L_TAB_IG3D
97 iel=tabconpatch%TAB_IG3D(j)
98 DO itnctrl=1,kxig3d(3,iel)
99 IF(ixig3d(kxig3d(4,iel)+itnctrl-1)==inctrl) THEN
100 ixig3d(kxig3d(4,iel)+itnctrl-1) = 0
101 ENDIF
102 ENDDO
103 DO k=1,idfils(1,iel)
104 jel=idfils(k+1,iel)
105 DO itnctrl=1,kxig3d(3,jel)
106 IF(ixig3d(kxig3d(4,jel)+itnctrl-1)==inctrl) THEN
107 ixig3d(kxig3d(4,jel)+itnctrl-1) = 0
108 ENDIF
109 ENDDO
110 ENDDO
111 ENDDO
112 ENDDO
113cc
114CC----------------------------------------------------------------------------------------------
115cc TRAITEMENT DES TABLES DE CONNECTIVITES DES ELEMENTS DU PATCH :
116cc RAJOUT DES NOUVELLES FONCTIONS CREES PAR LE RAFFINEMENT
117cc NB : POURRAIT ETRE LARGEMENT AMELIORE (BOUCLES DO WHILE)
118CC----------------------------------------------------------------------------------------------
119cc
120 DO i=1,tabconpatch%L_TAB_IG3D
121 iel=tabconpatch%TAB_IG3D(i)
122 j=1
123 k=offset_newfct
124 decalgeo=(tabconpatch%PID-1)*(numnod+nbnewx_tmp)
125 DO WHILE(j<=kxig3d(3,iel))
126 DO WHILE (ixig3d(kxig3d(4,iel)+j-1)==0.AND.j<=kxig3d(3,iel))
127 DO WHILE (ixig3d(kxig3d(4,iel)+j-1)==0.AND.k<=l_tab_newfct-1)
128c
129 el_connect(iel)=1 ! On devra reactualiser la table de connectivite de cet element
130c
1311000 k=k+1
132c IF(K>L_TAB_NEWFCT) CYCLE ! permet de securiser la boucle
133 inctrl = tab_newfct(k)
134 DO l=1,l_tab_remove
135 IF(tab_remove(l)==inctrl) GOTO 1000
136 ENDDO
137 DO l=1,kxig3d(3,iel)
138 IF(ixig3d(kxig3d(4,iel)+l-1)==inctrl) GOTO 1000
139 ENDDO
140c
141 IF(knotlocel(1,dir,iel)<(knotlocpc(1,dir,decalgeo+inctrl)-tol).OR.
142 . knotlocel(2,dir,iel)>(knotlocpc(deg+1,dir,decalgeo+inctrl)+tol)) cycle
143 IF(knotlocel(1,dirtang1,iel)<(knotlocpc(1,dirtang1,decalgeo+inctrl)-tol).OR.
144 . knotlocel(2,dirtang1,iel)>(knotlocpc(degtang1+1,dirtang1,decalgeo+inctrl)+tol)) cycle
145 IF(knotlocel(1,dirtang2,iel)<(knotlocpc(1,dirtang2,decalgeo+inctrl)-tol).OR.
146 . knotlocel(2,dirtang2,iel)>(knotlocpc(degtang2+1,dirtang2,decalgeo+inctrl)+tol)) cycle
147 ixig3d(kxig3d(4,iel)+j-1) = inctrl
148 ENDDO
149 j=j+1
150 ENDDO
151 j=j+1
152 ENDDO
153cc
154CC----------------------------------------------------------------------------------------------
155cc TRAITEMENT SIMILAIRE DES FILS DE CES ELEMENTS (ON POURRAIT COMPACTER LES TWO ENSEMBLES EN ONE)
156CC----------------------------------------------------------------------------------------------
157cc
158 DO itfils=1,idfils(1,iel)
159 jel=idfils(itfils+1,iel)
160 j=1
161 k=offset_newfct
162 decalgeo=(tabconpatch%PID-1)*(numnod+nbnewx_tmp)
163 DO WHILE(j<=kxig3d(3,jel))
164 DO WHILE (ixig3d(kxig3d(4,jel)+j-1)==0.AND.j<=kxig3d(3,jel))
165 DO WHILE (ixig3d(kxig3d(4,jel)+j-1)==0.AND.k<=l_tab_newfct-1)
166c
167 el_connect(jel)=1 ! On devra reactualiser la table de connectivite de cet element
168c
1692000 k=k+1
170c IF(K>L_TAB_NEWFCT) CYCLE ! permet de securiser la boucle
171 inctrl = tab_newfct(k)
172 DO l=1,l_tab_remove
173 IF(tab_remove(l)==inctrl) GOTO 2000
174 ENDDO
175 DO l=1,kxig3d(3,jel)
176 IF(ixig3d(kxig3d(4,jel)+l-1)==inctrl) GOTO 2000
177 ENDDO
178c
179 IF(knotlocel(1,dir,jel)<(knotlocpc(1,dir,decalgeo+inctrl)-tol).OR.
180 . knotlocel(2,dir,jel)>(knotlocpc(deg+1,dir,decalgeo+inctrl)+tol)) cycle
181 IF(knotlocel(1,dirtang1,jel)<(knotlocpc(1,dirtang1,decalgeo+inctrl)-tol).OR.
182 . knotlocel(2,dirtang1,jel)>(knotlocpc(degtang1+1,dirtang1,decalgeo+inctrl)+tol)) cycle
183 IF(knotlocel(1,dirtang2,jel)<(knotlocpc(1,dirtang2,decalgeo+inctrl)-tol).OR.
184 . knotlocel(2,dirtang2,jel)>(knotlocpc(degtang2+1,dirtang2,decalgeo+inctrl)+tol)) cycle
185 ixig3d(kxig3d(4,jel)+j-1) = inctrl
186 ENDDO
187 j=j+1
188 ENDDO
189 j=j+1
190 ENDDO
191 ENDDO
192 ENDDO
193cc
194CC----------------------------------------------------------------------------------------------
195cc VERIFICATION QU'IL N'Y AIT PLUS DE 0 DANS LA TABLE DE CONNECTIVITE
196cc SINON C'EST QUE LE RAFFINEMENT N'EST PAS CORRECT (RISQUE DE SURNOMBRE
197cc DE FONCTIONS PAR ELEMENT)
198CC----------------------------------------------------------------------------------------------
199cc
200 IF(flag_debug==1) THEN
201 DO i=1,sixig3d+addsixig3d
202 IF(ixig3d(i)==0) print*,'IL Y A ONE ZERO', ixig3d(i), i
203 ENDDO
204 ENDIF
205c
206 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
meshsurfig3d_mod
Definition meshsurfig3d_mod.F:33