1 : C DYNE30 SOURCE CHAT 05/01/12 23:17:07 5004
2 : SUBROUTINE DYNE30(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 : * Position initiale du profil mobile par rapport au profil fixe *
11 : * *
12 : * Param}tres: *
13 : * *
14 : * es IPALB tableau de description des liaisons sur base B *
15 : * es XPALB tableau de description des liaisons sur base B *
16 : * e NLIAB nombre total de liaisons sur base B *
17 : * e NOMBN1 nombre de points du profil fixe *
18 : * e NOMBN2 nombre de points du profil mobile *
19 : * e I num{ro de liaison trait{e *
20 : * e ID1 indice de tableau pour XPALB *
21 : * e IP1 indice de tableau pour IPALB *
22 : * *
23 : * *
24 : * Auteur, date de cr{ation: *
25 : * *
26 : * Lionel VIVAN, le 1 f{vrier 1991. *
27 : * *
28 : *--------------------------------------------------------------------*
29 : -INC CCOPTIO
30 : *
31 : INTEGER IPALB(NLIAB,*)
32 : REAL*8 XPALB(NLIAB,*)
33 : PARAMETER ( ZERO = 0.D0 )
34 : *
35 : ID2 = ID1 + IDIM
36 : ID3 = ID1 + 2*IDIM
37 : ID4 = ID1 + 3*IDIM
38 : ID7 = ID1 + 5*IDIM + IDIM*NOMBN1
39 : ID8 = ID7 + IDIM*NOMBN2
40 : NUM1 = ID7
41 : IEL2 = IP1 + NOMBN1
42 : DO 10 IN = 1,NOMBN2
43 : * calcul des coordonn{es dans le plan d{fini par les profils
44 : X1 = ZERO
45 : Y1 = ZERO
46 : DO 12 ID = 1,IDIM
47 : XX = XPALB(I,NUM1+ID) - XPALB(I,ID2+ID)
48 : X1 = X1 + ( XX * XPALB(I,ID3+ID) )
49 : Y1 = Y1 + ( XX * XPALB(I,ID4+ID) )
50 : 12 CONTINUE
51 : * end do
52 : NUM2 = ID8
53 : DO 14 IE = 1,NOMBN1
54 : ITYP = IPALB(I,IP1+IE)
55 : XAIJ = XPALB(I,NUM2+1)
56 : XBIJ = XPALB(I,NUM2+2)
57 : IF (ITYP.EQ.1) THEN
58 : * La droite est verticale
59 : IF (X1.GT.XAIJ) THEN
60 : IPALB(I,IEL2+IE) = 1
61 : ELSE IF (X1.LT.XAIJ) THEN
62 : IPALB(I,IEL2+IE) = -1
63 : ELSE
64 : IPALB(I,IEL2+IE) = 0
65 : ENDIF
66 : ELSE IF (ITYP.EQ.2) THEN
67 : * La droite est horizontale
68 : IF (Y1.GT.XBIJ) THEN
69 : IPALB(I,IEL2+IE) = 1
70 : ELSE IF (Y1.LT.XBIJ) THEN
71 : IPALB(I,IEL2+IE) = -1
72 : ELSE
73 : IPALB(I,IEL2+IE) = 0
74 : ENDIF
75 : ELSE
76 : * La droite est quelconque
77 : RES = ( XAIJ * X1 ) + XBIJ
78 : IF (Y1.GT.RES) THEN
79 : IPALB(I,IEL2+IE) = 1
80 : ELSE IF (Y1.LT.RES) THEN
81 : IPALB(I,IEL2+IE) = -1
82 : ELSE
83 : IPALB(I,IEL2+IE) = 0
84 : ENDIF
85 : ENDIF
86 : NUM2 = NUM2 + 2
87 : 14 CONTINUE
88 : * end do
89 : IEL2 = IEL2 + NOMBN1
90 : NUM1 = NUM1 + IDIM
91 : 10 CONTINUE
92 : * end do
93 : *
94 : END
95 :
© Cast3M 2003 - All rights reserved.
Disclaimer