1 : C DYCAND SOURCE CHAT 05/01/12 22:59:59 5004
2 : SUBROUTINE DYCAND(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,
3 : & XXXN,XDEP,XPOID,ICAND,IESC,IROLE)
4 : IMPLICIT INTEGER(I-N)
5 : IMPLICIT REAL*8(A-H,O-Z)
6 : *-----------------------------------------------------------------------*
7 : * *
8 : * Opérateur DYNE : algorithme de Fu - de Vogelaere *
9 : * ________________________________________________ *
10 : * *
11 : * Pour la liaison Ligne_Ligne , *
12 : * Donne le segment du maillage le plus proche du point butée , *
13 : * calcule la normale intérieure au segment, le déplacement suivant *
14 : * cette normale et la position du point de contact sur le segment *
15 : * *
16 : * *
17 : * Paramètres *
18 : * *
19 : * e IPALB Renseigne sur la liaison. *
20 : * e IPLIB Tableau contenant les numéros "DYNE" de la liaison. *
21 : * e XPALB Tableau contenant les paramètres de la liaison. * *
22 : * e XPTB Tableau des d{placements des points *
23 : * e NLIAB Nombre de liaisons sur la base B. *
24 : * e NPLB Nombre total de points intervenant dans les liaisons. *
25 : * e IND Indice du pas. *
26 : * e I numéro de la liaison. *
27 : * es ICAND Numéros 'dyne' des noeuds du segment candidat. *
28 : * es XPOID Position relative du point de contact sur le segment. *
29 : * es XXXN Normale intérieur au segment candidat. *
30 : * es XDEP Déplacement suivant la normale. *
31 : * *
32 : * *
33 : * Auteur, date de création: *
34 : * *
35 : * Samuel DURAND : le 08 Aout 1996 : Création *
36 : * *
37 : *-----------------------------------------------------------------------*
38 : INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
39 : INTEGER ICAND(2)
40 : REAL*8 XPTB(NPLB,4,*),XPALB(NLIAB,*)
41 : REAL*8 XXMA(3),PSC(2)
42 : REAL*8 XXXN(3),XXXC(2,3)
43 : *
44 : ITYP = IPALB(I,1)
45 : IDIM = IPALB(I,3)
46 : IF (ITYP.EQ.35) THEN
47 : ID1 = 6
48 : ELSE
49 : ID1 = 7
50 : ENDIF
51 : IF (IROLE.EQ.0) THEN
52 : KMAI = 0
53 : IMAI = ID1 +4*IDIM
54 : IBUT = IMAI + (IPALB(I,21))*IDIM
55 : NNOEMA= IPALB(I,21)
56 : IFERMA= IPALB(I,24)
57 : KBUT = IPALB(I,21)
58 : JVOI=26
59 : ELSE
60 : KMAI = IPALB(I,21)
61 : IBUT = ID1 + 4*IDIM
62 : IMAI = IBUT + (IPALB(I,21))*IDIM
63 : NNOEMA= IPALB(I,22)
64 : IFERMA= IPALB(I,25)
65 : KBUT = 0
66 : JVOI=26+IPALB(I,22)
67 : ENDIF
68 : IM = IPALB(I,JVOI+IESC)
69 : *
70 : *****************************************
71 : * Recherche du segment candidat *
72 : *****************************************
73 : IM2 = IM +1
74 : IM1 = IM -1
75 : IDM = IMAI +(IM-1)*IDIM
76 : PXXC1 = 0.D0
77 : PXXC2 = 0.D0
78 : XLONG = 0.D0
79 : PSC(1) = 0.D0
80 : PSC(2) = 0.D0
81 : XDEP = 0.D0
82 : * Prise en compte des extrémitées pour contour fermé
83 : IF (IM1.EQ.0.AND.IFERMA.EQ.1) THEN
84 : IM1 = NNOEMA
85 : ENDIF
86 : IF (IM2.EQ.(NNOEMA+1).AND.IFERMA.EQ.1) THEN
87 : IM2 = 1
88 : ENDIF
89 : IDM2 = IMAI +(IM2-1)*IDIM
90 : IDM1 = IMAI +(IM1-1)*IDIM
91 : * Tangentes au contour
92 : DO 500 ID=1,IDIM
93 : IF (IM2.NE.(NNOEMA+1)) THEN
94 : XXXC(2,ID) =XPALB(I,IDM2+ID)
95 : &+XPTB(IPLIB(I,KMAI+IM2),IND,ID)
96 : &-XPALB(I,IDM+ID)-XPTB(IPLIB(I,KMAI+IM),IND,ID)
97 : ELSE
98 : XXXC(2,ID) = XPALB(I,IDM+ID)
99 : &+XPTB(IPLIB(I,KMAI+IM),IND,ID)
100 : &-XPALB(I,IDM1+ID)-XPTB(IPLIB(I,KMAI+IM1),IND,ID)
101 : ENDIF
102 : IF (IM1.NE.0) THEN
103 : XXXC(1,ID) = XPALB(I,IDM+ID)
104 : &+XPTB(IPLIB(I,KMAI+IM),IND,ID)
105 : &-XPALB(I,IDM1+ID)-XPTB(IPLIB(I,KMAI+IM1),IND,ID)
106 : ELSE
107 : XXXC(1,ID) = XPALB(I,IDM2+ID)
108 : &+XPTB(IPLIB(I,KMAI+IM2),IND,ID)
109 : &-XPALB(I,IDM+ID)-XPTB(IPLIB(I,KMAI+IM),IND,ID)
110 : ENDIF
111 : PXXC1 = PXXC1 + XXXC(1,ID)*XXXC(1,ID)
112 : PXXC2 = PXXC2 + XXXC(2,ID)*XXXC(2,ID)
113 : 500 CONTINUE
114 : * Normalisation des tangentes
115 : PXXC1 = SQRT(PXXC1)
116 : PXXC2 = SQRT(PXXC2)
117 : DO 504 ID=1,IDIM
118 : XXXC(1,ID) = XXXC(1,ID)/PXXC1
119 : XXXC(2,ID) = XXXC(2,ID)/PXXC2
120 : 504 CONTINUE
121 : * Projections sur les deux segments
122 : IDESC=IBUT+(IESC-1)*IDIM
123 : DO 508 ID=1,IDIM
124 : XXMA(ID) = XPALB(I,IDESC+ID) + XPTB(IPLIB(I,KBUT+IESC),
125 : &IND,ID)- XPALB(I,IDM+ID) - XPTB(IPLIB(I,KMAI+IM),IND,ID)
126 : PSC(1) = PSC(1) - XXMA(ID)*XXXC(1,ID)
127 : PSC(2) = PSC(2) + XXMA(ID)*XXXC(2,ID)
128 : 508 CONTINUE
129 : * Choix du segment
130 : ICAND(1) = IM
131 : IF (PSC(2).GT.PSC(1)) THEN
132 : IPT = 2
133 : ICAND(2) = IM2
134 : ELSE
135 : IPT = 1
136 : ICAND(2) = IM1
137 : ENDIF
138 : * Normale extérieure retenue
139 : IF (IDIM.EQ.3) THEN
140 : XXXN(1) = XPALB(I,ID1+2)*XXXC(IPT,3)-XPALB(I,ID1+3)*
141 : &XXXC(IPT,2)
142 : XXXN(2) = XPALB(I,ID1+3)*XXXC(IPT,1)-XPALB(I,ID1+1)*
143 : &XXXC(IPT,3)
144 : XXXN(3) = XPALB(I,ID1+1)*XXXC(IPT,2)-XPALB(I,ID1+2)*
145 : &XXXC(IPT,1)
146 : ELSE
147 : XXXN(1) = -XXXC(IPT,2)
148 : XXXN(2) = XXXC(IPT,1)
149 : ENDIF
150 : * Projection sur la normale
151 : DO 510 ID=1,IDIM
152 : XDEP = XDEP + XXMA(ID)*XXXN(ID)
153 : 510 CONTINUE
154 : * Pour un contour ouvert,arrivée en limite
155 : IF (ICAND(2).EQ.0) THEN
156 : ICAND(2) = 2
157 : XDEP = - ABS(XDEP)
158 : ENDIF
159 : IF (ICAND(2).EQ.(NNOEMA+1)) THEN
160 : ICAND(2) = NNOEMA-1
161 : XDEP = - ABS(XDEP)
162 : ENDIF
163 : * En cas de pénétration ,on récupère le poids associé
164 : XPOID = 0
165 : IF (XDEP.GE.0) THEN
166 : IF (PSC(IPT).GE.0) THEN
167 : IDCAN1 = IMAI +(ICAND(1) -1)*IDIM
168 : IDCAN2 = IMAI +(ICAND(2) -1)*IDIM
169 : DO 512 ID=1,IDIM
170 : * Longueur du segment
171 : XAIDE = (XPALB(I,IDCAN1+ID)
172 : &+XPTB(IPLIB(I,KMAI+ICAND(1)),IND,ID)-XPALB(I,IDCAN2+ID)
173 : &-XPTB(IPLIB(I,KMAI+ICAND(2)),IND,ID))
174 : XLONG = XLONG + XAIDE*XAIDE
175 : 512 CONTINUE
176 : XLONG = SQRT(XLONG)
177 : XPOID = (1-PSC(IPT)/XLONG)
178 : ELSE
179 : PS = 0.D0
180 : DO 514 ID=1,IDIM
181 : PS = PS + XXMA(ID)*XXMA(ID)
182 : 514 CONTINUE
183 : PS = SQRT(PS)
184 : DO 516 ID=1,IDIM
185 : XXXN(ID) = XXMA(ID)/PS
186 : 516 CONTINUE
187 : XPOID = 1
188 : ENDIF
189 : ENDIF
190 : END
191 :
192 :
© Cast3M 2003 - All rights reserved.
Disclaimer