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