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
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "com04_c.inc"
53#include "param_c.inc"
54#include "scr17_c.inc"
55#include "remesh_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER IXS(NIXS,*),IXS10(6,*),IXS20(12,*),IXS16(8,*),
60 . IXQ(NIXQ,*),IXC(NIXC,*),IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),
61 . IXTG(6,*),INDEX(*), ITRI(*),SH4TREE(KSH4TREE,*),
62 . SH3TREE(KSH3TREE,*),IPARTS(*),IPARTQ(*),IPARTC(*),
63 . IPARTT(*),IPARTP(*),IPARTR(*),IPARTTG(*),
64 . IPART(LIPART1,*),ITAB(*)
65C REAL
66 my_real
67 . MSS(8,*),MSSX(12,*),MSQ(*),MSC(*),MST(*),MSP(*),MSR(3,*),
68 . MSTG(*),PTG(3,*),MS(*),GEO(NPROPG,*),
69 . partsav(20,*),totaddmas,part_area(*),thk(*),
70 . addedms(*),pm(npropm,*),partsav1_pon(npart),ele_area(*)
71C
72 INTEGER IDEB
73 TYPE (ADMAS_) , DIMENSION(NODMAS) :: IPMAS
74C-----------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 INTEGER I, J, K, N, II, IGTYP, WORK(70000),IP,KAD,IGM,IPM,NMAS,
78 . FLAG
79C
80 my_real
81 . MASS,KMASS,AREA_EL
82C-----------------------------------------------
83C
84! PARTSAV1_PON(1:NPART)=ZERO
85C
86 DO i = 1, numels
87 itri(i) = ixs(11,i)
88 ENDDO
89C
90 CALL my_orders(0,work,itri,index,numels8,1)
91
92 ideb=numels8+1
93 CALL my_orders(0,work,itri(ideb),index(ideb),numels10,1)
94
95 DO j=1,numels10
96 index(ideb+j-1) = index(ideb+j-1)+numels8
97 ENDDO
98
99 ideb = ideb + numels10
100 CALL my_orders(0,work,itri(ideb),index(ideb),numels20,1)
101 DO j = 1, numels20
102 index(ideb+j-1) = index(ideb+j-1)+numels8+numels10
103 ENDDO
104
105 ideb = ideb + numels20
106 CALL my_orders(0,work,itri(ideb),index(ideb),numels16,1)
107 DO j = 1, numels16
108 index(ideb+j-1) = index(ideb+j-1)+numels8+numels10+numels20
109 ENDDO
110C
111 DO igm=1,nodmas
112 nmas = ipmas(igm)%NPART
113 DO ii = 1,nmas
114 ipm = ipmas(igm)%PARTID(ii)
115C NUMELS
116 DO j=1,numels
117 i = index(j)
118 ip = iparts(i)
119 IF(ip == ipm)THEN
120 DO k=1,8
121 n = ixs(k+1,i)
122 kmass = mss(k,i) / max(em20,partsav1_pon(ip))
123 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
124 ms(n) = ms(n) + mass
125 totaddmas = totaddmas + mass
126 ENDDO
127 ENDIF
128 ENDDO
129C NUMELS10
130 IF(numels10>0) THEN
131 DO j=1,numels10
132 i = index(numels8+j)
133 ip = iparts(i)
134 IF(ip == ipm)THEN
135 DO k=1,6
136 n = ixs10(k,i-numels8)
137 kmass = mssx(k,i) / max(em20,partsav1_pon(ip))
138 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
139 IF(n/=0)THEN
140 ms(n) = ms(n) + mass
141 totaddmas = totaddmas + mass
142 END IF
143 ENDDO
144 ENDIF
145 ENDDO
146 ENDIF
147C NUMELS20
148 IF(numels20>0)THEN
149 DO j=1,numels20
150 i = index(numels8+numels10+j)
151 ip = iparts(i)
152 IF(ip == ipm)THEN
153 DO k=1,12
154 n = ixs20(k,i-numels8-numels10)
155 kmass = mssx(k,i) / max(em20,partsav1_pon(ip))
156 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
157 IF(n/=0)THEN
158 ms(n) = ms(n) + mass
159 totaddmas = totaddmas + mass
160 ENDIF
161 ENDDO
162 ENDIF
163 ENDDO
164 ENDIF
165C NUMELS20
166 IF(numels16>0)THEN
167 DO j=1,numels16
168 i = index(numels8+numels10+numels20+j)
169 ip = iparts(i)
170 IF(ip == ipm)THEN
171 DO k=1,8
172 n = ixs16(k,i-numels8-numels10-numels20)
173 kmass = mssx(k,i) / max(em20,partsav1_pon(ip))
174 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
175 IF(n/=0)THEN
176 ms(n) = ms(n) + mass
177 totaddmas = totaddmas + mass
178 ENDIF
179 ENDDO
180 ENDIF
181 ENDDO
182 ENDIF
183 ENDDO
184 ENDDO
185C NUMELQ
186 DO i = 1, numelq
187 itri(i) = ixq(7,i)
188 ENDDO
189 CALL my_orders(0,work,itri,index,numelq,1)
190C
191 DO igm=1,nodmas
192 nmas = ipmas(igm)%NPART
193 DO ii = 1,nmas
194 ipm = ipmas(igm)%PARTID(ii)
195 DO j=1,numelq
196 i = index(j)
197 ip = ipartq(i)
198 IF(ip == ipm)THEN
199 kmass = msq(i) / max(em20,partsav1_pon(ip))
200 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
201 DO k=1,4
202 n = ixq(k+1,i)
203 ms(n) = ms(n) + mass
204 totaddmas = totaddmas + mass
205 ENDDO
206 ENDIF
207 ENDDO
208 ENDDO
209 ENDDO
210C NUMELC
211
212
213C=======================================================================
214C Compute area of part
215 DO i = 1, numeltg
216 itri(i) = ixtg(6,i)
217 ENDDO
218 CALL my_orders(0,work,itri,index,numeltg,1)
219C P/ON computation of PART_AREA
220 DO j=1,numeltg
221 i = index(j)
222 ip = iparttg(i)
223 area_el = ele_area(i+numelc)
224 part_area(ip) = part_area(ip) + area_el
225 ENDDO
226 DO i = 1, numelc
227 itri(i) = ixc(7,i)
228 ENDDO
229 CALL my_orders(0,work,itri,index,numelc,1)
230C P/ON computation of PART_AREA
231 DO j=1,numelc
232 i = index(j)
233 ip = ipartc(i)
234 area_el = ele_area(i)
235 part_area(ip) = part_area(ip) + area_el
236 ENDDO
237C=======================================================================
238C
239 DO igm=1,nodmas
240 nmas = ipmas(igm)%NPART
241 flag = ipmas(igm)%WEIGHT_FLAG
242 DO ii = 1,nmas
243 ipm = ipmas(igm)%PARTID(ii)
244 IF(nadmesh==0)THEN
245 DO j=1,numelc
246 i = index(j)
247 ip = ipartc(i)
248 IF(ip == ipm)THEN
249 IF(flag == 0)THEN
250 kmass = msc(i) / max(em20,partsav1_pon(ip))
251 ELSE IF(flag == 1)THEN
252 area_el = ele_area(i)*fourth
253 kmass = area_el / max(em20,part_area(ip))
254 END IF
255 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
256 DO k=1,4
257 n = ixc(k+1,i)
258 ms(n) = ms(n) + mass
259 totaddmas = totaddmas + mass
260 ENDDO
261 ENDIF
262 ENDDO
263
264 ELSE
265 IF(istatcnd==0)THEN
266 DO j=1,numelc
267 i = index(j)
268 IF(sh4tree(3,i) >= 0)THEN
269 ip = ipartc(i)
270 IF(ip == ipm)THEN
271 IF(flag == 0)THEN
272 kmass = msc(i) / max(em20,partsav1_pon(ip))
273 ELSE IF(flag == 1)THEN
274 area_el = ele_area(i)*fourth
275 kmass = area_el / max(em20,part_area(ip))
276 END IF
277 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
278 DO k=1,4
279 n = ixc(k+1,i)
280 ms(n) = ms(n) + mass
281 totaddmas = totaddmas + mass
282 ENDDO
283 ENDIF
284 ENDIF
285 ENDDO
286 ELSE
287 DO j=1,numelc
288 i = index(j)
289 IF(sh4tree(3,i) == 0 .OR. sh4tree(3,i) == -1)THEN
290 ip = ipartc(i)
291 IF(ip == ipm)THEN
292 IF(flag == 0)THEN
293 kmass = msc(i) / max(em20,partsav1_pon(ip))
294 ELSE IF(flag == 1)THEN
295 area_el = ele_area(i)*fourth
296 kmass = area_el / max(em20,part_area(ip))
297 END IF
298 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
299 DO k=1,4
300 n = ixc(k+1,i)
301 ms(n) = ms(n) + mass
302 totaddmas = totaddmas + mass
303 ENDDO
304 ENDIF
305 ENDIF
306 ENDDO
307 ENDIF
308 ENDIF
309 ENDDO
310 ENDDO
311C NUMELT
312 DO i = 1, numelt
313 itri(i) = ixt(5,i)
314 ENDDO
315 CALL my_orders(0,work,itri,index,numelt,1)
316C
317 DO igm=1,nodmas
318 nmas = ipmas(igm)%NPART
319 DO ii = 1,nmas
320 ipm = ipmas(igm)%PARTID(ii)
321 DO j=1,numelt
322 i = index(j)
323 ip = ipartt(i)
324 IF(ip == ipm)THEN
325 kmass = mst(i) / max(em20,partsav1_pon(ip))
326 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
327 DO k=1,2
328 n = ixt(k+1,i)
329 ms(n) = ms(n) + mass
330 totaddmas = totaddmas + mass
331 ENDDO
332 ENDIF
333 ENDDO
334 ENDDO
335 ENDDO
336C NUMELP
337 DO i = 1, numelp
338 itri(i) = ixp(6,i)
339 ENDDO
340 CALL my_orders(0,work,itri,index,numelp,1)
341C
342 DO igm=1,nodmas
343 nmas = ipmas(igm)%NPART
344 DO ii = 1,nmas
345 ipm = ipmas(igm)%PARTID(ii)
346 DO j=1,numelp
347 i = index(j)
348 ip = ipartp(i)
349 IF(ip == ipm)THEN
350 kmass = msp(i) / max(em20,partsav1_pon(ip))
351 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
352 n = ixp(2,i)
353 ms(n) = ms(n) + mass
354 totaddmas = totaddmas + mass
355 n = ixp(3,i)
356 ms(n) = ms(n) + mass
357 totaddmas = totaddmas + mass
358 ENDIF
359 ENDDO
360 ENDDO
361 ENDDO
362C NUMELR
363 DO i = 1, numelr
364 itri(i) = ixr(6,i)
365 ENDDO
366 CALL my_orders(0,work,itri,index,numelr,1)
367C
368 DO igm=1,nodmas
369 nmas = ipmas(igm)%NPART
370 DO ii = 1,nmas
371 ipm = ipmas(igm)%PARTID(ii)
372 DO j=1,numelr
373 i = index(j)
374 ip = ipartr(i)
375 IF(ip == ipm)THEN
376 DO k=1,2
377 n = ixr(k+1,i)
378 kmass = msr(k,i) / max(em20,partsav1_pon(ip))
379 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
380 ms(n) = ms(n) + mass
381 totaddmas = totaddmas + mass
382 ENDDO
383 igtyp = nint(geo(12,ixr(1,i)))
384 IF(igtyp==12) THEN
385 n = ixr(4,i)
386 kmass = msr(3,i) / max(em20,partsav1_pon(ip))
387 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
388 ms(n) = ms(n) + mass
389 totaddmas = totaddmas + mass
390 ENDIF
391 ENDIF
392 ENDDO
393 ENDDO
394 ENDDO
395C NUMELTG
396 DO i = 1, numeltg
397 itri(i) = ixtg(6,i)
398 ENDDO
399 CALL my_orders(0,work,itri,index,numeltg,1)
400
401 DO igm=1,nodmas
402 nmas = ipmas(igm)%NPART
403 DO ii = 1,nmas
404 ipm = ipmas(igm)%PARTID(ii)
405 IF(nadmesh==0)THEN
406 DO j=1,numeltg
407 i = index(j)
408 ip = iparttg(i)
409 IF(ip == ipm)THEN
410!---
411 IF(flag == 0)THEN
412 kmass = mstg(i) / max(em20,partsav1_pon(ip))
413 ELSEIF(flag == 1)THEN
414 area_el = ele_area(i+numelc)
415 kmass = area_el / max(em20,part_area(ip))
416 ENDIF
417 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
418!---
419 DO k=1,3
420 n = ixtg(k+1,i)
421 ms(n) = ms(n) + mass*ptg(k,i)
422 totaddmas = totaddmas + mass*ptg(k,i)
423 ENDDO
424 ENDIF
425 ENDDO
426 ELSE
427 IF(istatcnd==0)THEN
428 DO j=1,numeltg
429 i = index(j)
430 IF(sh3tree(3,i) >= 0)THEN
431 ip = iparttg(i)
432 IF(ip == ipm)THEN
433!---
434 IF(flag == 0)THEN
435 kmass = mstg(i) / max(em20,partsav1_pon(ip))
436 ELSEIF(flag == 1)THEN
437 area_el = ele_area(i+numelc)
438 kmass = area_el / max(em20,part_area(ip))
439 ENDIF
440 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
441!---
442 DO k=1,3
443 n = ixtg(k+1,i)
444 ms(n) = ms(n) + mass*ptg(k,i)
445 totaddmas = totaddmas + mass*ptg(k,i)
446 ENDDO
447 ENDIF
448 ENDIF
449 ENDDO
450 ELSE
451 DO j=1,numeltg
452 i = index(j)
453 IF(sh3tree(3,i) == 0 .OR. sh3tree(3,i) == -1)THEN
454 ip = iparttg(i)
455 IF(ip == ipm)THEN
456!---
457 IF(flag == 0)THEN
458 kmass = mstg(i) / max(em20,partsav1_pon(ip))
459 ELSEIF(flag == 1)THEN
460 area_el = ele_area(i+numelc)
461 kmass = area_el / max(em20,part_area(ip))
462 ENDIF
463 mass = kmass * ipmas(igm)%PART(ii)%RPMAS
464!---
465 DO k=1,3
466 n = ixtg(k+1,i)
467 ms(n) = ms(n) + mass*ptg(k,i)
468 totaddmas = totaddmas + mass*ptg(k,i)
469 ENDDO
470 ENDIF
471 ENDIF
472 ENDDO
473 ENDIF
474 ENDIF
475 ENDDO
476 ENDDO
477C---
478 DO i=1,npart
479 IF(addedms(i) > zero) THEN
480 partsav(1,i) = partsav(1,i) + addedms(i)
481 partsav1_pon(i) = partsav1_pon(i) + addedms(i)
482 ENDIF
483 END DO
484C---
485 RETURN
486 END
487!||====================================================================
488!|| spmd_partsav_pon ../starter/source/elements/initia/spmd_msin_addmass.F
489!||--- called by ------------------------------------------------------
490!|| initia ../starter/source/elements/initia/initia.F
491!||--- calls -----------------------------------------------------
492!||====================================================================
493 SUBROUTINE spmd_partsav_pon(
494 1 IXS ,IXS10 ,IXS20 ,IXS16 ,IXQ ,
495 2 IXC ,IXT ,IXP ,IXR ,IXTG ,
496 3 MSS ,MSSX ,MSQ ,MSC ,
497 4 MST ,MSP ,MSR ,MSTG ,
498 5 INDEX ,ITRI ,GEO ,PARTSAV1_PON ,IPARTS ,
499 6 IPARTQ ,IPARTC ,IPARTT ,IPARTP ,IPARTR ,
500 7 IPARTTG,IPART )
501C-----------------------------------------------
502C I m p l i c i t T y p e s
503C-----------------------------------------------
504#include "implicit_f.inc"
505C-----------------------------------------------
506C C o m m o n B l o c k s
507C-----------------------------------------------
508#include "com04_c.inc"
509#include "param_c.inc"
510#include "scr17_c.inc"
511C-----------------------------------------------
512C D u m m y A r g u m e n t s
513C-----------------------------------------------
514 INTEGER IXS(NIXS,*),IXS10(6,*),IXS20(12,*),IXS16(8,*),
515 . IXQ(NIXQ,*),IXC(NIXC,*),IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),
516 . IXTG(6,*),INDEX(*), ITRI(*),
517 . IPARTS(*),IPARTQ(*),IPARTC(*),
518 . IPARTT(*),IPARTP(*),IPARTR(*),IPARTTG(*),
519 . IPART(LIPART1,*)
520C REAL
521 my_real
522 . MSS(8,*),MSSX(12,*),MSQ(*),MSC(*),MST(*),MSP(*),MSR(3,*),
523 . MSTG(*),GEO(NPROPG,*),PARTSAV1_PON(NPART)
524C
525 INTEGER IDEB
526C-----------------------------------------------
527C L o c a l V a r i a b l e s
528C-----------------------------------------------
529 INTEGER I, J, K, N, II, IGTYP, WORK(70000),IP,KAD,IGM,IPM,NMAS,
530 . FLAG
531C-----------------------------------------------
532C
533 partsav1_pon(1:npart)=zero
534C
535 DO i = 1, numels
536 itri(i) = ixs(11,i)
537 ENDDO
538C
539 CALL my_orders(0,work,itri,index,numels8,1)
540
541 ideb=numels8+1
542 CALL my_orders(0,work,itri(ideb),index(ideb),numels10,1)
543
544 DO j=1,numels10
545 index(ideb+j-1) = index(ideb+j-1)+numels8
546 ENDDO
547
548 ideb = ideb + numels10
549 CALL my_orders(0,work,itri(ideb),index(ideb),numels20,1)
550 DO j = 1, numels20
551 index(ideb+j-1) = index(ideb+j-1)+numels8+numels10
552 ENDDO
553
554 ideb = ideb + numels20
555 CALL my_orders(0,work,itri(ideb),index(ideb),numels16,1)
556 DO j = 1, numels16
557 index(ideb+j-1) = index(ideb+j-1)+numels8+numels10+numels20
558 ENDDO
559C
560 DO j=1,numels
561 i = index(j)
562 ip = iparts(i)
563 DO k=1,8
564 partsav1_pon(ip)=partsav1_pon(ip)+mss(k,i)
565 ENDDO
566 ENDDO
567
568C NUMELS10
569 IF(numels10>0) THEN
570 DO j=1,numels10
571 i = index(numels8+j)
572 ip = iparts(i)
573 DO k=1,6
574 partsav1_pon(ip)=partsav1_pon(ip)+mssx(k,i)
575 ENDDO
576 ENDDO
577 ENDIF
578C NUMELS20
579 IF(numels20>0)THEN
580 DO j=1,numels20
581 i = index(numels8+numels10+j)
582 ip = iparts(i)
583 DO k=1,12
584 partsav1_pon(ip)=partsav1_pon(ip)+mssx(k,i)
585 ENDDO
586 ENDDO
587 ENDIF
588C NUMELS16
589 IF(numels16>0)THEN
590 DO j=1,numels16
591 i = index(numels8+numels10+numels20+j)
592 ip = iparts(i)
593 DO k=1,8
594 partsav1_pon(ip)=partsav1_pon(ip)+mssx(k,i)
595 ENDDO
596 ENDDO
597 ENDIF
598
599C NUMELQ
600 DO i = 1, numelq
601 itri(i) = ixq(7,i)
602 ENDDO
603 CALL my_orders(0,work,itri,index,numelq,1)
604C
605 DO j=1,numelq
606 i = index(j)
607 ip = ipartq(i)
608 partsav1_pon(ip)=partsav1_pon(ip)+ four * msq(i)
609 ENDDO
610
611C NUMELC
612 DO i = 1, numelc
613 itri(i) = ixc(7,i)
614 ENDDO
615 CALL my_orders(0,work,itri,index,numelc,1)
616C
617 DO j=1,numelc
618 i=index(j)
619 ip=ipartc(i)
620 partsav1_pon(ip)=partsav1_pon(ip)+ four * msc(i)
621 ENDDO
622
623C NUMELT
624 DO i = 1, numelt
625 itri(i) = ixt(5,i)
626 ENDDO
627 CALL my_orders(0,work,itri,index,numelt,1)
628C
629 DO j=1,numelt
630 i=index(j)
631 ip=ipartt(i)
632 partsav1_pon(ip)=partsav1_pon(ip)+ two * mst(i)
633 ENDDO
634
635C NUMELP
636 DO i = 1, numelp
637 itri(i) = ixp(6,i)
638 ENDDO
639 CALL my_orders(0,work,itri,index,numelp,1)
640C
641 DO j=1,numelp
642 i=index(j)
643 ip=ipartp(i)
644 partsav1_pon(ip)=partsav1_pon(ip)+ two * msp(i)
645 ENDDO
646
647C NUMELR
648 DO i = 1, numelr
649 itri(i) = ixr(6,i)
650 ENDDO
651 CALL my_orders(0,work,itri,index,numelr,1)
652C
653 DO j=1,numelr
654 i=index(j)
655 ip=ipartr(i)
656 igtyp = nint(geo(12,ixr(1,i)))
657 IF(igtyp==12) THEN
658 k=3
659 ELSE
660 k=2
661 ENDIF
662 DO ii=1,k
663 partsav1_pon(ip)=partsav1_pon(ip)+msr(ii,i)
664 ENDDO
665 ENDDO
666
667C NUMELTG
668 DO i = 1, numeltg
669 itri(i) = ixtg(6,i)
670 ENDDO
671 CALL my_orders(0,work,itri,index,numeltg,1)
672C
673 DO j=1,numeltg
674 i=index(j)
675 ip=iparttg(i)
676 partsav1_pon(ip)=partsav1_pon(ip)+mstg(i)
677 ENDDO
678C---
679 RETURN
680 END
initia
subroutine initia(iparg, elbuf, ms, in, v, x, ixs, ixq, ixc, ixt, ixp, ixr, detonators, geo, pm, rby, npby, lpby, npc, npts, pld, veul, ale_connectivity, skew, fill, ipart, itab, sensors, skvol, ixtg, thk, nloc_dmg, group_param_tab, glob_therm, igrnod, igrsurf, bufsf, vr, bufmat, xlas, las, dtelem, mss, msq, msc, mst, msp, msr, mstg, ptg, inc, nod2eltg, knod2eltg, inp, inr, intg, index, itri, kxx, ixx, xelemwa, iwa, nod2elq, knod2elq, nod2els, knod2els, kxsp, ixsp, nod2sp, ispcond, icode, iskew, iskn, ispsym, xframe, isptag, spbuf, mssx, nsigi, npbyl, lpbyl, rbyl, msnf, mssf, nsigsh, igeo, ipm, nsigs, nsigsph, vns, vnsx, stc, stt, stp, str, sttg, stur, bns, bnsx, volnod, bvolnod, etnod, nshnod, stifint, fxbdep, fxbvit, fxbacc, fxbipm, fxbrpm, fxbelm, fxbsig, fxbmod, ins, ptshel, ptsh3n, ptsol, ptquad, wma, ptsph, fxbnod, mbufel, mdepl, fxani, numel, nsigrs, sh4tree, sh3tree, mcp, temp, imerge2, iadmerge2, slnrbm, nslnrbm, rmstifn, rmstifr, ms_layer, zi_layer, itag, itagel, mcpc, mcptg, xrefc, xreftg, xrefs, mssa, msrt, irbe2, lrbe2, inivol, kvol, nbsubmat, ixs10, ixs16, ixs20, totaddmas, ipmas, stifn, msz2, itagn, sitage, itage, ixr_kj, elbuf_tab, nom_opt, ptr_nopt_rbe2, ptr_nopt_adm, ptr_nopt_fun, sol2sph, irst, sh3trim, xfem_tab, kxig3d, ixig3d, msig3d, knot, nctrlmax, wige, stack, rnoise, drape, sh4ang, sh3ang, geo_stack, igeo_stack, stifintr, strc, strp, strr, strtg, perturb, itagnd, nativ_sms, iloadp, facload, ptspri, nsigbeam, ptbeam, nsigtruss, pttruss, multi_fvm, sigi, sigsh, sigsp, sigsph, sigrs, sigbeam, sigtruss, strsglob, straglob, orthoglob, isigsh, iyldini, ksigsh3, fail_ini, iusolyld, iuser, iddlevel, inimap1d, inimap2d, func2d, fvm_inivel, tagprt_sms, igrbric, igrquad, igrsh4n, igrsh3n, igrpart, totmas, knotlocpc, knotlocel, vnige, bnige, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxb_matrix, fxb_matrix_add, fxb_last_adress, ptr_nopt_fxb, r_skew, knod2el1d, nod2el1d, ebcs_tab, rby_iniaxis, alea, knod2elc, nod2elc, dr, slrbody, drapeg, ipari, intbuf_tab, interfaces, mat_param, npreload_a, preload_a, fail_fractal, fail_brokmann, defaults, ndamp_freq_range, dampr, ibeam_vector, rbeam_vector, ikine)
Definition initia.F:188
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:501
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
starter
program starter
Definition starter.F:39