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 29 of file spmd_msin.F.

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