1 : C DYNE35 SOURCE CHAT 05/01/12 23:17:35 5004
2 : SUBROUTINE DYNE35(IPOIN1,IPOIN2,XBARY,YBARY,XP,YP,XPP,YPP,XPALB,
3 : & IPALB,XPTB,NLIAB,NPLB,I,NPOI,ID1,IND,SOMAIR)
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 de l'aire de la section qui n'a pas travers{ le *
12 : * maillage fixe. *
13 : * *
14 : * Param}tres: *
15 : * *
16 : * e IPOIN1 point du profil mobile *
17 : * e IPOIN2 point du profil mobile *
18 : * e XBARY coordonn{e du barycentre *
19 : * e YBARY coordonn{e du barycentre *
20 : * e I num{ro de la liaison trait{e *
21 : * e XP,YP coordonn{es du point P d'intersection *
22 : * e XPP,YPP coordonn{es du point PP d'intersection *
23 : * e NLIAB nombre total de liaisons *
24 : * s SOMAIR aire de la section *
25 : * *
26 : * Auteur, date de cr{ation: *
27 : * *
28 : * Lionel VIVAN, le 1 f{vrier 1991. *
29 : * *
30 : *--------------------------------------------------------------------*
31 : *
32 : INTEGER IPALB(NLIAB,*)
33 : REAL*8 XPTB(NPLB,4,*),XPALB(NLIAB,*)
34 : PARAMETER ( ZERO = 0.D0 )
35 : *
36 : IDIM = IPALB(I,3)
37 : NOMBN1 = IPALB(I,4)
38 : NOMBN2 = IPALB(I,5)
39 : ID2 = ID1 + IDIM
40 : ID3 = ID1 + 2*IDIM
41 : ID4 = ID1 + 3*IDIM
42 : ID6 = ID1 + 5*IDIM
43 : ID7 = ID6 + IDIM*NOMBN1
44 : IPT1 = ID7 + IDIM*(IPOIN1-1)
45 : IPT2 = ID7 + IDIM*(IPOIN2-1)
46 : *
47 : SOMAIR = ZERO
48 : XP1 = ZERO
49 : YP1 = ZERO
50 : XP2 = ZERO
51 : YP2 = ZERO
52 : DO 12 ID = 1,IDIM
53 : XX1 = XPTB(NPOI,IND,ID) + XPALB(I,IPT1+ID)
54 : & - XPALB(I,ID2+ID)
55 : XX2 = XPTB(NPOI,IND,ID) + XPALB(I,IPT2+ID)
56 : & - XPALB(I,ID2+ID)
57 : XP1 = XP1 + ( XX1 * XPALB(I,ID3+ID) )
58 : YP1 = YP1 + ( XX1 * XPALB(I,ID4+ID) )
59 : XP2 = XP2 + ( XX2 * XPALB(I,ID3+ID) )
60 : YP2 = YP2 + ( XX2 * XPALB(I,ID4+ID) )
61 : 12 CONTINUE
62 : * end do
63 : XPPP2 = XP2 - XPP
64 : YPPP2 = YP2 - YPP
65 : DA = SQRT( (XPPP2 ** 2) + (YPPP2 ** 2) )
66 : XP2G = XBARY - XP2
67 : YP2G = YBARY - YP2
68 : DB = SQRT( (XP2G ** 2) + (YP2G ** 2) )
69 : XGPP = XPP - XBARY
70 : YGPP = YPP - YBARY
71 : DC = SQRT( (XGPP ** 2) + (YGPP ** 2) )
72 : PERI = 0.5 * ( DA + DB + DC )
73 : SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
74 : SOMAIR = SOMAIR + SQRT(SURF)
75 : XP1P = XP - XP1
76 : YP1P = YP - YP1
77 : DA = SQRT( (XP1P ** 2) + (YP1P ** 2 ) )
78 : XPG = XBARY - XP
79 : YPG = YBARY - YP
80 : DB = SQRT( (XPG ** 2) + (YPG ** 2) )
81 : XGP1 = XP1 - XBARY
82 : YGP1 = YP1 - YBARY
83 : DC = SQRT( (XGP1 ** 2) + (YGP1 ** 2) )
84 : PERI = 0.5 * ( DA + DB + DC )
85 : SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
86 : SOMAIR = SOMAIR + SQRT(SURF)
87 : NBSURF = 0
88 : IF (IPOIN1.GT.IPOIN2 ) THEN
89 : ICAS = 1
90 : NBSURF = 1
91 : I2 = IPOIN1
92 : 2 CONTINUE
93 : I2 = I2 - 1
94 : IF (I2.EQ.0) I2 = NOMBN2
95 : IF (I2.EQ.IPOIN2) GOTO 4
96 : NBSURF = NBSURF + 1
97 : GOTO 2
98 : 4 CONTINUE
99 : ELSE IF (IPOIN1.LT.IPOIN2 ) THEN
100 : ICAS = 2
101 : NBSURF = 1
102 : I6 = IPOIN2
103 : 6 CONTINUE
104 : I6 = I6 + 1
105 : IF (I6.EQ.(NOMBN2+1)) I6 = 1
106 : IF (I6.EQ.IPOIN1) GOTO 8
107 : NBSURF = NBSURF + 1
108 : GOTO 6
109 : 8 CONTINUE
110 : ENDIF
111 : IF (NBSURF.NE.0) THEN
112 : IF (ICAS.EQ.1) THEN
113 : NUM1 = IPOIN1
114 : ELSE
115 : NUM1 = IPOIN2
116 : ENDIF
117 : DO 14 IS = 1,NBSURF
118 : IF (ICAS.EQ.1) THEN
119 : NUM2 = NUM1 - 1
120 : IF (NUM2.EQ.0) NUM2 = NOMBN2
121 : ELSE
122 : NUM2 = NUM1 + 1
123 : IF (NUM2.EQ.(NOMBN2+1)) NUM2 = 1
124 : ENDIF
125 : IPT1 = ID7 + IDIM*(NUM1-1)
126 : IPT2 = ID7 + IDIM*(NUM2-1)
127 : XP1 = ZERO
128 : YP1 = ZERO
129 : XP2 = ZERO
130 : YP2 = ZERO
131 : DO 16 ID = 1,IDIM
132 : XX1 = XPTB(NPOI,IND,ID) + XPALB(I,IPT1+ID)
133 : & - XPALB(I,ID2+ID)
134 : XX2 = XPTB(NPOI,IND,ID) + XPALB(I,IPT2+ID)
135 : & - XPALB(I,ID2+ID)
136 : XP1 = XP1 + ( XX1 * XPALB(I,ID3+ID) )
137 : YP1 = YP1 + ( XX1 * XPALB(I,ID4+ID) )
138 : XP2 = XP2 + ( XX2 * XPALB(I,ID3+ID) )
139 : YP2 = YP2 + ( XX2 * XPALB(I,ID4+ID) )
140 : 16 CONTINUE
141 : * end do
142 : XP2P1 = XP1 - XP2
143 : YP2P1 = YP1 - YP2
144 : DA = SQRT( (XP2P1 ** 2) + (YP2P1 ** 2 ) )
145 : XP1G = XBARY - XP1
146 : YP1G = YBARY - YP1
147 : DB = SQRT( (XP1G ** 2) + (YP1G ** 2) )
148 : XGP2 = XP2 - XBARY
149 : YGP2 = YP2 - YBARY
150 : DC = SQRT( (XGP2 ** 2) + (YGP2 ** 2) )
151 : PERI = 0.5 * ( DA + DB + DC )
152 : SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
153 : SOMAIR = SOMAIR + SQRT(SURF)
154 : NUM1 = NUM2
155 : 14 CONTINUE
156 : * end do
157 : ENDIF
158 : *
159 : END
160 :
© Cast3M 2003 - All rights reserved.
Disclaimer