1 : C DYNE31 SOURCE CHAT 05/01/12 23:17:12 5004
2 : SUBROUTINE DYNE31(IPOIN1,IPOIN2,IELEM1,XPALB,IPALB,XPTB,NLIAB,
3 : & NPLB,I,NPOI,IND,ID1,IP1,XPP,YPP)
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 : * Calcul le point d'intersection *
12 : * *
13 : * Param}tres: *
14 : * *
15 : * e IPOIN1 point du profil mobile *
16 : * e IPOIN2 point du profil mobile *
17 : * e IELEM1 {l{ment du profil fixe *
18 : * e NLIAB nombre total de liaisons *
19 : * e NPOI point support *
20 : * s XPP 1}re coordonn{e du point d'intersection *
21 : * s YPP 2}me coordonn{e du point d'intersection *
22 : * *
23 : * *
24 : * Auteur, date de cr{ation: *
25 : * *
26 : * Lionel VIVAN, le 1 f{vrier 1991. *
27 : * *
28 : *--------------------------------------------------------------------*
29 : *
30 : INTEGER IPALB(NLIAB,*)
31 : REAL*8 XPTB(NPLB,4,*),XPALB(NLIAB,*)
32 : PARAMETER ( ZERO = 0.D0 , PRECIS = 1.D-15 )
33 : *
34 : III = 0
35 : XPP = ZERO
36 : YPP = ZERO
37 : ICOMP = 1
38 : IDIM = IPALB(I,3)
39 : NOMBN1 = IPALB(I,4)
40 : NOMBN2 = IPALB(I,5)
41 : ID2 = ID1 + IDIM
42 : ID3 = ID1 + 2*IDIM
43 : ID4 = ID1 + 3*IDIM
44 : ID6 = ID1 + 5*IDIM
45 : ID7 = ID1 + 5*IDIM + IDIM*NOMBN1
46 : ID8 = ID7 + IDIM*NOMBN2
47 : * calcul des coordonn{es dans le plan d{fini par les profils
48 : IPN1 = ID7 + IDIM*(IPOIN1-1)
49 : IPN2 = ID7 + IDIM*(IPOIN2-1)
50 : X1 = ZERO
51 : Y1 = ZERO
52 : X2 = ZERO
53 : Y2 = ZERO
54 : DO 8 ID = 1,IDIM
55 : XX1 = XPTB(NPOI,IND,ID) + XPALB(I,IPN1+ID) - XPALB(I,ID2+ID)
56 : XX2 = XPTB(NPOI,IND,ID) + XPALB(I,IPN2+ID) - XPALB(I,ID2+ID)
57 : X1 = X1 + ( XX1 * XPALB(I,ID3+ID) )
58 : Y1 = Y1 + ( XX1 * XPALB(I,ID4+ID) )
59 : X2 = X2 + ( XX2 * XPALB(I,ID3+ID) )
60 : Y2 = Y2 + ( XX2 * XPALB(I,ID4+ID) )
61 : 8 CONTINUE
62 : * end do
63 : XXX = X2 - X1
64 : YYY = Y2 - Y1
65 : IE = IELEM1
66 : 20 CONTINUE
67 : IEL1 = ID6 + IDIM*(IE-1)
68 : IEL2 = ID6 + IDIM*IE
69 : IF (IE.EQ.NOMBN1) IEL2 = ID6
70 : XE1 = ZERO
71 : YE1 = ZERO
72 : XE2 = ZERO
73 : YE2 = ZERO
74 : DO 10 ID = 1,IDIM
75 : XX1 = XPALB(I,IEL1+ID) - XPALB(I,ID2+ID)
76 : XX2 = XPALB(I,IEL2+ID) - XPALB(I,ID2+ID)
77 : XE1 = XE1 + ( XX1 * XPALB(I,ID3+ID) )
78 : YE1 = YE1 + ( XX1 * XPALB(I,ID4+ID) )
79 : XE2 = XE2 + ( XX2 * XPALB(I,ID3+ID) )
80 : YE2 = YE2 + ( XX2 * XPALB(I,ID4+ID) )
81 : 10 CONTINUE
82 : * end do
83 : IEL3 = ID8 + 2*(IE - 1)
84 : ICAS = IPALB(I,IP1+IE)
85 : XAIJ = XPALB(I,IEL3+1)
86 : XBIJ = XPALB(I,IEL3+2)
87 : *
88 : * La droite cr{{e par l'{l{ment du profil fixe est verticale
89 : *
90 : IF (ICAS.EQ.1) THEN
91 : XPP = XAIJ
92 : IF (ABS(YYY).LT.PRECIS) THEN
93 : * La droite cr{{e par les points IPOIN1 et IPOIN2 est horizontale
94 : YPP = Y1
95 : GOTO 30
96 : ELSE IF (ABS(XXX).LT.PRECIS) THEN
97 : * La droite cr{{e par les points IPOIN1 et IPOIN2 est verticale
98 : * alors on va chercher l'{l{ment du profil fixe suivant
99 : GOTO 12
100 : ELSE
101 : * La droite cr{{e par les points IPOIN1 et IPOIN2 est quelconque
102 : AL2 = YYY / XXX
103 : BL2 = ( X2*Y1 - Y2*X1 ) / XXX
104 : YPP = ( AL2 * XPP ) + BL2
105 : * V{rification des coordonn{es du point d'intersection
106 : IF (YE1.LE.YE2) THEN
107 : IF (YE1.LE.YPP .AND. YPP.LE.YE2) GOTO 30
108 : GOTO 12
109 : ELSE
110 : IF (YE2.LE.YPP .AND. YPP.LE.YE1) GOTO 30
111 : GOTO 12
112 : ENDIF
113 : ENDIF
114 : *
115 : * La droite cr{{e par l'{l{ment du profil fixe est horizontale
116 : *
117 : ELSE IF (ICAS.EQ.2) THEN
118 : YPP = XBIJ
119 : IF (ABS(XXX).LT.PRECIS) THEN
120 : * La droite cr{{e par les points IPOIN1 et IPOIN2 est verticale
121 : XPP = X1
122 : GOTO 30
123 : ELSE IF (ABS(YYY).LT.PRECIS) THEN
124 : * La droite cr{{e par les points IPOIN1 et IPOIN2 est horizontale
125 : * alors on va chercher l'{l{ment du profil fixe suivant
126 : GOTO 12
127 : ELSE
128 : * La droite cr{{e par les points IPOIN1 et IPOIN2 est quelconque
129 : AL2 = YYY / XXX
130 : BL2 = ( X2*Y1 - Y2*X1 ) / XXX
131 : XPP = ( YPP - BL2 ) / AL2
132 : * V{rification des coordonn{es du point d'intersection
133 : IF (XE1.LE.XE2) THEN
134 : IF (XE1.LE.XPP .AND. XPP.LE.XE2) GOTO 30
135 : GOTO 12
136 : ELSE
137 : IF (XE2.LE.XPP .AND. XPP.LE.XE1) GOTO 30
138 : GOTO 12
139 : ENDIF
140 : ENDIF
141 : *
142 : * La droite cr{{e par un {l{ment du profil fixe est quelconque
143 : *
144 : ELSE
145 : IF (ABS(XXX).LT.PRECIS) THEN
146 : * La droite cr{{e par les points IPOIN1 et IPOIN2 est verticale
147 : XPP = X1
148 : YPP = ( XAIJ * XPP ) + XBIJ
149 : * V{rification des coordonn{es du point d'intersection
150 : IF (YE1.LE.YE2) THEN
151 : IF (YE1.LE.YPP .AND. YPP.LE.YE2) GOTO 30
152 : GOTO 12
153 : ELSE
154 : IF (YE2.LE.YPP .AND. YPP.LE.YE1) GOTO 30
155 : GOTO 12
156 : ENDIF
157 : ELSE
158 : * La droite cr{{e par les points IPOIN1 et IPOIN2 est quelconque
159 : AL2 = YYY / XXX
160 : BL2 = ( X2*Y1 - Y2*X1 ) / XXX
161 : XPP = ( XBIJ - BL2 ) / ( AL2 - XAIJ )
162 : YPP = ( AL2 * XPP ) + BL2
163 : * V{rification des coordonn{es du point d'intersection
164 : IF (XE1.LE.XE2 .AND. YE1.LE.YE2) THEN
165 : IF (XE1.LE.XPP .AND. XPP.LE.XE2 .AND.
166 : & YE1.LE.YPP .AND. YPP.LE.YE2) GOTO 30
167 : GOTO 12
168 : ELSE IF (XE1.LE.XE2 .AND. YE2.LE.YE1) THEN
169 : IF (XE1.LE.XPP .AND. XPP.LE.XE2 .AND.
170 : & YE2.LE.YPP .AND. YPP.LE.YE1) GOTO 30
171 : GOTO 12
172 : ELSE IF (XE2.LE.XE1 .AND. YE2.LE.YE1) THEN
173 : IF (XE2.LE.XPP .AND. XPP.LE.XE1 .AND.
174 : & YE2.LE.YPP .AND. YPP.LE.YE1) GOTO 30
175 : GOTO 12
176 : ELSE
177 : IF (XE2.LE.XPP .AND. XPP.LE.XE1 .AND.
178 : & YE1.LE.YPP .AND. YPP.LE.YE2) GOTO 30
179 : GOTO 12
180 : ENDIF
181 : ENDIF
182 : ENDIF
183 : 12 CONTINUE
184 : IF (ICOMP.EQ.NOMBN1) RETURN
185 : IF (III.EQ.1) THEN
186 : * on regarde l'{l{ment pr{c{dent
187 : IE = IELEM1 - ICOMP
188 : IF (IE.LE.0) IE = IE + NOMBN1
189 : III = -1
190 : ICOMP = ICOMP + 1
191 : GOTO 20
192 : ELSE
193 : * on regarde l'{l{ment suivant
194 : IE = IELEM1 + ICOMP
195 : IF (IE.GE.(NOMBN1+1)) IE = IE - NOMBN1
196 : III = 1
197 : GOTO 20
198 : ENDIF
199 : 30 CONTINUE
200 : IELEM1 = IE
201 : *
202 : END
203 :
© Cast3M 2003 - All rights reserved.
Disclaimer