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