OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
prerafig3d.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "ige3d_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine prerafig3d (knot, knotlocpc, knotlocel, kxig3d, ixig3d, igeo, ipartig3d, x, v, d, ms, wige, tabconpatch, flag_pre)

Function/Subroutine Documentation

◆ prerafig3d()

subroutine prerafig3d ( knot,
knotlocpc,
knotlocel,
integer, dimension(nixig3d,*) kxig3d,
integer, dimension(*) ixig3d,
integer, dimension(npropgi,*) igeo,
integer, dimension(*) ipartig3d,
x,
v,
d,
ms,
wige,
type(tabconpatch_ig3d_), dimension(*) tabconpatch,
integer flag_pre )

Definition at line 40 of file prerafig3d.F.

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,L,M,N,P,ITNCTRL,INCTRL,ITKSI,ITETA,ITZETA,
72 . IPID,IAD_KNOT,ITTEST,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,
79 . FLAG_DEBUG
80 my_real, DIMENSION(:), ALLOCATABLE :: gama
81C-----------------------------------------------
82C arrays representing the elementary structure of the patches
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 working arrays
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 USED NOT IN CONTRL.F, BUT IN 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 of the sizes of the working arrays according to the number of elements
102C added, the estimated number of functions added at first
103C THEN TO EXACT SIZES REQUIRED IN A SECOND STEP
104c ------------------------------------------------------------------------------------------
105c
106 IF(flag_pre==0) THEN
107 nbnewx_tmp = addelig3d*20 ! number of points allowed as offset for the work (for multipatch) ! set according to the total number of points
108c
109 ALLOCATE (tab_initial_cut(3,numelig3d0))
110 ALLOCATE (idfils(nbfilsmax,numelig3d0))
111 ALLOCATE (tab_remove(addelig3d*27)) ! should take into account the number of base elements and the number of added elements
112 ALLOCATE (tab_stay(nint(addelig3d*27*0.5))) ! should take into account the number of base elements and the number of added elements
113 ALLOCATE (tab_newfct(nint(addelig3d*27*1.2))) ! COULD BE BETTER DIMENSIONED
114 ALLOCATE (meshsurf(nbmeshsurf))
115 ALLOCATE (gama(numnodige0+2*addelig3d*27))
116 ELSE
117 nbnewx_tmp = l_tab_newfct ! for the working length and the calculation of 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)) ! array containing a flag for the elements that have been modified
150 el_connect(:)=0
151
152C So an EL_CONNECT must be made in the TABCONPATCH structure and the connectivity tables must be redone by patch
153c
154c ------------------------------------------------------------------------------------------
155C initialization of the actual sizes of the arrays and working variables
156c ------------------------------------------------------------------------------------------
157C
158 nbmeshsurf = 0
159 addelig3d=0
160 addsixig3d=0
161 l_tab_remove=0
162 l_tab_stay=0
163 l_tab_newfct=0
164 tab_newfct = 0
165 tab_remove = 0
166 tab_stay = 0
167 idfils(:,:)=0
168 offset_newfct = 0
169c
170c ------------------------------------------------------------------------------------------
171C construction of local knot spans for each control point, for all patches
172c of the connectivities of the elements, and of the patches
173C NB : OPTIMIZE THESE STRUCTURES BY PATCH FOR KNOTLOCP WITHOUT EMPTY CASES
174c ------------------------------------------------------------------------------------------
175c
176c! vectorize possible with some modifications
177c
178 DO p=1,nbpart_ig3d
179 ipid=tabconpatch(p)%PID
180 iad_knot = igeo(40,ipid)
181 px = igeo(41,ipid)
182 py = igeo(42,ipid)
183 pz = igeo(43,ipid)
184 n1 = igeo(44,ipid)
185 n2 = igeo(45,ipid)
186 n3 = igeo(46,ipid)
187 nknot1 = n1+px
188 nknot2 = n2+py
189 nknot3 = n3+pz
190 decalgeo_tmp=(ipid-1)*(numnod+nbnewx_tmp)
191 DO i=1,tabconpatch(p)%L_TAB_IG3D
192 iel=tabconpatch(p)%TAB_IG3D(i)
193 itnctrl=0
194 idx = kxig3d(6,iel)
195 idy = kxig3d(7,iel)
196 idz = kxig3d(8,iel)
197 DO itzeta=1,pz
198 DO iteta=1,py
199 DO itksi=1,px
200 itnctrl=itnctrl+1
201 inctrl = ixig3d(kxig3d(4,iel)+itnctrl-1)
202 DO l=0,px
203 knotlocpc(l+1,1,decalgeo_tmp+inctrl)=knot(iad_knot+idx-itksi+l+1)
204 ENDDO
205 DO m=0,py
206 knotlocpc(m+1,2,decalgeo_tmp+inctrl)=knot(iad_knot+nknot1+idy-iteta+m+1)
207 ENDDO
208 DO n=0,pz
209 knotlocpc(n+1,3,decalgeo_tmp+inctrl)=knot(iad_knot+nknot1+nknot2+idz-itzeta+n+1)
210 ENDDO
211 ENDDO
212 ENDDO
213 ENDDO
214c
215 kxig3d(9,iel)=idx+1
216 kxig3d(10,iel)=idy+1
217 kxig3d(11,iel)=idz+1
218 DO WHILE (knot(iad_knot+kxig3d(9,iel))==knot(iad_knot+kxig3d(9,iel)+1))
219 kxig3d(9,iel)=kxig3d(9,iel)+1
220 ENDDO
221 DO WHILE (knot(iad_knot+nknot1+kxig3d(10,iel))==knot(iad_knot+nknot1+kxig3d(10,iel)+1))
222 kxig3d(10,iel)=kxig3d(10,iel)+1
223 ENDDO
224 DO WHILE (knot(iad_knot+nknot1+nknot2+kxig3d(11,iel))==knot(iad_knot+nknot1+nknot2+kxig3d(11,iel)+1))
225 kxig3d(11,iel)=kxig3d(11,iel)+1
226 ENDDO
227c
228 knotlocel(1,1,iel) = knot(iad_knot+kxig3d(6,iel))
229 knotlocel(2,1,iel) = knot(iad_knot+kxig3d(9,iel))
230 knotlocel(1,2,iel) = knot(iad_knot+nknot1+kxig3d(7,iel))
231 knotlocel(2,2,iel) = knot(iad_knot+nknot1+kxig3d(10,iel))
232 knotlocel(1,3,iel) = knot(iad_knot+nknot1+nknot2+kxig3d(8,iel))
233 knotlocel(2,3,iel) = knot(iad_knot+nknot1+nknot2+kxig3d(11,iel))
234c
235c ------------------------------------------------------------------------------------------
236C storing the number of initial refinements, allowing for progressive refinement
237C NB : TABLEAU GLOBAL ICI, MAIS SERAIT MIEUX PAR PATCH (ATTENTION AU ID DES ELEMENTS)
238c ------------------------------------------------------------------------------------------
239c
240 tab_initial_cut(1,iel) = kxig3d(12,iel)
241 tab_initial_cut(2,iel) = kxig3d(13,iel)
242 tab_initial_cut(3,iel) = kxig3d(14,iel)
243c
244c TABCONPATCH(P)%INITIAL_CUT(1,I) = KXIG3D(12,IEL)
245c TABCONPATCH(P)%INITIAL_CUT(2,I) = KXIG3D(13,IEL)
246c TABCONPATCH(P)%INITIAL_CUT(3,I) = KXIG3D(14,IEL)
247c
248 ENDDO
249 ENDDO
250c
251c ------------------------------------------------------------------------------------------
252C element refinement procedure, which operates by patch
253c ------------------------------------------------------------------------------------------
254c
255c! vectorize possible with some modifications
256c
257 DO p=1,nbpart_ig3d
258 ipid=tabconpatch(p)%PID
259 iad_knot = igeo(40,ipid)
260 px = igeo(41,ipid)
261 py = igeo(42,ipid)
262 pz = igeo(43,ipid)
263 n1 = igeo(44,ipid)
264 n2 = igeo(45,ipid)
265 n3 = igeo(46,ipid)
266 nknot1 = n1+px
267 nknot2 = n2+py
268 nknot3 = n3+pz
269 nelx=0
270 nely=0
271 nelz=0
272 ALLOCATE(idxel(nknot1))
273 ALLOCATE(idyel(nknot2))
274 ALLOCATE(idzel(nknot3))
275 idxel=0
276 idyel=0
277 idzel=0
278 DO i=1,nknot1-1
279 IF(knot(iad_knot+i)/=knot(iad_knot+i+1)) THEN
280 nelx=nelx+1
281 idxel(i)=nelx
282 ENDIF
283 ENDDO
284 DO i=1,nknot2-1
285 IF(knot(iad_knot+nknot1+i)/=knot(iad_knot+nknot1+i+1)) THEN
286 nely=nely+1
287 idyel(i)=nely
288 ENDIF
289 ENDDO
290 DO i=1,nknot3-1
291 IF(knot(iad_knot+nknot1+nknot2+i)/=knot(iad_knot+nknot1+nknot2+i+1)) THEN
292 nelz=nelz+1
293 idzel(i)=nelz
294 ENDIF
295 ENDDO
296c
297c ------------------------------------------------------------------------------------------
298C building the arrays allowing the location of the patch
299c ------------------------------------------------------------------------------------------
300c
301 ALLOCATE(meshigex(nely,nelz,nelx))
302 ALLOCATE(meshigey(nelz,nelx,nely))
303 ALLOCATE(meshigez(nelx,nely,nelz))
304 meshigex(:,:,:)=0
305 meshigey(:,:,:)=0
306 meshigez(:,:,:)=0
307c
308 DO l=1,tabconpatch(p)%L_TAB_IG3D ! nb of patch p elements
309 iel = tabconpatch(p)%TAB_IG3D(l)
310 meshigex(idyel(kxig3d(7,iel)),idzel(kxig3d(8,iel)),idxel(kxig3d(6,iel)))=iel
311 meshigey(idzel(kxig3d(8,iel)),idxel(kxig3d(6,iel)),idyel(kxig3d(7,iel)))=iel
312 meshigez(idxel(kxig3d(6,iel)),idyel(kxig3d(7,iel)),idzel(kxig3d(8,iel)))=iel
313 ENDDO
314c
315c ------------------------------------------------------------------------------------------
316c definition of variables according to the cutting direction
317c ------------------------------------------------------------------------------------------
318c
319 gama=1
320 DO dir=1,3
321 SELECT CASE (dir)
322 CASE(1)
323 idnbcut=12 ! where the nb of cut wished is located
324 idknot1=6 ! index of 1st knot in the Xknot vector
325 idknot2=9 ! index of 2nd knot in the Xknot vector
326 offset_knot=iad_knot
327 pdir=px
328 ptang1=py
329 ptang2=pz
330 neldir=nelx
331 neltang1=nely
332 neltang2=nelz
333 iddir => idxel
334 idtang1 => idyel
335 idtang2 => idzel
336 meshige => meshigex
337 CASE(2)
338 idnbcut=13 ! where the nb of cut wished is located
339 idknot1=7 ! index of 1st knot in the Yknot vector
340 idknot2=10 ! index of 2nd knot in the Yknot vector
341 offset_knot=iad_knot+nknot1
342 pdir=py
343 ptang1=pz
344 ptang2=px
345 neldir=nely
346 neltang1=nelz
347 neltang2=nelx
348 iddir => idyel
349 idtang1 => idzel
350 idtang2 => idxel
351 meshige => meshigey
352 CASE(3)
353 idnbcut=14 ! where the nb of cut wished is located
354 idknot1=8 ! index of 1st knot in the Zknot vector
355 idknot2=11 ! index of 2nd knot in the Zknot vector
356 offset_knot=iad_knot+nknot1+nknot2
357 pdir=pz
358 ptang1=px
359 ptang2=py
360 neldir=nelz
361 neltang1=nelx
362 neltang2=nely
363 iddir => idzel
364 idtang1 => idxel
365 idtang2 => idyel
366 meshige => meshigez
367 CASE DEFAULT
368 idnbcut= -huge(idnbcut)
369 idknot1=-huge(idknot1)
370 idknot2=-huge(idknot2)
371 offset_knot=-huge(offset_knot)
372 pdir=-huge(pdir)
373 ptang1=-huge(ptang1)
374 ptang2=-huge(ptang2)
375 neldir=-huge(neldir)
376 neltang1=-huge(neltang1)
377 neltang2=-huge(neltang2)
378 iddir => null()
379 idtang1 => null()
380 idtang2 => null()
381 meshige => null()
382 END SELECT
383c
384c ------------------------------------------------------------------------------------------
385c splitting the elements of the patch
386c ------------------------------------------------------------------------------------------
387c
388 DO l=1,tabconpatch(p)%L_TAB_IG3D
389 iel = tabconpatch(p)%TAB_IG3D(l)
390 decalgeo_tmp=(kxig3d(2,iel)-1)*(numnod+nbnewx_tmp)
391 IF(kxig3d(idnbcut,iel)>1) THEN
392 nbcut=tab_initial_cut(dir,iel)
393c NBCUT=TABCONPATCH(P)%INITIAL_CUT(DIR,IEL)
394 DO i=(tab_initial_cut(dir,iel)-kxig3d(idnbcut,iel))+1,tab_initial_cut(dir,iel)-1
395c DO I=(TABCONPATCH(P)%INITIAL_CUT(DIR,IEL)-KXIG3D(IDNBCUT,IEL))+1,TABCONPATCH(P)%INITIAL_CUT(DIR,IEL)-1
396 nbmeshsurf = nbmeshsurf + 1
397 newfct = 0
398 pmeshsurf => meshsurf(nbmeshsurf)
399 pmeshsurf%DIR=dir
400 pmeshsurf%ID_MESHSURF=nbmeshsurf
401 pmeshsurf%ID_PID=ipid
402C
403 CALL find_newknot(iel ,kxig3d,knot ,dir ,iad_knot,
404 . nknot1,nknot2,nknot3,i,pmeshsurf%KNOT_INSERE)
405C
406 CALL comput_coinknot(iel, ixig3d ,kxig3d ,meshige ,ptang1 ,ptang2 ,
407 . iddir ,idtang1 ,idtang2 ,
408 . neldir ,neltang1 ,neltang2 ,pmeshsurf%DIR ,
409 . pmeshsurf%TAB_COINKNOT,pmeshsurf%L_TAB_COINKNOT,
410 . pmeshsurf%TAB_ELCUT,pmeshsurf%L_TAB_ELCUT,
411 . pmeshsurf%TAB_NEWEL,pmeshsurf%L_TAB_NEWEL,
412 . knot,iad_knot,nknot1,nknot2,nknot3,idfils,
413 . knotlocel,pmeshsurf%KNOT_INSERE,ipartig3d,tab_initial_cut,i,0)
414C
415 ALLOCATE(pmeshsurf%TAB_COINKNOT(2,pmeshsurf%L_TAB_COINKNOT))
416 ALLOCATE(pmeshsurf%TAB_ELCUT(pmeshsurf%L_TAB_ELCUT))
417 ALLOCATE(pmeshsurf%TAB_NEWEL(pmeshsurf%L_TAB_NEWEL))
418C
419 CALL comput_coinknot(iel, ixig3d ,kxig3d ,meshige ,ptang1 ,ptang2 ,
420 . iddir ,idtang1 ,idtang2 ,
421 . neldir ,neltang1 ,neltang2 ,pmeshsurf%DIR ,
422 . pmeshsurf%TAB_COINKNOT,pmeshsurf%L_TAB_COINKNOT,
423 . pmeshsurf%TAB_ELCUT,pmeshsurf%L_TAB_ELCUT,
424 . pmeshsurf%TAB_NEWEL,pmeshsurf%L_TAB_NEWEL,
425 . knot,iad_knot,nknot1,nknot2,nknot3,idfils,
426 . knotlocel,pmeshsurf%KNOT_INSERE,ipartig3d,tab_initial_cut,i,1)
427C
428 pmeshsurf%L_TAB_MESHSURFCUT = 0
429C
430 DO ittest=1,nbmeshsurf-1
431 p2meshsurf => meshsurf(ittest)
432 CALL comput_mesh_neighbour(pmeshsurf%DIR, p2meshsurf%DIR,
433 . pmeshsurf%ID_PID, p2meshsurf%ID_PID, p2meshsurf%ID_MESHSURF,
434 . pmeshsurf%TAB_COINKNOT,pmeshsurf%L_TAB_COINKNOT,
435 . p2meshsurf%TAB_COINKNOT,p2meshsurf%L_TAB_COINKNOT,
436 . pmeshsurf%KNOT_INSERE,p2meshsurf%KNOT_INSERE,
437 . pmeshsurf%TAB_MESHSURFCUT,pmeshsurf%L_TAB_MESHSURFCUT,
438 . p2meshsurf%TAB_MESHSURFCUT,p2meshsurf%L_TAB_MESHSURFCUT,0)
439 ENDDO
440C
441 ALLOCATE(pmeshsurf%TAB_MESHSURFCUT(pmeshsurf%L_TAB_MESHSURFCUT))
442 pmeshsurf%L_TAB_MESHSURFCUT = 0
443C
444 DO ittest=1,nbmeshsurf-1
445 p2meshsurf => meshsurf(ittest)
446 CALL comput_mesh_neighbour(pmeshsurf%DIR, p2meshsurf%DIR,
447 . pmeshsurf%ID_PID, p2meshsurf%ID_PID, p2meshsurf%ID_MESHSURF,
448 . pmeshsurf%TAB_COINKNOT,pmeshsurf%L_TAB_COINKNOT,
449 . p2meshsurf%TAB_COINKNOT,p2meshsurf%L_TAB_COINKNOT,
450 . pmeshsurf%KNOT_INSERE,p2meshsurf%KNOT_INSERE,
451 . pmeshsurf%TAB_MESHSURFCUT,pmeshsurf%L_TAB_MESHSURFCUT,
452 . p2meshsurf%TAB_MESHSURFCUT,p2meshsurf%L_TAB_MESHSURFCUT,1)
453 ENDDO
454C
455 CALL test_support_fct(ixig3d, kxig3d, knotlocpc, ptang1, ptang2, pmeshsurf%DIR,
456 . pmeshsurf%TAB_ELCUT,pmeshsurf%L_TAB_ELCUT,
457 . pmeshsurf%TAB_COINKNOT,pmeshsurf%L_TAB_COINKNOT,
458 . pmeshsurf%TAB_FCTCUT,pmeshsurf%L_TAB_FCTCUT,decalgeo_tmp,0)
459C
460 ALLOCATE(pmeshsurf%TAB_FCTCUT(pmeshsurf%L_TAB_FCTCUT))
461C
462 CALL test_support_fct(ixig3d, kxig3d, knotlocpc, ptang1, ptang2, pmeshsurf%DIR,
463 . pmeshsurf%TAB_ELCUT,pmeshsurf%L_TAB_ELCUT,
464 . pmeshsurf%TAB_COINKNOT,pmeshsurf%L_TAB_COINKNOT,
465 . pmeshsurf%TAB_FCTCUT,pmeshsurf%L_TAB_FCTCUT,decalgeo_tmp,1)
466C
467 CALL rafig3d(knotlocpc,
468 . pdir,ptang1,ptang2,iad_knot,nknot1,nknot2,nknot3,
469 . gama,pmeshsurf%DIR,pmeshsurf%KNOT_INSERE,
470 . x_tmp,d_tmp,v_tmp,ms_tmp,wige_tmp,
471 . pmeshsurf%TAB_FCTCUT,pmeshsurf%L_TAB_FCTCUT,
472 . tab_remove,tab_newfct,decalgeo_tmp,tabconpatch,p,
473 . kxig3d,ixig3d,tab_stay,flag_pre)
474C
475 DO ittest=1,pmeshsurf%L_TAB_MESHSURFCUT
476 p2meshsurf => meshsurf(pmeshsurf%TAB_MESHSURFCUT(ittest))
477 IF(p2meshsurf%DIR==2) THEN
478 p2dir=py
479 p2tang1=pz
480 p2tang2=px
481 ELSEIF(p2meshsurf%DIR==1) THEN
482 p2dir=px
483 p2tang1=py
484 p2tang2=pz
485 ENDIF
486 l_tab_newfctcut = 0
487 CALL test_support_newfct(knotlocpc, p2dir, p2tang1, p2tang2,
488 . p2meshsurf%DIR, p2meshsurf%KNOT_INSERE,
489 . p2meshsurf%TAB_COINKNOT,p2meshsurf%L_TAB_COINKNOT, tab_newfct,
490 . tab_newfctcut,l_tab_newfctcut,decalgeo_tmp,tab_remove,0)
491 IF(l_tab_newfctcut>0) THEN
492 ALLOCATE(tab_newfctcut(l_tab_newfctcut))
493 CALL test_support_newfct(knotlocpc, p2dir, p2tang1, p2tang2,
494 . p2meshsurf%DIR, p2meshsurf%KNOT_INSERE,
495 . p2meshsurf%TAB_COINKNOT,p2meshsurf%L_TAB_COINKNOT, tab_newfct,
496 . tab_newfctcut,l_tab_newfctcut,decalgeo_tmp,tab_remove,1)
497 CALL rafig3d(knotlocpc,
498 . p2dir,p2tang1,p2tang2,iad_knot,nknot1,nknot2,nknot3,
499 . gama,p2meshsurf%DIR,p2meshsurf%KNOT_INSERE,
500 . x_tmp,d_tmp,v_tmp,ms_tmp,wige_tmp,
501 . tab_newfctcut,l_tab_newfctcut,
502 . tab_remove,tab_newfct,decalgeo_tmp,tabconpatch,p,
503 . kxig3d,ixig3d,tab_stay,flag_pre)
504
505 DEALLOCATE(tab_newfctcut)
506
507 ENDIF
508 ENDDO
509C
510 CALL rebuild_ig3d(ixig3d, kxig3d,pmeshsurf%DIR,pdir,ptang1,ptang2,
511 . knotlocpc,knotlocel,
512 . pmeshsurf%TAB_ELCUT,pmeshsurf%L_TAB_ELCUT,
513 . pmeshsurf%TAB_NEWEL,pmeshsurf%L_TAB_NEWEL,
514 . pmeshsurf%TAB_FCTCUT,pmeshsurf%L_TAB_FCTCUT,
515 . tab_remove,tab_newfct,el_connect,tabconpatch(p),
516 . idfils,flag_pre,flag_debug)
517
518 offset_newfct = offset_newfct + newfct ! "snew becomes s again" the new functions are no longer new
519
520 ENDDO ! loop over the number of cuts of the element
521 ENDIF
522 ENDDO ! loop over the elements of the patch
523 ENDDO ! loop over the directions
524 DEALLOCATE(idxel,idyel,idzel)
525 DEALLOCATE(meshigex,meshigey,meshigez)
526 ENDDO ! loop over the patches
527c
528CC----------------------------------------------------------------------------------------------
529C Deallocation of the structures defining the cuts
530CC----------------------------------------------------------------------------------------------
531c
532 DO i=1,nbmeshsurf
533 IF(meshsurf(i)%L_TAB_COINKNOT/=0) DEALLOCATE(meshsurf(i)%TAB_COINKNOT)
534 IF(meshsurf(i)%L_TAB_ELCUT/=0) DEALLOCATE(meshsurf(i)%TAB_ELCUT)
535 IF(meshsurf(i)%L_TAB_FCTCUT/=0) DEALLOCATE(meshsurf(i)%TAB_FCTCUT)
536 IF(meshsurf(i)%L_TAB_NEWEL/=0) DEALLOCATE(meshsurf(i)%TAB_NEWEL)
537 IF(meshsurf(i)%L_TAB_MESHSURFCUT/=0) DEALLOCATE(meshsurf(i)%TAB_MESHSURFCUT)
538 ENDDO
539 DEALLOCATE(meshsurf)
540c
541CC----------------------------------------------------------------------------------------------
542CC A POSTERIORI TEST OF FUNCTIONS AND ELEMENTS. DOES NOT DIRECTLY TEST IF THERE EXISTS
543C elements with too many functions, but allows to see if there is any issue
544CC----------------------------------------------------------------------------------------------
545c
546 IF(flag_debug==1) THEN
547 DO i=1,numelig3d0+addelig3d
548 j=1
549 decalgeo_tmp=(kxig3d(2,i)-1)*(numnod+nbnewx_tmp)
550 DO j=1,kxig3d(3,i)
551 inctrl=ixig3d(kxig3d(4,i)+j-1)
552 IF(inctrl==0) THEN
553 print*,'ELEMENT',i,'point',inctrl
554 ELSEIF(knotlocel(1,1,i)<knotlocpc(1,1,decalgeo_tmp+inctrl)-em06 .OR.
555 . knotlocel(2,1,i)>knotlocpc(4,1,decalgeo_tmp+inctrl)+em06 .OR.
556 . knotlocel(1,2,i)<knotlocpc(1,2,decalgeo_tmp+inctrl)-em06 .OR.
557 . knotlocel(2,2,i)>knotlocpc(4,2,decalgeo_tmp+inctrl)+em06 .OR.
558 . knotlocel(1,3,i)<knotlocpc(1,3,decalgeo_tmp+inctrl)-em06 .OR.
559 . knotlocel(2,3,i)>knotlocpc(4,3,decalgeo_tmp+inctrl)+em06) THEN
560 print*,'ELEMENT',i,'point',inctrl
561 print*,knotlocel(1,1,i),'<',knotlocpc(1,1,decalgeo_tmp+inctrl)
562 print*,knotlocel(2,1,i),'>',knotlocpc(4,1,decalgeo_tmp+inctrl)
563 print*,knotlocel(1,2,i),'<',knotlocpc(1,2,decalgeo_tmp+inctrl)
564 print*,knotlocel(2,2,i),'>',knotlocpc(4,2,decalgeo_tmp+inctrl)
565 print*,knotlocel(1,3,i),'<',knotlocpc(1,3,decalgeo_tmp+inctrl)
566 print*,knotlocel(2,3,i),'>',knotlocpc(4,3,decalgeo_tmp+inctrl)
567 ENDIF
568 ENDDO
569 ENDDO
570 ENDIF
571c
572 IF(nbmeshsurf/=0) THEN
573c
574c ------------------------------------------------------------------------------------------
575c reorganization of the elementary arrays and connectivities with the repacking of the points
576c ------------------------------------------------------------------------------------------
577c
578 CALL reorder_ig3d(ixig3d, kxig3d,knotlocpc,knotlocel,
579 . x_tmp,d_tmp,v_tmp,ms_tmp,wige_tmp,
580 . tab_remove,tab_newfct,el_connect,
581 . ipartig3d,igeo,tab_stay,flag_pre,flag_debug)
582c
583c ------------------------------------------------------------------------------------------
584c temporary arrays are brought back into the final arrays
585c ------------------------------------------------------------------------------------------
586c
587 IF(flag_pre==1) THEN
588 DO i=1,numnod
589 DO j=1,3
590 x((i-1)*3+j) = x_tmp((i-1)*3+j)
591 v((i-1)*3+j) = v_tmp((i-1)*3+j)
592 d((i-1)*3+j) = d_tmp((i-1)*3+j)
593 ENDDO
594 ms(i) = ms_tmp(i)
595 wige(i) = wige_tmp(i)
596 ENDDO
597 DO p=1,nbpart_ig3d
598 ipid=tabconpatch(p)%PID
599 decalgeofinal=(ipid-1)*numnod
600 decalgeo_tmp=(ipid-1)*(numnod+nbnewx_tmp)
601 DO i=1,numnod
602 knotlocpc(:,1,decalgeofinal+i) = knotlocpc(:,1,decalgeo_tmp+i)
603 knotlocpc(:,2,decalgeofinal+i) = knotlocpc(:,2,decalgeo_tmp+i)
604 knotlocpc(:,3,decalgeofinal+i) = knotlocpc(:,3,decalgeo_tmp+i)
605 ENDDO
606 ENDDO
607 DEALLOCATE(x_tmp,v_tmp,d_tmp,ms_tmp,wige_tmp)
608
609 IF(flag_debug==1) THEN
610 DO i=1,numelig3d0+addelig3d
611 j=1
612 decalgeofinal=(kxig3d(2,i)-1)*(numnod)
613 DO j=1,kxig3d(3,i)
614 inctrl=ixig3d(kxig3d(4,i)+j-1)
615 IF(inctrl==0) THEN
616 print*,'ELEMENT',i,'point',inctrl
617 ELSEIF(knotlocel(1,1,i)<knotlocpc(1,1,decalgeofinal+inctrl)-em06 .OR.
618 . knotlocel(2,1,i)>knotlocpc(4,1,decalgeofinal+inctrl)+em06 .OR.
619 . knotlocel(1,2,i)<knotlocpc(1,2,decalgeofinal+inctrl)-em06 .OR.
620 . knotlocel(2,2,i)>knotlocpc(4,2,decalgeofinal+inctrl)+em06 .OR.
621 . knotlocel(1,3,i)<knotlocpc(1,3,decalgeofinal+inctrl)-em06 .OR.
622 . knotlocel(2,3,i)>knotlocpc(4,3,decalgeofinal+inctrl)+em06) THEN
623 print*,'ELEMENT',i,'point',inctrl
624 print*,knotlocel(1,1,i),'<',KNOTLOCPC(1,1,DECALGEOFINAL+INCTRL)
625 print*,KNOTLOCEL(2,1,I),'>',KNOTLOCPC(4,1,DECALGEOFINAL+INCTRL)
626 print*,KNOTLOCEL(1,2,I),'<',KNOTLOCPC(1,2,DECALGEOFINAL+INCTRL)
627 print*,KNOTLOCEL(2,2,I),'>',KNOTLOCPC(4,2,DECALGEOFINAL+INCTRL)
628 print*,KNOTLOCEL(1,3,I),'<',KNOTLOCPC(1,3,DECALGEOFINAL+INCTRL)
629 print*,KNOTLOCEL(2,3,I),'>',KNOTLOCPC(4,3,DECALGEOFINAL+INCTRL)
630 ENDIF
631 ENDDO
632 ENDDO
633 ENDIF
634
635 ENDIF
636 ENDIF
637
638c
639c ------------------------------------------------------------------------------------------
640c
641 DEALLOCATE(TAB_REMOVE)
642 DEALLOCATE(TAB_STAY)
643 DEALLOCATE(TAB_NEWFCT)
644 DEALLOCATE(GAMA)
645 DEALLOCATE(IDFILS)
646 DEALLOCATE(EL_CONNECT)
647 DEALLOCATE(TAB_INITIAL_CUT)
648
649 RETURN
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
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
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