OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
srcoork.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "scr18_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine srcoork (x, ixs, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, offg, off, sav, r11, r12, r13, r21, r22, r23, r31, r32, r33, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8, ngl, mxt, ngeo, k11, k12, k13, k14, k15, k16, k17, k18, k22, k23, k24, k25, k26, k27, k28, k33, k34, k35, k36, k37, k38, k44, k45, k46, k47, k48, k55, k56, k57, k58, k66, k67, k68, k77, k78, k88, khbe, gama0, gama, nel, ismstr, jhbe, jcvt, irep, igtyp, isorth)

Function/Subroutine Documentation

◆ srcoork()

subroutine srcoork ( x,
integer, dimension(nixs,*) ixs,
x1,
x2,
x3,
x4,
x5,
x6,
x7,
x8,
y1,
y2,
y3,
y4,
y5,
y6,
y7,
y8,
z1,
z2,
z3,
z4,
z5,
z6,
z7,
z8,
offg,
off,
sav,
r11,
r12,
r13,
r21,
r22,
r23,
r31,
r32,
r33,
integer, dimension(*) nc1,
integer, dimension(*) nc2,
integer, dimension(*) nc3,
integer, dimension(*) nc4,
integer, dimension(*) nc5,
integer, dimension(*) nc6,
integer, dimension(*) nc7,
integer, dimension(*) nc8,
integer, dimension(*) ngl,
integer, dimension(*) mxt,
integer, dimension(*) ngeo,
k11,
k12,
k13,
k14,
k15,
k16,
k17,
k18,
k22,
k23,
k24,
k25,
k26,
k27,
k28,
k33,
k34,
k35,
k36,
k37,
k38,
k44,
k45,
k46,
k47,
k48,
k55,
k56,
k57,
k58,
k66,
k67,
k68,
k77,
k78,
k88,
integer khbe,
gama0,
gama,
integer nel,
integer, intent(in) ismstr,
integer, intent(in) jhbe,
integer, intent(in) jcvt,
integer, intent(in) irep,
integer, intent(in) igtyp,
integer, intent(in) isorth )

Definition at line 37 of file srcoork.F.

62 use element_mod , only : nixs
63C-----------------------------------------------
64C I m p l i c i t T y p e s
65C-----------------------------------------------
66#include "implicit_f.inc"
67C-----------------------------------------------
68C G l o b a l P a r a m e t e r s
69C-----------------------------------------------
70#include "mvsiz_p.inc"
71C-----------------------------------------------
72C C o m m o n B l o c k s
73C-----------------------------------------------
74#include "scr18_c.inc"
75C-----------------------------------------------
76C D u m m y A r g u m e n t s
77C-----------------------------------------------
78 INTEGER, INTENT(IN) :: ISMSTR
79 INTEGER, INTENT(IN) :: JHBE
80 INTEGER, INTENT(IN) :: JCVT
81 INTEGER, INTENT(IN) :: IREP
82 INTEGER, INTENT(IN) :: IGTYP
83 INTEGER, INTENT(IN) :: ISORTH
84 INTEGER NEL
85C REAL
86 my_real
87 . x(3,*),
88 . x1(*), x2(*), x3(*), x4(*), x5(*), x6(*), x7(*), x8(*),
89 . y1(*), y2(*), y3(*), y4(*), y5(*), y6(*), y7(*), y8(*),
90 . z1(*), z2(*), z3(*), z4(*), z5(*), z6(*), z7(*), z8(*),
91 . offg(*), off(*), sav(nel,21), gama0(nel,6),gama(mvsiz,6),
92 . r11(mvsiz),r12(mvsiz),r13(mvsiz),
93 . r21(mvsiz),r22(mvsiz),r23(mvsiz),
94 . r31(mvsiz),r32(mvsiz),r33(mvsiz)
95 my_real
96 . k11(9,*) ,k12(9,*) ,k13(9,*) ,k14(9,*) ,k15(9,*) ,
97 . k16(9,*) ,k17(9,*) ,k18(9,*) ,k22(9,*) ,k23(9,*) ,
98 . k24(9,*) ,k25(9,*) ,k26(9,*) ,k27(9,*) ,k28(9,*) ,
99 . k33(9,*) ,k34(9,*) ,k35(9,*) ,k36(9,*) ,k37(9,*) ,
100 . k38(9,*) ,k44(9,*) ,k45(9,*) ,k46(9,*) ,k47(9,*) ,
101 . k48(9,*) ,k55(9,*) ,k56(9,*) ,k57(9,*) ,k58(9,*) ,
102 . k66(9,*) ,k67(9,*) ,k68(9,*) ,k77(9,*) ,k78(9,*) ,
103 . k88(9,*)
104 INTEGER NC1(*), NC2(*), NC3(*), NC4(*),
105 . NC5(*), NC6(*), NC7(*), NC8(*), MXT(*), NGL(*),NGEO(*)
106 INTEGER IXS(NIXS,*),KHBE
107C-----------------------------------------------
108C L o c a l V a r i a b l e s
109C-----------------------------------------------
110 INTEGER I,J, MXT_1
111C REAL
112 my_real
113 . xl,yl,zl
114 my_real
115 . rx(mvsiz) , ry(mvsiz) , rz(mvsiz) ,
116 . sx(mvsiz) , sy(mvsiz) , sz(mvsiz) ,
117 . tx(mvsiz) , ty(mvsiz) , tz(mvsiz)
118C-----------------------------------------------
119C
120 mxt_1 = ixs(1,1)
121 DO i=1,nel
122 ngeo(i)=ixs(10,i)
123 ngl(i)=ixs(11,i)
124 mxt(i)=mxt_1
125 nc1(i)=ixs(2,i)
126 nc2(i)=ixs(3,i)
127 nc3(i)=ixs(4,i)
128 nc4(i)=ixs(5,i)
129 nc5(i)=ixs(6,i)
130 nc6(i)=ixs(7,i)
131 nc7(i)=ixs(8,i)
132 nc8(i)=ixs(9,i)
133 ENDDO
134C----------------------------
135C NODAL COORDINATES |
136C----------------------------
137 DO i=1,nel
138 x1(i)=x(1,nc1(i))
139 y1(i)=x(2,nc1(i))
140 z1(i)=x(3,nc1(i))
141 x2(i)=x(1,nc2(i))
142 y2(i)=x(2,nc2(i))
143 z2(i)=x(3,nc2(i))
144 x3(i)=x(1,nc3(i))
145 y3(i)=x(2,nc3(i))
146 z3(i)=x(3,nc3(i))
147 x4(i)=x(1,nc4(i))
148 y4(i)=x(2,nc4(i))
149 z4(i)=x(3,nc4(i))
150 x5(i)=x(1,nc5(i))
151 y5(i)=x(2,nc5(i))
152 z5(i)=x(3,nc5(i))
153 x6(i)=x(1,nc6(i))
154 y6(i)=x(2,nc6(i))
155 z6(i)=x(3,nc6(i))
156 x7(i)=x(1,nc7(i))
157 y7(i)=x(2,nc7(i))
158 z7(i)=x(3,nc7(i))
159 x8(i)=x(1,nc8(i))
160 y8(i)=x(2,nc8(i))
161 z8(i)=x(3,nc8(i))
162 ENDDO
163C-----------
164C convected frame (ITERATIONS).
165C-----------
166 CALL srepisot3(
167 1 x1, x2, x3, x4,
168 2 x5, x6, x7, x8,
169 3 y1, y2, y3, y4,
170 4 y5, y6, y7, y8,
171 5 z1, z2, z3, z4,
172 6 z5, z6, z7, z8,
173 7 rx, ry, rz, sx,
174 8 sy, sz, tx, ty,
175 9 tz, nel)
176 IF (khbe==15) THEN
177 CALL scortho3(
178 1 rx, ry, rz, sx,
179 2 sy, sz, tx, ty,
180 3 tz, r11, r12, r13,
181 4 r21, r22, r23, r31,
182 5 r32, r33, nel)
183 ELSEIF (khbe==1 .OR. khbe==2. or. khbe == 12 .OR. khbe==14 .OR.
184 . khbe==17.or .khbe==24) THEN
185 CALL sortho3(
186 1 rx, ry, rz, sx,
187 2 sy, sz, tx, ty,
188 3 tz, r12, r13, r11,
189 4 r22, r23, r21, r32,
190 5 r33, r31, nel)
191 ELSE
192 CALL sortho3(
193 1 rx, ry, rz, sx,
194 2 sy, sz, tx, ty,
195 3 tz, r11, r12, r13,
196 4 r21, r22, r23, r31,
197 5 r32, r33, nel)
198 ENDIF
199C-------sauf thick shells --------------
200 IF (igtyp /= 21 .AND. igtyp /= 22) THEN
201 IF (isorth == 0) THEN
202 DO i=1,nel
203 gama(i,1) = one
204 gama(i,2) = zero
205 gama(i,3) = zero
206 gama(i,4) = zero
207 gama(i,5) = one
208 gama(i,6) = zero
209 ENDDO
210 ELSE
211 CALL sorthdir3(
212 1 rx, ry, rz, sx,
213 2 sy, sz, tx, ty,
214 3 tz, r11, r12, r13,
215 4 r21, r22, r23, r31,
216 5 r32, r33, gama0, gama,
217 6 nel, irep)
218 IF (khbe==17) THEN
219 CALL sorthdir17(
220 1 rx, ry, rz, sx,
221 2 sy, sz, tx, ty,
222 3 tz, r11, r12, r13,
223 4 r21, r22, r23, r31,
224 5 r32, r33, gama, nel,
225 6 jcvt)
226 END IF
227 ENDIF
228 ENDIF
229C-----------
230C Change to the convected frame.
231C-----------
232C X=RX' <=> X'=t(R)X chgt de base.
233 IF((ismstr==1.OR.ismstr==3).OR.
234 . (ismstr==2.AND.idtmin(1)==3))THEN
235 IF (jhbe==14.OR.jhbe==24.OR.jhbe==15.OR.jhbe==222) THEN
236 DO i=1,nel
237 IF(offg(i)>one)THEN
238 x1(i)=sav(i,1)
239 y1(i)=sav(i,2)
240 z1(i)=sav(i,3)
241 x2(i)=sav(i,4)
242 y2(i)=sav(i,5)
243 z2(i)=sav(i,6)
244 x3(i)=sav(i,7)
245 y3(i)=sav(i,8)
246 z3(i)=sav(i,9)
247 x4(i)=sav(i,10)
248 y4(i)=sav(i,11)
249 z4(i)=sav(i,12)
250 x5(i)=sav(i,13)
251 y5(i)=sav(i,14)
252 z5(i)=sav(i,15)
253 x6(i)=sav(i,16)
254 y6(i)=sav(i,17)
255 z6(i)=sav(i,18)
256 x7(i)=sav(i,19)
257 y7(i)=sav(i,20)
258 z7(i)=sav(i,21)
259 x8(i)=zero
260 y8(i)=zero
261 z8(i)=zero
262 off(i) = offg(i)-one
263 ELSE
264 xl=r11(i)*x1(i)+r21(i)*y1(i)+r31(i)*z1(i)
265 yl=r12(i)*x1(i)+r22(i)*y1(i)+r32(i)*z1(i)
266 zl=r13(i)*x1(i)+r23(i)*y1(i)+r33(i)*z1(i)
267 x1(i)=xl
268 y1(i)=yl
269 z1(i)=zl
270 xl=r11(i)*x2(i)+r21(i)*y2(i)+r31(i)*z2(i)
271 yl=r12(i)*x2(i)+r22(i)*y2(i)+r32(i)*z2(i)
272 zl=r13(i)*x2(i)+r23(i)*y2(i)+r33(i)*z2(i)
273 x2(i)=xl
274 y2(i)=yl
275 z2(i)=zl
276 xl=r11(i)*x3(i)+r21(i)*y3(i)+r31(i)*z3(i)
277 yl=r12(i)*x3(i)+r22(i)*y3(i)+r32(i)*z3(i)
278 zl=r13(i)*x3(i)+r23(i)*y3(i)+r33(i)*z3(i)
279 x3(i)=xl
280 y3(i)=yl
281 z3(i)=zl
282 xl=r11(i)*x4(i)+r21(i)*y4(i)+r31(i)*z4(i)
283 yl=r12(i)*x4(i)+r22(i)*y4(i)+r32(i)*z4(i)
284 zl=r13(i)*x4(i)+r23(i)*y4(i)+r33(i)*z4(i)
285 x4(i)=xl
286 y4(i)=yl
287 z4(i)=zl
288 xl=r11(i)*x5(i)+r21(i)*y5(i)+r31(i)*z5(i)
289 yl=r12(i)*x5(i)+r22(i)*y5(i)+r32(i)*z5(i)
290 zl=r13(i)*x5(i)+r23(i)*y5(i)+r33(i)*z5(i)
291 x5(i)=xl
292 y5(i)=yl
293 z5(i)=zl
294 xl=r11(i)*x6(i)+r21(i)*y6(i)+r31(i)*z6(i)
295 yl=r12(i)*x6(i)+r22(i)*y6(i)+r32(i)*z6(i)
296 zl=r13(i)*x6(i)+r23(i)*y6(i)+r33(i)*z6(i)
297 x6(i)=xl
298 y6(i)=yl
299 z6(i)=zl
300 xl=r11(i)*x7(i)+r21(i)*y7(i)+r31(i)*z7(i)
301 yl=r12(i)*x7(i)+r22(i)*y7(i)+r32(i)*z7(i)
302 zl=r13(i)*x7(i)+r23(i)*y7(i)+r33(i)*z7(i)
303 x7(i)=xl
304 y7(i)=yl
305 z7(i)=zl
306 xl=r11(i)*x8(i)+r21(i)*y8(i)+r31(i)*z8(i)
307 yl=r12(i)*x8(i)+r22(i)*y8(i)+r32(i)*z8(i)
308 zl=r13(i)*x8(i)+r23(i)*y8(i)+r33(i)*z8(i)
309 x8(i)=xl
310 y8(i)=yl
311 z8(i)=zl
312C sav in local frame
313C SAV(I,1)=X1(I)-X8(I)
314C SAV(I,2)=Y1(I)-Y8(I)
315C SAV(I,3)=Z1(I)-Z8(I)
316C SAV(I,4)=X2(I)-X8(I)
317C SAV(I,5)=Y2(I)-Y8(I)
318C SAV(I,6)=Z2(I)-Z8(I)
319C SAV(I,7)=X3(I)-X8(I)
320C SAV(I,8)=Y3(I)-Y8(I)
321C SAV(I,9)=Z3(I)-Z8(I)
322C SAV(I,10)=X4(I)-X8(I)
323C SAV(I,11)=Y4(I)-Y8(I)
324C SAV(I,12)=Z4(I)-Z8(I)
325C SAV(I,13)=X5(I)-X8(I)
326C SAV(I,14)=Y5(I)-Y8(I)
327C SAV(I,15)=Z5(I)-Z8(I)
328C SAV(I,16)=X6(I)-X8(I)
329C SAV(I,17)=Y6(I)-Y8(I)
330C SAV(I,18)=Z6(I)-Z8(I)
331C SAV(I,19)=X7(I)-X8(I)
332C SAV(I,20)=Y7(I)-Y8(I)
333C SAV(I,21)=Z7(I)-Z8(I)
334 off(i) = offg(i)
335 ENDIF
336 ENDDO
337C------due to different initial systems and [K] is calculated using always HA8 system
338 ELSE
339 DO i=1,nel
340 IF(offg(i)>one)THEN
341 x1(i)=sav(i,1)
342 y1(i)=sav(i,2)
343 z1(i)=sav(i,3)
344 x2(i)=sav(i,4)
345 y2(i)=sav(i,5)
346 z2(i)=sav(i,6)
347 x3(i)=sav(i,7)
348 y3(i)=sav(i,8)
349 z3(i)=sav(i,9)
350 x4(i)=sav(i,10)
351 y4(i)=sav(i,11)
352 z4(i)=sav(i,12)
353 x5(i)=sav(i,13)
354 y5(i)=sav(i,14)
355 z5(i)=sav(i,15)
356 x6(i)=sav(i,16)
357 y6(i)=sav(i,17)
358 z6(i)=sav(i,18)
359 x7(i)=sav(i,19)
360 y7(i)=sav(i,20)
361 z7(i)=sav(i,21)
362 x8(i)=zero
363 y8(i)=zero
364 z8(i)=zero
365 off(i) = offg(i)-one
366 ENDIF
367 ENDDO
368 IF (jcvt==0) THEN
369 DO i=1,nel
370 xl=r11(i)*x1(i)+r21(i)*y1(i)+r31(i)*z1(i)
371 yl=r12(i)*x1(i)+r22(i)*y1(i)+r32(i)*z1(i)
372 zl=r13(i)*x1(i)+r23(i)*y1(i)+r33(i)*z1(i)
373 x1(i)=xl
374 y1(i)=yl
375 z1(i)=zl
376 xl=r11(i)*x2(i)+r21(i)*y2(i)+r31(i)*z2(i)
377 yl=r12(i)*x2(i)+r22(i)*y2(i)+r32(i)*z2(i)
378 zl=r13(i)*x2(i)+r23(i)*y2(i)+r33(i)*z2(i)
379 x2(i)=xl
380 y2(i)=yl
381 z2(i)=zl
382 xl=r11(i)*x3(i)+r21(i)*y3(i)+r31(i)*z3(i)
383 yl=r12(i)*x3(i)+r22(i)*y3(i)+r32(i)*z3(i)
384 zl=r13(i)*x3(i)+r23(i)*y3(i)+r33(i)*z3(i)
385 x3(i)=xl
386 y3(i)=yl
387 z3(i)=zl
388 xl=r11(i)*x4(i)+r21(i)*y4(i)+r31(i)*z4(i)
389 yl=r12(i)*x4(i)+r22(i)*y4(i)+r32(i)*z4(i)
390 zl=r13(i)*x4(i)+r23(i)*y4(i)+r33(i)*z4(i)
391 x4(i)=xl
392 y4(i)=yl
393 z4(i)=zl
394 xl=r11(i)*x5(i)+r21(i)*y5(i)+r31(i)*z5(i)
395 yl=r12(i)*x5(i)+r22(i)*y5(i)+r32(i)*z5(i)
396 zl=r13(i)*x5(i)+r23(i)*y5(i)+r33(i)*z5(i)
397 x5(i)=xl
398 y5(i)=yl
399 z5(i)=zl
400 xl=r11(i)*x6(i)+r21(i)*y6(i)+r31(i)*z6(i)
401 yl=r12(i)*x6(i)+r22(i)*y6(i)+r32(i)*z6(i)
402 zl=r13(i)*x6(i)+r23(i)*y6(i)+r33(i)*z6(i)
403 x6(i)=xl
404 y6(i)=yl
405 z6(i)=zl
406 xl=r11(i)*x7(i)+r21(i)*y7(i)+r31(i)*z7(i)
407 yl=r12(i)*x7(i)+r22(i)*y7(i)+r32(i)*z7(i)
408 zl=r13(i)*x7(i)+r23(i)*y7(i)+r33(i)*z7(i)
409 x7(i)=xl
410 y7(i)=yl
411 z7(i)=zl
412 xl=r11(i)*x8(i)+r21(i)*y8(i)+r31(i)*z8(i)
413 yl=r12(i)*x8(i)+r22(i)*y8(i)+r32(i)*z8(i)
414 zl=r13(i)*x8(i)+r23(i)*y8(i)+r33(i)*z8(i)
415 x8(i)=xl
416 y8(i)=yl
417 z8(i)=zl
418 ENDDO
419 ELSE
420 DO i=1,nel
421 xl=z1(i)
422 yl=x1(i)
423 zl=y1(i)
424 x1(i)=xl
425 y1(i)=yl
426 z1(i)=zl
427 xl=z2(i)
428 yl=x2(i)
429 zl=y2(i)
430 x2(i)=xl
431 y2(i)=yl
432 z2(i)=zl
433 xl=z3(i)
434 yl=x3(i)
435 zl=y3(i)
436 x3(i)=xl
437 y3(i)=yl
438 z3(i)=zl
439 xl=z4(i)
440 yl=x4(i)
441 zl=y4(i)
442 x4(i)=xl
443 y4(i)=yl
444 z4(i)=zl
445 xl=z5(i)
446 yl=x5(i)
447 zl=y5(i)
448 x5(i)=xl
449 y5(i)=yl
450 z5(i)=zl
451 xl=z6(i)
452 yl=x6(i)
453 zl=y6(i)
454 x6(i)=xl
455 y6(i)=yl
456 z6(i)=zl
457 xl=z7(i)
458 yl=x7(i)
459 zl=y7(i)
460 x7(i)=xl
461 y7(i)=yl
462 z7(i)=zl
463 xl=z8(i)
464 yl=x8(i)
465 zl=y8(i)
466 x8(i)=xl
467 y8(i)=yl
468 z8(i)=zl
469 ENDDO
470 ENDIF !IF (JCVT==0)
471 DO i=1,nel
472 IF(offg(i)<=one)THEN
473C sav in local frame
474 sav(i,1)=x1(i)-x8(i)
475 sav(i,2)=y1(i)-y8(i)
476 sav(i,3)=z1(i)-z8(i)
477 sav(i,4)=x2(i)-x8(i)
478 sav(i,5)=y2(i)-y8(i)
479 sav(i,6)=z2(i)-z8(i)
480 sav(i,7)=x3(i)-x8(i)
481 sav(i,8)=y3(i)-y8(i)
482 sav(i,9)=z3(i)-z8(i)
483 sav(i,10)=x4(i)-x8(i)
484 sav(i,11)=y4(i)-y8(i)
485 sav(i,12)=z4(i)-z8(i)
486 sav(i,13)=x5(i)-x8(i)
487 sav(i,14)=y5(i)-y8(i)
488 sav(i,15)=z5(i)-z8(i)
489 sav(i,16)=x6(i)-x8(i)
490 sav(i,17)=y6(i)-y8(i)
491 sav(i,18)=z6(i)-z8(i)
492 sav(i,19)=x7(i)-x8(i)
493 sav(i,20)=y7(i)-y8(i)
494 sav(i,21)=z7(i)-z8(i)
495 off(i) = offg(i)
496 ENDIF
497 ENDDO
498 ENDIF !IF (JHBE==14.OR.JHBE==24...)
499C
500 ELSE
501 DO i=1,nel
502 xl=r11(i)*x1(i)+r21(i)*y1(i)+r31(i)*z1(i)
503 yl=r12(i)*x1(i)+r22(i)*y1(i)+r32(i)*z1(i)
504 zl=r13(i)*x1(i)+r23(i)*y1(i)+r33(i)*z1(i)
505 x1(i)=xl
506 y1(i)=yl
507 z1(i)=zl
508 xl=r11(i)*x2(i)+r21(i)*y2(i)+r31(i)*z2(i)
509 yl=r12(i)*x2(i)+r22(i)*y2(i)+r32(i)*z2(i)
510 zl=r13(i)*x2(i)+r23(i)*y2(i)+r33(i)*z2(i)
511 x2(i)=xl
512 y2(i)=yl
513 z2(i)=zl
514 xl=r11(i)*x3(i)+r21(i)*y3(i)+r31(i)*z3(i)
515 yl=r12(i)*x3(i)+r22(i)*y3(i)+r32(i)*z3(i)
516 zl=r13(i)*x3(i)+r23(i)*y3(i)+r33(i)*z3(i)
517 x3(i)=xl
518 y3(i)=yl
519 z3(i)=zl
520 xl=r11(i)*x4(i)+r21(i)*y4(i)+r31(i)*z4(i)
521 yl=r12(i)*x4(i)+r22(i)*y4(i)+r32(i)*z4(i)
522 zl=r13(i)*x4(i)+r23(i)*y4(i)+r33(i)*z4(i)
523 x4(i)=xl
524 y4(i)=yl
525 z4(i)=zl
526 xl=r11(i)*x5(i)+r21(i)*y5(i)+r31(i)*z5(i)
527 yl=r12(i)*x5(i)+r22(i)*y5(i)+r32(i)*z5(i)
528 zl=r13(i)*x5(i)+r23(i)*y5(i)+r33(i)*z5(i)
529 x5(i)=xl
530 y5(i)=yl
531 z5(i)=zl
532 xl=r11(i)*x6(i)+r21(i)*y6(i)+r31(i)*z6(i)
533 yl=r12(i)*x6(i)+r22(i)*y6(i)+r32(i)*z6(i)
534 zl=r13(i)*x6(i)+r23(i)*y6(i)+r33(i)*z6(i)
535 x6(i)=xl
536 y6(i)=yl
537 z6(i)=zl
538 xl=r11(i)*x7(i)+r21(i)*y7(i)+r31(i)*z7(i)
539 yl=r12(i)*x7(i)+r22(i)*y7(i)+r32(i)*z7(i)
540 zl=r13(i)*x7(i)+r23(i)*y7(i)+r33(i)*z7(i)
541 x7(i)=xl
542 y7(i)=yl
543 z7(i)=zl
544 xl=r11(i)*x8(i)+r21(i)*y8(i)+r31(i)*z8(i)
545 yl=r12(i)*x8(i)+r22(i)*y8(i)+r32(i)*z8(i)
546 zl=r13(i)*x8(i)+r23(i)*y8(i)+r33(i)*z8(i)
547 x8(i)=xl
548 y8(i)=yl
549 z8(i)=zl
550 off(i) = min(one,offg(i))
551 ENDDO
552C
553 ENDIF
554C-----------
555 DO j=1,9
556 DO i=1,nel
557 k11(j,i)=zero
558 k12(j,i)=zero
559 k13(j,i)=zero
560 k14(j,i)=zero
561 k15(j,i)=zero
562 k16(j,i)=zero
563 k17(j,i)=zero
564 k18(j,i)=zero
565 k22(j,i)=zero
566 k23(j,i)=zero
567 k24(j,i)=zero
568 k25(j,i)=zero
569 k26(j,i)=zero
570 k27(j,i)=zero
571 k28(j,i)=zero
572 k33(j,i)=zero
573 k34(j,i)=zero
574 k35(j,i)=zero
575 k36(j,i)=zero
576 k37(j,i)=zero
577 k38(j,i)=zero
578 k44(j,i)=zero
579 k45(j,i)=zero
580 k46(j,i)=zero
581 k47(j,i)=zero
582 k48(j,i)=zero
583 k55(j,i)=zero
584 k56(j,i)=zero
585 k57(j,i)=zero
586 k58(j,i)=zero
587 k66(j,i)=zero
588 k67(j,i)=zero
589 k68(j,i)=zero
590 k77(j,i)=zero
591 k78(j,i)=zero
592 k88(j,i)=zero
593 ENDDO
594 ENDDO
595C-----------
596 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
sorthdir17
subroutine sorthdir17(rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, gama, nel, jcvt)
Definition sorthdir17.F:35
sorthdir3
subroutine sorthdir3(rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, gama0, gama, nel, irep)
Definition sorthdir3.F:43
srepisot3
subroutine srepisot3(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, nel)
Definition srepisot3.F:42
sortho3
subroutine sortho3(rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z)
Definition sortho3.F:33
scortho3
subroutine scortho3(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, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z)
Definition scortho3.F:34