1 : C DYNE36 SOURCE CHAT 05/01/12 23:17:40 5004
2 : SUBROUTINE DYNE36(NUMEL1,NUMEL2,XBARY,YBARY,XP,YP,XPP,YPP,XPALB,
3 : & IPALB,NLIAB,I,ID1,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 XBARY coordonn{e du barycentre *
17 : * e YBARY coordonn{e du barycentre *
18 : * e NUMEL1 {l{ment du profil fixe *
19 : * e NUMEL2 {l{ment du profil fixe *
20 : * e XP,YP coordonn{es du point P d'intersection *
21 : * e XPP,YPP coordonn{es du point PP d'intersection *
22 : * e NLIAB nombre total de liaisons *
23 : * e I num{ro de la liaison trait{e *
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 XPALB(NLIAB,*)
34 : PARAMETER ( ZERO = 0.D0 )
35 : *
36 : ITYP = IPALB(I,1)
37 : IDIM = IPALB(I,3)
38 : NOMBN1 = IPALB(I,4)
39 : ID2 = ID1 + IDIM
40 : ID3 = ID1 + 2*IDIM
41 : ID4 = ID1 + 3*IDIM
42 : ID6 = ID1 + 5*IDIM
43 : *
44 : SOMAIR = ZERO
45 : IF (NUMEL1.EQ.NUMEL2) THEN
46 : XPPG = XBARY - XPP
47 : YPPG = YBARY - YPP
48 : DA = SQRT( (XPPG ** 2) + (YPPG ** 2) )
49 : XGP = XP - XBARY
50 : YGP = YP - YBARY
51 : DB = SQRT( (XGP ** 2) + (YGP ** 2) )
52 : XPPP = XPP - XP
53 : YPPP = YPP - YP
54 : DC = SQRT( (XPPP ** 2) + (YPPP ** 2) )
55 : PERI = 0.5 * ( DA + DB + DC )
56 : SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
57 : SOMAIR = SOMAIR + SQRT(SURF)
58 : *
59 : ELSE
60 : NBELEM = 0
61 : IF (ITYP.EQ.31) THEN
62 : I2 = NUMEL1
63 : 2 CONTINUE
64 : I2 = I2 + 1
65 : IF (I2.EQ.(NOMBN1+1)) I2 = 1
66 : IF (I2.EQ.NUMEL2) GOTO 4
67 : NBELEM = NBELEM + 1
68 : GOTO 2
69 : 4 CONTINUE
70 : ELSE
71 : I6 = NUMEL1
72 : 6 CONTINUE
73 : I6 = I6 - 1
74 : IF (I6.EQ.0) I6 = NOMBN1
75 : IF (I6.EQ.NUMEL2) GOTO 8
76 : NBELEM = NBELEM + 1
77 : GOTO 6
78 : 8 CONTINUE
79 : ENDIF
80 : IF (ITYP.EQ.31) THEN
81 : IEE1 = NUMEL1 + 1
82 : IF (IEE1.EQ.(NOMBN1+1)) IEE1 = 1
83 : IE1 = ID6 + IDIM*(IEE1-1)
84 : ELSE
85 : IE1 = ID6 + IDIM*(NUMEL1-1)
86 : ENDIF
87 : XE1 = ZERO
88 : YE1 = ZERO
89 : DO 10 ID = 1,IDIM
90 : XX1 = XPALB(I,IE1+ID) - XPALB(I,ID2+ID)
91 : XE1 = XE1 + ( XX1 * XPALB(I,ID3+ID) )
92 : YE1 = YE1 + ( XX1 * XPALB(I,ID4+ID) )
93 : 10 CONTINUE
94 : * end do
95 : XPE1 = XE1 - XP
96 : YPE1 = YE1 - YP
97 : DA = SQRT( (XPE1 ** 2) + (YPE1 ** 2) )
98 : XE1G = XBARY - XE1
99 : YE1G = YBARY - YE1
100 : DB = SQRT( (XE1G ** 2) + (YE1G ** 2) )
101 : XGP = XP - XBARY
102 : YGP = YP - YBARY
103 : DC = SQRT( (XGP ** 2) + (YGP ** 2) )
104 : PERI = 0.5 * ( DA + DB + DC )
105 : SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
106 : SOMAIR = SOMAIR + SQRT(SURF)
107 : IF (NBELEM.NE.0) THEN
108 : IE1 = NUMEL1
109 : DO 12 IE = 1,NBELEM
110 : IF (ITYP.EQ.31) THEN
111 : IE1 = IE1 + 1
112 : IF (IE1.EQ.(NOMBN1+1)) IE1 = 1
113 : IE2 = IE1 + 1
114 : IF (IE2.EQ.(NOMBN1+1)) IE2 = 1
115 : IPT1 = ID6 + IDIM*(IE1-1)
116 : IPT2 = ID6 + IDIM*(IE2-1)
117 : ELSE
118 : IE2 =IE1 - 1
119 : IF (IE2.EQ.0) IE2 = NOMBN1
120 : IPT1 = ID6 + IDIM*(IE1-1)
121 : IPT2 = ID6 + IDIM*(IE2-1)
122 : IE1 = IE1 - 1
123 : IF (IE1.EQ.0) IE1 = NOMBN1
124 : ENDIF
125 : XE1 = ZERO
126 : YE1 = ZERO
127 : XE2 = ZERO
128 : YE2 = ZERO
129 : DO 14 ID = 1,IDIM
130 : XX1 = XPALB(I,IPT1+ID) - XPALB(I,ID2+ID)
131 : XX2 = XPALB(I,IPT2+ID) - XPALB(I,ID2+ID)
132 : XE1 = XE1 + ( XX1 * XPALB(I,ID3+ID) )
133 : YE1 = YE1 + ( XX1 * XPALB(I,ID4+ID) )
134 : XE2 = XE2 + ( XX2 * XPALB(I,ID3+ID) )
135 : YE2 = YE2 + ( XX2 * XPALB(I,ID4+ID) )
136 : 14 CONTINUE
137 : * end do
138 : XE1E2 = XE2 - XE1
139 : YE1E2 = YE2 - YE1
140 : DA = SQRT( (XE1E2 ** 2) + (YE1E2 ** 2) )
141 : XE2G = XBARY - XE2
142 : YE2G = YBARY - YE2
143 : DB = SQRT( (XE2G ** 2) + (YE2G ** 2) )
144 : XGE1 = XE1 - XBARY
145 : YGE1 = YE1 - YBARY
146 : DC = SQRT( (XGE1 ** 2) + (YGE1 ** 2) )
147 : PERI = 0.5 * ( DA + DB + DC )
148 : SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
149 : SOMAIR = SOMAIR + SQRT(SURF)
150 : 12 CONTINUE
151 : * end do
152 : XE2PP = XPP - XE2
153 : YE2PP = YPP - YE2
154 : DA = SQRT( (XE2PP ** 2) + (YE2PP ** 2) )
155 : XPPG = XBARY - XPP
156 : YPPG = YBARY - YPP
157 : DB = SQRT( (XPPG ** 2) + (YPPG ** 2) )
158 : XGE2 = XE2 - XBARY
159 : YGE2 = YE2 - YBARY
160 : DC = SQRT( (XGE2 ** 2) + (YGE2 ** 2 ) )
161 : PERI = 0.5 * ( DA + DB + DC )
162 : SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
163 : SOMAIR = SOMAIR + SQRT(SURF)
164 : ELSE
165 : XE1PP = XPP - XE1
166 : YE1PP = YPP - YE1
167 : DA = SQRT( (XE1PP ** 2) + (YE1PP ** 2) )
168 : XPPG = XBARY - XPP
169 : YPPG = YBARY - YPP
170 : DB = SQRT( (XPPG ** 2) + (YPPG ** 2 ) )
171 : XGE1 = XE1 - XBARY
172 : YGE1 = YE1 - YBARY
173 : DC = SQRT( (XGE1 ** 2 ) + (YGE1 ** 2) )
174 : PERI = 0.5 * ( DA + DB + DC )
175 : SURF = PERI * (PERI - DA) * (PERI - DB) * (PERI - DC)
176 : SOMAIR = SOMAIR + SQRT(SURF)
177 : ENDIF
178 : ENDIF
179 : *
180 : END
181 :
© Cast3M 2003 - All rights reserved.
Disclaimer