1 : C DYNE29 SOURCE CHAT 05/01/12 23:16:54 5004
2 : SUBROUTINE DYNE29(IPALB,XPALB,NLIAB,NOMBN1,NOMBN2,I,ID1,IP1)
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8(A-H,O-Z)
5 : *--------------------------------------------------------------------*
6 : * *
7 : * Op{rateur DYNE : algorithme de Fu - de Vogelaere *
8 : * ________________________________________________ *
9 : * *
10 : * Coefficient des droites form{es par les {l{ments du profil *
11 : * fixe. *
12 : * *
13 : * Param}tres: *
14 : * *
15 : * es IPALB tableau de description des liaisons sur base B *
16 : * es XPALB tableau de description des liaisons sur base B *
17 : * e NLIAB nombre total de liaisons sur base B *
18 : * e NOMBN1 nombre de points du profil fixe *
19 : * e NOMBN2 nombre de points du profil mobile *
20 : * e I num{ro de liaison trait{e *
21 : * e ID1 indice de tableau pour XPALB *
22 : * e IP1 indice de tableau pour IPALB *
23 : * *
24 : * *
25 : * Auteur, date de cr{ation: *
26 : * *
27 : * Lionel VIVAN, le 1 f{vrier 1991. *
28 : * *
29 : *--------------------------------------------------------------------*
30 : -INC CCOPTIO
31 : *
32 : INTEGER IPALB(NLIAB,*)
33 : REAL*8 XPALB(NLIAB,*)
34 : PARAMETER ( PRECIS = 1.D-15 , ZERO = 0.D0 )
35 : *
36 : ID2 = ID1 + IDIM
37 : ID3 = ID1 + 2*IDIM
38 : ID4 = ID1 + 3*IDIM
39 : ID6 = ID1 + 5*IDIM
40 : ID8 = ID1 + 5*IDIM + IDIM*NOMBN1 + IDIM*NOMBN2
41 : NUM1 = ID6
42 : NUM2 = ID6 + IDIM
43 : DO 10 IE = 1,NOMBN1
44 : IF (IE.EQ.NOMBN1) THEN
45 : NUM2 = ID6
46 : ENDIF
47 : * calcul des coordonn{es dans le plan d{fini par les profils
48 : X1 = ZERO
49 : Y1 = ZERO
50 : X2 = ZERO
51 : Y2 = ZERO
52 : DO 12 ID = 1,IDIM
53 : XX = XPALB(I,NUM1+ID) - XPALB(I,ID2+ID)
54 : YY = XPALB(I,NUM2+ID) - XPALB(I,ID2+ID)
55 : X1 = X1 + ( XX * XPALB(I,ID3+ID) )
56 : Y1 = Y1 + ( XX * XPALB(I,ID4+ID) )
57 : X2 = X2 + ( YY * XPALB(I,ID3+ID) )
58 : Y2 = Y2 + ( YY * XPALB(I,ID4+ID) )
59 : 12 CONTINUE
60 : * end do
61 : XXX = X2 - X1
62 : YYY = Y2 - Y1
63 : IF (ABS(XXX).LT.PRECIS) THEN
64 : * la droite est verticale
65 : IPALB(I,IP1+IE) = 1
66 : XPALB(I,ID8+1) = X1
67 : XPALB(I,ID8+2) = ZERO
68 : ELSE IF (ABS(YYY).LT.PRECIS) THEN
69 : * la droite est horizontale
70 : IPALB(I,IP1+IE) = 2
71 : XPALB(I,ID8+1) = ZERO
72 : XPALB(I,ID8+2) = Y1
73 : ELSE
74 : * la droite est quelconque
75 : IPALB(I,IP1+IE) = 3
76 : XPALB(I,ID8+1) = YYY / XXX
77 : XPALB(I,ID8+2) = ( X2*Y1 - X1*Y2 ) / XXX
78 : ENDIF
79 : NUM1 = NUM2
80 : NUM2 = NUM2 + IDIM
81 : ID8 = ID8 + 2
82 : 10 CONTINUE
83 : * end do
84 : *
85 : END
86 :
© Cast3M 2003 - All rights reserved.
Disclaimer