OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s6cumu3p.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!|| s6cumu3p ../engine/source/elements/thickshell/solide6c/s6cumu3p.F
25!||--- called by ------------------------------------------------------
26!|| s6cforc3 ../engine/source/elements/thickshell/solide6c/s6cforc3.F
27!||====================================================================
28 SUBROUTINE s6cumu3p(
29 1 OFFG, STI, FSKY, FSKYV,
30 2 IADS, F11, F21, F31,
31 3 F12, F22, F32, F13,
32 4 F23, F33, F14, F24,
33 5 F34, F15, F25, F35,
34 6 F16, F26, F36, NEL,
35 7 NFT, JTHE, FTHESKY, THEM,
36 8 CONDNSKY,CONDE,NODADT_THERM)
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41#include "comlock.inc"
42C-----------------------------------------------
43C G l o b a l P a r a m e t e r s
44C-----------------------------------------------
45#include "mvsiz_p.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "com01_c.inc"
50#include "parit_c.inc"
51#include "scr18_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
56 INTEGER, INTENT(IN) :: NFT
57 INTEGER, INTENT(IN) :: NODADT_THERM
58 my_real
59 . OFFG(*),FSKYV(LSKY,8),FSKY(8,LSKY),STI(*),
60 . F11(*),F21(*),F31(*),F12(*),F22(*),F32(*),
61 . F13(*),F23(*),F33(*),F14(*),F24(*),F34(*),
62 . F15(*),F25(*),F35(*),F16(*),F26(*),F36(*)
63 my_real, INTENT(INOUT) :: them(mvsiz,6),fthesky(lsky),
64 . condnsky(lsky),conde(mvsiz)
65 INTEGER IADS(8,*)
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER I, II, K, J
70 my_real
71 . off_l
72C-----------------------------------------------
73 off_l = zero
74 DO i=1,nel
75 off_l = min(off_l,offg(i))
76 ENDDO
77 IF(off_l<zero)THEN
78 DO i=1,nel
79 IF(offg(i)<zero)THEN
80 f11(i)=zero
81 f21(i)=zero
82 f31(i)=zero
83 f12(i)=zero
84 f22(i)=zero
85 f32(i)=zero
86 f13(i)=zero
87 f23(i)=zero
88 f33(i)=zero
89 f14(i)=zero
90 f24(i)=zero
91 f34(i)=zero
92 f15(i)=zero
93 f25(i)=zero
94 f35(i)=zero
95 f16(i)=zero
96 f26(i)=zero
97 f36(i)=zero
98 sti(i)=zero
99 ENDIF
100 ENDDO
101 ENDIF
102C-----------------------------------------------
103C
104C because 2*Mnodal = 2*Melement/6
105 DO i=1,nel
106 sti(i)=third*sti(i)
107 END DO
108 IF(nodadt_therm == 1 ) THEN
109 DO i=1,nel
110 conde(i)=one_over_6*conde(i)
111 END DO
112 ENDIF
113C
114 IF(jthe >= 0) THEN
115 IF(ivector==1) THEN
116#include "vectorize.inc"
117 DO i=1,nel
118 ii=i+nft
119 k = iads(1,ii)
120 fskyv(k,1)=f11(i)
121 fskyv(k,2)=f21(i)
122 fskyv(k,3)=f31(i)
123 fskyv(k,4)=zero
124 fskyv(k,5)=zero
125 fskyv(k,6)=zero
126 fskyv(k,7)=sti(i)
127C
128 k = iads(2,ii)
129 fskyv(k,1)=f12(i)
130 fskyv(k,2)=f22(i)
131 fskyv(k,3)=f32(i)
132 fskyv(k,4)=zero
133 fskyv(k,5)=zero
134 fskyv(k,6)=zero
135 fskyv(k,7)=sti(i)
136C
137 k = iads(3,ii)
138 fskyv(k,1)=f13(i)
139 fskyv(k,2)=f23(i)
140 fskyv(k,3)=f33(i)
141 fskyv(k,4)=zero
142 fskyv(k,5)=zero
143 fskyv(k,6)=zero
144 fskyv(k,7)=sti(i)
145C
146 k = iads(5,ii)
147 fskyv(k,1)=f14(i)
148 fskyv(k,2)=f24(i)
149 fskyv(k,3)=f34(i)
150 fskyv(k,4)=zero
151 fskyv(k,5)=zero
152 fskyv(k,6)=zero
153 fskyv(k,7)=sti(i)
154C
155 k = iads(6,ii)
156 fskyv(k,1)=f15(i)
157 fskyv(k,2)=f25(i)
158 fskyv(k,3)=f35(i)
159 fskyv(k,4)=zero
160 fskyv(k,5)=zero
161 fskyv(k,6)=zero
162 fskyv(k,7)=sti(i)
163C
164 k = iads(7,ii)
165 fskyv(k,1)=f16(i)
166 fskyv(k,2)=f26(i)
167 fskyv(k,3)=f36(i)
168 fskyv(k,4)=zero
169 fskyv(k,5)=zero
170 fskyv(k,6)=zero
171 fskyv(k,7)=sti(i)
172 ENDDO
173 ELSE
174 DO i=1,nel
175 ii=i+nft
176 k = iads(1,ii)
177 fsky(1,k)=f11(i)
178 fsky(2,k)=f21(i)
179 fsky(3,k)=f31(i)
180 fsky(7,k)=sti(i)
181C
182 k = iads(2,ii)
183 fsky(1,k)=f12(i)
184 fsky(2,k)=f22(i)
185 fsky(3,k)=f32(i)
186 fsky(7,k)=sti(i)
187C
188 k = iads(3,ii)
189 fsky(1,k)=f13(i)
190 fsky(2,k)=f23(i)
191 fsky(3,k)=f33(i)
192 fsky(7,k)=sti(i)
193C
194 k = iads(5,ii)
195 fsky(1,k)=f14(i)
196 fsky(2,k)=f24(i)
197 fsky(3,k)=f34(i)
198 fsky(7,k)=sti(i)
199C
200 k = iads(6,ii)
201 fsky(1,k)=f15(i)
202 fsky(2,k)=f25(i)
203 fsky(3,k)=f35(i)
204 fsky(7,k)=sti(i)
205C
206 k = iads(7,ii)
207 fsky(1,k)=f16(i)
208 fsky(2,k)=f26(i)
209 fsky(3,k)=f36(i)
210 fsky(7,k)=sti(i)
211 ENDDO
212 ENDIF
213 ELSE
214 IF(ivector==1) THEN
215#include "vectorize.inc"
216 DO i=1,nel
217 ii=i+nft
218 k = iads(1,ii)
219 fskyv(k,1)=f11(i)
220 fskyv(k,2)=f21(i)
221 fskyv(k,3)=f31(i)
222 fskyv(k,4)=zero
223 fskyv(k,5)=zero
224 fskyv(k,6)=zero
225 fskyv(k,7)=sti(i)
226 fthesky(k)=them(i,1)
227C
228 k = iads(2,ii)
229 fskyv(k,1)=f12(i)
230 fskyv(k,2)=f22(i)
231 fskyv(k,3)=f32(i)
232 fskyv(k,4)=zero
233 fskyv(k,5)=zero
234 fskyv(k,6)=zero
235 fskyv(k,7)=sti(i)
236 fthesky(k)=them(i,2)
237C
238 k = iads(3,ii)
239 fskyv(k,1)=f13(i)
240 fskyv(k,2)=f23(i)
241 fskyv(k,3)=f33(i)
242 fskyv(k,4)=zero
243 fskyv(k,5)=zero
244 fskyv(k,6)=zero
245 fskyv(k,7)=sti(i)
246 fthesky(k)=them(i,3)
247C
248 k = iads(5,ii)
249 fskyv(k,1)=f14(i)
250 fskyv(k,2)=f24(i)
251 fskyv(k,3)=f34(i)
252 fskyv(k,4)=zero
253 fskyv(k,5)=zero
254 fskyv(k,6)=zero
255 fskyv(k,7)=sti(i)
256 fthesky(k)=them(i,4)
257C
258 k = iads(6,ii)
259 fskyv(k,1)=f15(i)
260 fskyv(k,2)=f25(i)
261 fskyv(k,3)=f35(i)
262 fskyv(k,4)=zero
263 fskyv(k,5)=zero
264 fskyv(k,6)=zero
265 fskyv(k,7)=sti(i)
266 fthesky(k)=them(i,5)
267C
268 k = iads(7,ii)
269 fskyv(k,1)=f16(i)
270 fskyv(k,2)=f26(i)
271 fskyv(k,3)=f36(i)
272 fskyv(k,4)=zero
273 fskyv(k,5)=zero
274 fskyv(k,6)=zero
275 fskyv(k,7)=sti(i)
276 fthesky(k)=them(i,6)
277 ENDDO
278 ELSE
279 DO i=1,nel
280 ii=i+nft
281 k = iads(1,ii)
282 fsky(1,k)=f11(i)
283 fsky(2,k)=f21(i)
284 fsky(3,k)=f31(i)
285 fsky(7,k)=sti(i)
286 fthesky(k) = them(i,1)
287 IF(nodadt_therm == 1) condnsky(k) = conde(i)
288C
289 k = iads(2,ii)
290 fsky(1,k)=f12(i)
291 fsky(2,k)=f22(i)
292 fsky(3,k)=f32(i)
293 fsky(7,k)=sti(i)
294 fthesky(k) = them(i,2)
295 IF(nodadt_therm == 1) condnsky(k) = conde(i)
296C
297 k = iads(3,ii)
298 fsky(1,k)=f13(i)
299 fsky(2,k)=f23(i)
300 fsky(3,k)=f33(i)
301 fsky(7,k)=sti(i)
302 fthesky(k) = them(i,3)
303 IF(nodadt_therm == 1) condnsky(k) = conde(i)
304C
305 k = iads(5,ii)
306 fsky(1,k)=f14(i)
307 fsky(2,k)=f24(i)
308 fsky(3,k)=f34(i)
309 fsky(7,k)=sti(i)
310 fthesky(k) = them(i,4)
311 IF(nodadt_therm == 1) condnsky(k) = conde(i)
312C
313 k = iads(6,ii)
314 fsky(1,k)=f15(i)
315 fsky(2,k)=f25(i)
316 fsky(3,k)=f35(i)
317 fsky(7,k)=sti(i)
318 fthesky(k) = them(i,5)
319 IF(nodadt_therm == 1) condnsky(k) = conde(i)
320C
321 k = iads(7,ii)
322 fsky(1,k)=f16(i)
323 fsky(2,k)=f26(i)
324 fsky(3,k)=f36(i)
325 fsky(7,k)=sti(i)
326 fthesky(k) = them(i,6)
327 IF(nodadt_therm == 1) condnsky(k) = conde(i)
328 ENDDO
329 ENDIF
330 ENDIF
331C
332 RETURN
333 END
min
#define min(a, b)
Definition macros.h:20
s6cumu3p
subroutine s6cumu3p(offg, sti, fsky, fskyv, iads, f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, f15, f25, f35, f16, f26, f36, nel, nft, jthe, fthesky, them, condnsky, conde, nodadt_therm)
Definition s6cumu3p.F:37