1 : C DYNE33 SOURCE CHAT 05/01/12 23:17:23 5004
2 : SUBROUTINE DYNE33(XPALB,IPALB,NLIAB,I,ID1,XSECT)
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 : * Calcule la section du profil mobile *
11 : * *
12 : * Param}tres: *
13 : * *
14 : * e XPALB tableau de description des liaisons sur base B *
15 : * e IPALB tableau de description des liaisons sur base B *
16 : * e NLIAB nombre total de liaisons *
17 : * s XSECT section *
18 : * *
19 : * *
20 : * Auteur, date de cr{ation: *
21 : * *
22 : * Lionel VIVAN, le 1 f{vrier 1991. *
23 : * *
24 : *--------------------------------------------------------------------*
25 : *
26 : INTEGER IPALB(NLIAB,*)
27 : REAL*8 XPALB(NLIAB,*)
28 : PARAMETER ( ZERO = 0.D0 )
29 : *
30 : IDIM = IPALB(I,3)
31 : NOMBN1 = IPALB(I,4)
32 : NOMBN2 = IPALB(I,5)
33 : ID2 = ID1 + IDIM
34 : ID3 = ID1 + 2*IDIM
35 : ID4 = ID1 + 3*IDIM
36 : ID7 = ID1 + 5*IDIM + IDIM*NOMBN1
37 : * calcul du barycentre du profil mobile
38 : XBARY = ZERO
39 : YBARY = ZERO
40 : IPT1 = ID7
41 : DO 8 IN = 1,NOMBN2
42 : XP1 = ZERO
43 : YP1 = ZERO
44 : DO 10 ID = 1,IDIM
45 : XX1 = XPALB(I,IPT1+ID) - XPALB(I,ID2+ID)
46 : XP1 = XP1 + ( XX1 * XPALB(I,ID3+ID) )
47 : YP1 = YP1 + ( XX1 * XPALB(I,ID4+ID) )
48 : 10 CONTINUE
49 : * end do
50 : IPT1 = IPT1 + IDIM
51 : XBARY = XBARY + XP1
52 : YBARY = YBARY + YP1
53 : 8 CONTINUE
54 : * end do
55 : XBARY = XBARY / NOMBN2
56 : YBARY = YBARY / NOMBN2
57 : *
58 : XSECT = ZERO
59 : IPT1 = ID7
60 : IPT2 = ID7 + IDIM
61 : DO 12 IS = 1,NOMBN2
62 : IF (IS.EQ.NOMBN2) IPT2 = ID7
63 : * calcul des coordonn{es dans le plan d{fini par les profils
64 : XP1 = ZERO
65 : YP1 = ZERO
66 : XP2 = ZERO
67 : YP2 = ZERO
68 : DO 14 ID = 1,IDIM
69 : XX1 = XPALB(I,IPT1+ID) - XPALB(I,ID2+ID)
70 : XX2 = XPALB(I,IPT2+ID) - XPALB(I,ID2+ID)
71 : XP1 = XP1 + ( XX1 * XPALB(I,ID3+ID) )
72 : YP1 = YP1 + ( XX1 * XPALB(I,ID4+ID) )
73 : XP2 = XP2 + ( XX2 * XPALB(I,ID3+ID) )
74 : YP2 = YP2 + ( XX2 * XPALB(I,ID4+ID) )
75 : 14 CONTINUE
76 : * end do
77 : XP1P2 = XP2 - XP1
78 : YP1P2 = YP2 - YP1
79 : DA = SQRT( (XP1P2 ** 2) + (YP1P2 ** 2 ) )
80 : XP2G = XBARY - XP2
81 : YP2G = YBARY - YP2
82 : DB = SQRT( (XP2G ** 2) + (YP2G ** 2) )
83 : XGP1 = XP1 - XBARY
84 : YGP1 = YP1 - YBARY
85 : DC = SQRT( (XGP1 ** 2) + (YGP1 ** 2) )
86 : PERI = 0.5 * ( DA + DB + DC )
87 : SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
88 : XSECT = XSECT + SQRT(SURF)
89 : *
90 : IPT1 = IPT2
91 : IPT2 = IPT2 + IDIM
92 : 12 CONTINUE
93 : * end do
94 : *
95 : END
96 :
© Cast3M 2003 - All rights reserved.
Disclaimer