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 35 of file srcoork.F.

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