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

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ test_support_fct()

subroutine test_support_fct ( integer, dimension(*) ixig3d,
integer, dimension(nixig3d,*) kxig3d,
knotlocpc,
integer degtang1,
integer degtang2,
integer dir,
integer, dimension(l_tab_elcut) tab_elcut,
integer l_tab_elcut,
tab_coinknot,
integer l_tab_coinknot,
integer, dimension(l_tab_fctcut) tab_fctcut,
integer l_tab_fctcut,
integer decalgeo,
integer flag )

Definition at line 29 of file test_support_fct.F.

33C----------------------------------------------------------------------
34C ROUTINE QUI PERMET DE METTRE DE COTE TOUTES LES FONCTIONS D'ONE
35C ENSEMBLE D'ELEMENTS DU PATCH QUI VONT POTENTIELLEMENT ETRE MODIFIEES
36C EN INSERANT LE KNOT DE LA MESHSURF
37C CETTE ROUTINE UTILISE ONE ALGORITHME DE DETECTION D'INCLUSION
38C DE SEGMENTS DANS UNE SURFACE (LEGEREMENT MODIFIE)
39C----------------------------------------------------------------------
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "param_c.inc"
48#include "ige3d_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER IXIG3D(*),KXIG3D(NIXIG3D,*),DEGTANG1,DEGTANG2,DIR,DECALGEO,
53 . TAB_ELCUT(L_TAB_ELCUT),L_TAB_ELCUT,L_TAB_COINKNOT,
54 . TAB_FCTCUT(L_TAB_FCTCUT),L_TAB_FCTCUT,FLAG
55 my_real knotlocpc(deg_max,3,*),tab_coinknot(2,*)
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER I,J,K,DIRTANG1,DIRTANG2,
60 . IEL,INTERSEC,
61 . WORK(70000),SIZ_LIST_FCTTOT,IDFCT,IOUT
62 my_real det, t1, t2, xa(5),ya(5),coin(2,2),
63 . xb, yb, xc, yc, xd, yd, tol
64 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX, LIST_FCTTOT, LIST_FCTTRI
65C-----------------------------------------------
66c
67 l_tab_fctcut = 0
68 tol = em06
69c
70 IF(dir==1) THEN
71 dirtang1 = 2
72 dirtang2 = 3
73 ELSEIF(dir==2) THEN
74 dirtang1 = 3
75 dirtang2 = 1
76 ELSEIF(dir==3) THEN
77 dirtang1 = 1
78 dirtang2 = 2
79 ELSE
80 dirtang1 = -huge(dirtang1)
81 dirtang2 = -huge(dirtang2)
82 ENDIF
83c
84C----------------------------------------------------------------------
85c on liste toutes les fonctions a traiter et les trier pour
86c ne pas traiter deux fois la meme fonction
87C----------------------------------------------------------------------
88c
89 siz_list_fcttot = l_tab_elcut*kxig3d(3,tab_elcut(1))
90 ALLOCATE(list_fcttot(siz_list_fcttot))
91 ALLOCATE(list_fcttri(siz_list_fcttot))
92 list_fcttot(:) = ep06
93c
94 DO i=1,l_tab_elcut
95 iel=tab_elcut(i)
96 DO j=1,kxig3d(3,iel)
97 list_fcttot((i-1)*kxig3d(3,iel)+j) = ixig3d(kxig3d(4,iel)+j-1)
98 ENDDO
99 ENDDO
100c
101 ALLOCATE(index(2*siz_list_fcttot))
102 CALL my_orders(0, work, list_fcttot, index, siz_list_fcttot , 1)
103c
104 DO i=1,siz_list_fcttot
105 list_fcttri(i)=list_fcttot(index(i))
106 ENDDO
107c
108 DEALLOCATE(list_fcttot)
109 DEALLOCATE(index)
110c
111 coin(1,1) = minval(tab_coinknot(1,1:(l_tab_coinknot)))
112 coin(2,1) = minval(tab_coinknot(2,1:(l_tab_coinknot)))
113 coin(1,2) = maxval(tab_coinknot(1,1:(l_tab_coinknot)))
114 coin(2,2) = maxval(tab_coinknot(2,1:(l_tab_coinknot)))
115c
116 DO i=1,siz_list_fcttot
117c
118 IF(i/=1) THEN
119 IF(list_fcttri(i-1)==list_fcttri(i)) cycle
120 ENDIF
121c
122 idfct = list_fcttri(i)
123 iout=0
124c
125C----------------------------------------------------------------------
126c CREATION DES VARIABLES DE TRAVAIL : COIN DES ETENDUES KNOT DE LA FONCTION
127c A TESTER
128C----------------------------------------------------------------------
129c
130 xa(1) = knotlocpc(1,dirtang1,decalgeo+idfct) + tol
131 xa(2) = knotlocpc(degtang1+1,dirtang1,decalgeo+idfct) - tol
132 xa(3) = knotlocpc(degtang1+1,dirtang1,decalgeo+idfct) - tol
133 xa(4) = knotlocpc(1,dirtang1,decalgeo+idfct) + tol
134 xa(5) = xa(1)
135c
136 ya(1) = knotlocpc(1,dirtang2,decalgeo+idfct) + tol
137 ya(2) = knotlocpc(1,dirtang2,decalgeo+idfct) + tol
138 ya(3) = knotlocpc(degtang2+1,dirtang2,decalgeo+idfct) - tol
139 ya(4) = knotlocpc(degtang2+1,dirtang2,decalgeo+idfct) - tol
140 ya(5) = ya(1)
141c
142C----------------------------------------------------------------------
143c 1er test : test des 4 points en fonction des 4 coins convexes de la meshsurf
144C----------------------------------------------------------------------
145c
146 IF(xa(1)<coin(1,1).OR.ya(1)<coin(2,1)) cycle
147 IF(xa(3)>coin(1,2).OR.ya(3)>coin(2,2)) cycle
148c
149C----------------------------------------------------------------------
150cc 2eme test : test si le segment forme avec un point eloigne intersecte un cote du polygone
151C----------------------------------------------------------------------
152c
153 xb=coin(1,1)-1000 ! ON PREND LE POINT SUFFISAMMENT ELOIGNE DE LA MESHSURF
154 yb=coin(2,1)-2000
155 DO j=1,4 ! BOUCLE SUR LES 4 COINS DE L'ETENDUE
156 intersec=0
157 DO k=1,l_tab_coinknot-1
158 xc=tab_coinknot(1,k)
159 yc=tab_coinknot(2,k)
160 xd=tab_coinknot(1,k+1)
161 yd=tab_coinknot(2,k+1)
162 det = (xb-xa(j))*(yc-yd) - (xc-xd)*(yb-ya(j))
163 IF(det==0) THEN
164c segments paralleles ou colineaires
165 ELSE
166 t1 = ((xc-xa(j))*(yc-yd)-(xc-xd)*(yc-ya(j)))/det
167 t2 = ((xb-xa(j))*(yc-ya(j))-(xc-xa(j))*(yb-ya(j)))/det
168 IF(t1>1.OR.t1<0.OR.t2>1.OR.t2<=0) THEN ! pas d'intersection
169c ! pas d'intersection
170 ELSE
171 intersec = intersec + 1
172c ! intersection : incrementer le compteur de 1
173 ENDIF
174 ENDIF
175 ENDDO
176 IF(mod(intersec,2)==0) iout=1 ! NOMBRE PAIRE D'INTERSECTION, LE POINT EST EN DEHORS DE LA MESHSURF
177 ENDDO
178c
179 IF(iout==1) cycle
180c
181C----------------------------------------------------------------------
182c 3eme test : Pour traiter les polygones concaves, il faut tester les segments forme par les etendus
183C----------------------------------------------------------------------
184c
185 DO j=1,4 ! BOUCLE SUR LES 4 COINS DE L'ETENDUE
186 DO k=1,l_tab_coinknot-1
187 xc=tab_coinknot(1,k)
188 yc=tab_coinknot(2,k)
189 xd=tab_coinknot(1,k+1)
190 yd=tab_coinknot(2,k+1)
191 det = (xa(j+1)-xa(j))*(yc-yd) - (xc-xd)*(ya(j+1)-ya(j))
192 IF(det==0) THEN
193c segments paralleles ou colineaires donc boucler sur un autre segment du polygone
194 ELSE
195 t1 = ((xc-xa(j))*(yc-yd)-(xc-xd)*(yc-ya(j)))/det
196 t2 = ((xa(j+1)-xa(j))*(yc-ya(j))-(xc-xa(j))*(ya(j+1)-ya(j)))/det
197 IF(t1>1.OR.t1<0.OR.t2>1.OR.t2<=0) THEN ! pas d'intersection
198c ! pas d'intersection
199 ELSE
200 iout=1 ! intersection : fonction a exclure
201 cycle
202 ENDIF
203 ENDIF
204 ENDDO
205 ENDDO
206C
207C----------------------------------------------------------------------
208C DIMENSIONNEMENT ET STOCKAGE DU TABLEAU DES FONCTIONS A RAFFINER
209C----------------------------------------------------------------------
210C
211 IF(iout==0) THEN
212 IF(flag==0) THEN
213 l_tab_fctcut = l_tab_fctcut + 1
214 ELSE
215 l_tab_fctcut = l_tab_fctcut + 1
216 tab_fctcut(l_tab_fctcut) = idfct
217 ENDIF
218 ENDIF
219c
220 ENDDO
221c
222 DEALLOCATE(list_fcttri)
223C
224 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82