OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s8slke3.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!|| s8slke3 ../engine/source/elements/solid/solide8s/s8slke3.F
25!||--- called by ------------------------------------------------------
26!|| s8ske3 ../engine/source/elements/solid/solide8s/s8ske3.F
27!||--- calls -----------------------------------------------------
28!|| arret ../engine/source/system/arret.F
29!|| s8sansb ../engine/source/elements/solid/solide8s/s8sansb.F
30!||====================================================================
31 SUBROUTINE s8slke3(
32 1 KL, HH, VOL, !DN_X,
33 2 DN_Y, DN_Z, KSI, ETA,
34 3 ZETA, DN_R, DN_S, DN_T,
35 4 INVJ, X1, X2, X3,
36 5 X4, X5, X6, X7,
37 6 X8, Y1, Y2, Y3,
38 7 Y4, Y5, Y6, Y7,
39 8 Y8, Z1, Z2, Z3,
40 9 Z4, Z5, Z6, Z7,
41 A Z8, A11, A12, A13,
42 B A21, A22, A23, A31,
43 C A32, A33, NEL)
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C G l o b a l P a r a m e t e r s
50C-----------------------------------------------
51#include "mvsiz_p.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER, INTENT(IN) :: NEL
56 my_real
57 . VOL(MVSIZ),KSI,ETA,ZETA
58 DOUBLE PRECISION
59 . KL(24,24,MVSIZ), HH(2,MVSIZ),
60 . DN_X(MVSIZ,8),DN_Y(MVSIZ,8),DN_Z(MVSIZ,8),KTEMP(6,24),B(6,24),
61 . HV(6,6),DN_R(8),DN_S(8),DN_T(8),INVJ(9,MVSIZ)!,KLL(24,24)
62 my_real
63 . X1(MVSIZ), X2(MVSIZ), X3(MVSIZ), X4(MVSIZ),
64 . X5(MVSIZ), X6(MVSIZ), X7(MVSIZ), X8(MVSIZ),
65 . Y1(MVSIZ), Y2(MVSIZ), Y3(MVSIZ), Y4(MVSIZ),
66 . Y5(MVSIZ), Y6(MVSIZ), Y7(MVSIZ), Y8(MVSIZ),
67 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
68 . z5(mvsiz), z6(mvsiz), z7(mvsiz), z8(mvsiz)
69 my_real
70 . a11(mvsiz), a12(mvsiz), a13(mvsiz),
71 . a21(mvsiz), a22(mvsiz), a23(mvsiz),
72 . a31(mvsiz), a32(mvsiz), a33(mvsiz)
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76#if defined(MYREAL8) && !defined(WITHOUT_LINALG)
77 INTEGER I, J,JJ,K,JK, IS
78 B(1:6,1:24) = zero
79 hv(1:6,1:6) = zero
80
81 DO i=1,nel
82! Full integration
83 !DO J=1,8
84 ! JJ=3*(J-1)
85 ! B(1,JJ+1) = DN_X(I,J)
86 ! B(2,JJ+2) = DN_Y(I,J)
87 ! B(3,JJ+3) = DN_Z(I,J)
88 ! B(4,JJ+1) = DN_Y(I,J)
89 ! B(4,JJ+2) = DN_X(I,J)
90 ! B(5,JJ+1) = DN_Z(I,J)
91 ! B(5,JJ+3) = DN_X(I,J)
92 ! B(6,JJ+2) = DN_Z(I,J)
93 ! B(6,JJ+3) = DN_Y(I,J)
94 !ENDDO
95! ANS formulation
96 CALL s8sansb(
97 . x1(i),x2(i),x3(i),x4(i),x5(i),x6(i),x7(i),x8(i),
98 . y1(i),y2(i),y3(i),y4(i),y5(i),y6(i),y7(i),y8(i),
99 . z1(i),z2(i),z3(i),z4(i),z5(i),z6(i),z7(i),z8(i),
100 . invj(1,i),ksi,eta,zeta,
101 . a11(i),a12(i),a13(i),
102 . a21(i),a22(i),a23(i),
103 . a31(i),a32(i),a33(i),
104 . dn_r, dn_s, dn_t,b)
105
106 hv(1,1) = (hh(1,i)+two*hh(2,i))*vol(i)
107 hv(2,1) = hh(1,i)*vol(i)
108 hv(3,1) = hh(1,i)*vol(i)
109 hv(1,2) = hh(1,i)*vol(i)
110 hv(2,2) = (hh(1,i)+two*hh(2,i))*vol(i)
111 hv(3,2) = hh(1,i)*vol(i)
112 hv(1,3) = hh(1,i)*vol(i)
113 hv(2,3) = hh(1,i)*vol(i)
114 hv(3,3) = (hh(1,i)+two*hh(2,i))*vol(i)
115 hv(4,4) = hh(2,i)*vol(i)
116 hv(5,5) = hh(2,i)*vol(i)
117 hv(6,6) = hh(2,i)*vol(i)
118
119 ktemp(1:6,1:24)=zero
120 !DO J=1,6
121 ! DO K=1,24
122 ! DO JK=1,6
123 ! KTEMP(J,K) = KTEMP(J,K)+HV(J,JK)*B(JK,K)
124 ! ENDDO
125 ! ENDDO
126 !ENDDO
127
128 ! CALL DGEMM('N','N',6,24,6,ONE,HV,6,B,6,ZERO,KTEMP,6)
129 CALL dsymm('L','U',6,24,one,hv,6,b,6,zero,ktemp,6)
130 !DO J=1,24
131 ! DO K=1,24
132 ! DO JK=1,6
133 ! KL(J,K,I) = KL(J,K,I)+B(JK,J)*KTEMP(JK,K)
134 ! ENDDO
135 ! ENDDO
136 !ENDDO
137 CALL dgemm('T','N',24,24,6,one,b,6,ktemp,6,one,kl(1,1,i),24)
138 ENDDO
139#else
140 CALL arret(5)
141#endif
142 RETURN
143 END
dgemm
subroutine dgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
DGEMM
Definition dgemm.f:187
dsymm
subroutine dsymm(side, uplo, m, n, alpha, a, lda, b, ldb, beta, c, ldc)
DSYMM
Definition dsymm.f:189
s8sansb
subroutine s8sansb(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, invj, ksi, eta, zeta, a11, a12, a13, a21, a22, a23, a31, a32, a33, dn_r, dn_s, dn_t, bb)
Definition s8sansb.F:35
s8slke3
subroutine s8slke3(kl, hh, vol, dn_y, dn_z, ksi, eta, zeta, dn_r, dn_s, dn_t, invj, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, a11, a12, a13, a21, a22, a23, a31, a32, a33, nel)
Definition s8slke3.F:44
arret
subroutine arret(nn)
Definition arret.F:86