35
36
37
41
42
43
44#include "implicit_f.inc"
45
46
47
48#include "scr17_c.inc"
49#include "com04_c.inc"
50#include "param_c.inc"
51
52
53
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
58
59
60
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
64
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
79
80 IF (itype == 4) THEN
81 msp = zero
82 amas = zero
83 DO ii = 1,nmas
84 ip = ipmas(i)%PARTID(ii)
85 msp = msp + partsav_pon(ip)
86 amas = ipmas(i)%PART(ii)%RPMAS
87 ENDDO
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
93 ENDDO
94 ELSE
96 . msgtype=msgerror,
97 . anmode=anstop,
98 . i1=id_mass,
99 . c1=ipmas(i)%TITLE,
100 . r1=msp-amas)
101 ENDIF
102 ELSEIF (itype == 7) THEN
103 DO ii = 1,nmas
104 ip = ipmas(i)%PARTID(ii)
105 msp = partsav_pon(ip)
106 amas = ipmas(i)%PART(ii)%RPMAS
107 IF (amas > msp) THEN
108 addmas = amas - msp
109 ipmas(i)%PART(ii)%RPMAS = addmas
110 ELSE
111 ipa = ipart(4,ip)
113 . msgtype=msgerror,
114 . anmode=anstop,
115 . i1=id_mass,
116 . c1=ipmas(i)%TITLE,
117 . r1=msp-amas,
118 . i2=ipa)
119 ENDIF
120 ENDDO
121 ENDIF
122
123
124
125 DO ii = 1,nmas
126 ip = ipmas(i)%PARTID(ii)
127 msp = partsav_pon(ip)
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)
134 amas = ipmas(i)%PART(ii)%RPMAS
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
143
144 addedms(ip) = addedms(ip) + ipmas(i)%PART(ii)%RPMAS
145
146 ENDDO
147
148 10 CONTINUE
149
150 RETURN
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)