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

Go to the source code of this file.

Functions/Subroutines

subroutine s4cumg3 (px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, k11, k12, k13, k14, k22, k23, k24, k33, k34, k44, dd, gg, dg, g33, iksup, nel)

Function/Subroutine Documentation

◆ s4cumg3()

subroutine s4cumg3 ( px1,
px2,
px3,
px4,
py1,
py2,
py3,
py4,
pz1,
pz2,
pz3,
pz4,
k11,
k12,
k13,
k14,
k22,
k23,
k24,
k33,
k34,
k44,
dd,
gg,
dg,
g33,
integer iksup,
integer, intent(in) nel )

Definition at line 33 of file s4cumg3.F.

41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER, INTENT(IN) :: NEL
52 INTEGER IKSUP
53 my_real
54 . px1(*), px2(*), px3(*), px4(*),
55 . py1(*), py2(*), py3(*), py4(*),
56 . pz1(*), pz2(*), pz3(*), pz4(*),
57 . k11(9,*) ,k12(9,*) ,k13(9,*) ,k14(9,*) ,k22(9,*) ,
58 . k23(9,*) ,k24(9,*) ,k33(9,*) ,k34(9,*) ,k44(9,*) ,
59 . dd(3,3,*),gg(*),dg(9,*) ,g33(9,*)
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63 INTEGER I, J,IS
64 my_real
65 . tt,tv
66C-----------------------------------------------
67C -------symm(diag)------
68 is =1
69 CALL s8zked3(1,nel,px1, py1 ,pz1 ,px1, py1, pz1, dd, k11,is)
70 CALL s8zked3(1,nel,px2, py2 ,pz2 ,px2, py2, pz2, dd, k22,is)
71 CALL s8zked3(1,nel,px3, py3 ,pz3 ,px3, py3, pz3, dd, k33,is)
72 CALL s8zked3(1,nel,px4, py4 ,pz4 ,px4, py4, pz4, dd, k44,is)
73C
74 IF (iksup==0) THEN
75 CALL s8zkeg3(1,nel,py1, px1 ,pz1,px1 ,pz1,py1,
76 . py1, px1 ,pz1,px1 ,pz1,py1,gg,k11,is)
77 CALL s8zkeg3(1,nel,py2, px2 ,pz2,px2 ,pz2,py2,
78 . py2, px2 ,pz2,px2 ,pz2,py2,gg,k22,is)
79 CALL s8zkeg3(1,nel,py3, px3 ,pz3,px3 ,pz3,py3,
80 . py3, px3 ,pz3,px3 ,pz3,py3,gg,k33,is)
81 CALL s8zkeg3(1,nel,py4, px4 ,pz4,px4 ,pz4,py4,
82 . py4, px4 ,pz4,px4 ,pz4,py4,gg,k44,is)
83 ENDIF
84C -------non symm------
85 is =0
86 CALL s8zked3(1,nel,px1, py1 ,pz1 ,px2, py2, pz2, dd, k12,is)
87 CALL s8zked3(1,nel,px1, py1 ,pz1 ,px3, py3, pz3, dd, k13,is)
88 CALL s8zked3(1,nel,px1, py1 ,pz1 ,px4, py4, pz4, dd, k14,is)
89 CALL s8zked3(1,nel,px2, py2 ,pz2 ,px3, py3, pz3, dd, k23,is)
90 CALL s8zked3(1,nel,px2, py2 ,pz2 ,px4, py4, pz4, dd, k24,is)
91 CALL s8zked3(1,nel,px3, py3 ,pz3 ,px4, py4, pz4, dd, k34,is)
92C
93 IF (iksup==0) THEN
94 CALL s8zkeg3(1,nel,py1, px1 ,pz1,px1 ,pz1,py1,
95 . py2, px2 ,pz2,px2 ,pz2,py2,gg,k12,is)
96 CALL s8zkeg3(1,nel,py1, px1 ,pz1,px1 ,pz1,py1,
97 . py3, px3 ,pz3,px3 ,pz3,py3,gg,k13,is)
98 CALL s8zkeg3(1,nel,py1, px1 ,pz1,px1 ,pz1,py1,
99 . py4, px4 ,pz4,px4 ,pz4,py4,gg,k14,is)
100 CALL s8zkeg3(1,nel,py2, px2 ,pz2,px2 ,pz2,py2,
101 . py3, px3 ,pz3,px3 ,pz3,py3,gg,k23,is)
102 CALL s8zkeg3(1,nel,py2, px2 ,pz2,px2 ,pz2,py2,
103 . py4, px4 ,pz4,px4 ,pz4,py4,gg,k24,is)
104 CALL s8zkeg3(1,nel,py3, px3 ,pz3,px3 ,pz3,py3,
105 . py4, px4 ,pz4,px4 ,pz4,py4,gg,k34,is)
106 ELSE
107 CALL s8zkeg33(1,nel,py1, px1 ,pz1,px1 ,pz1,py1,
108 . py2, px2 ,pz2,px2 ,pz2,py2,g33,k12,is)
109 CALL s8zkeg33(1,nel,py1, px1 ,pz1,px1 ,pz1,py1,
110 . py3, px3 ,pz3,px3 ,pz3,py3,g33,k13,is)
111 CALL s8zkeg33(1,nel,py1, px1 ,pz1,px1 ,pz1,py1,
112 . py4, px4 ,pz4,px4 ,pz4,py4,g33,k14,is)
113 CALL s8zkeg33(1,nel,py2, px2 ,pz2,px2 ,pz2,py2,
114 . py3, px3 ,pz3,px3 ,pz3,py3,g33,k23,is)
115 CALL s8zkeg33(1,nel,py2, px2 ,pz2,px2 ,pz2,py2,
116 . py4, px4 ,pz4,px4 ,pz4,py4,g33,k24,is)
117 CALL s8zkeg33(1,nel,py3, px3 ,pz3,px3 ,pz3,py3,
118 . py4, px4 ,pz4,px4 ,pz4,py4,g33,k34,is)
119C
120 CALL s8zkebg1(1,nel,px1, py1 ,pz1 ,px2, py2, pz2, dg, k12,is)
121 CALL s8zkebg1(1,nel,px1, py1 ,pz1 ,px3, py3, pz3, dg, k13,is)
122 CALL s8zkebg1(1,nel,px1, py1 ,pz1 ,px4, py4, pz4, dg, k14,is)
123 CALL s8zkebg1(1,nel,px2, py2 ,pz2 ,px3, py3, pz3, dg, k23,is)
124 CALL s8zkebg1(1,nel,px2, py2 ,pz2 ,px4, py4, pz4, dg, k24,is)
125 CALL s8zkebg1(1,nel,px3, py3 ,pz3 ,px4, py4, pz4, dg, k34,is)
126 is =1
127 CALL s8zkebg1(1,nel,px1, py1 ,pz1 ,px1, py1, pz1, dg, k11,is)
128 CALL s8zkebg1(1,nel,px2, py2 ,pz2 ,px2, py2, pz2, dg, k22,is)
129 CALL s8zkebg1(1,nel,px3, py3 ,pz3 ,px3, py3, pz3, dg, k33,is)
130 CALL s8zkebg1(1,nel,px4, py4 ,pz4 ,px4, py4, pz4, dg, k44,is)
131C
132 CALL s8zkeg33(1,nel,py1, px1 ,pz1,px1 ,pz1,py1,
133 . py1, px1 ,pz1,px1 ,pz1,py1,g33,k11,is)
134 CALL s8zkeg33(1,nel,py2, px2 ,pz2,px2 ,pz2,py2,
135 . py2, px2 ,pz2,px2 ,pz2,py2,g33,k22,is)
136 CALL s8zkeg33(1,nel,py3, px3 ,pz3,px3 ,pz3,py3,
137 . py3, px3 ,pz3,px3 ,pz3,py3,g33,k33,is)
138 CALL s8zkeg33(1,nel,py4, px4 ,pz4,px4 ,pz4,py4,
139 . py4, px4 ,pz4,px4 ,pz4,py4,g33,k44,is)
140 ENDIF
141C
142 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
s8zkebg1
subroutine s8zkebg1(lft, llt, pxi, pyi, pzi, pxj, pyj, pzj, dg, kij, is)
Definition s8zkebg1.F:32
s8zked3
subroutine s8zked3(lft, llt, pxi, pyi, pzi, pxj, pyj, pzj, dd, kij, is)
Definition s8zked3.F:34
s8zkeg33
subroutine s8zkeg33(lft, llt, pxyi, pyxi, pxzi, pzxi, pyzi, pzyi, pxyj, pyxj, pxzj, pzxj, pyzj, pzyj, g33, kij, is)
Definition s8zkeg33.F:34
s8zkeg3
subroutine s8zkeg3(lft, llt, pxyi, pyxi, pxzi, pzxi, pyzi, pzyi, pxyj, pyxj, pxzj, pzxj, pyzj, pzyj, g, kij, is)
Definition s8zkeg3.F:34