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

Go to the source code of this file.

Functions/Subroutines

subroutine s8zkebg3 (lft, llt, pxi, pyi, pzi, pxj, pyj, pzj, bxyi, byxi, bxzi, bzxi, byzi, bzyi, bxyj, byxj, bxzj, bzxj, byzj, bzyj, pxyi, pyxi, pxzi, pzxi, pyzi, pzyi, pxyj, pyxj, pxzj, pzxj, pyzj, pzyj, dg, kij, is, icp)

Function/Subroutine Documentation

◆ s8zkebg3()

subroutine s8zkebg3 ( integer lft,
integer llt,
pxi,
pyi,
pzi,
pxj,
pyj,
pzj,
bxyi,
byxi,
bxzi,
bzxi,
byzi,
bzyi,
bxyj,
byxj,
bxzj,
bzxj,
byzj,
bzyj,
pxyi,
pyxi,
pxzi,
pzxi,
pyzi,
pzyi,
pxyj,
pyxj,
pxzj,
pzxj,
pyzj,
pzyj,
dg,
kij,
integer is,
integer icp )

Definition at line 28 of file s8zkebg3.F.

34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.inc"
38C-----------------------------------------------
39C G l o b a l P a r a m e t e r s
40C-----------------------------------------------
41#include "mvsiz_p.inc"
42C-----------------------------------------------
43C D u m m y A r g u m e n t s
44C-----------------------------------------------
45 INTEGER LFT,LLT,IS,ICP
46C REAL
47 my_real
48 . pxi(*), pxj(*),pyi(*), pyj(*), pzi(*), pzj(*),
49 . bxyi(*), byxi(*) ,bxzi(*),bzxi(*) ,byzi(*),bzyi(*),
50 . bxyj(*), byxj(*) ,bxzj(*),bzxj(*) ,byzj(*),bzyj(*),
51 . pxyi(*), pyxi(*) ,pxzi(*),pzxi(*) ,pyzi(*),pzyi(*),
52 . pxyj(*), pyxj(*) ,pxzj(*),pzxj(*) ,pyzj(*),pzyj(*),
53 . dg(3,3,*), kij(3,3,*)
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 INTEGER I,J,EP
58C REAL
59 my_real
60 . bi(3,3,mvsiz),bj(3,3,mvsiz),ci(3,3,mvsiz),cj(3,3,mvsiz)
61C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
62 IF (is==1) THEN
63 IF (icp==1) THEN
64 DO i=lft,llt
65 bi(1,1,i)=pxi(i)
66 bi(2,2,i)=pyi(i)
67 bi(3,3,i)=pzi(i)
68 bi(1,2,i)=zero
69 bi(2,1,i)=zero
70 bi(1,3,i)=zero
71 bi(3,1,i)=zero
72 bi(2,3,i)=zero
73 bi(3,2,i)=zero
74 ENDDO
75 ELSE
76 DO i=lft,llt
77 bi(1,1,i)=pxi(i)
78 bi(2,2,i)=pyi(i)
79 bi(3,3,i)=pzi(i)
80 bi(1,2,i)=byxi(i)
81 bi(2,1,i)=bxyi(i)
82 bi(1,3,i)=bzxi(i)
83 bi(3,1,i)=bxzi(i)
84 bi(2,3,i)=bzyi(i)
85 bi(3,2,i)=byzi(i)
86 ENDDO
87 endif!.. icp =1
88 DO i=lft,llt
89 ci(1,1,i)=pxyi(i)
90 ci(1,2,i)=pyxi(i)
91 ci(1,3,i)=zero
92 ci(2,1,i)=zero
93 ci(2,2,i)=pyzi(i)
94 ci(2,3,i)=pzyi(i)
95 ci(3,1,i)=pxzi(i)
96 ci(3,2,i)=zero
97 ci(3,3,i)=pzxi(i)
98 ENDDO
99C------use tempo CJ----
100 DO i=1,3
101 DO j=1,3
102 DO ep=lft,llt
103 cj(i,j,ep)=zero
104 ENDDO
105 ENDDO
106 ENDDO
107C
108 DO i=1,3
109 DO j=1,3
110 DO ep=lft,llt
111 cj(i,j,ep)=cj(i,j,ep)+bi(1,i,ep)*(dg(1,1,ep)*ci(1,j,ep)+
112 1 dg(1,2,ep)*ci(2,j,ep)+dg(1,3,ep)*ci(3,j,ep))+
113 2 bi(2,i,ep)*(dg(2,1,ep)*ci(1,j,ep)+
114 3 dg(2,2,ep)*ci(2,j,ep)+dg(2,3,ep)*ci(3,j,ep))+
115 4 bi(3,i,ep)*(dg(3,1,ep)*ci(1,j,ep)+
116 5 dg(3,2,ep)*ci(2,j,ep)+dg(3,3,ep)*ci(3,j,ep))
117 ENDDO
118 ENDDO
119 ENDDO
120C
121 DO i=1,3
122 DO j=i,3
123 DO ep=lft,llt
124 kij(i,j,ep)=kij(i,j,ep)+cj(i,j,ep)+cj(j,i,ep)
125 ENDDO
126 ENDDO
127 ENDDO
128 ELSE ! IS = 0 -- non-symmetry
129 IF (icp==1) THEN
130 DO i=lft,llt
131 bi(1,1,i)=pxi(i)
132 bi(2,2,i)=pyi(i)
133 bi(3,3,i)=pzi(i)
134 bi(1,2,i)=zero
135 bi(2,1,i)=zero
136 bi(1,3,i)=zero
137 bi(3,1,i)=zero
138 bi(2,3,i)=zero
139 bi(3,2,i)=zero
140 ENDDO
141 DO i=lft,llt
142 bj(1,1,i)=pxj(i)
143 bj(2,2,i)=pyj(i)
144 bj(3,3,i)=pzj(i)
145 bj(1,2,i)=zero
146 bj(2,1,i)=zero
147 bj(1,3,i)=zero
148 bj(3,1,i)=zero
149 bj(2,3,i)=zero
150 bj(3,2,i)=zero
151 ENDDO
152 ELSE ! .. icp = 0
153 DO i=lft,llt
154 bi(1,1,i)=pxi(i)
155 bi(2,2,i)=pyi(i)
156 bi(3,3,i)=pzi(i)
157 bi(1,2,i)=byxi(i)
158 bi(2,1,i)=bxyi(i)
159 bi(1,3,i)=bzxi(i)
160 bi(3,1,i)=bxzi(i)
161 bi(2,3,i)=bzyi(i)
162 bi(3,2,i)=byzi(i)
163 ENDDO
164 DO i=lft,llt
165 bj(1,1,i)=pxj(i)
166 bj(2,2,i)=pyj(i)
167 bj(3,3,i)=pzj(i)
168 bj(1,2,i)=byxj(i)
169 bj(2,1,i)=bxyj(i)
170 bj(1,3,i)=bzxj(i)
171 bj(3,1,i)=bxzj(i)
172 bj(2,3,i)=bzyj(i)
173 bj(3,2,i)=byzj(i)
174 ENDDO
175 ENDIF
176 DO i=lft,llt
177 ci(1,1,i)=pxyi(i)
178 ci(1,2,i)=pyxi(i)
179 ci(1,3,i)=zero
180 ci(2,1,i)=zero
181 ci(2,2,i)=pyzi(i)
182 ci(2,3,i)=pzyi(i)
183 ci(3,1,i)=pxzi(i)
184 ci(3,2,i)=zero
185 ci(3,3,i)=pzxi(i)
186 ENDDO
187 DO i=lft,llt
188 cj(1,1,i)=pxyj(i)
189 cj(1,2,i)=pyxj(i)
190 cj(1,3,i)=zero
191 cj(2,1,i)=zero
192 cj(2,2,i)=pyzj(i)
193 cj(2,3,i)=pzyj(i)
194 cj(3,1,i)=pxzj(i)
195 cj(3,2,i)=zero
196 cj(3,3,i)=pzxj(i)
197 ENDDO
198 DO i=1,3
199 DO j=1,3
200 DO ep=lft,llt
201 kij(i,j,ep)=kij(i,j,ep)+bi(1,i,ep)*(dg(1,1,ep)*cj(1,j,ep)+
202 1 dg(1,2,ep)*cj(2,j,ep)+dg(1,3,ep)*cj(3,j,ep))+
203 2 bi(2,i,ep)*(dg(2,1,ep)*cj(1,j,ep)+
204 3 dg(2,2,ep)*cj(2,j,ep)+dg(2,3,ep)*cj(3,j,ep))+
205 4 bi(3,i,ep)*(dg(3,1,ep)*cj(1,j,ep)+
206 5 dg(3,2,ep)*cj(2,j,ep)+dg(3,3,ep)*cj(3,j,ep))+
207candr.. transpose of DG must be taken here
208c$$$ 6 CI(1,I,EP)*(DG(1,1,EP)*BJ(1,J,EP)+
209c$$$ 7 DG(1,2,EP)*BJ(2,J,EP)+DG(1,3,EP)*BJ(3,J,EP))+
210c$$$ 8 CI(2,I,EP)*(DG(2,1,EP)*BJ(1,J,EP)+
211c$$$ 9 DG(2,2,EP)*BJ(2,J,EP)+DG(2,3,EP)*BJ(3,J,EP))+
212c$$$ A CI(3,I,EP)*(DG(3,1,EP)*BJ(1,J,EP)+
213c$$$ B DG(3,2,EP)*BJ(2,J,EP)+DG(3,3,EP)*BJ(3,J,EP))
214 6 ci(1,i,ep)*(dg(1,1,ep)*bj(1,j,ep)+
215 7 dg(2,1,ep)*bj(2,j,ep)+dg(3,1,ep)*bj(3,j,ep))+
216 8 ci(2,i,ep)*(dg(1,2,ep)*bj(1,j,ep)+
217 9 dg(2,2,ep)*bj(2,j,ep)+dg(3,2,ep)*bj(3,j,ep))+
218 a ci(3,i,ep)*(dg(1,3,ep)*bj(1,j,ep)+
219 b dg(2,3,ep)*bj(2,j,ep)+dg(3,3,ep)*bj(3,j,ep))
220
221 ENDDO
222 ENDDO
223 ENDDO
224 ENDIF
225C
226 RETURN
my_real
#define my_real
Definition cppsort.cpp:32