OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_msin.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr12_c.inc"
#include "remesh_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_msin (ixs, ixq, ixc, ixt, ixp, ixr, ixtg, mss, msq, msc, mst, msp, msr, mstg, inc, inp, inr, intg, index, itri, ms, in, ptg, geo, ixs10, ixs20, ixs16, mssx, msnf, mssf, vns, vnsx, stc, stt, stp, str, sttg, stur, bns, bnsx, volnod, bvolnod, etnod, stifint, ins, mcpc, mcp, mcps, mcpsx, mcptg, sh4tree, sh3tree, ms_layerc, zi_layerc, ms_layer, zi_layer, msz2c, msz2, zply, kxig3d, ixig3d, msig3d, nctrlmax, strc, strp, strr, strtg, stifintr, nshnod, vnige, bnige, mcpp, itherm_fe)

Function/Subroutine Documentation

◆ spmd_msin()

subroutine spmd_msin ( integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer, dimension(nixc,*) ixc,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(6,*) ixtg,
mss,
msq,
msc,
mst,
msp,
msr,
mstg,
inc,
inp,
inr,
intg,
integer, dimension(*) index,
integer, dimension(*) itri,
ms,
in,
ptg,
geo,
integer, dimension(6,*) ixs10,
integer, dimension(12,*) ixs20,
integer, dimension(8,*) ixs16,
mssx,
msnf,
mssf,
vns,
vnsx,
stc,
stt,
stp,
str,
sttg,
stur,
bns,
bnsx,
volnod,
bvolnod,
etnod,
stifint,
ins,
mcpc,
mcp,
mcps,
mcpsx,
mcptg,
integer, dimension(ksh4tree,*) sh4tree,
integer, dimension(ksh3tree,*) sh3tree,
ms_layerc,
zi_layerc,
ms_layer,
zi_layer,
msz2c,
msz2,
zply,
integer, dimension(nixig3d,*) kxig3d,
integer, dimension(*) ixig3d,
msig3d,
integer nctrlmax,
strc,
strp,
strr,
strtg,
stifintr,
integer, dimension(*) nshnod,
vnige,
bnige,
mcpp,
integer, intent(in) itherm_fe )

Definition at line 30 of file spmd_msin.F.

47 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr
48C
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "com01_c.inc"
57#include "com04_c.inc"
58#include "param_c.inc"
59#include "scr12_c.inc"
60#include "remesh_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER IXS(NIXS,*), IXQ(NIXQ,*), IXC(NIXC,*),
65 . IXT(NIXT,*),IXP(NIXP,*), IXR(NIXR,*), IXTG(6,*),
66 . INDEX(*), ITRI(*),
67 . IXS10(6,*),IXS20(12,*),IXS16(8,*),
68 . SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*),KXIG3D(NIXIG3D,*),
69 . IXIG3D(*),NSHNOD(*)
70 INTEGER, INTENT(IN) :: ITHERM_FE
71C REAL
72 my_real
73 . mss(8,*), msq(*),msc(*),mst(*),msp(*),msr(3,*),
74 . mstg(*),mssx(12,*),inc(*),
75 . inp(*),inr(3,*),intg(*),
76 . ms(*), in(*),ptg(3,*), geo(npropg,*),
77 . msnf(*), mssf(8,*),
78 . vns(8,*) ,vnsx(12,*) ,stc(*) ,stt(*) ,stp(*) ,str(*) ,
79 . sttg(*) ,stur(*) ,bns(8,*) ,bnsx(12,*) ,
80 . volnod(*) ,bvolnod(*) ,etnod(*), stifint(*), ins(8,*),
81 . mcp(*),mcpc(*),mcps(8,*),mcpsx(12,*),mcptg(*),
82 . ms_layerc(numelc,*),zi_layerc(numelc,*),
83 . ms_layer(numnod,*),zi_layer(numnod,*),msz2c(*),msz2(*),
84 . zply(*),msig3d(numelig3d,nctrlmax),strc(*),strp(*),strr(*),
85 . strtg(*),stifintr(*), vnige(nctrlmax,*),bnige(nctrlmax,*),
86 . mcpp(*)
87C
88 INTEGER IDEB,NCTRLMAX
89C-----------------------------------------------
90C L o c a l V a r i a b l e s
91C-----------------------------------------------
92 INTEGER I, J, K, N, IGTYP, WORK(70000),IP
93C
94 DO i = 1, numels
95 itri(i) = ixs(11,i)
96 ENDDO
97C
98 CALL my_orders(0,work,itri,index,numels8,1)
99
100 ideb=numels8+1
101 CALL my_orders(0,work,itri(ideb),index(ideb),numels10,1)
102
103 DO j=1,numels10
104 index(ideb+j-1) = index(ideb+j-1)+numels8
105 ENDDO
106
107 ideb = ideb + numels10
108 CALL my_orders(0,work,itri(ideb),index(ideb),numels20,1)
109 DO j = 1, numels20
110 index(ideb+j-1) = index(ideb+j-1)+numels8+numels10
111 ENDDO
112
113 ideb = ideb + numels20
114 CALL my_orders(0,work,itri(ideb),index(ideb),numels16,1)
115 DO j = 1, numels16
116 index(ideb+j-1) = index(ideb+j-1)+numels8+numels10+numels20
117 ENDDO
118C
119 IF(itherm_fe == 0 ) THEN
120 DO j=1,numels
121 i = index(j)
122 DO k=1,8
123 n = ixs(k+1,i)
124 ms(n) = ms(n) + mss(k,i)
125 ENDDO
126 ENDDO
127 ELSE
128 DO j=1,numels
129 i = index(j)
130 DO k=1,8
131 n = ixs(k+1,i)
132 ms(n) = ms(n) + mss(k,i)
133 mcp(n) = mcp(n) + mcps(k,i)
134 ENDDO
135 ENDDO
136 ENDIF
137C
138 IF(iale==1.OR.ieuler==1 .OR. ialelag==1) THEN
139 DO j=1,numels
140 i = index(j)
141 DO k=1,8
142 n = ixs(k+1,i)
143 msnf(n) = msnf(n) + mssf(k,i)
144 ENDDO
145 ENDDO
146 ENDIF
147C
148 IF(itherm_fe== 0 ) THEN
149 IF(numels10>0) THEN
150 DO j=1,numels10
151 i = index(numels8+j)
152 DO k=1,6
153 n = ixs10(k,i-numels8)
154 IF (n/=0) THEN
155 ms(n) = ms(n) + mssx(k,i)
156 END IF
157 ENDDO
158 ENDDO
159 ENDIF
160
161 IF(numels20>0)THEN
162 DO j=1,numels20
163 i = index(numels8+numels10+j)
164 DO k=1,12
165 n = ixs20(k,i-numels8-numels10)
166 IF (n/=0) THEN
167 ms(n) = ms(n) + mssx(k,i)
168 END IF
169 ENDDO
170 ENDDO
171 ENDIF
172C
173 IF(numels16>0)THEN
174 DO j=1,numels16
175 i = index(numels8+numels10+numels20+j)
176 DO k=1,8
177 n = ixs16(k,i-numels8-numels10-numels20)
178 IF (n/=0) THEN
179 ms(n) = ms(n) + mssx(k,i)
180 END IF
181 ENDDO
182 ENDDO
183 ENDIF
184 ELSE
185C
186C + heat transfer
187C
188 IF(numels10>0) THEN
189 DO j=1,numels10
190 i = index(numels8+j)
191 DO k=1,6
192 n = ixs10(k,i-numels8)
193 IF (n/=0) THEN
194 ms(n) = ms(n) + mssx(k,i)
195 mcp(n) = mcp(n) + mcpsx(k,i)
196 END IF
197 ENDDO
198 ENDDO
199 ENDIF
200
201 IF(numels20>0)THEN
202 DO j=1,numels20
203 i = index(numels8+numels10+j)
204 DO k=1,12
205 n = ixs20(k,i-numels8-numels10)
206 IF (n/=0) THEN
207 ms(n) = ms(n) + mssx(k,i)
208 mcp(n) = mcp(n) + mcpsx(k,i)
209 END IF
210 ENDDO
211 ENDDO
212 ENDIF
213C
214 IF(numels16>0)THEN
215 DO j=1,numels16
216 i = index(numels8+numels10+numels20+j)
217 DO k=1,8
218 n = ixs16(k,i-numels8-numels10-numels20)
219 IF (n/=0) THEN
220 ms(n) = ms(n) + mssx(k,i)
221 mcp(n) = mcp(n) + mcpsx(k,i)
222 END IF
223 ENDDO
224 ENDDO
225 ENDIF
226 ENDIF
227C
228
229 IF(iroddl /= 0)THEN
230 DO j=1,numels8+numels10
231 i = index(j)
232 DO k=1,8
233 n = ixs(k+1,i)
234 in(n) = in(n) + ins(k,i)
235 ENDDO
236 ENDDO
237 ENDIF
238C
239 IF(i7stifs/=0)THEN
240 DO j=1,numels
241 i = index(j)
242 DO k=1,8
243 n = ixs(k+1,i)
244 volnod(n) = volnod(n) + vns(k,i)
245 bvolnod(n) = bvolnod(n) + bns(k,i)
246 ENDDO
247 ENDDO
248C
249 IF(numels10>0) THEN
250 DO j=1,numels10
251 i = index(numels8+j)
252 DO k=1,6
253 n = ixs10(k,i-numels8)
254 IF (n/=0) THEN
255 volnod(n) = volnod(n) + vnsx(k,i)
256 bvolnod(n) = bvolnod(n) + bnsx(k,i)
257 END IF
258 ENDDO
259 ENDDO
260 ENDIF
261C
262 IF(numels20>0)THEN
263 DO j=1,numels20
264 i = index(numels8+numels10+j)
265 DO k=1,12
266 n = ixs20(k,i-numels8-numels10)
267 IF (n/=0) THEN
268 volnod(n) = volnod(n) + vnsx(k,i)
269 bvolnod(n) = bvolnod(n) + bnsx(k,i)
270 END IF
271 ENDDO
272 ENDDO
273 ENDIF
274C
275 IF(numels16>0)THEN
276 DO j=1,numels16
277 i = index(numels8+numels10+numels20+j)
278 DO k=1,8
279 n = ixs16(k,i-numels8-numels10-numels20)
280 IF (n/=0) THEN
281 volnod(n) = volnod(n) + vnsx(k,i)
282 bvolnod(n) = bvolnod(n) + bnsx(k,i)
283 END IF
284 ENDDO
285 ENDDO
286 ENDIF
287C
288 IF(numelig3d>0) THEN
289 DO i = 1, numelig3d
290 itri(i) = kxig3d(5,i)
291 ENDDO
292 CALL my_orders(0,work,itri,index,numelig3d,1)
293 DO j=1,numelig3d
294 i = index(j)
295 DO k=1,kxig3d(3,i)
296 n = ixig3d(kxig3d(4,i)+k-1)
297 IF (n/=0) THEN
298 volnod(n) = volnod(n) + vnige(k,i)
299 bvolnod(n) = bvolnod(n) + bnige(k,i)
300 END IF
301 ENDDO
302 ENDDO
303 ENDIF
304 ENDIF
305C
306 DO i = 1, numelq
307 itri(i) = ixq(7,i)
308 ENDDO
309 CALL my_orders(0,work,itri,index,numelq,1)
310 DO j=1,numelq
311 i = index(j)
312 DO k=1,4
313 n = ixq(k+1,i)
314 ms(n) = ms(n) + msq(i)
315 ENDDO
316 ENDDO
317C
318 DO i = 1, numelc
319 itri(i) = ixc(7,i)
320 ENDDO
321C
322 CALL my_orders(0,work,itri,index,numelc,1)
323C
324 IF(itherm_fe == 0 ) THEN
325 IF(nadmesh==0)THEN
326 DO j=1,numelc
327 i = index(j)
328 DO k=1,4
329 n = ixc(k+1,i)
330 ms(n) = ms(n) + msc(i)
331 in(n) = in(n) + inc(i)
332 ENDDO
333 ENDDO
334 ELSE
335 IF(istatcnd==0)THEN
336 DO j=1,numelc
337 i = index(j)
338 IF(sh4tree(3,i) >= 0)THEN
339 DO k=1,4
340 n = ixc(k+1,i)
341 ms(n) = ms(n) + msc(i)
342 in(n) = in(n) + inc(i)
343 ENDDO
344 END IF
345 ENDDO
346 ELSE
347 DO j=1,numelc
348 i = index(j)
349 IF(sh4tree(3,i) == 0 .OR. sh4tree(3,i) == -1)THEN
350 DO k=1,4
351 n = ixc(k+1,i)
352 ms(n) = ms(n) + msc(i)
353 in(n) = in(n) + inc(i)
354 ENDDO
355 END IF
356 ENDDO
357 END IF
358 END IF
359 ELSE ! ITHERM_FE /= 0
360 IF(nadmesh==0)THEN
361 DO j=1,numelc
362 i = index(j)
363 DO k=1,4
364 n = ixc(k+1,i)
365 ms(n) = ms(n) + msc(i)
366 in(n) = in(n) + inc(i)
367 mcp(n) = mcp(n) + mcpc(i)
368 ENDDO
369 ENDDO
370 ELSE
371 IF(istatcnd==0)THEN
372 DO j=1,numelc
373 i = index(j)
374 IF(sh4tree(3,i) >= 0)THEN
375 DO k=1,4
376 n = ixc(k+1,i)
377 ms(n) = ms(n) + msc(i)
378 in(n) = in(n) + inc(i)
379 mcp(n) = mcp(n) + mcpc(i)
380 ENDDO
381 END IF
382 ENDDO
383 ELSE
384 DO j=1,numelc
385 i = index(j)
386 IF(sh4tree(3,i) == -1)THEN
387 DO k=1,4
388 n = ixc(k+1,i)
389 ms(n) = ms(n) + msc(i)
390 in(n) = in(n) + inc(i)
391 ENDDO
392 ELSEIF(sh4tree(3,i) == 0) THEN
393 DO k=1,4
394 n = ixc(k+1,i)
395 ms(n) = ms(n) + msc(i)
396 in(n) = in(n) + inc(i)
397 mcp(n) = mcp(n) + mcpc(i)
398 ENDDO
399 ELSEIF(sh4tree(3,i) > 0) THEN
400 DO k=1,4
401 n = ixc(k+1,i)
402 mcp(n) = mcp(n) + mcpc(i)
403 ENDDO
404 END IF
405 ENDDO
406 END IF
407 END IF
408 ENDIF
409C
410 IF(iplyxfem > 0) THEN
411 DO ip=1,nplymax
412 DO j=1,numelc
413 i = index(j)
414 DO k=1,4
415 n = ixc(k+1,i)
416 ms_layer(n,ip) = ms_layer(n,ip) + ms_layerc(i,ip)
417 IF(zi_layerc(i,ip) == zero) THEN
418 zi_layer(n,ip) = zply(ip)
419 ELSE
420 zi_layer(n,ip) = zi_layerc(i,ip)
421 ENDIF
422 ENDDO
423
424 ENDDO
425 ENDDO
426C sum mi*zi*zi
427 DO j=1,numelc
428 i = index(j)
429 DO k=1,4
430 n = ixc(k+1,i)
431 msz2(n) = msz2(n) + msz2c(i)
432 ENDDO
433 ENDDO
434 ENDIF
435C
436 IF(i7stifs/=0)THEN
437C
438 DO j=1,numelc
439 i = index(j)
440 DO k=1,4
441 n = ixc(k+1,i)
442 etnod(n) = etnod(n) + stc(i)
443 stifintr(n) = stifintr(n) + strc(i)/nshnod(n)
444 ENDDO
445 ENDDO
446C
447 ENDIF
448C
449 DO i = 1, numelt
450 itri(i) = ixt(5,i)
451 ENDDO
452 CALL my_orders(0,work,itri,index,numelt,1)
453 DO j=1,numelt
454 i = index(j)
455 DO k=1,2
456 n = ixt(k+1,i)
457 ms(n) = ms(n) + mst(i)
458 ENDDO
459 ENDDO
460C
461 IF(i7stifs/=0)THEN
462 DO j=1,numelt
463 i = index(j)
464 DO k=1,2
465 n = ixt(k+1,i)
466 stifint(n) = stifint(n) + stt(i)
467 ENDDO
468 ENDDO
469 ENDIF
470C
471 DO i = 1, numelp
472 itri(i) = ixp(6,i)
473 ENDDO
474 CALL my_orders(0,work,itri,index,numelp,1)
475 IF(itherm_fe == 0) THEN
476 DO j=1,numelp
477 i = index(j)
478 n = ixp(2,i)
479 ms(n) = ms(n) + msp(i)
480 in(n) = in(n) + inp(i)
481 n = ixp(3,i)
482 ms(n) = ms(n) + msp(i)
483 in(n) = in(n) + inp(i)
484 ENDDO
485 ELSE
486 DO j=1,numelp
487 i = index(j)
488 n = ixp(2,i)
489 ms(n) = ms(n) + msp(i)
490 in(n) = in(n) + inp(i)
491 mcp(n) = mcp(n) + mcpp(i)
492 n = ixp(3,i)
493 ms(n) = ms(n) + msp(i)
494 in(n) = in(n) + inp(i)
495 mcp(n) = mcp(n) + mcpp(i)
496 ENDDO
497 ENDIF
498C
499 IF(i7stifs/=0)THEN
500 DO j=1,numelp
501 i = index(j)
502 n = ixp(2,i)
503 stifint(n) = stifint(n) + stp(i)
504 stifintr(n) = stifintr(n) + strp(i)
505 n = ixp(3,i)
506 stifint(n) = stifint(n) + stp(i)
507 stifintr(n) = stifintr(n) + strp(i)
508 ENDDO
509 ENDIF
510C
511 DO i = 1, numelr
512 itri(i) = ixr(6,i)
513 ENDDO
514 CALL my_orders(0,work,itri,index,numelr,1)
515 DO j=1,numelr
516 i = index(j)
517 DO k=1,2
518 n = ixr(k+1,i)
519 ms(n) = ms(n) + msr(k,i)
520 in(n) = in(n) + inr(k,i)
521 ENDDO
522 igtyp = nint(geo(12,ixr(1,i)))
523 IF(igtyp==12) THEN
524 n = ixr(4,i)
525 ms(n) = ms(n) + msr(3,i)
526 in(n) = in(n) + inr(3,i)
527 ENDIF
528 ENDDO
529C
530 IF(i7stifs/=0)THEN
531 DO j=1,numelr
532 i = index(j)
533 DO k=1,2
534 n = ixr(k+1,i)
535 stifint(n) = stifint(n) + str(i)
536 stifintr(n) = stifintr(n) + strr(i)
537 ENDDO
538 igtyp = nint(geo(12,ixr(1,i)))
539 IF(igtyp==12) THEN
540 n = ixr(4,i)
541 stifint(n) = stifint(n) + two*str(i)
542 ENDIF
543 ENDDO
544 ENDIF
545C
546 DO i = 1, numeltg
547 itri(i) = ixtg(6,i)
548 ENDDO
549 CALL my_orders(0,work,itri,index,numeltg,1)
550 IF(itherm _fe== 0 ) THEN
551 IF(nadmesh==0)THEN
552 DO j=1,numeltg
553 i = index(j)
554 DO k=1,3
555 n = ixtg(k+1,i)
556 ms(n) = ms(n) + mstg(i)*ptg(k,i)
557 in(n) = in(n) + intg(i)*ptg(k,i)
558 ENDDO
559 ENDDO
560 ELSE
561 IF(istatcnd==0)THEN
562 DO j=1,numeltg
563 i = index(j)
564 IF(sh3tree(3,i) >= 0)THEN
565 DO k=1,3
566 n = ixtg(k+1,i)
567 ms(n) = ms(n) + mstg(i)*ptg(k,i)
568 in(n) = in(n) + intg(i)*ptg(k,i)
569 ENDDO
570 END IF
571 ENDDO
572 ELSE
573 DO j=1,numeltg
574 i = index(j)
575 IF(sh3tree(3,i) == 0 .OR. sh3tree(3,i) == -1)THEN
576 DO k=1,3
577 n = ixtg(k+1,i)
578 ms(n) = ms(n) + mstg(i)*ptg(k,i)
579 in(n) = in(n) + intg(i)*ptg(k,i)
580 ENDDO
581 END IF
582 ENDDO
583 END IF
584 END IF
585 ELSE ! ITHERM_FE /= 0
586 IF(nadmesh==0)THEN
587 DO j=1,numeltg
588 i = index(j)
589 DO k=1,3
590 n = ixtg(k+1,i)
591 ms(n) = ms(n) + mstg(i)*ptg(k,i)
592 mcp(n) = mcp(n) + mcptg(i)*ptg(k,i)
593 ENDDO
594 ENDDO
595 ELSE
596 IF(istatcnd==0)THEN
597 DO j=1,numeltg
598 i = index(j)
599 IF(sh3tree(3,i) >= 0)THEN
600 DO k=1,3
601 n = ixtg(k+1,i)
602 ms(n) = ms(n) + mstg(i)*ptg(k,i)
603 mcp(n) = mcp(n) + mcptg(i)*ptg(k,i)
604 ENDDO
605 END IF
606 ENDDO
607 ELSE
608 DO j=1,numeltg
609 i = index(j)
610 IF(sh3tree(3,i) == -1)THEN
611 DO k=1,3
612 n = ixtg(k+1,i)
613 ms(n) = ms(n) + mstg(i)*ptg(k,i)
614 ENDDO
615 ELSEIF(sh3tree(3,i) == 0)THEN
616 DO k=1,3
617 n = ixtg(k+1,i)
618 ms(n) = ms(n) + mstg(i)*ptg(k,i)
619 mcp(n) = mcp(n) + mcptg(i)*ptg(k,i)
620 ENDDO
621 ELSEIF(sh3tree(3,i) > 0)THEN
622 DO k=1,3
623 n = ixtg(k+1,i)
624 mcp(n) = mcp(n) + mcptg(i)*ptg(k,i)
625 ENDDO
626 END IF
627 ENDDO
628 END IF
629 END IF
630 ENDIF
631C
632 IF(i7stifs/=0)THEN
633 DO j=1,numeltg
634 i = index(j)
635 DO k=1,3
636 n = ixtg(k+1,i)
637 etnod(n) = etnod(n) + sttg(i)
638 stifintr(n) = stifintr(n) + strtg(i)/nshnod(n)
639 ENDDO
640 ENDDO
641 ENDIF
642C
643 DO i = 1, numelig3d
644 itri(i) = kxig3d(5,i)
645 ENDDO
646 CALL my_orders(0,work,itri,index,numelig3d,1)
647 DO j=1,numelig3d
648 i = index(j)
649 DO k=1,kxig3d(3,i)
650 n = ixig3d(kxig3d(4,i)+k-1)
651 ms(n) = ms(n) + msig3d(i,k)
652 ENDDO
653 ENDDO
654C
655 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
strr
character *8 function strr(y)
Definition strr.F:34