1 : C DYCAN1 SOURCE CHAT 05/01/12 22:59:53 5004
2 : C DYCAND SOURCE LAVARENN 96/11/05 21:22:27 2357
3 : SUBROUTINE DYCAN1(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,
4 : & XXXN,XNET,XTE,XPOID,ICAND,IESC,IROLE)
5 : IMPLICIT INTEGER(I-N)
6 : IMPLICIT REAL*8(A-H,O-Z)
7 : *-----------------------------------------------------------------------*
8 : * *
9 : * Opérateur DYNE : algorithme de Fu - de Vogelaere *
10 : * ________________________________________________ *
11 : * *
12 : * Pour la liaison Ligne_cercle , *
13 : * Donne le segment du maillage le plus proche du point butée , *
14 : * calcule la normale de contact, le déplacement suivant *
15 : * cette normale et la position du point de contact sur le segment *
16 : * *
17 : * *
18 : * Paramètres *
19 : * *
20 : * e IPALB Renseigne sur la liaison. *
21 : * e IPLIB Tableau contenant les numéros "DYNE" de la liaison. *
22 : * e XPALB Tableau contenant les paramètres de la liaison. * *
23 : * e XPTB Tableau des d{placements des points *
24 : * e NLIAB Nombre de liaisons sur la base B. *
25 : * e NPLB Nombre total de points intervenant dans les liaisons. *
26 : * e IND Indice du pas. *
27 : * e I numéro de la liaison. *
28 : * es ICAND Numéros 'dyne' des noeuds du segment candidat. *
29 : * es XPOID Position relative du point de contact sur le segment. *
30 : * es XXXN Normale au contact *
31 : * es XNET distance du centre du cercle(E) au point du *
32 : * segment candidat dans le plan du cercle (T) *
33 : * s XTE vecteur TE (T POINT DE CONTACT, E CENTRE DU CERCLE ) *
34 : * *
35 : * Auteur, date de création: *
36 : * *
37 : * IBRAHIM PINTO, 05/97 *
38 : * *
39 : *-----------------------------------------------------------------------*
40 : INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
41 : INTEGER ICAND(2)
42 : REAL*8 XPTB(NPLB,4,*),XPALB(NLIAB,*)
43 : REAL*8 XXMA(3),PSC(2),AE(3),AB(3), PCONT(3),XTE(3)
44 : REAL*8 XXXN(3),XXXC(2,3),U(3)
45 : *
46 :
47 :
48 : ITYP = IPALB(I,1)
49 : IDIM = IPALB(I,3)
50 : XRAIT = XPALB(I,5)
51 : IF (ITYP.EQ.37 .OR. ITYP.EQ.39) THEN
52 : ID1 = 6
53 : ELSE
54 : ID1 = 7
55 : ENDIF
56 : IF (IROLE.EQ.0) THEN
57 : KMAI = 0
58 : IMAI = ID1 +4*IDIM
59 : IBUT = IMAI + (IPALB(I,21))*IDIM
60 : NNOEMA= IPALB(I,21)
61 : IFERMA= IPALB(I,24)
62 : KBUT = IPALB(I,21)
63 : JVOI=26
64 : ELSE
65 : KMAI = IPALB(I,21)
66 : IBUT = ID1 + 4*IDIM
67 : IMAI = IBUT + (IPALB(I,21))*IDIM
68 : NNOEMA= IPALB(I,22)
69 : IFERMA= IPALB(I,25)
70 : KBUT = 0
71 : JVOI=26+IPALB(I,22)
72 : ENDIF
73 : IM = IPALB(I,JVOI+IESC)
74 :
75 :
76 :
77 : *
78 : *****************************************
79 : * Recherche du segment candidat *
80 : *****************************************
81 : IM2 = IM +1
82 : IM1 = IM -1
83 : IDM = IMAI +(IM-1)*IDIM
84 : PXXC1 = 0.D0
85 : PXXC2 = 0.D0
86 : XLONG = 0.D0
87 : PSC(1) = 0.D0
88 : PSC(2) = 0.D0
89 : XNET = 0.D0
90 : * Prise en compte des extrémitées pour contour fermé
91 : IF (IM1.EQ.0.AND.IFERMA.EQ.1) THEN
92 : IM1 = NNOEMA
93 : ENDIF
94 : IF (IM2.EQ.(NNOEMA+1).AND.IFERMA.EQ.1) THEN
95 : IM2 = 1
96 : ENDIF
97 : IDM2 = IMAI +(IM2-1)*IDIM
98 : IDM1 = IMAI +(IM1-1)*IDIM
99 : * Tangentes au contour
100 : DO 500 ID=1,IDIM
101 : IF (IM2.NE.(NNOEMA+1)) THEN
102 : XXXC(2,ID) =XPALB(I,IDM2+ID)
103 : &+XPTB(IPLIB(I,KMAI+IM2),IND,ID)
104 : &-XPALB(I,IDM+ID)-XPTB(IPLIB(I,KMAI+IM),IND,ID)
105 : ELSE
106 : XXXC(2,ID) = -XPALB(I,IDM+ID)
107 : &-XPTB(IPLIB(I,KMAI+IM),IND,ID)
108 : &+XPALB(I,IDM1+ID)+XPTB(IPLIB(I,KMAI+IM1),IND,ID)
109 : ENDIF
110 : IF (IM1.NE.0) THEN
111 : XXXC(1,ID) = -XPALB(I,IDM+ID)
112 : &-XPTB(IPLIB(I,KMAI+IM),IND,ID)
113 : &+XPALB(I,IDM1+ID)+XPTB(IPLIB(I,KMAI+IM1),IND,ID)
114 : ELSE
115 : XXXC(1,ID) = XPALB(I,IDM2+ID)
116 : &+XPTB(IPLIB(I,KMAI+IM2),IND,ID)
117 : &-XPALB(I,IDM+ID)-XPTB(IPLIB(I,KMAI+IM),IND,ID)
118 : ENDIF
119 : PXXC1 = PXXC1 + XXXC(1,ID)*XXXC(1,ID)
120 : PXXC2 = PXXC2 + XXXC(2,ID)*XXXC(2,ID)
121 : 500 CONTINUE
122 : * Normalisation des tangentes
123 : PXXC1 = SQRT(PXXC1)
124 : PXXC2 = SQRT(PXXC2)
125 : DO 504 ID=1,IDIM
126 : XXXC(1,ID) = XXXC(1,ID)/PXXC1
127 : XXXC(2,ID) = XXXC(2,ID)/PXXC2
128 : 504 CONTINUE
129 : * Projections sur les deux segments
130 : IDESC=IBUT+(IESC-1)*IDIM
131 : DO 508 ID=1,IDIM
132 : XXMA(ID) = XPALB(I,IDESC+ID) + XPTB(IPLIB(I,KBUT+IESC),
133 : &IND,ID)- XPALB(I,IDM+ID) - XPTB(IPLIB(I,KMAI+IM),IND,ID)
134 : PSC(1) = PSC(1) + XXMA(ID)*XXXC(1,ID)
135 : PSC(2) = PSC(2) + XXMA(ID)*XXXC(2,ID)
136 : 508 CONTINUE
137 : * Choix du segment
138 : ICAND(1) = IM
139 : IF (PSC(2).GT.PSC(1)) THEN
140 : IPT = 2
141 : ICAND(2) = IM2
142 : ELSE
143 : IPT = 1
144 : ICAND(2) = IM1
145 : ENDIF
146 :
147 :
148 : * Pour un contour ouvert arrivee en limite
149 : * mise a zero de xnet pour indiquer qu'il n'a pas
150 : * contact
151 :
152 : IF (ICAND(2).EQ.0) THEN
153 : ICAND(2) = 2
154 : XNET = 0
155 : ENDIF
156 : IF (ICAND(1).EQ.(NNOEMA+1)) THEN
157 : ICAND(2)= NNOEMA-1
158 : XNET=0
159 : ENDIF
160 :
161 :
162 :
163 : *---position relative du point de contact sur le segment candidat
164 :
165 :
166 : IDCAN1 = IMAI +(ICAND(1) -1)*IDIM
167 : IDCAN2 = IMAI +(ICAND(2) -1)*IDIM
168 : PSNAE = 0.D0
169 : PSNAB = 0.D0
170 :
171 :
172 :
173 : *------calcul des produits scalaires necessaires
174 :
175 : *--------calcul des coordonnees des vecteurs icand1iesc(AE) et icand1icand2(AB)
176 :
177 : DO 510 ID=1,IDIM
178 : AE(ID) = XPALB(I,IDESC+ID)+XPTB(IPLIB(I,KBUT+IESC),IND,
179 : &ID)-XPALB(I,IDCAN1+ID)-XPTB(IPLIB(I,KMAI+ICAND(1)),IND,ID)
180 :
181 : AB(ID)= XPALB(I,IDCAN2+ID)+XPTB(IPLIB(I,KMAI+ICAND(2)),IND,
182 : &ID)-XPALB(I,IDCAN1+ID)-XPTB(IPLIB(I,KMAI+ICAND(1)),IND,ID)
183 : 510 CONTINUE
184 :
185 :
186 :
187 : *------calcul des produits scalaires
188 : *------AVEC LA NORMALE AU PLAN DU CERCLE
189 :
190 : DO 512 ID=1,IDIM
191 : PSNAE=PSNAE+XPALB(I,ID1+ID)*AE(ID)
192 : PSNAB=PSNAB+XPALB(I,ID1+ID)*AB(ID)
193 : 512 CONTINUE
194 :
195 : *------CALCUL DE LA POSITION RELATIVE DU POINT DU
196 : *------SEGMENT DANS LE PLAN DU CERCLE(ORIGINE:LE+PROCHE VOISIN MAITRE)
197 :
198 : XNHU=0.D0
199 : XNHU=PSNAE/PSNAB
200 :
201 :
202 :
203 : IF (XNHU.GE.0) THEN
204 :
205 :
206 : *------CALCUL DES COORDONNES CARTESIENNES
207 : *------DU "POINT DE CONTACT POTENTIEL"(POINT T)
208 :
209 : DO 514 ID=1,IDIM
210 : PCONT(ID)=0.D0
211 : PCONT(ID)=(1-XNHU)*(XPALB(I,IDCAN1+ID)
212 : &+XPTB(IPLIB(I,KMAI+ICAND(1)),IND,ID))+
213 : &XNHU*(XPALB(I,IDCAN2+ID)
214 : &+XPTB(IPLIB(I,KMAI+ICAND(2)),IND,ID))
215 : 514 CONTINUE
216 :
217 :
218 : *-----CALCUL DE LA DISTANCE ENTRE LE NOEUD ESCLAVE(CENTRE DU CERCLE)
219 : *-----ET LE POINT DU SEGMENT DANS LE PLAN DU CERCLE( DISTANCE ET)
220 :
221 : XNET=0.D0
222 : PSET2=0.D0
223 :
224 :
225 :
226 :
227 : DO 516 ID=1,IDIM
228 : XA=-PCONT(ID)
229 : XB=XPALB(I,IDESC+ID)
230 : XC=XPTB(IPLIB(I,KBUT+IESC),IND,ID)
231 : XTE(ID)=XA+XB+XC
232 : * XTE(ID)=-PCONT(ID)+XPALB(I,IDESC+ID)+XPTB(IPLIB(I,KBUT+IESC),
233 : * &IND,ID)
234 : PSET2=PSET2+XTE(ID)*XTE(ID)
235 :
236 :
237 :
238 : 516 CONTINUE
239 :
240 :
241 : XNET=SQRT(PSET2)
242 :
243 :
244 : *-----CALCUL DU POIDS EN CAS DE CONTACT
245 :
246 : XPOID=0.D0
247 : XRAY=XPALB(I,2)
248 :
249 : IF (XNET.GE.XRAY) THEN
250 : XPOID=1-XNHU
251 : ENDIF
252 :
253 : ELSE
254 : *--------SINON TOUT SE PASSE COMME S'IL N'Y AVAIT
255 : *--------PAS CONTACT;ON MET XNET A ZERO
256 :
257 : XNET=0.D0
258 :
259 : ENDIF
260 :
261 : *----ENDIF DU XNHU.GE.0
262 :
263 :
264 :
265 :
266 : *-----CALCUL DE LA NORMALE AU PLAN DE CONTACT
267 :
268 :
269 : IF (ITYP.EQ.37 .OR. ITYP.EQ.38) THEN
270 : *-----SI ON SUPPOSE LA NORMALE DANS LE PLAN DU CERCLE
271 : *-----NORMALE=TE, ON NE DIFFERENCIE PAS CAS 2D ET 3D(SANREAC)
272 :
273 : DO 517 ID=1,IDIM
274 : XXXN(ID)=XTE(ID)/XNET
275 : 517 CONTINUE
276 :
277 :
278 :
279 : ELSE
280 :
281 : *-----DANS LE CAS GENERAL (REACNOR)
282 : *-----ON A BESOIN DE LA NORMALE AU PLAN ABE
283 :
284 : PSN=0.D0
285 : PSN2=0.D0
286 :
287 : *-------CALCUL DE LA NORMALE AU PLAN ABE(U)
288 : IF (IDIM.EQ.3) THEN
289 : U(1)=AB(2)*AE(3)-AB(3)*AE(2)
290 : U(2)=AB(3)*AE(1)-AB(1)*AE(3)
291 : U(3)=AB(1)*AE(2)-AB(2)*AE(1)
292 :
293 :
294 : *-------CALCUL DE LA NORMALE AU PLAN DE CONTACT EN 3D
295 :
296 : XXXN(1)=U(2)*AB(3)-U(3)*AB(2)
297 : XXXN(2)=U(3)*AB(1)-U(1)*AB(3)
298 : XXXN(3)=U(1)*AB(2)-U(2)*AB(1)
299 :
300 :
301 : ELSE
302 :
303 : *-------calcul de la normale en 2d
304 : XXXN(1)=-(AB(1)*AE(2)-AB(2)*AE(1))*AB(2)
305 : XXXN(2)=(AB(1)*AE(2)-AB(2)*AE(1))*AB(1)
306 : ENDIF
307 :
308 : *-------NORMALISATION,INDEPENDANTE DE LA DIMENSION
309 : DO 522 ID=1,IDIM
310 : PSN2=PSN2 + XXXN(ID)*XXXN(ID)
311 : 522 CONTINUE
312 : PSN=SQRT(PSN2)
313 : DO 524 ID=1,IDIM
314 : XXXN(ID)=XXXN(ID)/PSN
315 : 524 CONTINUE
316 :
317 : ENDIF
318 :
319 :
320 :
321 :
322 :
323 : C
324 :
325 : END
326 :
327 :
328 :
329 :
© Cast3M 2003 - All rights reserved.
Disclaimer