OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s8sfint3_crimp.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!|| s8sfint3_crimp ../engine/source/elements/solid/solide8s/s8sfint3_crimp.F
25!||--- called by ------------------------------------------------------
26!|| s8sforc3 ../engine/source/elements/solid/solide8s/s8sforc3.F
27!||====================================================================
28 SUBROUTINE s8sfint3_crimp(TRM,QF,R,
29 . F11,F21,F31,F12,F22,F32,F13,F23,F33,F14,F24,F34,
30 . F15,F25,F35,F16,F26,F36,F17,F27,F37,F18,F28,F38,
31 . NEL )
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 C o m m o n B l o c k s
42C-----------------------------------------------
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER NEL
47C REAL
48 my_real
49 . f11(*),f21(*),f31(*),f12(*),f22(*),f32(*),
50 . f13(*),f23(*),f33(*),f14(*),f24(*),f34(*),
51 . f15(*),f25(*),f35(*),f16(*),f26(*),f36(*),
52 . f17(*),f27(*),f37(*),f18(*),f28(*),f38(*),
53 . r(3,3,mvsiz)
54
55 DOUBLE PRECISION
56 . TRM(NEL,24,24),QF(NEL,24),T(24)
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER I,J
61
62 DO I=1,nel
63 qf(i,1) = -(r(1,1,i)*f11(i)+r(1,2,i)*f21(i)+r(1,3,i)*f31(i))
64 qf(i,2) = -(r(2,1,i)*f11(i)+r(2,2,i)*f21(i)+r(2,3,i)*f31(i))
65 qf(i,3) = -(r(3,1,i)*f11(i)+r(3,2,i)*f21(i)+r(3,3,i)*f31(i))
66 qf(i,4) = -(r(1,1,i)*f12(i)+r(1,2,i)*f22(i)+r(1,3,i)*f32(i))
67 qf(i,5) = -(r(2,1,i)*f12(i)+r(2,2,i)*f22(i)+r(2,3,i)*f32(i))
68 qf(i,6) = -(r(3,1,i)*f12(i)+r(3,2,i)*f22(i)+r(3,3,i)*f32(i))
69 qf(i,7) = -(r(1,1,i)*f13(i)+r(1,2,i)*f23(i)+r(1,3,i)*f33(i))
70 qf(i,8) = -(r(2,1,i)*f13(i)+r(2,2,i)*f23(i)+r(2,3,i)*f33(i))
71 qf(i,9) = -(r(3,1,i)*f13(i)+r(3,2,i)*f23(i)+r(3,3,i)*f33(i))
72 qf(i,10) = -(r(1,1,i)*f14(i)+r(1,2,i)*f24(i)+r(1,3,i)*f34(i))
73 qf(i,11) = -(r(2,1,i)*f14(i)+r(2,2,i)*f24(i)+r(2,3,i)*f34(i))
74 qf(i,12) = -(r(3,1,i)*f14(i)+r(3,2,i)*f24(i)+r(3,3,i)*f34(i))
75 qf(i,13) = -(r(1,1,i)*f15(i)+r(1,2,i)*f25(i)+r(1,3,i)*f35(i))
76 qf(i,14) = -(r(2,1,i)*f15(i)+r(2,2,i)*f25(i)+r(2,3,i)*f35(i))
77 qf(i,15) = -(r(3,1,i)*f15(i)+r(3,2,i)*f25(i)+r(3,3,i)*f35(i))
78 qf(i,16) = -(r(1,1,i)*f16(i)+r(1,2,i)*f26(i)+r(1,3,i)*f36(i))
79 qf(i,17) = -(r(2,1,i)*f16(i)+r(2,2,i)*f26(i)+r(2,3,i)*f36(i))
80 qf(i,18) = -(r(3,1,i)*f16(i)+r(3,2,i)*f26(i)+r(3,3,i)*f36(i))
81 qf(i,19) = -(r(1,1,i)*f17(i)+r(1,2,i)*f27(i)+r(1,3,i)*f37(i))
82 qf(i,20) = -(r(2,1,i)*f17(i)+r(2,2,i)*f27(i)+r(2,3,i)*f37(i))
83 qf(i,21) = -(r(3,1,i)*f17(i)+r(3,2,i)*f27(i)+r(3,3,i)*f37(i))
84 qf(i,22) = -(r(1,1,i)*f18(i)+r(1,2,i)*f28(i)+r(1,3,i)*f38(i))
85 qf(i,23) = -(r(2,1,i)*f18(i)+r(2,2,i)*f28(i)+r(2,3,i)*f38(i))
86 qf(i,24) = -(r(3,1,i)*f18(i)+r(3,2,i)*f28(i)+r(3,3,i)*f38(i))
87 ENDDO
88
89 DO i=1,nel
90 DO j=1,24
91 t(j) = trm(i,1,j)*f11(i)+trm(i,2,j)*f21(i)+trm(i,3,j)*f31(i)
92 . +trm(i,4,j)*f12(i)+trm(i,5,j)*f22(i)+trm(i,6,j)*f32(i)
93 . +trm(i,7,j)*f13(i)+trm(i,8,j)*f23(i)+trm(i,9,j)*f33(i)
94 . +trm(i,10,j)*f14(i)+trm(i,11,j)*f24(i)+trm(i,12,j)*f34(i)
95 . +trm(i,13,j)*f15(i)+trm(i,14,j)*f25(i)+trm(i,15,j)*f35(i)
96 . +trm(i,16,j)*f16(i)+trm(i,17,j)*f26(i)+trm(i,18,j)*f36(i)
97 . +trm(i,19,j)*f17(i)+trm(i,20,j)*f27(i)+trm(i,21,j)*f37(i)
98 . +trm(i,22,j)*f18(i)+trm(i,23,j)*f28(i)+trm(i,24,j)*f38(i)
99 ENDDO
100 f11(i) = t(1)
101 f21(i) = t(2)
102 f31(i) = t(3)
103 f12(i) = t(4)
104 f22(i) = t(5)
105 f32(i) = t(6)
106 f13(i) = t(7)
107 f23(i) = t(8)
108 f33(i) = t(9)
109 f14(i) = t(10)
110 f24(i) = t(11)
111 f34(i) = t(12)
112 f15(i) = t(13)
113 f25(i) = t(14)
114 f35(i) = t(15)
115 f16(i) = t(16)
116 f26(i) = t(17)
117 f36(i) = t(18)
118 f17(i) = t(19)
119 f27(i) = t(20)
120 f37(i) = t(21)
121 f18(i) = t(22)
122 f28(i) = t(23)
123 f38(i) = t(24)
124 ENDDO
125
126 RETURN
127 END
128
s8sfint3_crimp
subroutine s8sfint3_crimp(trm, qf, r, f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, f15, f25, f35, f16, f26, f36, f17, f27, f37, f18, f28, f38, nel)
Definition s8sfint3_crimp.F:32