OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
addmaspart.F File Reference
#include "implicit_f.inc"
#include "scr17_c.inc"
#include "com04_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine addmaspart (ipart, ipmas, partsav, part_area, pm, addedms, nom_opt, partsav_pon)

Function/Subroutine Documentation

◆ addmaspart()

subroutine addmaspart ( integer, dimension(lipart1,*) ipart,
type (admas_), dimension(nodmas) ipmas,
partsav,
part_area,
pm,
addedms,
integer, dimension(lnopt1,*) nom_opt,
partsav_pon )

Definition at line 33 of file addmaspart.F.

35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE message_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "scr17_c.inc"
49#include "com04_c.inc"
50#include "param_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER IPART(LIPART1,*)
55 my_real partsav(20,*),partsav_pon(*),part_area(*),pm(npropm,*),addedms(*)
56 INTEGER NOM_OPT(LNOPT1,*)
57 TYPE (ADMAS_) , DIMENSION(NODMAS) :: IPMAS
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER I,ID_MASS,IPA,IP,NMAS,KAD,II,IMID,ITYPE,IFLAG
62 my_real amas,msp,masst(nodmas),ratio,addmas
63 CHARACTER(LEN=NCHARTITLE) :: TITR
64C=======================================================================
65!---
66 masst(1:nodmas) = zero
67!
68 DO 10 i=1,nodmas
69 id_mass = ipmas(i)%ID
70 nmas = ipmas(i)%NPART
71 itype= ipmas(i)%TYPE
72 iflag= ipmas(i)%WEIGHT_FLAG
73 IF (itype /= 3 .and. itype /= 4 .and.
74 . itype /= 6 .and. itype /= 7) GOTO 10
75!
76 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,i),ltitr)
77!
78! check for type 4 and 7 :
79! if AMAS (replacing mass) < MSP (structured mass of concerned parts or list of parts)
80 IF (itype == 4) THEN
81 msp = zero ! structured mass of liste of parts
82 amas = zero
83 DO ii = 1,nmas
84 ip = ipmas(i)%PARTID(ii)
85 msp = msp + partsav_pon(ip) ! structured mass (of list of parts)
86 amas = ipmas(i)%PART(ii)%RPMAS
87 ENDDO ! DO II = 1,NMAS
88 IF (amas > msp) THEN
89 addmas = amas - msp
90 DO ii =1,nmas
91 ip = ipmas(i)%PARTID(ii)
92 ipmas(i)%PART(ii)%RPMAS = addmas ! non structural mass to be added (distributed)
93 ENDDO ! DO II = KAD
94 ELSE
95 CALL ancmsg(msgid=1576,
96 . msgtype=msgerror,
97 . anmode=anstop,
98 . i1=id_mass,
99 . c1=ipmas(i)%TITLE,
100 . r1=msp-amas)
101 ENDIF ! IF (AMAS > MSP)
102 ELSEIF (itype == 7) THEN
103 DO ii = 1,nmas
104 ip = ipmas(i)%PARTID(ii)
105 msp = partsav_pon(ip) ! structured mass of part
106 amas = ipmas(i)%PART(ii)%RPMAS ! non structural mass to be added (distributed)
107 IF (amas > msp) THEN
108 addmas = amas - msp
109 ipmas(i)%PART(ii)%RPMAS = addmas ! non structural mass to be added (distributed)
110 ELSE
111 ipa = ipart(4,ip)
112 CALL ancmsg(msgid=877,
113 . msgtype=msgerror,
114 . anmode=anstop,
115 . i1=id_mass,
116 . c1=ipmas(i)%TITLE,
117 . r1=msp-amas,
118 . i2=ipa)
119 ENDIF ! IF (AMAS > MSP)
120 ENDDO ! DO II = 1,NMAS
121 ENDIF ! IF (ITYPE)
122!
123! PART MASS DISTRIBUTION :
124!
125 DO ii = 1,nmas
126 ip = ipmas(i)%PARTID(ii)
127 msp = partsav_pon(ip) ! ---> mass tag of PART
128 masst(i) = masst(i) + msp
129 ENDDO
130!---
131 DO ii = 1,nmas
132 ip = ipmas(i)%PARTID(ii)
133 msp = partsav_pon(ip) ! structured mass part
134 amas = ipmas(i)%PART(ii)%RPMAS ! added mass part
135!---
136 IF (itype == 3 .OR. itype == 4) THEN
137 ratio = msp / masst(i)
138 amas = amas * ratio
139 ipmas(i)%PART(ii)%RPMAS = amas
140 ELSEIF (itype == 6 .OR. itype == 7) THEN
141 ipmas(i)%PART(ii)%RPMAS = amas
142 ENDIF ! IF (ITYPE)
143!---
144 addedms(ip) = addedms(ip) + ipmas(i)%PART(ii)%RPMAS
145!---
146 ENDDO ! DO II = 1,NMAS
147!---
148 10 CONTINUE
149!---
150 RETURN
#define my_real
Definition cppsort.cpp:32
integer, parameter nchartitle
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804