OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
scumu3p.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "parit_c.inc"
#include "scr18_c.inc"
#include "vectorize.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine scumu3p (offg, sti, fsky, fskyv, iads, f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, f15, f25, f35, f16, f26, f36, f17, f27, f37, f18, f28, f38, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8, ar, fr_wave, fr_wav, mx1, my1, mz1, mx2, my2, mz2, mx3, my3, mz3, mx4, my4, mz4, mx5, my5, mz5, mx6, my6, mz6, mx7, my7, mz7, mx8, my8, mz8, them, fthesky, condnsky, conde, nel, nft, jthe, isrot, ipartsph, nodadt_therm)

Function/Subroutine Documentation

◆ scumu3p()

subroutine scumu3p ( offg,
sti,
fsky,
fskyv,
integer, dimension(8,*) iads,
f11,
f21,
f31,
f12,
f22,
f32,
f13,
f23,
f33,
f14,
f24,
f34,
f15,
f25,
f35,
f16,
f26,
f36,
f17,
f27,
f37,
f18,
f28,
f38,
integer, dimension(*) nc1,
integer, dimension(*) nc2,
integer, dimension(*) nc3,
integer, dimension(*) nc4,
integer, dimension(*) nc5,
integer, dimension(*) nc6,
integer, dimension(*) nc7,
integer, dimension(*) nc8,
ar,
fr_wave,
fr_wav,
mx1,
my1,
mz1,
mx2,
my2,
mz2,
mx3,
my3,
mz3,
mx4,
my4,
mz4,
mx5,
my5,
mz5,
mx6,
my6,
mz6,
mx7,
my7,
mz7,
mx8,
my8,
mz8,
them,
fthesky,
condnsky,
conde,
integer, intent(in) nel,
integer, intent(in) nft,
integer, intent(in) jthe,
integer, intent(in) isrot,
integer, intent(in) ipartsph,
integer, intent(in) nodadt_therm )

Definition at line 36 of file scumu3p.F.

56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59#include "implicit_f.inc"
60#include "comlock.inc"
61C-----------------------------------------------
62C G l o b a l P a r a m e t e r s
63C-----------------------------------------------
64#include "mvsiz_p.inc"
65C-----------------------------------------------
66C C o m m o n B l o c k s
67C-----------------------------------------------
68#include "com01_c.inc"
69#include "parit_c.inc"
70#include "scr18_c.inc"
71C-----------------------------------------------
72C D u m m y A r g u m e n t s
73C-----------------------------------------------
74 INTEGER, INTENT(IN) :: NEL
75 INTEGER, INTENT(IN) :: NFT
76 INTEGER, INTENT(IN) :: JTHE
77 INTEGER, INTENT(IN) :: ISROT
78 INTEGER, INTENT(IN) :: IPARTSPH
79 INTEGER, INTENT(IN) :: NODADT_THERM
80C REAL
81 INTEGER NC1(*), NC2(*), NC3(*), NC4(*), NC5(*), NC6(*), NC7(*),
82 . NC8(*)
83 my_real
84 . offg(*),fskyv(lsky,8),fsky(8,lsky),sti(*),
85 . f11(*),f21(*),f31(*),f12(*),f22(*),f32(*),
86 . f13(*),f23(*),f33(*),f14(*),f24(*),f34(*),
87 . f15(*),f25(*),f35(*),f16(*),f26(*),f36(*),
88 . f17(*),f27(*),f37(*),f18(*),f28(*),f38(*),
89 . ar(3,*),fr_wave(*),fr_wav(*),
90 . mx1(*),my1(*),mz1(*),mx2(*),my2(*),mz2(*),
91 . mx3(*),my3(*),mz3(*),mx4(*),my4(*),mz4(*),
92 . mx5(*),my5(*),mz5(*),mx6(*),my6(*),mz6(*),
93 . mx7(*),my7(*),mz7(*),mx8(*),my8(*),mz8(*),
94 . them(mvsiz,8),fthesky(*),condnsky(*),conde(*)
95 INTEGER IADS(8,*)
96C-----------------------------------------------
97C L o c a l V a r i a b l e s
98C-----------------------------------------------
99 INTEGER I, II, K, J
100 my_real
101 . off_l
102C-----------------------------------------------
103 off_l = zero
104 DO i=1,nel
105 off_l = min(off_l,offg(i))
106 ENDDO
107 IF(ipartsph==0)THEN
108 IF(off_l<zero)THEN
109 DO i=1,nel
110 IF(offg(i)<zero)THEN
111 f11(i)=zero
112 f21(i)=zero
113 f31(i)=zero
114 f12(i)=zero
115 f22(i)=zero
116 f32(i)=zero
117 f13(i)=zero
118 f23(i)=zero
119 f33(i)=zero
120 f14(i)=zero
121 f24(i)=zero
122 f34(i)=zero
123 f15(i)=zero
124 f25(i)=zero
125 f35(i)=zero
126 f16(i)=zero
127 f26(i)=zero
128 f36(i)=zero
129 f17(i)=zero
130 f27(i)=zero
131 f37(i)=zero
132 f18(i)=zero
133 f28(i)=zero
134 f38(i)=zero
135 ENDIF
136 ENDDO
137 ENDIF
138 ELSE
139 IF(off_l<=zero)THEN
140 DO i=1,nel
141 IF(offg(i)<=zero)THEN
142C
143C case /DT/BRICK/DEL => OFFG==0 & F,STI/=0
144 f11(i)=zero
145 f21(i)=zero
146 f31(i)=zero
147 f12(i)=zero
148 f22(i)=zero
149 f32(i)=zero
150 f13(i)=zero
151 f23(i)=zero
152 f33(i)=zero
153 f14(i)=zero
154 f24(i)=zero
155 f34(i)=zero
156 f15(i)=zero
157 f25(i)=zero
158 f35(i)=zero
159 f16(i)=zero
160 f26(i)=zero
161 f36(i)=zero
162 f17(i)=zero
163 f27(i)=zero
164 f37(i)=zero
165 f18(i)=zero
166 f28(i)=zero
167 f38(i)=zero
168 sti(i)=zero
169 ENDIF
170 ENDDO
171 ENDIF
172 ENDIF
173 IF(jthe < 0 ) THEN
174 IF(off_l<=zero)THEN
175 DO j=1,8
176 DO i=1,nel
177 IF(offg(i)<=zero)THEN
178 them(i,j)=zero
179 ENDIF
180 ENDDO
181 ENDDO
182 ENDIF
183 IF(nodadt_therm == 1) THEN
184 IF(off_l<zero)THEN
185 DO i=1,nel
186 IF(offg(i)<zero)THEN
187 conde(i)=zero
188 ENDIF
189 ENDDO
190 ENDIF
191 ENDIF
192 ENDIF
193
194C
195C because 2*Mnodal = 2*Melement/8
196 DO i=1,nel
197 sti(i)=fourth*sti(i)
198 END DO
199 IF(nodadt_therm == 1 ) THEN
200 DO i=1,nel
201 conde(i)=one_over_8*conde(i)
202 END DO
203 ENDIF
204C
205 IF(jthe >= 0) THEN
206 IF(ivector==1) THEN
207#include "vectorize.inc"
208 DO i=1,nel
209 ii=i+nft
210 k = iads(1,ii)
211 fskyv(k,1)=f11(i)
212 fskyv(k,2)=f21(i)
213 fskyv(k,3)=f31(i)
214 fskyv(k,7)=sti(i)
215C
216 k = iads(7,ii)
217 fskyv(k,1)=f17(i)
218 fskyv(k,2)=f27(i)
219 fskyv(k,3)=f37(i)
220 fskyv(k,7)=sti(i)
221C
222 k = iads(2,ii)
223 fskyv(k,1)=f12(i)
224 fskyv(k,2)=f22(i)
225 fskyv(k,3)=f32(i)
226 fskyv(k,7)=sti(i)
227C
228 k = iads(8,ii)
229 fskyv(k,1)=f18(i)
230 fskyv(k,2)=f28(i)
231 fskyv(k,3)=f38(i)
232 fskyv(k,7)=sti(i)
233C
234 k = iads(3,ii)
235 fskyv(k,1)=f13(i)
236 fskyv(k,2)=f23(i)
237 fskyv(k,3)=f33(i)
238 fskyv(k,7)=sti(i)
239C
240 k = iads(5,ii)
241 fskyv(k,1)=f15(i)
242 fskyv(k,2)=f25(i)
243 fskyv(k,3)=f35(i)
244 fskyv(k,7)=sti(i)
245C
246 k = iads(4,ii)
247 fskyv(k,1)=f14(i)
248 fskyv(k,2)=f24(i)
249 fskyv(k,3)=f34(i)
250 fskyv(k,7)=sti(i)
251C
252 k = iads(6,ii)
253 fskyv(k,1)=f16(i)
254 fskyv(k,2)=f26(i)
255 fskyv(k,3)=f36(i)
256 fskyv(k,7)=sti(i)
257 ENDDO
258 ELSE
259 DO i=1,nel
260 ii=i+nft
261 k = iads(1,ii)
262 fsky(1,k)=f11(i)
263 fsky(2,k)=f21(i)
264 fsky(3,k)=f31(i)
265 fsky(7,k)=sti(i)
266C
267 k = iads(7,ii)
268 fsky(1,k)=f17(i)
269 fsky(2,k)=f27(i)
270 fsky(3,k)=f37(i)
271 fsky(7,k)=sti(i)
272C
273 k = iads(2,ii)
274 fsky(1,k)=f12(i)
275 fsky(2,k)=f22(i)
276 fsky(3,k)=f32(i)
277 fsky(7,k)=sti(i)
278C
279 k = iads(8,ii)
280 fsky(1,k)=f18(i)
281 fsky(2,k)=f28(i)
282 fsky(3,k)=f38(i)
283 fsky(7,k)=sti(i)
284C
285 k = iads(3,ii)
286 fsky(1,k)=f13(i)
287 fsky(2,k)=f23(i)
288 fsky(3,k)=f33(i)
289 fsky(7,k)=sti(i)
290C
291 k = iads(5,ii)
292 fsky(1,k)=f15(i)
293 fsky(2,k)=f25(i)
294 fsky(3,k)=f35(i)
295 fsky(7,k)=sti(i)
296C
297 k = iads(4,ii)
298 fsky(1,k)=f14(i)
299 fsky(2,k)=f24(i)
300 fsky(3,k)=f34(i)
301 fsky(7,k)=sti(i)
302C
303 k = iads(6,ii)
304 fsky(1,k)=f16(i)
305 fsky(2,k)=f26(i)
306 fsky(3,k)=f36(i)
307 fsky(7,k)=sti(i)
308 ENDDO
309 ENDIF
310C
311C heat transfert
312C
313 ELSE
314 IF(ivector==1) THEN
315#include "vectorize.inc"
316 DO i=1,nel
317 ii=i+nft
318 k = iads(1,ii)
319 fskyv(k,1)=f11(i)
320 fskyv(k,2)=f21(i)
321 fskyv(k,3)=f31(i)
322 fskyv(k,7)=sti(i)
323 fthesky(k) = them(i,1)
324C
325 k = iads(7,ii)
326 fskyv(k,1)=f17(i)
327 fskyv(k,2)=f27(i)
328 fskyv(k,3)=f37(i)
329 fskyv(k,7)=sti(i)
330 fthesky(k) = them(i,7)
331C
332 k = iads(2,ii)
333 fskyv(k,1)=f12(i)
334 fskyv(k,2)=f22(i)
335 fskyv(k,3)=f32(i)
336 fskyv(k,7)=sti(i)
337 fthesky(k) = them(i,2)
338C
339 k = iads(8,ii)
340 fskyv(k,1)=f18(i)
341 fskyv(k,2)=f28(i)
342 fskyv(k,3)=f38(i)
343 fskyv(k,7)=sti(i)
344 fthesky(k) = them(i,8)
345C
346 k = iads(3,ii)
347 fskyv(k,1)=f13(i)
348 fskyv(k,2)=f23(i)
349 fskyv(k,3)=f33(i)
350 fskyv(k,7)=sti(i)
351 fthesky(k) = them(i,3)
352C
353 k = iads(5,ii)
354 fskyv(k,1)=f15(i)
355 fskyv(k,2)=f25(i)
356 fskyv(k,3)=f35(i)
357 fskyv(k,7)=sti(i)
358 fthesky(k) = them(i,5)
359C
360 k = iads(4,ii)
361 fskyv(k,1)=f14(i)
362 fskyv(k,2)=f24(i)
363 fskyv(k,3)=f34(i)
364 fskyv(k,7)=sti(i)
365 fthesky(k) = them(i,4)
366C
367 k = iads(6,ii)
368 fskyv(k,1)=f16(i)
369 fskyv(k,2)=f26(i)
370 fskyv(k,3)=f36(i)
371 fskyv(k,7)=sti(i)
372 fthesky(k) = them(i,6)
373 ENDDO
374 ELSE
375 IF(nodadt_therm == 1) THEN
376 DO i=1,nel
377 ii=i+nft
378 k = iads(1,ii)
379 fsky(1,k)=f11(i)
380 fsky(2,k)=f21(i)
381 fsky(3,k)=f31(i)
382 fsky(7,k)=sti(i)
383 fthesky(k) = them(i,1)
384 condnsky(k) = conde(i)
385C
386 k = iads(7,ii)
387 fsky(1,k)=f17(i)
388 fsky(2,k)=f27(i)
389 fsky(3,k)=f37(i)
390 fsky(7,k)=sti(i)
391 fthesky(k) = them(i,7)
392 condnsky(k) = conde(i)
393C
394 k = iads(2,ii)
395 fsky(1,k)=f12(i)
396 fsky(2,k)=f22(i)
397 fsky(3,k)=f32(i)
398 fsky(7,k)=sti(i)
399 fthesky(k) = them(i,2)
400 condnsky(k) = conde(i)
401C
402 k = iads(8,ii)
403 fsky(1,k)=f18(i)
404 fsky(2,k)=f28(i)
405 fsky(3,k)=f38(i)
406 fsky(7,k)=sti(i)
407 fthesky(k) = them(i,8)
408 condnsky(k) = conde(i)
409C
410 k = iads(3,ii)
411 fsky(1,k)=f13(i)
412 fsky(2,k)=f23(i)
413 fsky(3,k)=f33(i)
414 fsky(7,k)=sti(i)
415 condnsky(k) = conde(i)
416C
417 k = iads(5,ii)
418 fsky(1,k)=f15(i)
419 fsky(2,k)=f25(i)
420 fsky(3,k)=f35(i)
421 fsky(7,k)=sti(i)
422 fthesky(k) = them(i,5)
423 condnsky(k) = conde(i)
424C
425 k = iads(4,ii)
426 fsky(1,k)=f14(i)
427 fsky(2,k)=f24(i)
428 fsky(3,k)=f34(i)
429 fsky(7,k)=sti(i)
430 fthesky(k) = them(i,4)
431 condnsky(k) = conde(i)
432C
433 k = iads(6,ii)
434 fsky(1,k)=f16(i)
435 fsky(2,k)=f26(i)
436 fsky(3,k)=f36(i)
437 fsky(7,k)=sti(i)
438 fthesky(k) = them(i,6)
439 condnsky(k) = conde(i)
440 ENDDO
441 ELSE
442 DO i=1,nel
443 ii=i+nft
444 k = iads(1,ii)
445 fsky(1,k)=f11(i)
446 fsky(2,k)=f21(i)
447 fsky(3,k)=f31(i)
448 fsky(7,k)=sti(i)
449 fthesky(k) = them(i,1)
450C
451 k = iads(7,ii)
452 fsky(1,k)=f17(i)
453 fsky(2,k)=f27(i)
454 fsky(3,k)=f37(i)
455 fsky(7,k)=sti(i)
456 fthesky(k) = them(i,7)
457C
458 k = iads(2,ii)
459 fsky(1,k)=f12(i)
460 fsky(2,k)=f22(i)
461 fsky(3,k)=f32(i)
462 fsky(7,k)=sti(i)
463 fthesky(k) = them(i,2)
464C
465 k = iads(8,ii)
466 fsky(1,k)=f18(i)
467 fsky(2,k)=f28(i)
468 fsky(3,k)=f38(i)
469 fsky(7,k)=sti(i)
470 fthesky(k) = them(i,8)
471C
472 k = iads(3,ii)
473 fsky(1,k)=f13(i)
474 fsky(2,k)=f23(i)
475 fsky(3,k)=f33(i)
476 fsky(7,k)=sti(i)
477 fthesky(k) = them(i,3)
478C
479 k = iads(5,ii)
480 fsky(1,k)=f15(i)
481 fsky(2,k)=f25(i)
482 fsky(3,k)=f35(i)
483 fsky(7,k)=sti(i)
484 fthesky(k) = them(i,5)
485C
486 k = iads(4,ii)
487 fsky(1,k)=f14(i)
488 fsky(2,k)=f24(i)
489 fsky(3,k)=f34(i)
490 fsky(7,k)=sti(i)
491 fthesky(k) = them(i,4)
492C
493 k = iads(6,ii)
494 fsky(1,k)=f16(i)
495 fsky(2,k)=f26(i)
496 fsky(3,k)=f36(i)
497 fsky(7,k)=sti(i)
498 fthesky(k) = them(i,6)
499 ENDDO
500 ENDIF
501 ENDIF
502
503 ENDIF
504
505 IF(isrot/=0)THEN
506 IF(off_l<zero)THEN
507 DO i=1,nel
508 IF(offg(i)<zero)THEN
509 mx1(i)=0.
510 my1(i)=0.
511 mz1(i)=0.
512 mx2(i)=0.
513 my2(i)=0.
514 mz2(i)=0.
515 mx3(i)=0.
516 my3(i)=0.
517 mz3(i)=0.
518 mx4(i)=0.
519 my4(i)=0.
520 mz4(i)=0.
521 mx5(i)=0.
522 my5(i)=0.
523 mz5(i)=0.
524 mx6(i)=0.
525 my6(i)=0.
526 mz6(i)=0.
527 mx7(i)=0.
528 my7(i)=0.
529 mz7(i)=0.
530 mx8(i)=0.
531 my8(i)=0.
532 mz8(i)=0.
533 ENDIF
534 ENDDO
535 ENDIF
536 IF(ivector==1) THEN
537#include "vectorize.inc"
538 DO i=1,nel
539 ii=i+nft
540 k = iads(1,ii)
541 fskyv(k,4)=mx1(i)
542 fskyv(k,5)=my1(i)
543 fskyv(k,6)=mz1(i)
544C FSKYV(K,8)=STIR(I)
545C
546 k = iads(2,ii)
547 fskyv(k,4)=mx2(i)
548 fskyv(k,5)=my2(i)
549 fskyv(k,6)=mz2(i)
550C FSKYV(K,8)=STIR(I)
551C
552 k = iads(3,ii)
553 fskyv(k,4)=mx3(i)
554 fskyv(k,5)=my3(i)
555 fskyv(k,6)=mz3(i)
556C FSKYV(K,8)=STIR(I)
557C
558 k = iads(4,ii)
559 fskyv(k,4)=mx4(i)
560 fskyv(k,5)=my4(i)
561 fskyv(k,6)=mz4(i)
562C FSKYV(K,8)=STIR(I)
563C
564 k = iads(5,ii)
565 fskyv(k,4)=mx5(i)
566 fskyv(k,5)=my5(i)
567 fskyv(k,6)=mz5(i)
568C FSKYV(K,8)=STIR(I)
569C
570 k = iads(6,ii)
571 fskyv(k,4)=mx6(i)
572 fskyv(k,5)=my6(i)
573 fskyv(k,6)=mz6(i)
574C FSKYV(K,8)=STIR(I)
575C
576 k = iads(7,ii)
577 fskyv(k,4)=mx7(i)
578 fskyv(k,5)=my7(i)
579 fskyv(k,6)=mz7(i)
580C FSKYV(K,8)=STIR(I)
581C
582 k = iads(8,ii)
583 fskyv(k,4)=mx8(i)
584 fskyv(k,5)=my8(i)
585 fskyv(k,6)=mz8(i)
586C FSKYV(K,8)=STIR(I)
587C
588 ENDDO
589 ELSE
590#include "vectorize.inc"
591 DO i=1,nel
592 ii=i+nft
593 k = iads(1,ii)
594 fsky(4,k)=mx1(i)
595 fsky(5,k)=my1(i)
596 fsky(6,k)=mz1(i)
597C FSKY(8,K)=STIR(I)
598C
599 k = iads(2,ii)
600 fsky(4,k)=mx2(i)
601 fsky(5,k)=my2(i)
602 fsky(6,k)=mz2(i)
603C FSKY(8,K)=STIR(I)
604C
605 k = iads(3,ii)
606 fsky(4,k)=mx3(i)
607 fsky(5,k)=my3(i)
608 fsky(6,k)=mz3(i)
609C FSKY(8,K)=STIR(I)
610C
611 k = iads(4,ii)
612 fsky(4,k)=mx4(i)
613 fsky(5,k)=my4(i)
614 fsky(6,k)=mz4(i)
615C FSKY(8,K)=STIR(I)
616C
617 k = iads(5,ii)
618 fsky(4,k)=mx5(i)
619 fsky(5,k)=my5(i)
620 fsky(6,k)=mz5(i)
621C FSKY(8,K)=STIR(I)
622C
623 k = iads(6,ii)
624 fsky(4,k)=mx6(i)
625 fsky(5,k)=my6(i)
626 fsky(6,k)=mz6(i)
627C FSKY(8,K)=STIR(I)
628C
629 k = iads(7,ii)
630 fsky(4,k)=mx7(i)
631 fsky(5,k)=my7(i)
632 fsky(6,k)=mz7(i)
633C FSKY(8,K)=STIR(I)
634C
635 k = iads(8,ii)
636 fsky(4,k)=mx8(i)
637 fsky(5,k)=my8(i)
638 fsky(6,k)=mz8(i)
639C FSKY(8,K)=STIR(I)
640C
641 ENDDO
642 ENDIF
643C--------------------------------------------
644C Front wave
645C--------------------------------------------
646 IF (ifrwv/=0)THEN
647#include "lockon.inc"
648 DO i=1,nel
649 IF(fr_wave(nc1(i))==0.0)fr_wave(nc1(i))=-fr_wav(i)
650 IF(fr_wave(nc2(i))==0.0)fr_wave(nc2(i))=-fr_wav(i)
651 IF(fr_wave(nc3(i))==0.0)fr_wave(nc3(i))=-fr_wav(i)
652 IF(fr_wave(nc4(i))==0.0)fr_wave(nc4(i))=-fr_wav(i)
653 IF(fr_wave(nc5(i))==0.0)fr_wave(nc5(i))=-fr_wav(i)
654 IF(fr_wave(nc6(i))==0.0)fr_wave(nc6(i))=-fr_wav(i)
655 IF(fr_wave(nc7(i))==0.0)fr_wave(nc7(i))=-fr_wav(i)
656 IF(fr_wave(nc8(i))==0.0)fr_wave(nc8(i))=-fr_wav(i)
657 ENDDO
658#include "lockoff.inc"
659 ENDIF
660 ENDIF
661C
662 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20