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
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 IS
64C-----------------------------------------------
65C -------symm(diag)------
66 is =1
67 CALL s8zked3(1,nel,px1, py1 ,pz1 ,px1, py1, pz1, dd, k11,is)
68 CALL s8zked3(1,nel,px2, py2 ,pz2 ,px2, py2, pz2, dd, k22,is)
69 CALL s8zked3(1,nel,px3, py3 ,pz3 ,px3, py3, pz3, dd, k33,is)
70 CALL s8zked3(1,nel,px4, py4 ,pz4 ,px4, py4, pz4, dd, k44,is)
71C
72 IF (iksup==0) THEN
73 CALL s8zkeg3(1,nel,py1, px1 ,pz1,px1 ,pz1,py1,
74 . py1, px1 ,pz1,px1 ,pz1,py1,gg,k11,is)
75 CALL s8zkeg3(1,nel,py2, px2 ,pz2,px2 ,pz2,py2,
76 . py2, px2 ,pz2,px2 ,pz2,py2,gg,k22,is)
77 CALL s8zkeg3(1,nel,py3, px3 ,pz3,px3 ,pz3,py3,
78 . py3, px3 ,pz3,px3 ,pz3,py3,gg,k33,is)
79 CALL s8zkeg3(1,nel,py4, px4 ,pz4,px4 ,pz4,py4,
80 . py4, px4 ,pz4,px4 ,pz4,py4,gg,k44,is)
81 ENDIF
82C -------non symm------
83 is =0
84 CALL s8zked3(1,nel,px1, py1 ,pz1 ,px2, py2, pz2, dd, k12,is)
85 CALL s8zked3(1,nel,px1, py1 ,pz1 ,px3, py3, pz3, dd, k13,is)
86 CALL s8zked3(1,nel,px1, py1 ,pz1 ,px4, py4, pz4, dd, k14,is)
87 CALL s8zked3(1,nel,px2, py2 ,pz2 ,px3, py3, pz3, dd, k23,is)
88 CALL s8zked3(1,nel,px2, py2 ,pz2 ,px4, py4, pz4, dd, k24,is)
89 CALL s8zked3(1,nel,px3, py3 ,pz3 ,px4, py4, pz4, dd, k34,is)
90C
91 IF (iksup==0) THEN
92 CALL s8zkeg3(1,nel,py1, px1 ,pz1,px1 ,pz1,py1,
93 . py2, px2 ,pz2,px2 ,pz2,py2,gg,k12,is)
94 CALL s8zkeg3(1,nel,py1, px1 ,pz1,px1 ,pz1,py1,
95 . py3, px3 ,pz3,px3 ,pz3,py3,gg,k13,is)
96 CALL s8zkeg3(1,nel,py1, px1 ,pz1,px1 ,pz1,py1,
97 . py4, px4 ,pz4,px4 ,pz4,py4,gg,k14,is)
98 CALL s8zkeg3(1,nel,py2, px2 ,pz2,px2 ,pz2,py2,
99 . py3, px3 ,pz3,px3 ,pz3,py3,gg,k23,is)
100 CALL s8zkeg3(1,nel,py2, px2 ,pz2,px2 ,pz2,py2,
101 . py4, px4 ,pz4,px4 ,pz4,py4,gg,k24,is)
102 CALL s8zkeg3(1,nel,py3, px3 ,pz3,px3 ,pz3,py3,
103 . py4, px4 ,pz4,px4 ,pz4,py4,gg,k34,is)
104 ELSE
105 CALL s8zkeg33(1,nel,py1, px1 ,pz1,px1 ,pz1,py1,
106 . py2, px2 ,pz2,px2 ,pz2,py2,g33,k12,is)
107 CALL s8zkeg33(1,nel,py1, px1 ,pz1,px1 ,pz1,py1,
108 . py3, px3 ,pz3,px3 ,pz3,py3,g33,k13,is)
109 CALL s8zkeg33(1,nel,py1, px1 ,pz1,px1 ,pz1,py1,
110 . py4, px4 ,pz4,px4 ,pz4,py4,g33,k14,is)
111 CALL s8zkeg33(1,nel,py2, px2 ,pz2,px2 ,pz2,py2,
112 . py3, px3 ,pz3,px3 ,pz3,py3,g33,k23,is)
113 CALL s8zkeg33(1,nel,py2, px2 ,pz2,px2 ,pz2,py2,
114 . py4, px4 ,pz4,px4 ,pz4,py4,g33,k24,is)
115 CALL s8zkeg33(1,nel,py3, px3 ,pz3,px3 ,pz3,py3,
116 . py4, px4 ,pz4,px4 ,pz4,py4,g33,k34,is)
117C
118 CALL s8zkebg1(1,nel,px1, py1 ,pz1 ,px2, py2, pz2, dg, k12,is)
119 CALL s8zkebg1(1,nel,px1, py1 ,pz1 ,px3, py3, pz3, dg, k13,is)
120 CALL s8zkebg1(1,nel,px1, py1 ,pz1 ,px4, py4, pz4, dg, k14,is)
121 CALL s8zkebg1(1,nel,px2, py2 ,pz2 ,px3, py3, pz3, dg, k23,is)
122 CALL s8zkebg1(1,nel,px2, py2 ,pz2 ,px4, py4, pz4, dg, k24,is)
123 CALL s8zkebg1(1,nel,px3, py3 ,pz3 ,px4, py4, pz4, dg, k34,is)
124 is =1
125 CALL s8zkebg1(1,nel,px1, py1 ,pz1 ,px1, py1, pz1, dg, k11,is)
126 CALL s8zkebg1(1,nel,px2, py2 ,pz2 ,px2, py2, pz2, dg, k22,is)
127 CALL s8zkebg1(1,nel,px3, py3 ,pz3 ,px3, py3, pz3, dg, k33,is)
128 CALL s8zkebg1(1,nel,px4, py4 ,pz4 ,px4, py4, pz4, dg, k44,is)
129C
130 CALL s8zkeg33(1,nel,py1, px1 ,pz1,px1 ,pz1,py1,
131 . py1, px1 ,pz1,px1 ,pz1,py1,g33,k11,is)
132 CALL s8zkeg33(1,nel,py2, px2 ,pz2,px2 ,pz2,py2,
133 . py2, px2 ,pz2,px2 ,pz2,py2,g33,k22,is)
134 CALL s8zkeg33(1,nel,py3, px3 ,pz3,px3 ,pz3,py3,
135 . py3, px3 ,pz3,px3 ,pz3,py3,g33,k33,is)
136 CALL s8zkeg33(1,nel,py4, px4 ,pz4,px4 ,pz4,py4,
137 . py4, px4 ,pz4,px4 ,pz4,py4,g33,k44,is)
138 ENDIF
139C
140 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine s8zkebg1(lft, llt, pxi, pyi, pzi, pxj, pyj, pzj, dg, kij, is)
Definition s8zkebg1.F:32
subroutine s8zked3(lft, llt, pxi, pyi, pzi, pxj, pyj, pzj, dd, kij, is)
Definition s8zked3.F:34
subroutine s8zkeg33(lft, llt, pxyi, pyxi, pxzi, pzxi, pyzi, pzyi, pxyj, pyxj, pxzj, pzxj, pyzj, pzyj, g33, kij, is)
Definition s8zkeg33.F:34
subroutine s8zkeg3(lft, llt, pxyi, pyxi, pxzi, pzxi, pyzi, pzyi, pxyj, pyxj, pxzj, pzxj, pyzj, pzyj, g, kij, is)
Definition s8zkeg3.F:34