OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
prerafig3d.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!|| prerafig3d ../starter/source/elements/ige3d/prerafig3d.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!|| nbadigemesh ../starter/source/elements/ige3d/nbadigemesh.F
28!||--- calls -----------------------------------------------------
29!|| comput_coinknot ../starter/source/elements/ige3d/comput_coinknot.F
30!|| comput_mesh_neighbour ../starter/source/elements/ige3d/comput_mesh_neighbour.F
31!|| find_newknot ../starter/source/elements/ige3d/find_newknot.F
32!|| rafig3d ../starter/source/elements/ige3d/rafig3d.F
33!|| rebuild_ig3d ../starter/source/elements/ige3d/rebuild_ig3d.F
34!|| reorder_ig3d ../starter/source/elements/ige3d/reorder_ig3d.F
35!|| test_support_fct ../starter/source/elements/ige3d/test_support_fct.F
36!|| test_support_newfct ../starter/source/elements/ige3d/test_support_newfct.F
37!||--- uses -----------------------------------------------------
38!|| meshsurfig3d_mod ../starter/source/elements/ige3d/meshsurfig3d_mod.F
39!||====================================================================
40 SUBROUTINE prerafig3d(KNOT,KNOTLOCPC,KNOTLOCEL,KXIG3D,IXIG3D,
41 . IGEO,IPARTIG3D,X ,V ,D ,
42 . MS ,WIGE ,TABCONPATCH,FLAG_PRE)
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,*),IGEO(NPROPGI,*),
61 . IPARTIG3D(*)
62 INTEGER FLAG_PRE
63 TYPE(TABCONPATCH_IG3D_), DIMENSION(*) :: TABCONPATCH
64 my_real knot(*),knotlocpc(deg_max,3,*),knotlocel(2,3,*)
65 my_real x(*),v(*),d(*),ms(*),wige(*)
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 TYPE(meshsurfig3d_), DIMENSION(:), ALLOCATABLE, TARGET :: MESHSURF
70 TYPE(MESHSURFIG3D_), POINTER :: PMESHSURF, P2MESHSURF
71 INTEGER I,J,K,L,M,N,P,ITNCTRL,INCTRL,ITKSI,ITETA,ITZETA,
72 . ipid,iad_knot,ittest,itel,offset_knot,
73 . px,py,pz,idx,idy,idz,iel,
74 . n1,n2,n3,nknot1,nknot2,nknot3,nelx,nely,nelz,
75 . dir,decalgeo_tmp,decalgeofinal,nbcut,idnbcut,
76 . idknot1,idknot2,pdir,ptang1,ptang2,
77 . neldir,neltang1,neltang2,
78 . p2dir,p2tang1,p2tang2,l_tab_newfctcut,itpatch,
79 . nbpatch_ig3d,flag_debug
80 my_real, DIMENSION(:), ALLOCATABLE :: gama
81C-----------------------------------------------
82C TABLEAUX DE REPRESENTATION DE LA STRUCTURE ELEMENTAIRE DES PATCHS
83C-----------------------------------------------
84 INTEGER, DIMENSION(:,:,:), POINTER :: MESHIGE
85 INTEGER, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: MESHIGEX,MESHIGEY,MESHIGEZ
86 INTEGER, DIMENSION(:), ALLOCATABLE, TARGET :: IDXEL,IDYEL,IDZEL
87 INTEGER, DIMENSION(:), POINTER :: IDDIR,IDTANG1,IDTANG2
88C-----------------------------------------------
89C TABLEAUX DE TRAVAIL
90C-----------------------------------------------
91 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IDFILS,TAB_INITIAL_CUT
92 INTEGER, DIMENSION(:), ALLOCATABLE :: TAB_REMOVE,TAB_STAY,TAB_NEWFCT,
93 . tab_newfctcut,el_connect
94C-----------------------------------------------
95C ARGUMENTS UTILISES NON PAS DANS CONTRL.F, MAIS DANS LECTUR.F
96C-----------------------------------------------
97 my_real, DIMENSION(:), ALLOCATABLE :: x_tmp,v_tmp,d_tmp,ms_tmp,wige_tmp
98C=======================================================================
99 flag_debug=0
100c ------------------------------------------------------------------------------------------
101C DEFINITION DES TAILLES DES TABLEAUX DE TRAVAIL EN FONCTION DU NOMBRE D'ELEMENTS
102C AJOUTES, DU NOMBRE ESTIME DE FONCTION AJOUTES DANS ONE PREMIER TEMPS
103C PUIS AUX TAILLES EXACTES NECESSAIRES DANS ONE SECOND TEMPS
104c ------------------------------------------------------------------------------------------
105c
106 IF(flag_pre==0) THEN
107 nbnewx_tmp = addelig3d*20 ! nombre de points qu'on s'accord en decalage pour le travail (pour le multipatch) ! le definir en fonction du nombre total de point
108c
109 ALLOCATE (tab_initial_cut(3,numelig3d0))
110 ALLOCATE (idfils(nbfilsmax,numelig3d0))
111 ALLOCATE (tab_remove(addelig3d*27)) ! DEVRAIT TENIR EN COMPTE DU NOMBRE D'ELEMENT DE BASE ET DU NOMBRE D'ELEMENT AJOUTES
112 ALLOCATE (tab_stay(nint(addelig3d*27*0.5))) ! DEVRAIT TENIR EN COMPTE DU NOMBRE D'ELEMENT DE BASE ET DU NOMBRE D'ELEMENT AJOUTES
113 ALLOCATE (tab_newfct(nint(addelig3d*27*1.2))) ! POURRAIENT TRE MIEUX DIMENSIONNES
114 ALLOCATE (meshsurf(nbmeshsurf))
115 ALLOCATE (gama(numnodige0+2*addelig3d*27))
116 ELSE
117 nbnewx_tmp = l_tab_newfct ! pour la longueur de travail et le calcul de decalgeo_tmp
118 ALLOCATE (tab_initial_cut(3,numelig3d))
119 ALLOCATE (idfils(nbfilsmax,numelig3d))
120 ALLOCATE (tab_remove(l_tab_remove))
121 ALLOCATE (tab_stay(l_tab_stay))
122 ALLOCATE (tab_newfct(l_tab_newfct))
123 ALLOCATE (meshsurf(nbmeshsurf))
124 ALLOCATE (x_tmp(3*(numnodige0+l_tab_newfct)))
125 ALLOCATE (d_tmp(3*(numnodige0+l_tab_newfct)))
126 ALLOCATE (v_tmp(3*(numnodige0+l_tab_newfct)))
127 ALLOCATE (ms_tmp(numnodige0+l_tab_newfct))
128 ALLOCATE (wige_tmp(numnodige0+l_tab_newfct))
129 ALLOCATE (gama(numnodige0+l_tab_newfct))
130 DO i=1,numnodige0
131 DO j=1,3
132 x_tmp((i-1)*3+j) = x((i-1)*3+j)
133 v_tmp((i-1)*3+j) = v((i-1)*3+j)
134 d_tmp((i-1)*3+j) = d((i-1)*3+j)
135 ENDDO
136 ms_tmp(i) = ms(i)
137 wige_tmp(i) = wige(i)
138 ENDDO
139 DO i=numnodige0+1,numnodige0+l_tab_newfct
140 DO j=1,3
141 x_tmp((i-1)*3+j) = 0
142 v_tmp((i-1)*3+j) = 0
143 d_tmp((i-1)*3+j) = 0
144 ENDDO
145 ms_tmp(i) = 0
146 wige_tmp(i) = 0
147 ENDDO
148 ENDIF
149 ALLOCATE (el_connect(numelig3d0+addelig3d)) ! TABLEAU QUI CONTIENT ONE FLAG POUR LES ELEMENTS QUI ONT ETE MODIFIES
150 el_connect(:)=0
151
152ccc ATTENTION, S'IL Y A DES ELEMENTS CLASSIQUES ET DES ELEMENT ISOGEOMETRIQUES, IL VA Y AVOIR ONE SOUCIS
153CC IL FAUT DONC FAIRE ONE EL_CONNECT DANS LA STRUCTURE TABCONPATCH ET REFAIRE LES TABLES DE CONNECTIVITE PAR PATCH
154c
155c ------------------------------------------------------------------------------------------
156C INITIALISATION DES TAILLES REELLES DES TABLEAUX ET DES VARIABLES DE TRAVAIL
157c ------------------------------------------------------------------------------------------
158C
159 nbmeshsurf = 0
160 addelig3d=0
161 addsixig3d=0
162 l_tab_remove=0
163 l_tab_stay=0
164 l_tab_newfct=0
165 tab_newfct = 0
166 tab_remove = 0
167 tab_stay = 0
168 idfils(:,:)=0
169 offset_newfct = 0
170c
171c ------------------------------------------------------------------------------------------
172C CONSTRUCTION DES ETENDUES KNOT LOCALES POUR CHAQUE POINT DE CONTROLE, POUR TOUT LES PATCHS
173c DES CONNECTIVITES DES ELEMENTS, ET DES PATCHS
174C NB : OPTIMISER CES STRUCTURES PAR PATCH POUR KNOTLOCP SANS CASES VIDES
175c ------------------------------------------------------------------------------------------
176c
177c! vectorize possible with some modifications
178c
179 DO p=1,nbpart_ig3d
180 ipid=tabconpatch(p)%PID
181 iad_knot = igeo(40,ipid)
182 px = igeo(41,ipid)
183 py = igeo(42,ipid)
184 pz = igeo(43,ipid)
185 n1 = igeo(44,ipid)
186 n2 = igeo(45,ipid)
187 n3 = igeo(46,ipid)
188 nknot1 = n1+px
189 nknot2 = n2+py
190 nknot3 = n3+pz
191 decalgeo_tmp=(ipid-1)*(numnod+nbnewx_tmp)
192 DO i=1,tabconpatch(p)%L_TAB_IG3D
193 iel=tabconpatch(p)%TAB_IG3D(i)
194 itnctrl=0
195 idx = kxig3d(6,iel)
196 idy = kxig3d(7,iel)
197 idz = kxig3d(8,iel)
198 DO itzeta=1,pz
199 DO iteta=1,py
200 DO itksi=1,px
201 itnctrl=itnctrl+1
202 inctrl = ixig3d(kxig3d(4,iel)+itnctrl-1)
203 DO l=0,px
204 knotlocpc(l+1,1,decalgeo_tmp+inctrl)=knot(iad_knot+idx-itksi+l+1)
205 ENDDO
206 DO m=0,py
207 knotlocpc(m+1,2,decalgeo_tmp+inctrl)=knot(iad_knot+nknot1+idy-iteta+m+1)
208 ENDDO
209 DO n=0,pz
210 knotlocpc(n+1,3,decalgeo_tmp+inctrl)=knot(iad_knot+nknot1+nknot2+idz-itzeta+n+1)
211 ENDDO
212 ENDDO
213 ENDDO
214 ENDDO
215c
216 kxig3d(9,iel)=idx+1
217 kxig3d(10,iel)=idy+1
218 kxig3d(11,iel)=idz+1
219 DO WHILE (knot(iad_knot+kxig3d(9,iel))==knot(iad_knot+kxig3d(9,iel)+1))
220 kxig3d(9,iel)=kxig3d(9,iel)+1
221 ENDDO
222 DO WHILE (knot(iad_knot+nknot1+kxig3d(10,iel))==knot(iad_knot+nknot1+kxig3d(10,iel)+1))
223 kxig3d(10,iel)=kxig3d(10,iel)+1
224 ENDDO
225 DO WHILE (knot(iad_knot+nknot1+nknot2+kxig3d(11,iel))==knot(iad_knot+nknot1+nknot2+kxig3d(11,iel)+1))
226 kxig3d(11,iel)=kxig3d(11,iel)+1
227 ENDDO
228c
229 knotlocel(1,1,iel) = knot(iad_knot+kxig3d(6,iel))
230 knotlocel(2,1,iel) = knot(iad_knot+kxig3d(9,iel))
231 knotlocel(1,2,iel) = knot(iad_knot+nknot1+kxig3d(7,iel))
232 knotlocel(2,2,iel) = knot(iad_knot+nknot1+kxig3d(10,iel))
233 knotlocel(1,3,iel) = knot(iad_knot+nknot1+nknot2+kxig3d(8,iel))
234 knotlocel(2,3,iel) = knot(iad_knot+nknot1+nknot2+kxig3d(11,iel))
235c
236c ------------------------------------------------------------------------------------------
237C MISE EN MEMOIRE DU NOMBRE DE RAFFINEMENT INITIAL, PERMETTANT LE RAFFINEMENT PROGRESSIF
238C NB : TABLEAU GLOBAL ICI, MAIS SERAIT MIEUX PAR PATCH (ATTENTION AU ID DES ELEMENTS)
239c ------------------------------------------------------------------------------------------
240c
241 tab_initial_cut(1,iel) = kxig3d(12,iel)
242 tab_initial_cut(2,iel) = kxig3d(13,iel)
243 tab_initial_cut(3,iel) = kxig3d(14,iel)
244c
245c TABCONPATCH(P)%INITIAL_CUT(1,I) = KXIG3D(12,IEL)
246c TABCONPATCH(P)%INITIAL_CUT(2,I) = KXIG3D(13,IEL)
247c TABCONPATCH(P)%INITIAL_CUT(3,I) = KXIG3D(14,IEL)
248c
249 ENDDO
250 ENDDO
251c
252c ------------------------------------------------------------------------------------------
253C PROCEDURE DE RAFFINEMENT DES ELEMENTS, QUI FONCTIONNE PAR PATCH
254c ------------------------------------------------------------------------------------------
255c
256c! vectorize possible with some modifications
257c
258 DO p=1,nbpart_ig3d
259 ipid=tabconpatch(p)%PID
260 iad_knot = igeo(40,ipid)
261 px = igeo(41,ipid)
262 py = igeo(42,ipid)
263 pz = igeo(43,ipid)
264 n1 = igeo(44,ipid)
265 n2 = igeo(45,ipid)
266 n3 = igeo(46,ipid)
267 nknot1 = n1+px
268 nknot2 = n2+py
269 nknot3 = n3+pz
270 nelx=0
271 nely=0
272 nelz=0
273 ALLOCATE(idxel(nknot1))
274 ALLOCATE(idyel(nknot2))
275 ALLOCATE(idzel(nknot3))
276 idxel=0
277 idyel=0
278 idzel=0
279 DO i=1,nknot1-1
280 IF(knot(iad_knot+i)/=knot(iad_knot+i+1)) THEN
281 nelx=nelx+1
282 idxel(i)=nelx
283 ENDIF
284 ENDDO
285 DO i=1,nknot2-1
286 IF(knot(iad_knot+nknot1+i)/=knot(iad_knot+nknot1+i+1)) THEN
287 nely=nely+1
288 idyel(i)=nely
289 ENDIF
290 ENDDO
291 DO i=1,nknot3-1
292 IF(knot(iad_knot+nknot1+nknot2+i)/=knot(iad_knot+nknot1+nknot2+i+1)) THEN
293 nelz=nelz+1
294 idzel(i)=nelz
295 ENDIF
296 ENDDO
297c
298c ------------------------------------------------------------------------------------------
299C CONSTRUCTION DES TABLEAUX PERMETTANT LA LOCALISATION LE PATCH
300c ------------------------------------------------------------------------------------------
301c
302 ALLOCATE(meshigex(nely,nelz,nelx))
303 ALLOCATE(meshigey(nelz,nelx,nely))
304 ALLOCATE(meshigez(nelx,nely,nelz))
305 meshigex(:,:,:)=0
306 meshigey(:,:,:)=0
307 meshigez(:,:,:)=0
308c
309 DO l=1,tabconpatch(p)%L_TAB_IG3D ! nb d'elements du patch P
310 iel = tabconpatch(p)%TAB_IG3D(l)
311 meshigex(idyel(kxig3d(7,iel)),idzel(kxig3d(8,iel)),idxel(kxig3d(6,iel)))=iel
312 meshigey(idzel(kxig3d(8,iel)),idxel(kxig3d(6,iel)),idyel(kxig3d(7,iel)))=iel
313 meshigez(idxel(kxig3d(6,iel)),idyel(kxig3d(7,iel)),idzel(kxig3d(8,iel)))=iel
314 ENDDO
315c
316c ------------------------------------------------------------------------------------------
317c DEFINITION DES VARIABLES EN FONCTION DE LA DIRECTION DE COUPE
318c ------------------------------------------------------------------------------------------
319c
320 gama=1
321 DO dir=1,3
322 SELECT CASE (dir)
323 CASE(1)
324 idnbcut=12 ! where the nb of cut wished is located
325 idknot1=6 ! index of 1st knot in the Xknot vector
326 idknot2=9 ! index of 2nd knot in the Xknot vector
327 offset_knot=iad_knot
328 pdir=px
329 ptang1=py
330 ptang2=pz
331 neldir=nelx
332 neltang1=nely
333 neltang2=nelz
334 iddir => idxel
335 idtang1 => idyel
336 idtang2 => idzel
337 meshige => meshigex
338 CASE(2)
339 idnbcut=13 ! where the nb of cut wished is located
340 idknot1=7 ! index of 1st knot in the Yknot vector
341 idknot2=10 ! index of 2nd knot in the Yknot vector
342 offset_knot=iad_knot+nknot1
343 pdir=py
344 ptang1=pz
345 ptang2=px
346 neldir=nely
347 neltang1=nelz
348 neltang2=nelx
349 iddir => idyel
350 idtang1 => idzel
351 idtang2 => idxel
352 meshige => meshigey
353 CASE(3)
354 idnbcut=14 ! where the nb of cut wished is located
355 idknot1=8 ! index of 1st knot in the Zknot vector
356 idknot2=11 ! index of 2nd knot in the Zknot vector
357 offset_knot=iad_knot+nknot1+nknot2
358 pdir=pz
359 ptang1=px
360 ptang2=py
361 neldir=nelz
362 neltang1=nelx
363 neltang2=nely
364 iddir => idzel
365 idtang1 => idxel
366 idtang2 => idyel
367 meshige => meshigez
368 CASE DEFAULT
369 idnbcut= -huge(idnbcut)
370 idknot1=-huge(idknot1)
371 idknot2=-huge(idknot2)
372 offset_knot=-huge(offset_knot)
373 pdir=-huge(pdir)
374 ptang1=-huge(ptang1)
375 ptang2=-huge(ptang2)
376 neldir=-huge(neldir)
377 neltang1=-huge(neltang1)
378 neltang2=-huge(neltang2)
379 iddir => null()
380 idtang1 => null()
381 idtang2 => null()
382 meshige => null()
383 END SELECT
384c
385c ------------------------------------------------------------------------------------------
386c DECOUPAGE DES ELEMENTS DU PATCH
387c ------------------------------------------------------------------------------------------
388c
389 DO l=1,tabconpatch(p)%L_TAB_IG3D
390 iel = tabconpatch(p)%TAB_IG3D(l)
391 decalgeo_tmp=(kxig3d(2,iel)-1)*(numnod+nbnewx_tmp)
392 IF(kxig3d(idnbcut,iel)>1) THEN
393 nbcut=tab_initial_cut(dir,iel)
394c NBCUT=TABCONPATCH(P)%INITIAL_CUT(DIR,IEL)
395 DO i=(tab_initial_cut(dir,iel)-kxig3d(idnbcut,iel))+1,tab_initial_cut(dir,iel)-1
396c DO I=(TABCONPATCH(P)%INITIAL_CUT(DIR,IEL)-KXIG3D(IDNBCUT,IEL))+1,TABCONPATCH(P)%INITIAL_CUT(DIR,IEL)-1
397 nbmeshsurf = nbmeshsurf + 1
398 newfct = 0
399 pmeshsurf => meshsurf(nbmeshsurf)
400 pmeshsurf%DIR=dir
401 pmeshsurf%ID_MESHSURF=nbmeshsurf
402 pmeshsurf%ID_PID=ipid
403C
404 CALL find_newknot(iel ,kxig3d,knot ,dir ,iad_knot,
405 . nknot1,nknot2,nknot3,i,pmeshsurf%KNOT_INSERE)
406C
407 CALL comput_coinknot(iel, ixig3d ,kxig3d ,meshige ,ptang1 ,ptang2 ,
408 . iddir ,idtang1 ,idtang2 ,
409 . neldir ,neltang1 ,neltang2 ,pmeshsurf%DIR ,
410 . pmeshsurf%TAB_COINKNOT,pmeshsurf%L_TAB_COINKNOT,
411 . pmeshsurf%TAB_ELCUT,pmeshsurf%L_TAB_ELCUT,
412 . pmeshsurf%TAB_NEWEL,pmeshsurf%L_TAB_NEWEL,
413 . knot,iad_knot,nknot1,nknot2,nknot3,idfils,
414 . knotlocel,pmeshsurf%KNOT_INSERE,ipartig3d,tab_initial_cut,i,0)
415C
416 ALLOCATE(pmeshsurf%TAB_COINKNOT(2,pmeshsurf%L_TAB_COINKNOT))
417 ALLOCATE(pmeshsurf%TAB_ELCUT(pmeshsurf%L_TAB_ELCUT))
418 ALLOCATE(pmeshsurf%TAB_NEWEL(pmeshsurf%L_TAB_NEWEL))
419C
420 CALL comput_coinknot(iel, ixig3d ,kxig3d ,meshige ,ptang1 ,ptang2 ,
421 . iddir ,idtang1 ,idtang2 ,
422 . neldir ,neltang1 ,neltang2 ,pmeshsurf%DIR ,
423 . pmeshsurf%TAB_COINKNOT,pmeshsurf%L_TAB_COINKNOT,
424 . pmeshsurf%TAB_ELCUT,pmeshsurf%L_TAB_ELCUT,
425 . pmeshsurf%TAB_NEWEL,pmeshsurf%L_TAB_NEWEL,
426 . knot,iad_knot,nknot1,nknot2,nknot3,idfils,
427 . knotlocel,pmeshsurf%KNOT_INSERE,ipartig3d,tab_initial_cut,i,1)
428C
429 pmeshsurf%L_TAB_MESHSURFCUT = 0
430C
431 DO ittest=1,nbmeshsurf-1
432 p2meshsurf => meshsurf(ittest)
433 CALL comput_mesh_neighbour(pmeshsurf%DIR, p2meshsurf%DIR,
434 . pmeshsurf%ID_PID, p2meshsurf%ID_PID, p2meshsurf%ID_MESHSURF,
435 . pmeshsurf%TAB_COINKNOT,pmeshsurf%L_TAB_COINKNOT,
436 . p2meshsurf%TAB_COINKNOT,p2meshsurf%L_TAB_COINKNOT,
437 . pmeshsurf%KNOT_INSERE,p2meshsurf%KNOT_INSERE,
438 . pmeshsurf%TAB_MESHSURFCUT,pmeshsurf%L_TAB_MESHSURFCUT,
439 . p2meshsurf%TAB_MESHSURFCUT,p2meshsurf%L_TAB_MESHSURFCUT,0)
440 ENDDO
441C
442 ALLOCATE(pmeshsurf%TAB_MESHSURFCUT(pmeshsurf%L_TAB_MESHSURFCUT))
443 pmeshsurf%L_TAB_MESHSURFCUT = 0
444C
445 DO ittest=1,nbmeshsurf-1
446 p2meshsurf => meshsurf(ittest)
447 CALL comput_mesh_neighbour(pmeshsurf%DIR, p2meshsurf%DIR,
448 . pmeshsurf%ID_PID, p2meshsurf%ID_PID, p2meshsurf%ID_MESHSURF,
449 . pmeshsurf%TAB_COINKNOT,pmeshsurf%L_TAB_COINKNOT,
450 . p2meshsurf%TAB_COINKNOT,p2meshsurf%L_TAB_COINKNOT,
451 . pmeshsurf%KNOT_INSERE,p2meshsurf%KNOT_INSERE,
452 . pmeshsurf%TAB_MESHSURFCUT,pmeshsurf%L_TAB_MESHSURFCUT,
453 . p2meshsurf%TAB_MESHSURFCUT,p2meshsurf%L_TAB_MESHSURFCUT,1)
454 ENDDO
455C
456 CALL test_support_fct(ixig3d, kxig3d, knotlocpc, ptang1, ptang2, pmeshsurf%DIR,
457 . pmeshsurf%TAB_ELCUT,pmeshsurf%L_TAB_ELCUT,
458 . pmeshsurf%TAB_COINKNOT,pmeshsurf%L_TAB_COINKNOT,
459 . pmeshsurf%TAB_FCTCUT,pmeshsurf%L_TAB_FCTCUT,decalgeo_tmp,0)
460C
461 ALLOCATE(pmeshsurf%TAB_FCTCUT(pmeshsurf%L_TAB_FCTCUT))
462C
463 CALL test_support_fct(ixig3d, kxig3d, knotlocpc, ptang1, ptang2, pmeshsurf%DIR,
464 . pmeshsurf%TAB_ELCUT,pmeshsurf%L_TAB_ELCUT,
465 . pmeshsurf%TAB_COINKNOT,pmeshsurf%L_TAB_COINKNOT,
466 . pmeshsurf%TAB_FCTCUT,pmeshsurf%L_TAB_FCTCUT,decalgeo_tmp,1)
467C
468 CALL rafig3d(knotlocpc,
469 . pdir,ptang1,ptang2,iad_knot,nknot1,nknot2,nknot3,
470 . gama,pmeshsurf%DIR,pmeshsurf%KNOT_INSERE,
471 . x_tmp,d_tmp,v_tmp,ms_tmp,wige_tmp,
472 . pmeshsurf%TAB_FCTCUT,pmeshsurf%L_TAB_FCTCUT,
473 . tab_remove,tab_newfct,decalgeo_tmp,tabconpatch,p,
474 . kxig3d,ixig3d,tab_stay,flag_pre)
475C
476 DO ittest=1,pmeshsurf%L_TAB_MESHSURFCUT
477 p2meshsurf => meshsurf(pmeshsurf%TAB_MESHSURFCUT(ittest))
478 IF(p2meshsurf%DIR==2) THEN
479 p2dir=py
480 p2tang1=pz
481 p2tang2=px
482 ELSEIF(p2meshsurf%DIR==1) THEN
483 p2dir=px
484 p2tang1=py
485 p2tang2=pz
486 ENDIF
487 l_tab_newfctcut = 0
488 CALL test_support_newfct(knotlocpc, p2dir, p2tang1, p2tang2,
489 . p2meshsurf%DIR, p2meshsurf%KNOT_INSERE,
490 . p2meshsurf%TAB_COINKNOT,p2meshsurf%L_TAB_COINKNOT, tab_newfct,
491 . tab_newfctcut,l_tab_newfctcut,decalgeo_tmp,tab_remove,0)
492 IF(l_tab_newfctcut>0) THEN
493 ALLOCATE(tab_newfctcut(l_tab_newfctcut))
494 CALL test_support_newfct(knotlocpc, p2dir, p2tang1, p2tang2,
495 . p2meshsurf%DIR, p2meshsurf%KNOT_INSERE,
496 . p2meshsurf%TAB_COINKNOT,p2meshsurf%L_TAB_COINKNOT, tab_newfct,
497 . tab_newfctcut,l_tab_newfctcut,decalgeo_tmp,tab_remove,1)
498 CALL rafig3d(knotlocpc,
499 . p2dir,p2tang1,p2tang2,iad_knot,nknot1,nknot2,nknot3,
500 . gama,p2meshsurf%DIR,p2meshsurf%KNOT_INSERE,
501 . x_tmp,d_tmp,v_tmp,ms_tmp,wige_tmp,
502 . tab_newfctcut,l_tab_newfctcut,
503 . tab_remove,tab_newfct,decalgeo_tmp,tabconpatch,p,
504 . kxig3d,ixig3d,tab_stay,flag_pre)
505
506 DEALLOCATE(tab_newfctcut)
507
508 ENDIF
509 ENDDO
510C
511 CALL rebuild_ig3d(ixig3d, kxig3d,pmeshsurf%DIR,pdir,ptang1,ptang2,
512 . knotlocpc,knotlocel,
513 . pmeshsurf%TAB_ELCUT,pmeshsurf%L_TAB_ELCUT,
514 . pmeshsurf%TAB_NEWEL,pmeshsurf%L_TAB_NEWEL,
515 . pmeshsurf%TAB_FCTCUT,pmeshsurf%L_TAB_FCTCUT,
516 . tab_remove,tab_newfct,el_connect,tabconpatch(p),
517 . idfils,flag_pre,flag_debug)
518
519 offset_newfct = offset_newfct + newfct ! "SNEW REDEVIENT S" les nouvelles fonctions ne le sont plus
520
521 ENDDO ! boucle sur le nombre de coupe de l'element
522 ENDIF
523 ENDDO ! boucle sur les elements du patch
524 ENDDO ! boucle sur les direction
525 DEALLOCATE(idxel,idyel,idzel)
526 DEALLOCATE(meshigex,meshigey,meshigez)
527 ENDDO ! boucle sur les patchs
528c
529CC----------------------------------------------------------------------------------------------
530CC DEALLOCATION DES STRUCTURES DEFINISSANT LES COUPES
531CC----------------------------------------------------------------------------------------------
532c
533 DO i=1,nbmeshsurf
534 IF(meshsurf(i)%L_TAB_COINKNOT/=0) DEALLOCATE(meshsurf(i)%TAB_COINKNOT)
535 IF(meshsurf(i)%L_TAB_ELCUT/=0) DEALLOCATE(meshsurf(i)%TAB_ELCUT)
536 IF(meshsurf(i)%L_TAB_FCTCUT/=0) DEALLOCATE(meshsurf(i)%TAB_FCTCUT)
537 IF(meshsurf(i)%L_TAB_NEWEL/=0) DEALLOCATE(meshsurf(i)%TAB_NEWEL)
538 IF(meshsurf(i)%L_TAB_MESHSURFCUT/=0) DEALLOCATE(meshsurf(i)%TAB_MESHSURFCUT)
539 ENDDO
540 DEALLOCATE(meshsurf)
541c
542CC----------------------------------------------------------------------------------------------
543CC TEST A POSTERIORI DES FONCTIONS ET DES ELEMENTS. NE TESTE PAS DIRECTEMENT S'IL EXISTE
544CC DES ELEMENTS AVEC TROP DE FONCTIONS, MAIS PERMET DE VOIR S'IL Y A ONE QUELCONQUE SOUCI
545CC----------------------------------------------------------------------------------------------
546c
547 IF(flag_debug==1) THEN
548 DO i=1,numelig3d0+addelig3d
549 j=1
550 decalgeo_tmp=(kxig3d(2,i)-1)*(numnod+nbnewx_tmp)
551 DO j=1,kxig3d(3,i)
552 inctrl=ixig3d(kxig3d(4,i)+j-1)
553 IF(inctrl==0) THEN
554 print*,'ELEMENT',i,'point',inctrl
555 ELSEIF(knotlocel(1,1,i)<knotlocpc(1,1,decalgeo_tmp+inctrl)-em06 .OR.
556 . knotlocel(2,1,i)>knotlocpc(4,1,decalgeo_tmp+inctrl)+em06 .OR.
557 . knotlocel(1,2,i)<knotlocpc(1,2,decalgeo_tmp+inctrl)-em06 .OR.
558 . knotlocel(2,2,i)>knotlocpc(4,2,decalgeo_tmp+inctrl)+em06 .OR.
559 . knotlocel(1,3,i)<knotlocpc(1,3,decalgeo_tmp+inctrl)-em06 .OR.
560 . knotlocel(2,3,i)>knotlocpc(4,3,decalgeo_tmp+inctrl)+em06) THEN
561 print*,'ELEMENT',i,'point',inctrl
562 print*,knotlocel(1,1,i),'<',knotlocpc(1,1,decalgeo_tmp+inctrl)
563 print*,knotlocel(2,1,i),'>',knotlocpc(4,1,decalgeo_tmp+inctrl)
564 print*,knotlocel(1,2,i),'<',knotlocpc(1,2,decalgeo_tmp+inctrl)
565 print*,knotlocel(2,2,i),'>',knotlocpc(4,2,decalgeo_tmp+inctrl)
566 print*,knotlocel(1,3,i),'<',knotlocpc(1,3,decalgeo_tmp+inctrl)
567 print*,knotlocel(2,3,i),'>',knotlocpc(4,3,decalgeo_tmp+inctrl)
568 ENDIF
569 ENDDO
570 ENDDO
571 ENDIF
572c
573 IF(nbmeshsurf/=0) THEN
574c
575c ------------------------------------------------------------------------------------------
576c REORGANISATION DES TABLEAUX ELEMENTAIRES ET DES CONNECTIVITES AVEC LE RECOMPACTAGE DES POINTS
577c ------------------------------------------------------------------------------------------
578c
579 CALL reorder_ig3d(ixig3d, kxig3d,knotlocpc,knotlocel,
580 . x_tmp,d_tmp,v_tmp,ms_tmp,wige_tmp,
581 . tab_remove,tab_newfct,el_connect,
582 . ipartig3d,igeo,tab_stay,flag_pre,flag_debug)
583c
584c ------------------------------------------------------------------------------------------
585c ON RAMENE NOS TABLEAUX TEMPORAIRES DANS LES TABLEAUX FINAUX
586c ------------------------------------------------------------------------------------------
587c
588 IF(flag_pre==1) THEN
589 DO i=1,numnod
590 DO j=1,3
591 x((i-1)*3+j) = x_tmp((i-1)*3+j)
592 v((i-1)*3+j) = v_tmp((i-1)*3+j)
593 d((i-1)*3+j) = d_tmp((i-1)*3+j)
594 ENDDO
595 ms(i) = ms_tmp(i)
596 wige(i) = wige_tmp(i)
597 ENDDO
598 DO p=1,nbpart_ig3d
599 ipid=tabconpatch(p)%PID
600 decalgeofinal=(ipid-1)*numnod
601 decalgeo_tmp=(ipid-1)*(numnod+nbnewx_tmp)
602 DO i=1,numnod
603 knotlocpc(:,1,decalgeofinal+i) = knotlocpc(:,1,decalgeo_tmp+i)
604 knotlocpc(:,2,decalgeofinal+i) = knotlocpc(:,2,decalgeo_tmp+i)
605 knotlocpc(:,3,decalgeofinal+i) = knotlocpc(:,3,decalgeo_tmp+i)
606 ENDDO
607 ENDDO
608 DEALLOCATE(x_tmp,v_tmp,d_tmp,ms_tmp,wige_tmp)
609
610 IF(flag_debug==1) THEN
611 DO i=1,numelig3d0+addelig3d
612 j=1
613 decalgeofinal=(kxig3d(2,i)-1)*(numnod)
614 DO j=1,kxig3d(3,i)
615 inctrl=ixig3d(kxig3d(4,i)+j-1)
616 IF(inctrl==0) THEN
617 print*,'ELEMENT',i,'point',inctrl
618 ELSEIF(knotlocel(1,1,i)<knotlocpc(1,1,decalgeofinal+inctrl)-em06 .OR.
619 . knotlocel(2,1,i)>knotlocpc(4,1,decalgeofinal+inctrl)+em06 .OR.
620 . knotlocel(1,2,i)<knotlocpc(1,2,decalgeofinal+inctrl)-em06 .OR.
621 . knotlocel(2,2,i)>knotlocpc(4,2,decalgeofinal+inctrl)+em06 .OR.
622 . knotlocel(1,3,i)<knotlocpc(1,3,decalgeofinal+inctrl)-em06 .OR.
623 . knotlocel(2,3,i)>knotlocpc(4,3,decalgeofinal+inctrl)+em06) THEN
624 print*,'ELEMENT',i,'point',inctrl
625 print*,knotlocel(1,1,i),'<',knotlocpc(1,1,decalgeofinal+inctrl)
626 print*,knotlocel(2,1,i),'>',knotlocpc(4,1,decalgeofinal+inctrl)
627 print*,knotlocel(1,2,i),'<',knotlocpc(1,2,decalgeofinal+inctrl)
628 print*,knotlocel(2,2,i),'>',knotlocpc(4,2,decalgeofinal+inctrl)
629 print*,knotlocel(1,3,i),'<',knotlocpc(1,3,decalgeofinal+inctrl)
630 print*,knotlocel(2,3,i),'>',knotlocpc(4,3,decalgeofinal+inctrl)
631 ENDIF
632 ENDDO
633 ENDDO
634 ENDIF
635
636 ENDIF
637 ENDIF
638
639c
640c ------------------------------------------------------------------------------------------
641c
642 DEALLOCATE(tab_remove)
643 DEALLOCATE(tab_stay)
644 DEALLOCATE(tab_newfct)
645 DEALLOCATE(gama)
646 DEALLOCATE(idfils)
647 DEALLOCATE(el_connect)
648 DEALLOCATE(tab_initial_cut)
649
650 RETURN
651 END
652
comput_coinknot
subroutine comput_coinknot(iel, ixig3d, kxig3d, meshige, ptang1, ptang2, iddir, idtang1, idtang2, neldir, neltang1, neltang2, dir, tab_coinknot, l_tab_coinknot, tab_elcut, l_tab_elcut, tab_newel, l_tab_newel, knot, iad_knot, nknot1, nknot2, nknot3, idfils, knotlocel, newknot, ipartig3d, tab_oldidcut, idcut, flag)
Definition comput_coinknot.F:34
comput_mesh_neighbour
subroutine comput_mesh_neighbour(dir, dir2, ipid, ipid2, id_meshsurf, tab_coinknot, l_tab_coinknot, tab_coinknot_test, l_tab_coinknot_test, knot_insere, knot_insere2, tab_meshsurfcut, l_tab_meshsurfcut, tab_meshsurfcut2, l_tab_meshsurfcut2, flag)
Definition comput_mesh_neighbour.F:34
my_real
#define my_real
Definition cppsort.cpp:32
find_newknot
subroutine find_newknot(iel, kxig3d, knot, dir, iad_knot, nknot1, nknot2, nknot3, idcut, newknot)
Definition find_newknot.F:30
meshsurfig3d_mod
Definition meshsurfig3d_mod.F:33
prerafig3d
subroutine prerafig3d(knot, knotlocpc, knotlocel, kxig3d, ixig3d, igeo, ipartig3d, x, v, d, ms, wige, tabconpatch, flag_pre)
Definition prerafig3d.F:43
rafig3d
subroutine rafig3d(knotlocpc, deg, degtang1, degtang2, iad_knot, nknot1, nknot2, nknot3, gama, dir, newknot, x, d, v, ms, wige, tab_fctcut, l_tab_fctcut, tab_remove, tab_newfct, decalgeo, tabconpatch, numpatch, kxig3d, ixig3d, tab_stay, flag_pre)
Definition rafig3d.F:36
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
reorder_ig3d
subroutine reorder_ig3d(ixig3d, kxig3d, knotlocpc, knotlocel, x_tmp, d_tmp, v_tmp, ms_tmp, wige_tmp, tab_remove, tab_newfct, el_connect, ipartig3d, igeo, tab_stay, flag_pre, flag_debug)
Definition reorder_ig3d.F:34
meshsurfig3d_mod::meshsurfig3d_
Definition meshsurfig3d_mod.F:42
test_support_fct
subroutine test_support_fct(ixig3d, kxig3d, knotlocpc, degtang1, degtang2, dir, tab_elcut, l_tab_elcut, tab_coinknot, l_tab_coinknot, tab_fctcut, l_tab_fctcut, decalgeo, flag)
Definition test_support_fct.F:33
test_support_newfct
subroutine test_support_newfct(knotlocpc, dirdeg, degtang1, degtang2, dir, newknot, tab_coinknot, l_tab_coinknot, tab_newfct, tab_newfctcut, l_tab_newfctcut, decalgeo, tab_remove, flag)
Definition test_support_newfct.F:32