OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s6cumu3.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!|| s6cumu3 ../engine/source/elements/thickshell/solide6c/s6cumu3.F
25!||--- called by ------------------------------------------------------
26!|| s6cforc3 ../engine/source/elements/thickshell/solide6c/s6cforc3.F
27!||====================================================================
28 SUBROUTINE s6cumu3(
29 1 OFFG, E, NC1, NC2,
30 2 NC3, NC4, NC5, NC6,
31 3 STIFN, STI, F11, F21,
32 4 F31, F12, F22, F32,
33 5 F13, F23, F33, F14,
34 6 F24, F34, F15, F25,
35 7 F35, F16, F26, F36,
36 8 NEL, JTHE, FTHE, THEM,
37 9 CONDN, CONDE, IFTHE, ICONDN,
38 . NODADT_THERM)
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43#include "comlock.inc"
44C-----------------------------------------------
45C G l o b a l P a r a m e t e r s
46C-----------------------------------------------
47#include "mvsiz_p.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "com01_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER, INTENT(IN) :: NEL,JTHE,IFTHE,ICONDN
56 INTEGER, INTENT(IN) :: NODADT_THERM
57 INTEGER NC1(*), NC2(*), NC3(*), NC4(*), NC5(*), NC6(*)
58C REAL
59 my_real
60 . OFFG(*),E(3,*),STIFN(*),STI(*),
61 . F11(*),F21(*),F31(*),F12(*),F22(*),F32(*),
62 . F13(*),F23(*),F33(*),F14(*),F24(*),F34(*),
63 . F15(*),F25(*),F35(*),F16(*),F26(*),F36(*)
64 my_real, INTENT(INOUT) :: THEM(MVSIZ,6),FTHE(IFTHE),
65 . condn(icondn),conde(mvsiz)
66C-----------------------------------------------
67C C o m m o n B l o c k s
68C-----------------------------------------------
69#include "scr18_c.inc"
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER I, J
74C-----------------------------------------------
75 my_real
76 . off_l
77C-----------------------------------------------
78 off_l = zero
79 DO i=1,nel
80 off_l = min(off_l,offg(i))
81 ENDDO
82 IF(off_l<zero)THEN
83 DO i=1,nel
84 IF(offg(i)<zero)THEN
85 f11(i)=zero
86 f21(i)=zero
87 f31(i)=zero
88 f12(i)=zero
89 f22(i)=zero
90 f32(i)=zero
91 f13(i)=zero
92 f23(i)=zero
93 f33(i)=zero
94 f14(i)=zero
95 f24(i)=zero
96 f34(i)=zero
97 f15(i)=zero
98 f25(i)=zero
99 f35(i)=zero
100 f16(i)=zero
101 f26(i)=zero
102 f36(i)=zero
103 sti(i)=zero
104 ENDIF
105 ENDDO
106 ENDIF
107 IF (jthe < 0) THEN
108 IF (off_l<=zero) THEN
109 DO j=1,6
110 DO i=1,nel
111 IF(offg(i)<=zero)THEN
112 them(i,j)=zero
113 ENDIF
114 ENDDO
115 ENDDO
116 ENDIF
117 IF (nodadt_therm == 1) THEN
118 IF(off_l<zero)THEN
119 DO i=1,nel
120 IF(offg(i)<zero)THEN
121 conde(i)=zero
122 ENDIF
123 ENDDO
124 ENDIF
125 ENDIF
126 ENDIF
127C
128C because 2*Mnodal = 2*Melement/6
129 DO i=1,nel
130 sti(i)=third*sti(i)
131 END DO
132 IF (nodadt_therm == 1) THEN
133 DO i = 1,nel
134 conde(i) = one_over_6*conde(i)
135 END DO
136 ENDIF
137C
138 DO i=1,nel
139C
140 IF(jthe >= 0) THEN
141C
142 e(1,nc1(i))=e(1,nc1(i))+f11(i)
143 e(2,nc1(i))=e(2,nc1(i))+f21(i)
144 e(3,nc1(i))=e(3,nc1(i))+f31(i)
145 stifn(nc1(i))=stifn(nc1(i))+sti(i)
146C
147 e(1,nc2(i))=e(1,nc2(i))+f12(i)
148 e(2,nc2(i))=e(2,nc2(i))+f22(i)
149 e(3,nc2(i))=e(3,nc2(i))+f32(i)
150 stifn(nc2(i))=stifn(nc2(i))+sti(i)
151C
152 e(1,nc3(i))=e(1,nc3(i))+f13(i)
153 e(2,nc3(i))=e(2,nc3(i))+f23(i)
154 e(3,nc3(i))=e(3,nc3(i))+f33(i)
155 stifn(nc3(i))=stifn(nc3(i))+sti(i)
156C
157 e(1,nc5(i))=e(1,nc5(i))+f15(i)
158 e(2,nc5(i))=e(2,nc5(i))+f25(i)
159 e(3,nc5(i))=e(3,nc5(i))+f35(i)
160 stifn(nc5(i))=stifn(nc5(i))+sti(i)
161C
162 e(1,nc4(i))=e(1,nc4(i))+f14(i)
163 e(2,nc4(i))=e(2,nc4(i))+f24(i)
164 e(3,nc4(i))=e(3,nc4(i))+f34(i)
165 stifn(nc4(i))=stifn(nc4(i))+sti(i)
166C
167 e(1,nc6(i))=e(1,nc6(i))+f16(i)
168 e(2,nc6(i))=e(2,nc6(i))+f26(i)
169 e(3,nc6(i))=e(3,nc6(i))+f36(i)
170 stifn(nc6(i))=stifn(nc6(i))+sti(i)
171CCC
172 ELSE
173C
174 e(1,nc1(i))=e(1,nc1(i))+f11(i)
175 e(2,nc1(i))=e(2,nc1(i))+f21(i)
176 e(3,nc1(i))=e(3,nc1(i))+f31(i)
177 stifn(nc1(i))=stifn(nc1(i))+sti(i)
178 fthe(nc1(i)) = fthe(nc1(i)) + them(i,1)
179 IF(nodadt_therm == 1) condn(nc1(i))= condn(nc1(i))+ conde(i)
180C
181 e(1,nc2(i))=e(1,nc2(i))+f12(i)
182 e(2,nc2(i))=e(2,nc2(i))+f22(i)
183 e(3,nc2(i))=e(3,nc2(i))+f32(i)
184 stifn(nc2(i))=stifn(nc2(i))+sti(i)
185 fthe(nc2(i)) = fthe(nc2(i)) + them(i,2)
186 IF(nodadt_therm == 1) condn(nc2(i))= condn(nc2(i))+ conde(i)
187C
188 e(1,nc3(i))=e(1,nc3(i))+f13(i)
189 e(2,nc3(i))=e(2,nc3(i))+f23(i)
190 e(3,nc3(i))=e(3,nc3(i))+f33(i)
191 stifn(nc3(i))=stifn(nc3(i))+sti(i)
192 fthe(nc3(i)) = fthe(nc3(i)) + them(i,3)
193 IF(nodadt_therm == 1) condn(nc3(i))= condn(nc3(i))+ conde(i)
194C
195 e(1,nc5(i))=e(1,nc5(i))+f15(i)
196 e(2,nc5(i))=e(2,nc5(i))+f25(i)
197 e(3,nc5(i))=e(3,nc5(i))+f35(i)
198 stifn(nc5(i))=stifn(nc5(i))+sti(i)
199 fthe(nc5(i)) = fthe(nc5(i)) + them(i,5)
200 IF(nodadt_therm == 1) condn(nc5(i))= condn(nc5(i))+ conde(i)
201C
202 e(1,nc4(i))=e(1,nc4(i))+f14(i)
203 e(2,nc4(i))=e(2,nc4(i))+f24(i)
204 e(3,nc4(i))=e(3,nc4(i))+f34(i)
205 stifn(nc4(i))=stifn(nc4(i))+sti(i)
206 fthe(nc4(i)) = fthe(nc4(i)) + them(i,4)
207 IF(nodadt_therm == 1) condn(nc4(i))= condn(nc4(i))+ conde(i)
208C
209 e(1,nc6(i))=e(1,nc6(i))+f16(i)
210 e(2,nc6(i))=e(2,nc6(i))+f26(i)
211 e(3,nc6(i))=e(3,nc6(i))+f36(i)
212 stifn(nc6(i))=stifn(nc6(i))+sti(i)
213 fthe(nc6(i)) = fthe(nc6(i)) + them(i,6)
214 IF(nodadt_therm == 1)condn(nc6(i))= condn(nc6(i))+ conde(i)
215C
216 ENDIF
217C
218 ENDDO
219 RETURN
220 END
min
#define min(a, b)
Definition macros.h:20
s6cumu3
subroutine s6cumu3(offg, e, nc1, nc2, nc3, nc4, nc5, nc6, stifn, sti, f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, f15, f25, f35, f16, f26, f36, nel, jthe, fthe, them, condn, conde, ifthe, icondn, nodadt_therm)
Definition s6cumu3.F:39