OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_msin_addmass.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!|| spmd_msin_addmass ../starter/source/elements/initia/spmd_msin_addmass.F
25!||--- called by ------------------------------------------------------
26!|| initia ../starter/source/elements/initia/initia.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!||====================================================================
30 SUBROUTINE spmd_msin_addmass(
31 1 IXS ,IXS10 ,IXS20 ,IXS16 ,IXQ ,
32 2 IXC ,IXT ,IXP ,IXR ,IXTG ,
33 3 MSS ,MSSX ,MSQ ,MSC ,
34 4 MST ,MSP ,MSR ,MSTG ,
35 5 PTG ,MS ,INDEX ,ITRI ,
36 6 GEO ,SH4TREE,SH3TREE,PARTSAV,IPMAS ,
37 7 IPARTS ,IPARTQ ,IPARTC ,IPARTT ,
38 8 IPARTP ,IPARTR ,IPARTTG,TOTADDMAS,
39 9 IPART ,THK ,PM ,PART_AREA,
40 A ADDEDMS,ITAB ,PARTSAV1_PON,ELE_AREA)
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE optiondef_mod
45 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "com04_c.inc"
54#include "param_c.inc"
55#include "scr17_c.inc"
56#include "remesh_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER IXS(NIXS,*),IXS10(6,*),IXS20(12,*),IXS16(8,*),
61 . IXQ(NIXQ,*),IXC(NIXC,*),IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),
62 . IXTG(6,*),INDEX(*), ITRI(*),SH4TREE(KSH4TREE,*),
63 . SH3TREE(KSH3TREE,*),IPARTS(*),IPARTQ(*),IPARTC(*),
64 . IPARTT(*),IPARTP(*),IPARTR(*),IPARTTG(*),
65 . IPART(LIPART1,*),ITAB(*)
66C REAL
67 my_real
68 . MSS(8,*),MSSX(12,*),MSQ(*),MSC(*),MST(*),MSP(*),MSR(3,*),
69 . MSTG(*),PTG(3,*),MS(*),GEO(NPROPG,*),
70 . partsav(20,*),totaddmas,part_area(*),thk(*),
71 . addedms(*),pm(npropm,*),partsav1_pon(npart),ele_area(*)
72C
73 INTEGER IDEB
74 TYPE (ADMAS_) , DIMENSION(NODMAS) :: IPMAS
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER I, J, K, N, II, IGTYP, WORK(70000),IP,KAD,IGM,IPM,NMAS,
79 . FLAG
80C
81 my_real
82 . MASS,KMASS,AREA_EL
83C-----------------------------------------------
84C
85! PARTSAV1_PON(1:NPART)=ZERO
86C
87 DO i = 1, numels
88 itri(i) = ixs(11,i)
89 ENDDO
90C
91 CALL my_orders(0,work,itri,index,numels8,1)
92
93 ideb=numels8+1
94 CALL my_orders(0,work,itri(ideb),index(ideb),numels10,1)
95
96 DO j=1,numels10
97 index(ideb+j-1) = index(ideb+j-1)+numels8
98 ENDDO
99
100 ideb = ideb + numels10
101 CALL my_orders(0,work,itri(ideb),index(ideb),numels20,1)
102 DO j = 1, numels20
103 index(ideb+j-1) = index(ideb+j-1)+numels8+numels10
104 ENDDO
105
106 ideb = ideb + numels20
107 CALL my_orders(0,work,itri(ideb),index(ideb),numels16,1)
108 DO j = 1, numels16
109 index(ideb+j-1) = index(ideb+j-1)+numels8+numels10+numels20
110 ENDDO
111C
112 DO igm=1,nodmas
113 nmas = ipmas(igm)%NPART
114 DO ii = 1,nmas
115 ipm = ipmas(igm)%PARTID(ii)
116C NUMELS
117 DO j=1,numels
118 i = index(j)
119 ip = iparts(i)
120 IF(ip == ipm)THEN
121 DO k=1,8
122 n = ixs(k+1,i)
123 kmass = mss(k,i) / max(em20,partsav1_pon(ip))
124 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
125 ms(n) = ms(n) + mass
126 totaddmas = totaddmas + mass
127 ENDDO
128 ENDIF
129 ENDDO
130C NUMELS10
131 IF(numels10>0) THEN
132 DO j=1,numels10
133 i = index(numels8+j)
134 ip = iparts(i)
135 IF(ip == ipm)THEN
136 DO k=1,6
137 n = ixs10(k,i-numels8)
138 kmass = mssx(k,i) / max(em20,partsav1_pon(ip))
139 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
140 IF(n/=0)THEN
141 ms(n) = ms(n) + mass
142 totaddmas = totaddmas + mass
143 END IF
144 ENDDO
145 ENDIF
146 ENDDO
147 ENDIF
148C NUMELS20
149 IF(numels20>0)THEN
150 DO j=1,numels20
151 i = index(numels8+numels10+j)
152 ip = iparts(i)
153 IF(ip == ipm)THEN
154 DO k=1,12
155 n = ixs20(k,i-numels8-numels10)
156 kmass = mssx(k,i) / max(em20,partsav1_pon(ip))
157 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
158 IF(n/=0)THEN
159 ms(n) = ms(n) + mass
160 totaddmas = totaddmas + mass
161 ENDIF
162 ENDDO
163 ENDIF
164 ENDDO
165 ENDIF
166C NUMELS20
167 IF(numels16>0)THEN
168 DO j=1,numels16
169 i = index(numels8+numels10+numels20+j)
170 ip = iparts(i)
171 IF(ip == ipm)THEN
172 DO k=1,8
173 n = ixs16(k,i-numels8-numels10-numels20)
174 kmass = mssx(k,i) / max(em20,partsav1_pon(ip))
175 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
176 IF(n/=0)THEN
177 ms(n) = ms(n) + mass
178 totaddmas = totaddmas + mass
179 ENDIF
180 ENDDO
181 ENDIF
182 ENDDO
183 ENDIF
184 ENDDO
185 ENDDO
186C NUMELQ
187 DO i = 1, numelq
188 itri(i) = ixq(7,i)
189 ENDDO
190 CALL my_orders(0,work,itri,index,numelq,1)
191C
192 DO igm=1,nodmas
193 nmas = ipmas(igm)%NPART
194 DO ii = 1,nmas
195 ipm = ipmas(igm)%PARTID(ii)
196 DO j=1,numelq
197 i = index(j)
198 ip = ipartq(i)
199 IF(ip == ipm)THEN
200 kmass = msq(i) / max(em20,partsav1_pon(ip))
201 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
202 DO k=1,4
203 n = ixq(k+1,i)
204 ms(n) = ms(n) + mass
205 totaddmas = totaddmas + mass
206 ENDDO
207 ENDIF
208 ENDDO
209 ENDDO
210 ENDDO
211C NUMELC
212
213
214C=======================================================================
215C Compute area of part
216 DO i = 1, numeltg
217 itri(i) = ixtg(6,i)
218 ENDDO
219 CALL my_orders(0,work,itri,index,numeltg,1)
220C P/ON computation of PART_AREA
221 DO j=1,numeltg
222 i = index(j)
223 ip = iparttg(i)
224 area_el = ele_area(i+numelc)
225 part_area(ip) = part_area(ip) + area_el
226 ENDDO
227 DO i = 1, numelc
228 itri(i) = ixc(7,i)
229 ENDDO
230 CALL my_orders(0,work,itri,index,numelc,1)
231C P/ON computation of PART_AREA
232 DO j=1,numelc
233 i = index(j)
234 ip = ipartc(i)
235 area_el = ele_area(i)
236 part_area(ip) = part_area(ip) + area_el
237 ENDDO
238C=======================================================================
239C
240 DO igm=1,nodmas
241 nmas = ipmas(igm)%NPART
242 flag = ipmas(igm)%WEIGHT_FLAG
243 DO ii = 1,nmas
244 ipm = ipmas(igm)%PARTID(ii)
245 IF(nadmesh==0)THEN
246 DO j=1,numelc
247 i = index(j)
248 ip = ipartc(i)
249 IF(ip == ipm)THEN
250 IF(flag == 0)THEN
251 kmass = msc(i) / max(em20,partsav1_pon(ip))
252 ELSE IF(flag == 1)THEN
253 area_el = ele_area(i)*fourth
254 kmass = area_el / max(em20,part_area(ip))
255 END IF
256 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
257 DO k=1,4
258 n = ixc(k+1,i)
259 ms(n) = ms(n) + mass
260 totaddmas = totaddmas + mass
261 ENDDO
262 ENDIF
263 ENDDO
264
265 ELSE
266 IF(istatcnd==0)THEN
267 DO j=1,numelc
268 i = index(j)
269 IF(sh4tree(3,i) >= 0)THEN
270 ip = ipartc(i)
271 IF(ip == ipm)THEN
272 IF(flag == 0)THEN
273 kmass = msc(i) / max(em20,partsav1_pon(ip))
274 ELSE IF(flag == 1)THEN
275 area_el = ele_area(i)*fourth
276 kmass = area_el / max(em20,part_area(ip))
277 END IF
278 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
279 DO k=1,4
280 n = ixc(k+1,i)
281 ms(n) = ms(n) + mass
282 totaddmas = totaddmas + mass
283 ENDDO
284 ENDIF
285 ENDIF
286 ENDDO
287 ELSE
288 DO j=1,numelc
289 i = index(j)
290 IF(sh4tree(3,i) == 0 .OR. sh4tree(3,i) == -1)THEN
291 ip = ipartc(i)
292 IF(ip == ipm)THEN
293 IF(flag == 0)THEN
294 kmass = msc(i) / max(em20,partsav1_pon(ip))
295 ELSE IF(flag == 1)THEN
296 area_el = ele_area(i)*fourth
297 kmass = area_el / max(em20,part_area(ip))
298 END IF
299 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
300 DO k=1,4
301 n = ixc(k+1,i)
302 ms(n) = ms(n) + mass
303 totaddmas = totaddmas + mass
304 ENDDO
305 ENDIF
306 ENDIF
307 ENDDO
308 ENDIF
309 ENDIF
310 ENDDO
311 ENDDO
312C NUMELT
313 DO i = 1, numelt
314 itri(i) = ixt(5,i)
315 ENDDO
316 CALL my_orders(0,work,itri,index,numelt,1)
317C
318 DO igm=1,nodmas
319 nmas = ipmas(igm)%NPART
320 DO ii = 1,nmas
321 ipm = ipmas(igm)%PARTID(ii)
322 DO j=1,numelt
323 i = index(j)
324 ip = ipartt(i)
325 IF(ip == ipm)THEN
326 kmass = mst(i) / max(em20,partsav1_pon(ip))
327 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
328 DO k=1,2
329 n = ixt(k+1,i)
330 ms(n) = ms(n) + mass
331 totaddmas = totaddmas + mass
332 ENDDO
333 ENDIF
334 ENDDO
335 ENDDO
336 ENDDO
337C NUMELP
338 DO i = 1, numelp
339 itri(i) = ixp(6,i)
340 ENDDO
341 CALL my_orders(0,work,itri,index,numelp,1)
342C
343 DO igm=1,nodmas
344 nmas = ipmas(igm)%NPART
345 DO ii = 1,nmas
346 ipm = ipmas(igm)%PARTID(ii)
347 DO j=1,numelp
348 i = index(j)
349 ip = ipartp(i)
350 IF(ip == ipm)THEN
351 kmass = msp(i) / max(em20,partsav1_pon(ip))
352 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
353 n = ixp(2,i)
354 ms(n) = ms(n) + mass
355 totaddmas = totaddmas + mass
356 n = ixp(3,i)
357 ms(n) = ms(n) + mass
358 totaddmas = totaddmas + mass
359 ENDIF
360 ENDDO
361 ENDDO
362 ENDDO
363C NUMELR
364 DO i = 1, numelr
365 itri(i) = ixr(6,i)
366 ENDDO
367 CALL my_orders(0,work,itri,index,numelr,1)
368C
369 DO igm=1,nodmas
370 nmas = ipmas(igm)%NPART
371 DO ii = 1,nmas
372 ipm = ipmas(igm)%PARTID(ii)
373 DO j=1,numelr
374 i = index(j)
375 ip = ipartr(i)
376 IF(ip == ipm)THEN
377 DO k=1,2
378 n = ixr(k+1,i)
379 kmass = msr(k,i) / max(em20,partsav1_pon(ip))
380 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
381 ms(n) = ms(n) + mass
382 totaddmas = totaddmas + mass
383 ENDDO
384 igtyp = nint(geo(12,ixr(1,i)))
385 IF(igtyp==12) THEN
386 n = ixr(4,i)
387 kmass = msr(3,i) / max(em20,partsav1_pon(ip))
388 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
389 ms(n) = ms(n) + mass
390 totaddmas = totaddmas + mass
391 ENDIF
392 ENDIF
393 ENDDO
394 ENDDO
395 ENDDO
396C NUMELTG
397 DO i = 1, numeltg
398 itri(i) = ixtg(6,i)
399 ENDDO
400 CALL my_orders(0,work,itri,index,numeltg,1)
401
402 DO igm=1,nodmas
403 nmas = ipmas(igm)%NPART
404 DO ii = 1,nmas
405 ipm = ipmas(igm)%PARTID(ii)
406 IF(nadmesh==0)THEN
407 DO j=1,numeltg
408 i = index(j)
409 ip = iparttg(i)
410 IF(ip == ipm)THEN
411!---
412 IF(flag == 0)THEN
413 kmass = mstg(i) / max(em20,partsav1_pon(ip))
414 ELSEIF(flag == 1)THEN
415 area_el = ele_area(i+numelc)
416 kmass = area_el / max(em20,part_area(ip))
417 ENDIF
418 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
419!---
420 DO k=1,3
421 n = ixtg(k+1,i)
422 ms(n) = ms(n) + mass*ptg(k,i)
423 totaddmas = totaddmas + mass*ptg(k,i)
424 ENDDO
425 ENDIF
426 ENDDO
427 ELSE
428 IF(istatcnd==0)THEN
429 DO j=1,numeltg
430 i = index(j)
431 IF(sh3tree(3,i) >= 0)THEN
432 ip = iparttg(i)
433 IF(ip == ipm)THEN
434!---
435 IF(flag == 0)THEN
436 kmass = mstg(i) / max(em20,partsav1_pon(ip))
437 ELSEIF(flag == 1)THEN
438 area_el = ele_area(i+numelc)
439 kmass = area_el / max(em20,part_area(ip))
440 ENDIF
441 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
442!---
443 DO k=1,3
444 n = ixtg(k+1,i)
445 ms(n) = ms(n) + mass*ptg(k,i)
446 totaddmas = totaddmas + mass*ptg(k,i)
447 ENDDO
448 ENDIF
449 ENDIF
450 ENDDO
451 ELSE
452 DO j=1,numeltg
453 i = index(j)
454 IF(sh3tree(3,i) == 0 .OR. sh3tree(3,i) == -1)THEN
455 ip = iparttg(i)
456 IF(ip == ipm)THEN
457!---
458 IF(flag == 0)THEN
459 kmass = mstg(i) / max(em20,partsav1_pon(ip))
460 ELSEIF(flag == 1)THEN
461 area_el = ele_area(i+numelc)
462 kmass = area_el / max(em20,part_area(ip))
463 ENDIF
464 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
465!---
466 DO k=1,3
467 n = ixtg(k+1,i)
468 ms(n) = ms(n) + mass*ptg(k,i)
469 totaddmas = totaddmas + mass*ptg(k,i)
470 ENDDO
471 ENDIF
472 ENDIF
473 ENDDO
474 ENDIF
475 ENDIF
476 ENDDO
477 ENDDO
478C---
479 DO i=1,npart
480 IF(addedms(i) > zero) THEN
481 partsav(1,i) = partsav(1,i) + addedms(i)
482 partsav1_pon(i) = partsav1_pon(i) + addedms(i)
483 ENDIF
484 END DO
485C---
486 RETURN
487 END
488!||====================================================================
489!|| spmd_partsav_pon ../starter/source/elements/initia/spmd_msin_addmass.F
490!||--- called by ------------------------------------------------------
491!|| initia ../starter/source/elements/initia/initia.F
492!||--- calls -----------------------------------------------------
493!||--- uses -----------------------------------------------------
494!||====================================================================
495 SUBROUTINE spmd_partsav_pon(
496 1 IXS ,IXS10 ,IXS20 ,IXS16 ,IXQ ,
497 2 IXC ,IXT ,IXP ,IXR ,IXTG ,
498 3 MSS ,MSSX ,MSQ ,MSC ,
499 4 MST ,MSP ,MSR ,MSTG ,
500 5 INDEX ,ITRI ,GEO ,PARTSAV1_PON ,IPARTS ,
501 6 IPARTQ ,IPARTC ,IPARTT ,IPARTP ,IPARTR ,
502 7 IPARTTG,IPART )
503 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr
504C-----------------------------------------------
505C I m p l i c i t T y p e s
506C-----------------------------------------------
507#include "implicit_f.inc"
508C-----------------------------------------------
509C C o m m o n B l o c k s
510C-----------------------------------------------
511#include "com04_c.inc"
512#include "param_c.inc"
513#include "scr17_c.inc"
514C-----------------------------------------------
515C D u m m y A r g u m e n t s
516C-----------------------------------------------
517 INTEGER IXS(NIXS,*),IXS10(6,*),IXS20(12,*),IXS16(8,*),
518 . IXQ(NIXQ,*),IXC(NIXC,*),IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),
519 . IXTG(6,*),INDEX(*), ITRI(*),
520 . iparts(*),ipartq(*),ipartc(*),
521 . ipartt(*),ipartp(*),ipartr(*),iparttg(*),
522 . ipart(lipart1,*)
523C REAL
524 my_real
525 . mss(8,*),mssx(12,*),msq(*),msc(*),mst(*),msp(*),msr(3,*),
526 . mstg(*),geo(npropg,*),partsav1_pon(npart)
527C
528 INTEGER IDEB
529C-----------------------------------------------
530C L o c a l V a r i a b l e s
531C-----------------------------------------------
532 INTEGER I, J, K, N, II, IGTYP, WORK(70000),IP,KAD,IGM,IPM,NMAS,
533 . FLAG
534C-----------------------------------------------
535C
536 partsav1_pon(1:npart)=zero
537C
538 DO i = 1, numels
539 itri(i) = ixs(11,i)
540 ENDDO
541C
542 CALL my_orders(0,work,itri,index,numels8,1)
543
544 ideb=numels8+1
545 CALL my_orders(0,work,itri(ideb),index(ideb),numels10,1)
546
547 DO j=1,numels10
548 index(ideb+j-1) = index(ideb+j-1)+numels8
549 ENDDO
550
551 ideb = ideb + numels10
552 CALL my_orders(0,work,itri(ideb),index(ideb),numels20,1)
553 DO j = 1, numels20
554 index(ideb+j-1) = index(ideb+j-1)+numels8+numels10
555 ENDDO
556
557 ideb = ideb + numels20
558 CALL my_orders(0,work,itri(ideb),index(ideb),numels16,1)
559 DO j = 1, numels16
560 index(ideb+j-1) = index(ideb+j-1)+numels8+numels10+numels20
561 ENDDO
562C
563 DO j=1,numels
564 i = index(j)
565 ip = iparts(i)
566 DO k=1,8
567 partsav1_pon(ip)=partsav1_pon(ip)+mss(k,i)
568 ENDDO
569 ENDDO
570
571C NUMELS10
572 IF(numels10>0) THEN
573 DO j=1,numels10
574 i = index(numels8+j)
575 ip = iparts(i)
576 DO k=1,6
577 partsav1_pon(ip)=partsav1_pon(ip)+mssx(k,i)
578 ENDDO
579 ENDDO
580 ENDIF
581C NUMELS20
582 IF(numels20>0)THEN
583 DO j=1,numels20
584 i = index(numels8+numels10+j)
585 ip = iparts(i)
586 DO k=1,12
587 partsav1_pon(ip)=partsav1_pon(ip)+mssx(k,i)
588 ENDDO
589 ENDDO
590 ENDIF
591C NUMELS16
592 IF(numels16>0)THEN
593 DO j=1,numels16
594 i = index(numels8+numels10+numels20+j)
595 ip = iparts(i)
596 DO k=1,8
597 partsav1_pon(ip)=partsav1_pon(ip)+mssx(k,i)
598 ENDDO
599 ENDDO
600 ENDIF
601
602C NUMELQ
603 DO i = 1, numelq
604 itri(i) = ixq(7,i)
605 ENDDO
606 CALL my_orders(0,work,itri,index,numelq,1)
607C
608 DO j=1,numelq
609 i = index(j)
610 ip = ipartq(i)
611 partsav1_pon(ip)=partsav1_pon(ip)+ four * msq(i)
612 ENDDO
613
614C NUMELC
615 DO i = 1, numelc
616 itri(i) = ixc(7,i)
617 ENDDO
618 CALL my_orders(0,work,itri,index,numelc,1)
619C
620 DO j=1,numelc
621 i=index(j)
622 ip=ipartc(i)
623 partsav1_pon(ip)=partsav1_pon(ip)+ four * msc(i)
624 ENDDO
625
626C NUMELT
627 DO i = 1, numelt
628 itri(i) = ixt(5,i)
629 ENDDO
630 CALL my_orders(0,work,itri,index,numelt,1)
631C
632 DO j=1,numelt
633 i=index(j)
634 ip=ipartt(i)
635 partsav1_pon(ip)=partsav1_pon(ip)+ two * mst(i)
636 ENDDO
637
638C NUMELP
639 DO i = 1, numelp
640 itri(i) = ixp(6,i)
641 ENDDO
642 CALL my_orders(0,work,itri,index,numelp,1)
643C
644 DO j=1,numelp
645 i=index(j)
646 ip=ipartp(i)
647 partsav1_pon(ip)=partsav1_pon(ip)+ two * msp(i)
648 ENDDO
649
650C NUMELR
651 DO i = 1, numelr
652 itri(i) = ixr(6,i)
653 ENDDO
654 CALL my_orders(0,work,itri,index,numelr,1)
655C
656 DO j=1,numelr
657 i=index(j)
658 ip=ipartr(i)
659 igtyp = nint(geo(12,ixr(1,i)))
660 IF(igtyp==12) THEN
661 k=3
662 ELSE
663 k=2
664 ENDIF
665 DO ii=1,k
666 partsav1_pon(ip)=partsav1_pon(ip)+msr(ii,i)
667 ENDDO
668 ENDDO
669
670C NUMELTG
671 DO i = 1, numeltg
672 itri(i) = ixtg(6,i)
673 ENDDO
674 CALL my_orders(0,work,itri,index,numeltg,1)
675C
676 DO j=1,numeltg
677 i=index(j)
678 ip=iparttg(i)
679 partsav1_pon(ip)=partsav1_pon(ip)+mstg(i)
680 ENDDO
681C---
682 RETURN
683 END
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
optiondef_mod
Definition optiondef_mod.F:90
spmd_partsav_pon
subroutine spmd_partsav_pon(ixs, ixs10, ixs20, ixs16, ixq, ixc, ixt, ixp, ixr, ixtg, mss, mssx, msq, msc, mst, msp, msr, mstg, index, itri, geo, partsav1_pon, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipart)
Definition spmd_msin_addmass.F:503
spmd_msin_addmass
subroutine spmd_msin_addmass(ixs, ixs10, ixs20, ixs16, ixq, ixc, ixt, ixp, ixr, ixtg, mss, mssx, msq, msc, mst, msp, msr, mstg, ptg, ms, index, itri, geo, sh4tree, sh3tree, partsav, ipmas, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, totaddmas, ipart, thk, pm, part_area, addedms, itab, partsav1_pon, ele_area)
Definition spmd_msin_addmass.F:41