OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s8zkebg1.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| s8zkebg1 ../engine/source/elements/solid/solide8z/s8zkebg1.F
25!||--- called by ------------------------------------------------------
26!|| s10cumg3 ../engine/source/elements/solid/solide10/s10cumg3.F
27!|| s20cumg3 ../engine/source/elements/solid/solide20/s20cumg3.F
28!|| s4cumg3 ../engine/source/elements/solid/solide4/s4cumg3.f
29!||====================================================================
30 SUBROUTINE s8zkebg1(LFT,LLT,
31 . PXI, PYI ,PZI ,PXJ, PYJ, PZJ, DG, KIJ,IS)
32C-----------------------------------------------
33C I m p l i c i t T y p e s
34C-----------------------------------------------
35#include "implicit_f.inc"
36C-----------------------------------------------
37C G l o b a l P a r a m e t e r s
38C-----------------------------------------------
39#include "mvsiz_p.inc"
40C-----------------------------------------------
41C D u m m y A r g u m e n t s
42C-----------------------------------------------
43 INTEGER LFT,LLT,IS
44C REAL
45 my_real
46 . pxi(*), pxj(*),pyi(*), pyj(*), pzi(*), pzj(*),
47 . dg(3,3,*), kij(3,3,*)
48C-----------------------------------------------
49C L o c a l V a r i a b l e s
50C-----------------------------------------------
51 INTEGER I,J,EP
52C REAL
53 my_real
54 . bi(3,mvsiz),bj(3,mvsiz),ci(3,3,mvsiz),cj(3,3,mvsiz)
55C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
56 IF (is==1) THEN
57 DO i=lft,llt
58 bi(1,i)=pxi(i)
59 bi(2,i)=pyi(i)
60 bi(3,i)=pzi(i)
61 ENDDO
62 DO i=lft,llt
63 ci(1,1,i)=pyi(i)
64 ci(1,2,i)=pxi(i)
65 ci(1,3,i)=zero
66 ci(2,1,i)=zero
67 ci(2,2,i)=pzi(i)
68 ci(2,3,i)=pyi(i)
69 ci(3,1,i)=pzi(i)
70 ci(3,2,i)=zero
71 ci(3,3,i)=pxi(i)
72 ENDDO
73C------use tempo CJ----
74 DO i=1,3
75 DO j=1,3
76 DO ep=lft,llt
77 cj(i,j,ep)=zero
78 ENDDO
79 ENDDO
80 ENDDO
81C
82 DO j=1,3
83 DO ep=lft,llt
84 cj(1,j,ep)=cj(1,j,ep)+bi(1,ep)*(dg(1,1,ep)*ci(1,j,ep)+
85 1 dg(1,2,ep)*ci(2,j,ep)+dg(1,3,ep)*ci(3,j,ep))
86 cj(2,j,ep)=cj(2,j,ep)+bi(2,ep)*(dg(2,1,ep)*ci(1,j,ep)+
87 3 dg(2,2,ep)*ci(2,j,ep)+dg(2,3,ep)*ci(3,j,ep))
88 cj(3,j,ep)=cj(3,j,ep)+bi(3,ep)*(dg(3,1,ep)*ci(1,j,ep)+
89 5 dg(3,2,ep)*ci(2,j,ep)+dg(3,3,ep)*ci(3,j,ep))
90 ENDDO
91 ENDDO
92C
93 DO i=1,3
94 DO j=i,3
95 DO ep=lft,llt
96 kij(i,j,ep)=kij(i,j,ep)+cj(i,j,ep)+cj(j,i,ep)
97 ENDDO
98 ENDDO
99 ENDDO
100 ELSE
101 DO i=lft,llt
102 bi(1,i)=pxi(i)
103 bi(2,i)=pyi(i)
104 bi(3,i)=pzi(i)
105 ENDDO
106 DO i=lft,llt
107 bj(1,i)=pxj(i)
108 bj(2,i)=pyj(i)
109 bj(3,i)=pzj(i)
110 ENDDO
111 DO i=lft,llt
112 ci(1,1,i)=pyi(i)
113 ci(1,2,i)=pxi(i)
114 ci(1,3,i)=zero
115 ci(2,1,i)=zero
116 ci(2,2,i)=pzi(i)
117 ci(2,3,i)=pyi(i)
118 ci(3,1,i)=pzi(i)
119 ci(3,2,i)=zero
120 ci(3,3,i)=pxi(i)
121 ENDDO
122 DO i=lft,llt
123 cj(1,1,i)=pyj(i)
124 cj(1,2,i)=pxj(i)
125 cj(1,3,i)=zero
126 cj(2,1,i)=zero
127 cj(2,2,i)=pzj(i)
128 cj(2,3,i)=pyj(i)
129 cj(3,1,i)=pzj(i)
130 cj(3,2,i)=zero
131 cj(3,3,i)=pxj(i)
132 ENDDO
133C
134 DO j=1,3
135 DO ep=lft,llt
136 kij(1,j,ep)=kij(1,j,ep)+bi(1,ep)*(dg(1,1,ep)*cj(1,j,ep)+
137 1 dg(1,2,ep)*cj(2,j,ep)+dg(1,3,ep)*cj(3,j,ep))
138 kij(2,j,ep)=kij(2,j,ep)+bi(2,ep)*(dg(2,1,ep)*cj(1,j,ep)+
139 3 dg(2,2,ep)*cj(2,j,ep)+dg(2,3,ep)*cj(3,j,ep))
140 kij(3,j,ep)=kij(3,j,ep)+bi(3,ep)*(dg(3,1,ep)*cj(1,j,ep)+
141 5 dg(3,2,ep)*cj(2,j,ep)+dg(3,3,ep)*cj(3,j,ep))
142 ENDDO
143 ENDDO
144C
145 DO i=1,3
146 DO ep=lft,llt
147 kij(i,1,ep)=kij(i,1,ep)+bj(1,ep)*(dg(1,1,ep)*ci(1,i,ep)+
148 1 dg(1,2,ep)*ci(2,i,ep)+dg(1,3,ep)*ci(3,i,ep))
149 kij(i,2,ep)=kij(i,2,ep)+bj(2,ep)*(dg(1,2,ep)*ci(1,i,ep)+
150 3 dg(2,2,ep)*ci(2,i,ep)+dg(2,3,ep)*ci(3,i,ep))
151 kij(i,3,ep)=kij(i,3,ep)+bj(3,ep)*(dg(1,3,ep)*ci(1,i,ep)+
152 5 dg(3,2,ep)*ci(2,i,ep)+dg(3,3,ep)*ci(3,i,ep))
153 ENDDO
154 ENDDO
155 ENDIF
156C
157 RETURN
158 END
my_real
#define my_real
Definition cppsort.cpp:32
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, iksup, nel)
Definition s4cumg3.F:41
s8zkebg1
subroutine s8zkebg1(lft, llt, pxi, pyi, pzi, pxj, pyj, pzj, dg, kij, is)
Definition s8zkebg1.F:32