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

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ test_support_newfct()

subroutine test_support_newfct ( knotlocpc,
integer dirdeg,
integer degtang1,
integer degtang2,
integer dir,
newknot,
tab_coinknot,
integer l_tab_coinknot,
integer, dimension(*) tab_newfct,
integer, dimension(l_tab_newfctcut) tab_newfctcut,
integer l_tab_newfctcut,
integer decalgeo,
integer, dimension(*) tab_remove,
integer flag )

Definition at line 28 of file test_support_newfct.F.

32C----------------------------------------------------------------------
33C ROUTINE QUI MET DE COTE TOUTES LES FONCTIONS QUI ONT
34C ETE MODIFIEES OU CREES PAR RAFIG3D.F MAIS QUI PEUVENT ENCORE ETRE
35C MODIFIEE OU SUPPRIMEES PAR LES ANCIENNES MESHSURFS QUE LA MESHSURF
36C ACTUELLE CROISE
37C----------------------------------------------------------------------
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "ige3d_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER DIRDEG,DEGTANG1,DEGTANG2,DIR,DECALGEO,
50 . L_TAB_COINKNOT,TAB_NEWFCT(*),
51 . TAB_NEWFCTCUT(L_TAB_NEWFCTCUT),L_TAB_NEWFCTCUT,FLAG,TAB_REMOVE(*)
52 my_real knotlocpc(deg_max,3,*),tab_coinknot(2,*),newknot
53C-----------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56 INTEGER :: I,J,K,DIRTANG1,DIRTANG2,INTERSEC,IDFCT,IOUT
57 my_real :: det, t1, t2, xa(5),ya(5),coin(2,2),xb, yb, xc, yc, xd, yd, tol
58C-----------------------------------------------
59C Initialize local variables
60C-----------------------------------------------
61 i = 0
62 j = 0
63 k = 0
64 dirtang1 = 0
65 dirtang2 = 0
66 intersec = 0
67 idfct = 0
68 iout = 0
69 det = 0.0
70 t1 = 0.0
71 t2 = 0.0
72 xa = 0.0
73 ya = 0.0
74 coin = 0.0
75 xb = 0.0
76 yb = 0.0
77 xc = 0.0
78 yc = 0.0
79 xd = 0.0
80 yd = 0.0
81 tol = 0.0
82C-----------------------------------------------
83
84
85C
86 l_tab_newfctcut = 0
87 tol = em06
88C
89 IF(dir==1) THEN
90 dirtang1 = 2
91 dirtang2 = 3
92 ELSEIF(dir==2) THEN
93 dirtang1 = 3
94 dirtang2 = 1
95 ELSEIF(dir==3) THEN
96 dirtang1 = 1
97 dirtang2 = 2
98 ENDIF
99C
100 coin(1,1) = minval(tab_coinknot(1,1:(l_tab_coinknot)))
101 coin(2,1) = minval(tab_coinknot(2,1:(l_tab_coinknot)))
102 coin(1,2) = maxval(tab_coinknot(1,1:(l_tab_coinknot)))
103 coin(2,2) = maxval(tab_coinknot(2,1:(l_tab_coinknot)))
104C
105 DO i=1,newfct ! les nouvelles fonctions ajoutees par le dernier rafig3d.F
106
107 idfct = tab_newfct(offset_newfct+i)
108C Fonctions stockees dans le tableau tab_newfct offsete
109c pour ne pas prendre les newfct des anciennes coupes terminees
110
111 DO j=1,l_tab_remove
112 IF(tab_remove(j)==idfct) EXIT
113 ENDDO
114 IF(j<=l_tab_remove) cycle
115
116 IF(knotlocpc(1,dir,decalgeo+idfct)>=newknot) cycle
117 IF(knotlocpc(dirdeg+1,dir,decalgeo+idfct)<=newknot) cycle
118C
119C----------------------------------------------------------------------
120C LE KNOT A INSERER NE DOIT PAS DEJA ETRE PRESENT
121C----------------------------------------------------------------------
122C
123 DO j=2,dirdeg
124 IF(knotlocpc(j,dir,decalgeo+idfct)==newknot) EXIT
125 ENDDO
126 IF(j<=dirdeg) cycle
127c
128 iout=0
129C
130C----------------------------------------------------------------------
131CC DOCUMENTATION TEST D'INCLUSION : VOIR TEST_SUPPORT_FCT.F
132C----------------------------------------------------------------------
133C
134 xa(1) = knotlocpc(1,dirtang1,decalgeo+idfct) + tol
135 xa(2) = knotlocpc(degtang1+1,dirtang1,decalgeo+idfct) - tol
136 xa(3) = knotlocpc(degtang1+1,dirtang1,decalgeo+idfct) - tol
137 xa(4) = knotlocpc(1,dirtang1,decalgeo+idfct) + tol
138 xa(5) = xa(1)
139 ya(1) = knotlocpc(1,dirtang2,decalgeo+idfct) + tol
140 ya(2) = knotlocpc(1,dirtang2,decalgeo+idfct) + tol
141 ya(3) = knotlocpc(degtang2+1,dirtang2,decalgeo+idfct) - tol
142 ya(4) = knotlocpc(degtang2+1,dirtang2,decalgeo+idfct) - tol
143 ya(5) = ya(1)
144C
145 IF(xa(1)<coin(1,1).OR.ya(1)<coin(2,1)) cycle
146 IF(xa(3)>coin(1,2).OR.ya(3)>coin(2,2)) cycle
147C
148 xb=coin(1,1)-1000
149 yb=coin(2,1)-2000
150C
151 DO j=1,4
152 intersec=0
153 DO k=1,l_tab_coinknot-1
154 xc=tab_coinknot(1,k)
155 yc=tab_coinknot(2,k)
156 xd=tab_coinknot(1,k+1)
157 yd=tab_coinknot(2,k+1)
158 det = (xb-xa(j))*(yc-yd) - (xc-xd)*(yb-ya(j))
159 IF(det==0) THEN
160 ELSE
161 t1 = ((xc-xa(j))*(yc-yd)-(xc-xd)*(yc-ya(j)))/det
162 t2 = ((xb-xa(j))*(yc-ya(j))-(xc-xa(j))*(yb-ya(j)))/det
163 IF(t1>1.OR.t1<0.OR.t2>1.OR.t2<=0) THEN
164 ELSE
165 intersec = intersec + 1
166 ENDIF
167 ENDIF
168 ENDDO
169 IF(mod(intersec,2)==0) iout=1
170 ENDDO
171C
172 DO j=1,4
173 DO k=1,l_tab_coinknot-1
174 xc=tab_coinknot(1,k)
175 yc=tab_coinknot(2,k)
176 xd=tab_coinknot(1,k+1)
177 yd=tab_coinknot(2,k+1)
178 det = (xa(j+1)-xa(j))*(yc-yd) - (xc-xd)*(ya(j+1)-ya(j))
179 IF(det==0) THEN
180 ELSE
181 t1 = ((xc-xa(j))*(yc-yd)-(xc-xd)*(yc-ya(j)))/det
182 t2 = ((xa(j+1)-xa(j))*(yc-ya(j))-(xc-xa(j))*(ya(j+1)-ya(j)))/det
183 IF(t1>1.OR.t1<0.OR.t2>1.OR.t2<=0) THEN
184 ELSE
185 iout=1
186 cycle
187 ENDIF
188 ENDIF
189 ENDDO
190 ENDDO
191C
192C----------------------------------------------------------------------
193C DIMENSIONNEMENT ET STOCKAGE DU TABLEAU DES FONCTIONS A RETRAITER
194C PAR LES ANCIENNES COUPES (TAB_MESHSURFCUT)
195C----------------------------------------------------------------------
196C
197 IF(iout==0) THEN
198 IF(flag==0) THEN
199 l_tab_newfctcut = l_tab_newfctcut + 1
200 ELSE
201 l_tab_newfctcut = l_tab_newfctcut + 1
202 tab_newfctcut(l_tab_newfctcut)=idfct
203 ENDIF
204 ENDIF
205 ENDDO
206C
207 RETURN
my_real
#define my_real
Definition cppsort.cpp:32