53 use element_mod , only : nixs
54
55
56
57#include "implicit_f.inc"
58
59
60
61#include "mvsiz_p.inc"
62
63
64
65#include "vect01_c.inc"
66#include "scr03_c.inc"
67#include "com04_c.inc"
68
69
70
71 INTEGER IXS(NIXS,*),MXT(*),NGL(*),NGEO(*),JHBE,
72 . IX1(*),IX2(*),IX3(*),IX4(*),IX5(*),IX6(*),IX7(*),IX8(*)
73 INTEGER ,INTENT(IN) :: NINTEMP
74
76 . x(3,*),geo(*),
77 . x1(*), x2(*), x3(*), x4(*), x5(*), x6(*), x7(*), x8(*),
78 . y1(*), y2(*), y3(*), y4(*), y5(*), y6(*), y7(*), y8(*),
79 . z1(*), z2(*), z3(*), z4(*), z5(*), z6(*), z7(*), z8(*),
80 . e1x(*),e2x(*),e3x(*),e1y(*),e2y(*),e3y(*),e1z(*),e2z(*),e3z(*),
81 . rx(*) ,ry(*) ,rz(*) ,sx(*) ,sy(*) ,sz(*) ,tx(*) ,ty(*) ,tz(*),
82 . f1x(*),f1y(*),f1z(*),f2x(*),f2y(*),f2z(*),temp0(mvsiz),
83 . temp(*),xrefs(8,3,*)
84 DOUBLE PRECISION
85 . XD1(MVSIZ), XD2(MVSIZ), XD3(MVSIZ), XD4(MVSIZ),
86 . XD5(MVSIZ), XD6(MVSIZ), XD7(MVSIZ), XD8(MVSIZ),
87 . YD1(MVSIZ), YD2(MVSIZ), YD3(MVSIZ), YD4(MVSIZ),
88 . YD5(MVSIZ), YD6(MVSIZ), YD7(MVSIZ), YD8(MVSIZ),
89 . ZD1(MVSIZ), ZD2(MVSIZ), ZD3(MVSIZ), ZD4(MVSIZ),
90 . ZD5(MVSIZ), ZD6(MVSIZ), ZD7(MVSIZ), ZD8(MVSIZ)
91
92
93
94 INTEGER I
95 DOUBLE PRECISION
96 . XL,YL,ZL
97
98
99
102
103
104
105 DO i=lft,llt
106 mxt(i)=ixs(1,i)
107 ix1(i)=ixs(2,i)
108 ix2(i)=ixs(3,i)
109 ix3(i)=ixs(4,i)
110 ix4(i)=ixs(5,i)
111 ix5(i)=ixs(6,i)
112 ix6(i)=ixs(7,i)
113 ix7(i)=ixs(8,i)
114 ix8(i)=ixs(9,i)
115 ngeo(i)=ixs(nixs-1,i)
116 ngl(i)=ixs(nixs,i)
118
119 ix1(i)=ixs(6,i)
120 ix2(i)=ixs(7,i)
121 ix3(i)=ixs(8,i)
122 ix4(i)=ixs(9,i)
123 ix5(i)=ixs(2,i)
124 ix6(i)=ixs(3,i)
125 ix7(i)=ixs(4,i)
126 ix8(i)=ixs(5,i)
127 ixs(2,i)=ix1(i)
128 ixs(3,i)=ix2(i)
129 ixs(4,i)=ix3(i)
130 ixs(5,i)=ix4(i)
131 ixs(6,i)=ix5(i)
132 ixs(7,i)=ix6(i)
133 ixs(8,i)=ix7(i)
134 ixs(9,i)=ix8(i)
135 ENDIF
136 ENDDO
137
138
139
140
141 IF (nxref == 0) THEN
142 DO i=lft,llt
143 x1(i)=x(1,ix1(i))
144 y1(i)=x(2,ix1(i))
145 z1(i)=x(3,ix1(i))
146 x2(i)=x(1,ix2(i))
147 y2(i)=x(2,ix2(i))
148 z2(i)=x(3,ix2(i))
149 x3(i)=x(1,ix3(i))
150 y3(i)=x(2,ix3(i))
151 z3(i)=x(3,ix3(i))
152 x4(i)=x(1,ix4(i))
153 y4(i)=x(2,ix4(i))
154 z4(i)=x(3,ix4(i))
155 x5(i)=x(1,ix5(i))
156 y5(i)=x(2,ix5(i))
157 z5(i)=x(3,ix5(i))
158 x6(i)=x(1,ix6(i))
159 y6(i)=x(2,ix6(i))
160 z6(i)=x(3,ix6(i))
161 x7(i)=x(1,ix7(i))
162 y7(i)=x(2,ix7(i))
163 z7(i)=x(3,ix7(i))
164 x8(i)=x(1,ix8(i))
165 y8(i)=x(2,ix8(i))
166 z8(i)=x(3,ix8(i))
167 ENDDO
168 ELSE
169 DO i=lft,llt
171 x1(i)=xrefs(5,1,i)
172 y1(i)=xrefs(5,2,i)
173 z1(i)=xrefs(5,3,i)
174 x2(i)=xrefs(6,1,i)
175 y2(i)=xrefs(6,2,i)
176 z2(i)=xrefs(6,3,i)
177 x3(i)=xrefs(7,1,i)
178 y3(i)=xrefs(7,2,i)
179 z3(i)=xrefs(7,3,i)
180 x4(i)=xrefs(8,1,i)
181 y4(i)=xrefs(8,2,i)
182 z4(i)=xrefs(8,3,i)
183 x5(i)=xrefs(1,1,i)
184 y5(i)=xrefs(1,2,i)
185 z5(i)=xrefs(1,3,i)
186 x6(i)=xrefs(2,1,i)
187 y6(i)=xrefs(2,2,i)
188 z6(i)=xrefs(2,3,i)
189 x7(i)=xrefs(3,1,i)
190 y7(i)=xrefs(3,2,i)
191 z7(i)=xrefs(3,3,i)
192 x8(i)=xrefs(4,1,i)
193 y8(i)=xrefs(4,2,i)
194 z8(i)=xrefs(4,3,i)
195 xrefs(1,1,i)=x1(i)
196 xrefs(1,2,i)=y1(i)
197 xrefs(1,3,i)=z1(i)
198 xrefs(2,1,i)=x2(i)
199 xrefs(2,2,i)=y2(i)
200 xrefs(2,3,i)=z2(i)
201 xrefs(3,1,i)=x3(i)
202 xrefs(3,2,i)=y3(i)
203 xrefs(3,3,i)=z3(i)
204 xrefs(4,1,i)=x4(i)
205 xrefs(4,2,i)=y4(i)
206 xrefs(4,3,i)=z4(i)
207 xrefs(5,1,i)=x5(i)
208 xrefs(5,2,i)=y5(i)
209 xrefs(5,3,i)=z5(i)
210 xrefs(6,1,i)=x6(i)
211 xrefs(6,2,i)=y6(i)
212 xrefs(6,3,i)=z6(i)
213 xrefs(7,1,i)=x7(i)
214 xrefs(7,2,i)=y7(i)
215 xrefs(7,3,i)=z7(i)
216 xrefs(8,1,i)=x8(i)
217 xrefs(8,2,i)=y8(i)
218 xrefs(8,3,i)=z8(i)
219 ELSE
220 x1(i)=xrefs(1,1,i)
221 y1(i)=xrefs(1,2,i)
222 z1(i)=xrefs(1,3,i)
223 x2(i)=xrefs(2,1,i)
224 y2(i)=xrefs(2,2,i)
225 z2(i)=xrefs(2,3,i)
226 x3(i)=xrefs(3,1,i)
227 y3(i)=xrefs(3,2,i)
228 z3(i)=xrefs(3,3,i)
229 x4(i)=xrefs(4,1,i)
230 y4(i)=xrefs(4,2,i)
231 z4(i)=xrefs(4,3,i)
232 x5(i)=xrefs(5,1,i)
233 y5(i)=xrefs(5,2,i)
234 z5(i)=xrefs(5,3,i)
235 x6(i)=xrefs(6,1,i)
236 y6(i)=xrefs(6,2,i)
237 z6(i)=xrefs(6,3,i)
238 x7(i)=xrefs(7,1,i)
239 y7(i)=xrefs(7,2,i)
240 z7(i)=xrefs(7,3,i)
241 x8(i)=xrefs(8,1,i)
242 y8(i)=xrefs(8,2,i)
243 z8(i)=xrefs(8,3,i)
244 ENDIF
245 ENDDO
246 ENDIF
247
248 DO i=lft,llt
249 xd1(i) = x1(i)
250 yd1(i) = y1(i)
251 zd1(i) = z1(i)
252 xd2(i) = x2(i)
253 yd2(i) = y2(i)
254 zd2(i) = z2(i)
255 xd3(i) = x3(i)
256 yd3(i) = y3(i)
257 zd3(i) = z3(i)
258 xd4(i) = x4(i)
259 yd4(i) = y4(i)
260 zd4(i) = z4(i)
261 xd5(i) = x5(i)
262 yd5(i) = y5(i)
263 zd5(i) = z5(i)
264 xd6(i) = x6(i)
265 yd6(i) = y6(i)
266 zd6(i) = z6(i)
267 xd7(i) = x7(i)
268 yd7(i) = y7(i)
269 zd7(i) = z7(i)
270 xd8(i) = x8(i)
271 yd8(i) = y8(i)
272 zd8(i) = z8(i)
273 ENDDO
274
276 . x1, x2, x3, x4, x5, x6, x7, x8,
277 . y1, y2, y3, y4, y5, y6, y7, y8,
278 . z1, z2, z3, z4, z5, z6, z7, z8)
279
280
282 . x1, x2, x3, x4, x5, x6, x7, x8,
283 . y1, y2, y3, y4, y5, y6, y7, y8,
284 . z1, z2, z3, z4, z5, z6, z7, z8,
285 . rx, ry, rz, sx, sy, sz, tx, ty,
286 . tz ,f1x ,f1y ,f1z ,f2x ,f2y ,f2z )
287
288
289
290 IF (jhbe == 14 .OR. jhbe == 24) THEN
291
293 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
294 . e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,e1x ,e1y ,e1z )
295 ELSE
297 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
298 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z )
299 END IF
300
301
302
303 IF (jhbe==14 .OR. jhbe==24 .OR. jhbe==17 .OR.(jhbe==1 .AND. isorth==0)) THEN
304 DO i=lft,llt
305 xl=e1x(i)*xd1(i)+e1y(i)*yd1(i)+e1z(i)*zd1(i)
306 yl=e2x(i)*xd1(i)+e2y(i)*yd1(i)+e2z(i)*zd1(i)
307 zl=e3x(i)*xd1(i)+e3y(i)*yd1(i)+e3z(i)*zd1(i)
308 xd1(i)=xl
309 yd1(i)=yl
310 zd1(i)=zl
311 xl=e1x(i)*xd2(i)+e1y(i)*yd2(i)+e1z(i)*zd2(i)
312 yl=e2x(i)*xd2(i)+e2y(i)*yd2(i)+e2z(i)*zd2(i)
313 zl=e3x(i)*xd2(i)+e3y(i)*yd2(i)+e3z(i)*zd2(i)
314 xd2(i)=xl
315 yd2(i)=yl
316 zd2(i)=zl
317 xl=e1x(i)*xd3(i)+e1y(i)*yd3(i)+e1z(i)*zd3(i)
318 yl=e2x(i)*xd3(i)+e2y(i)*yd3(i)+e2z(i)*zd3(i
319 zl=e3x(i)*xd3(i)+e3y(i)*yd3(i)+e3z(i)*zd3(i)
320 xd3(i)=xl
321 yd3(i)=yl
322 zd3(i)=zl
323 xl=e1x(i)*xd4(i)+e1y(i)*yd4(i)+e1z(i)*zd4(i)
324 yl=e2x(i)*xd4(i)+e2y(i)*yd4(i)+e2z(i)*zd4(i)
325 zl=e3x(i)*xd4(i)+e3y(i)*yd4(i)+e3z(i)*zd4(i)
326 xd4(i)=xl
327 yd4(i)=yl
328 zd4(i)=zl
329 xl=e1x(i)*xd5(i)+e1y(i)*yd5(i)+e1z(i)*zd5(i)
330 yl=e2x(i)*xd5(i)+e2y(i)*yd5(i)+e2z(i)*zd5(i)
331 zl=e3x(i)*xd5(i)+e3y(i)*yd5(i)+e3z(i)*zd5(i)
332 xd5(i)=xl
333 yd5(i)=yl
334 zd5(i)=zl
335 xl=e1x(i)*xd6(i)+e1y(i)*yd6(i)+e1z(i)*zd6(i)
336 yl=e2x(i)*xd6(i)+e2y(i)*yd6(i)+e2z(i)*zd6(i)
337 zl=e3x(i)*xd6(i)+e3y(i)*yd6(i)+e3z(i)*zd6(i)
338 xd6(i)=xl
339 yd6(i)=yl
340 zd6(i)=zl
341 xl=e1x(i)*xd7(i)+e1y(i)*yd7(i)+e1z(i)*zd7(i)
342 yl=e2x(i)*xd7(i)+e2y(i)*yd7(i)+e2z(i)*zd7(i)
343 zl=e3x(i)*xd7(i)+e3y(i)*yd7(i)+e3z(i)*zd7(i)
344 xd7(i)=xl
345 yd7(i)=yl
346 zd7(i)=zl
347 xl=e1x(i)*xd8(i)+e1y(i)*yd8(i)+e1z(i)*zd8(i)
348 yl=e2x(i)*xd8(i)+e2y(i)*yd8(i)+e2z(i)*zd8(i)
349 zl=e3x(i)*xd8(i)+e3y(i)*yd8(i)+e3z(i)*zd8(i)
350 xd8(i)=xl
351 yd8(i)=yl
352 zd8(i)=zl
353 ENDDO
354 END IF
355 IF (jhbe==14 .OR. jhbe==24 .OR. jhbe==17 ) THEN
356 DO i=lft,llt
357 x1(i) = xd1(i)
358 y1(i) = yd1(i)
359 z1(i) = zd1(i)
360 x2(i) = xd2(i)
361 y2(i) = yd2(i)
362 z2(i) = zd2(i)
363 x3(i) = xd3(i)
364 y3(i) = yd3(i)
365 z3(i) = zd3(i)
366 x4(i) = xd4(i)
367 y4(i) = yd4(i)
368 z4(i) = zd4(i)
369 x5(i) = xd5(i)
370 y5(i) = yd5(i)
371 z5(i) = zd5(i)
372 x6(i) = xd6(i)
373 y6(i) = yd6(i)
374 z6(i) = zd6(i)
375 x7(i) = xd7(i)
376 y7(i) = yd7(i)
377 z7(i) = zd7(i)
378 x8(i) = xd8(i)
379 y8(i) = yd8(i)
380 z8(i) = zd8(i)
381 ENDDO
382 END IF
383
384 IF (jthe < 0 .or. nintemp > 0) THEN
385 IF(nintemp > 0 ) THEN
386 DO i= lft,llt
387 IF(temp(ix1(i))== zero) temp(ix1(i)) = temp0(i)
388 IF(temp(ix2(i))== zero) temp(ix2(i)) = temp0(i)
389 IF(temp(ix3(i))== zero) temp(ix3(i)) = temp0(i)
390 IF(temp(ix4(i))== zero) temp(ix4(i)) = temp0(i)
391 IF(temp(ix5(i))== zero) temp(ix5(i)) = temp0(i)
392 IF(temp(ix6(i))== zero) temp(ix6(i)) = temp0(i)
393 IF(temp(ix7(i))== zero) temp(ix7(i)) = temp0(i)
394 IF(temp(ix8(i))== zero) temp(ix8(i)) = temp0(i)
395 ENDDO
396 ELSE
397 DO i=lft,llt
398 temp(ix1(i))=temp0(i)
399 temp(ix2(i))=temp0(i)
400 temp(ix3(i))=temp0(i)
401 temp(ix4(i))=temp0(i)
402 temp(ix5(i))=temp0(i)
403 temp(ix6(i))=temp0(i)
404 temp(ix7(i))=temp0(i)
405 temp(ix8(i))=temp0(i)
406 ENDDO
407 ENDIF
408 ENDIF
409
410 RETURN
function checkvolume_8n(x, ixs)
subroutine mod_close(geo, ngeo, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8)
subroutine sortho3(rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z)
subroutine srepiso3(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, f1x, f1y, f1z, f2x, f2y, f2z)