OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rebuild_ig3d.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!|| rebuild_ig3d ../starter/source/elements/ige3d/rebuild_ig3d.F
25!||--- called by ------------------------------------------------------
26!|| prerafig3d ../starter/source/elements/ige3d/prerafig3d.F
27!||--- uses -----------------------------------------------------
28!|| meshsurfig3d_mod ../starter/source/elements/ige3d/meshsurfig3d_mod.f
29!||====================================================================
30 SUBROUTINE rebuild_ig3d(IXIG3D, KXIG3D,DIR,DEG,DEGTANG1,
31 . DEGTANG2,KNOTLOCPC,KNOTLOCEL,
32 . TAB_ELCUT,L_TAB_ELCUT,
33 . TAB_NEWEL,L_TAB_NEWEL,
34 . TAB_FCTCUT,L_TAB_FCTCUT,
35 . TAB_REMOVE,TAB_NEWFCT,EL_CONNECT,
36 . TABCONPATCH,IDFILS,FLAG_PRE,FLAG_DEBUG)
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
207 END
208
209
my_real
#define my_real
Definition cppsort.cpp:32
meshsurfig3d_mod
Definition meshsurfig3d_mod.F:33
rebuild_ig3d
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)
Definition rebuild_ig3d.F:37
starter
program starter
Definition starter.F:39