45
46
47
48
49
50#include "implicit_f.inc"
51
52
53
54 INTEGER, INTENT(INOUT) :: LFT
55 INTEGER, INTENT(INOUT) :: LLT
57 . x1(*), x2(*), x3(*), x4(*),
58 . y1(*), y2(*), y3(*), y4(*),
59 . z1(*), z2(*), z3(*), z4(*),
60 . xi(*), yi(*), zi(*), ans(*),
61 . n1(*), n2(*), n3(*), ssc(*), ttc(*),
62 . x0(*), y0(*), z0(*), xface(*)
64 . xx1(*), xx2(*), xx3(*), xx4(*),
65 . yy1(*), yy2(*), yy3(*), yy4(*),
66 . zz1(*), zz2(*), zz3(*), zz4(*),
67 . xi1(*), xi2(*), xi3(*), xi4(*),
68 . yi1(*), yi2(*), yi3(*), yi4(*),
69 . zi1(*), zi2(*), zi3(*), zi4(*),
70 . xn1(*), xn2(*), xn3(*), xn4(*),
71 . yn1(*), yn2(*), yn3(*), yn4(*),
72 . zn1(*), zn2(*), zn3(*), zn4(*),
74
75
76
77
78
79
80 INTEGER I
82
83 DO 100 i=lft,llt
84 x0(i) = fourth*(x1(i)+x2(i)+x3(i)+x4(i))
85 y0(i) = fourth*(y1(i)+y2(i)+y3(i)+y4(i))
86 z0(i) = fourth*(z1(i)+z2(i)+z3(i)+z4(i))
87
88 xx1(i) = x1(i)-x0(i)
89 xx2(i) = x2(i)-x0(i)
90 xx3(i) = x3(i)-x0(i)
91 xx4(i) = x4(i)-x0(i)
92 yy1(i) = y1(i)-y0(i)
93 yy2(i) = y2(i)-y0(i)
94 yy3(i) = y3(i)-y0(i)
95 yy4(i) = y4(i)-y0(i)
96 zz1(i) = z1(i)-z0(i)
97 zz2(i) = z2(i)-z0(i)
98 zz3(i) = z3(i)-z0(i)
99 zz4(i) = z4(i)-z0(i)
100
101 xi1(i) = x1(i)-xi(i)
102 xi2(i) = x2(i)-xi(i)
103 xi3(i) = x3(i)-xi(i)
104 xi4(i) = x4(i)-xi(i)
105 yi1(i) = y1(i)-yi(i)
106 yi2(i) = y2(i)-yi(i)
107 yi3(i) = y3(i)-yi(i)
108 yi4(i) = y4(i)-yi(i)
109 zi1(i) = z1(i)-zi(i)
110 zi2(i) = z2(i)-zi(i)
111 zi3(i) = z3(i)-zi(i)
112 zi4(i) = z4(i)-zi(i)
113 100 CONTINUE
114
115 DO 120 i=lft,llt
116 xn1(i) = yy1(i)*zz2(i) - yy2(i)*zz1(i)
117 yn1(i) = zz1(i)*xx2(i) - zz2(i)*xx1(i)
118 zn1(i) = xx1(i)*yy2(i) - xx2(i)*yy1(i)
119 n1(i)=xn1(i)
120 n2(i)=yn1(i)
121 n3(i)=zn1(i)
122 120 CONTINUE
123
124 DO 140 i=lft,llt
125 xn2(i) = yy2(i)*zz3(i) - yy3(i)*zz2(i)
126 yn2(i) = zz2(i)*xx3(i) - zz3(i)*xx2(i)
127 zn2(i) = xx2(i)*yy3(i) - xx3(i)*yy2(i)
128 n1(i)=n1(i)+xn2(i)
129 n2(i)=n2(i)+yn2(i)
130 n3(i)=n3(i)+zn2(i)
131 140 CONTINUE
132
133 DO 160 i=lft,llt
134 xn3(i) = yy3(i)*zz4(i) - yy4(i)*zz3(i)
135 yn3(i) = zz3(i)*xx4(i) - zz4(i)*xx3(i)
136 zn3(i) = xx3(i)*yy4(i) - xx4(i)*yy3(i)
137 n1(i)=n1(i)+xn3(i)
138 n2(i)=n2(i)+yn3(i)
139 n3(i)=n3(i)+zn3(i)
140 160 CONTINUE
141
142 DO 180 i=lft,llt
143 xn4(i) = yy4(i)*zz1(i) - yy1(i)*zz4(i)
144 yn4(i) = zz4(i)*xx1(i) - zz1(i)*xx4(i)
145 zn4(i) = xx4(i)*yy1(i) - xx1(i)*yy4(i)
146 n1(i)=n1(i)+xn4(i)
147 n2(i)=n2(i)+yn4(i)
148 n3(i)=n3(i)+zn4(i)
149 180 CONTINUE
150
151 DO 200 i=lft,llt
152 an=
max(em20,sqrt(n1(i)*n1(i)+n2(i)*n2(i)+n3(i)*n3(i)))
153 n1(i)=n1(i)/an
154 n2(i)=n2(i)/an
155 n3(i)=n3(i)/an
157 200 CONTINUE
158
159 DO 210 i=lft,llt
160 x0(i)=(n1(i)*xn1(i)+n2(i)*yn1(i)+n3(i)*zn1(i))
161 y0(i)=(n1(i)*xn2(i)+n2(i)*yn2(i)+n3(i)*zn2(i))
162 z0(i)=(n1(i)*xn3(i)+n2(i)*yn3(i)+n3(i)*zn3(i))
163 xx1(i)=(n1(i)*xn4(i)+n2(i)*yn4(i)+n3(i)*zn4(i))
164 210 CONTINUE
165
166 DO 220 i=lft,llt
167 xn1(i) = yi1(i)*zi2(i) - yi2(i)*zi1(i)
168 yn1(i) = zi1(i)*xi2(i) - zi2(i)*xi1(i)
169 zn1(i) = xi1(i)*yi2(i) - xi2(i)*yi1(i)
170 yy1(i)=(n1(i)*xn1(i)+n2(i)*yn1(i)+n3(i)*zn1(i))
171 220 CONTINUE
172
173 DO 240 i=lft,llt
174 xn2(i) = yi2(i)*zi3(i) - yi3(i)*zi2(i)
175 yn2(i) = zi2(i)*xi3(i) - zi3(i)*xi2(i)
176 zn2(i) = xi2(i)*yi3(i) - xi3(i)*yi2(i)
177 zz1(i)=(n1(i)*xn2(i)+n2(i)*yn2(i)+n3(i)*zn2(i))
178 240 CONTINUE
179
180 DO 260 i=lft,llt
181 xn3(i) = yi3(i)*zi4(i) - yi4(i)*zi3(i)
182 yn3(i) = zi3(i)*xi4(i) - zi4(i)*xi3(i)
183 zn3(i) = xi3(i)*yi4(i) - xi4(i)*yi3(i)
184 xx2(i)=(n1(i)*xn3(i)+n2(i)*yn3(i)+n3(i)*zn3(i))
185 260 CONTINUE
186
187 DO 280 i=lft,llt
188 xn4(i) = yi4(i)*zi1(i) - yi1(i)*zi4(i)
189 yn4(i) = zi4(i)*xi1(i) - zi1(i)*xi4(i)
190 zn4(i) = xi4(i)*yi1(i) - xi1(i)*yi4(i)
191 yy2(i)=(n1(i)*xn4(i)+n2(i)*yn4(i)+n3(i)*zn4(i))
192 280 CONTINUE
193
194 DO 300 i=lft,llt
195 zz2(i)=y0(i)*yy2(i)
196 xx3(i)=zz1(i)*xx1(i)
197 300 CONTINUE
198
199 DO 320 i=lft,llt
200 IF(xface(i)==zero)GOTO 320
201 IF(zz2(i)+xx3(i)/=zero)THEN
202 ssc(i)=(zz2(i)-xx3(i))/(zz2(i)+xx3(i))
203 ELSE
204 ssc(i)=zero
205 ENDIF
206 IF(z0(i)/=zero)THEN
207 zz2(i)=yy1(i)*z0(i)
208 xx3(i)=xx2(i)*x0(i)
209 IF(zz2(i)+xx3(i)/=zero)THEN
210 ttc(i)=(zz2(i)-xx3(i))/(zz2(i)+xx3(i))
211 ELSE
212 ttc(i)=zero
213 ENDIF
214 ELSE
215 ttc(i)=(yy1(i)-x0(i))/x0(i)
216 ENDIF
217 320 CONTINUE
218
219 RETURN
subroutine area(d1, x, x2, y, y2, eint, stif0)