-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathMGT3.F
286 lines (248 loc) · 8.92 KB
/
MGT3.F
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
SUBROUTINE MGT3(IN, VEN)
COMMON /INIT/ NR, NW, ND, NT7, NT8, NDAT, NS1, NS2
COMMON /GEN/ ITOT, ISIZE, NOWT, NOWY, NDAYS, NRUNS, IATRIB(18), ATRIB(4)
COMMON /HOUSE/ NH(6), N1, N2, N3, N4, N5, N6, NXTFAR, MX1, MX2, MX3, MX4, X1, X2, X4
COMMON /SURVIV/ DUMY(7), MDEAD(8)
COMMON /BIRTH/ DUM(8), NOBRN
COMMON /SALES/ MDSELL, WTS, NXTSAL, NSLD(4), WTSLD(4), VSLD(4), PRIH, PRIS
COMMON /MG3/ NHH(6), MDEADH(8), NHP(6), MDP(6), KCALL, KPRET, KNSLD4, KPREB
COMMON /CLEAN/ NDPREV, NH4CLN, LOSSL, SWTLP, SSLP, KL4
COMMON /SCH/ K2(2, 500), IPT, IEVT, KODE, IWE, IWN(45), NKT
COMMON /BRED/ LBREED, NBREED, IFAR(6, 5), IDB(30), KAGEW, LGTHW, NAGEM
COMMON /COST/ FCS, FCB, CLAB, TFAR, TNUR, TSOW, TFIN, VAR(3), COST(30)
COMMON /RPT4/ IDCS, IDCE, IDCN, IDCF, IDCM, IDCB, IDCFS, IDCFP, IOFLW
COMMON /CULL/ NGLTS, MXSRV, MXAGS, PCULG, PCULS, PSSR, PRGT, MXBOR
COMMON /GAIN/GW1, GW23, GSRT, GFIN1, GFIN2, GSOWM, GSOWL, SDP, SSOWM, SSOWL
COMMON /STAT/ SUM(5, 20), SUM2(5, 10), SUM3(5, 10), SUM4(5, 10), SUM5(5, 10)
DIMENSION IN(3, 1), VEN(2, 1)
C KRS1 SWITCH IS SET=1 IN SUB. MGT IF HAS BEEN CHANGE IN INV.
C CALCULATE DIFFERENCES
NSLD4 = NSLD(4) - KNSLD4
NOBR = NOBRN - KPREB
DO 4 K = 1,5
NHP(K) = NH(K) - NHH(K)
4 MDP(K) = MDEAD(K + 3) - MDEADH(K + 3)
GO TO 789
500 WRITE(ND, 510) NOBR, NOBRN
510 FORMAT(27X'PIGS BORN'13X'='I9,I21/)
WRITE(ND, 512) (MDP(J), MDEAD(J + 3), J = 1,5)
512 FORMAT(27X'FARROWING BLD. DEATHS ='I9,I21/27X'NURSERY BLD. DEATHS ='I9,I21/27X'SOW MAINT. BLD. DEATHS='I9,I21/27X'FINISHING BLD. DEATHS ='I9,I21/27X'BOAR DEATHS'11X'='I9,I21)
WRITE(ND, 515) NSLD4, NSLD(4)
515 FORMAT(/27X'SALES OF BUTCHERS ='I9,I21)
GO TO 1271
789 KNSLD4 = NSLD(4)
KPREB = NOBRN
KPRET = NOWT
DO 7 I = 1,6
7 NHH(I) = NH(I)
DO 8 II = 1,8
8 MDEADH(II) = MDEAD(II)
IF(NOWT-IDCS) 2000, 1201, 1201
1201 IF(NOWT-IDCE) 1203, 1203, 2000
C WRITE CONSECUTIVE DAILY INVENTORY BY BUILDING IF REQUESTED
1203 WRITE(ND, 1205) NOWT, ITOT
1205 FORMAT(/////5X'DAILY INVENTORY ON DAY='I5' TOTAL ANIMALS='I6/5X,95(1H=))
IF(IDCN) 1213, 1213, 1207
C NURSERY INFORMATION.
1207 NH2 = NH(2)
IF(NH2) 1213, 1213, 1209
1209 WT = 0.0
NN1 = N1 + 1
DO 1210 I = NN1,N2
1210 WT = WT + VEN(1, I)
AWT = WT / NH2
WRITE(ND, 1212) NH2, AWT
1212 FORMAT(/6X'NURSERY HAS'I6' PIGS AT'F5.1' LBS. AVE. WT.')
C FINISHING BLD.
1213 IF(IDCF) 1219, 1219, 1215
1215 NH4 = NH(4)
IF(NH4) 1219, 1219, 1216
1216 WT = 0.0
NN1 = N3 + 1
DO 1217 I = NN1,N4
1217 WT = WT + VEN(1, I)
AWT = WT / NH4
WRITE(ND, 1218) NH4, AWT
1218 FORMAT(/6X'FINISHING HAS'I6' PIGS AT'F7.1' LBS. AVE. WT.')
C MAINTENANCE BUILDING + CULL PEN FOR SALE.
1219 IF(IDCM) 1227, 1227, 1221
1221 NH3 = NH(3)
IF(NH3) 1227, 1227, 1223
1223 LNONO = 0
LOPEN = 0
LPREG = 0
DO 1225 I = 1,NH3
CALL REMOV(IN, VEN, N2 + 1)
IF(IATRIB(3) - 2) 1231, 1232, 1233
1231 LNONO = LNONO + 1
GO TO 1225
1232 LOPEN = LOPEN + 1
GO TO 1225
1233 LPREG = LPREG + 1
1225 CALL FILEM(IN, VEN, 6)
WRITE(ND, 1226) NH3, LNONO, LOPEN, LPREG, NH(6)
1226 FORMAT(/6X'MAINTENANCE HAS'I5' TOTAL SOWS CLASSED AS FOLLOWS-'/10X'NON-OVULATING='I3', OPEN='I3', IN GESTATION='I3/10X'IN ADDITION'I4' SOWS AWAIT SALE IN THE CULL PEN')
1227 IF(IDCB) 1241, 1241, 1228
1228 NH5 = NH(5)
IF(NH5) 1241, 1241, 1229
1229 WRITE(ND, 1230) NH5
1230 FORMAT(/6X'BOARS TOTAL= 'I3)
C FARROWING BLD. KL4= NO SOWS IN FARROWING HOUSE.
1241 IF(IDCFS) 1261, 1261, 1243
1243 IF(N1) 1261, 1261, 1245
1245 LPIGS = N1 - KL4
WRITE(ND, 1247) N1, KL4, LPIGS
1247 FORMAT(/6X'FARROWING HAS'I4' TOTAL WHERE SOWS='I3', PIGS='I4)
C SALES, BIRTHS, MORTALITY MISC.
1261 IF(IDCFP) 1271, 1271, 1263
1263 WRITE(ND, 1265)
1265 FORMAT(/6X'BIRTHS, DEATHS, SALES MISC.'/50X'CHANGE='10X'TOTAL TO DATE=')
C USE STATEMENTS ABOVE.
GO TO 500
1271 WRITE(ND, 1273)
1273 FORMAT(/5X'END DAILY INVENTORY REPORT'69(1H=))
2000 CONTINUE
C OVERFLOW CHECKING AND REPORTING
C FARROWING HOUSE CHECKED IN SUB. FAROW.
C
C NURSERY SEND OVERFLOW TO FINISHING.
C IF FINISHING IS FULL, NURSERY MAY BE OVERSTOCKED UP TO MX2*X2
C NURSERY PIGS ARE MOVED BY S. UPDATE AT OPTION AGE.
C CAPACITY CALCULATION FOR PERCENT OCCUPANCY=SUM4( ,1)
RNH = NH(2)
RMX = MX2
CALL COLLECT(SUM4, 1, RNH / RMX * 100.0)
NI5 = NH(2)
C IF FINISHING HAS ROOM APPLY MX2, ELSE MX2*X2
IF(NH(4) - MX4) 251, 251, 253
251 MFLOW = NI5 - MX2
GO TO 255
253 RNI5 = NI5
MFLOW = RNI5 - RMX * X2
255 IF(MFLOW) 300, 300, 201
201 II = 0
DO 203 I = 1,MFLOW
205 CALL REMOV(IN, VEN, N1 + 1)
IF(IATRIB(1)-22) 211, 215, 215
211 CALL FILEM(IN, VEN, 5)
GO TO 203
215 CALL FILEM(IN, VEN, 7)
II = II + 1
203 CONTINUE
IF(IOFLOW) 300, 300, 291
291 WRITE(ND, 292) NOWT, II
292 FORMAT(/3X'NURSERY OVERFLOW DAY='I5', 'I4'PIGS MOVED TO FINISHING')
C MAINTENANCE OVERFLOW CHECK AND REPORTED ONLY.
C CAPACITY CALCULATION MAINT., SUB4(, 3)
300 RNH = NH(3)
RMX = MX3
CALL COLLECT(SUM4, 3, RNH / RMX * 100.0)
MFLOW = NH(3) - MX3
IF(MFLOW) 308, 308, 303
303 IF(IOFLW) 308, 308, 333
333 WRITE(ND, 304) MFLOW, NOWT
304 FORMAT(/3X'MAINTENANCE OVERFLOW BY'I4' SOWS, DAY='I5)
C FINISHING -FIRST NORMAL SALE, IF NOT SATISFIED DROP MIN. WEIGHT
C BY 10 LBS. AND SELL MORE UNTIL WITHIN MX4.
C MX4 OVERFLOW REPORTED, BUT FORCE SELL ONLY AT MX4*X4
C CAPACITY CALCULATION- FINISHING, SUM4(, 2)
308 RNH = NH(4)
RMX = MX4
CALL COLLECT(SUM4, 2, RNH / RMX * 100.0)
SAVWTS = WTS
KISTOP7 = ISTOP7
CHG = 0.0
LFLOW = RNH - RMX * X4
C MX4 IS DESIGN CAPACITY, X4 IS OVERFLOW FACTOR ALLOWED,
C FORCED SALE TAKES PLACE ONLY IF MX4*X4 IS EXCEEDED.
401 IF(LFLOW) 408, 408, 403
403 WTS = WTS - CHG
IF(WTS .LT. 191.0) GO TO 407
CALL SELL(IN, VEN)
RNH4 = NH(4)
LFLOW = RNH4 - RMX * X4
MFLOW = NH(4) - MX4
IF(IOFLW) 400, 400, 418
418 WRITE(ND,419) WTS, MFLOW, NOWT
419 FORMAT(/3X'FINISHING OVERFLOW SALE AT MINIMUM WEIGHT='F5.0' REDUCED OVERFLOW TO'I4' AT DAY='I5)
400 CHG = 10.0
GO TO 401
407 WRITE(ND, 406) NOWT, NH(4), MX4, X4
406 FORMAT(/5X'FINISHING HOUSE OVERFLOW SALES CURTAILED AT 190 LBS. MINIMUM TO ALLOW HOG GROWTH.'/10X'DAY='I5' BLD. HAS'I6' ANIMALS WITH CAPACITY='I6' OVERFLOW FACTOR='F5.2)
408 WTS = SAVWTS
ISTOP7 = KISTOP7
C CAPACITY CALCULATION, FARROWING CRATES, OVERFLOW DONE IN FARROW.
RNH = KL4
RMX = MX1
CALL COLLECT(SUM4, 4, RNH / RMX * 100.0)
C WEANING, FOLLOW NO. WEAN IN IWN(NKT).
C SCHEDULE MADE IN SUB. EVENTS.
C DAILY WEANING DONE HERE.
C SEASON ENDS WITH CLEANING DAY, SUB. CLEAN4
IF(IWE-1) 5000, 4000, 5000
C WEAN DURING WEANING SEASON OF LGTHW DAYS.
4000 NKT = NKT + 1
IF(NKT .GT. 45) GO TO 5000
C NKT=CURRENT DAY OF SEASON, IWN(NKT)= NO. TO WEAN.
IF(NKT) 4013, 4013, 4002
4002 NWN = IWN(NKT)
IF(NWN) 5000, 5000, 4005
4005 DO 4100 I = 1,NWN
C FIND SOW AND REMOVE, THEN HER PIGS
C FIRST IN FIRST OUT ORDER.
CALL FIND(0, 1, 4, 4, KOL, IN, VEN)
IF(KOL) 4100, 4100, 4006
4006 CALL REMOV(IN, VEN, KOL)
IF(IATRIB(1)-200) 4013, 4013, 4008
4008 IATRIB(3) = 2
IATRIB(4) = IATRIB(10) / 3 * 2 + 2
IATRIB(8) = 0
IATRIB(11) = 0
NAME = IATRIB(5)
ATRIB(2) = RNORM(GSOWM, SSOWM, -5.0, 10.0)
C PROBABILITY CULLING HERE AND IN SUB. CLEAN4.
C PROB. PCULG FOR GILTS, PCULS FOR SOWS.
C IF CULLED PUT N FILE 9 FOR SALE AT NEXT SALE SCHEDULED.
RN = RANUM(0)
IF(IATRIB(1)-450) 4905, 4901, 4901
4901 PROB = PCULS
4903 IF(PROB-RN) 4909, 4909, 4908
4905 PROB = PCULG
GO TO 4903
C GET READY FOR NEXT SALE DATE NXSAL, GAIN AT MAINT. RATES.
4908 ISTIP = NXSAL - NOWT
SKIP = ISKIP
IATRIB(9) = IATRIB(9) + ISKIP
IATRIB(1) = IATRIB(1) + ISKIP
ATRIB(I) = ATRIB(1) + SKIP * RNORM(GSOWM, SSOWM, -5.0, 10.0)
CALL FILEM(IN, VEN, 9)
GO TO 4018
4909 CALL FILEM(IN, VEN, 6)
C LOOK FOR ABOVE SOWS LITTER.
4018 KCO = 0
CALL FIND(NAME, 5, 4, 8, KCO, IN, VEN)
IF(KCO) 4100, 4100, 4009
4009 CALL REMOV(IN, VEN, KCO)
IF(IATRIB(1)-200) 4011, 4100, 4100
4011 CALL FILEM(IN, VEN, 5)
GO TO 4018
4100 CONTINUE
GO TO 5000
C DIAGNOSTIC WRITE.
4013 WRITE(ND, 4014) NKT, IATRIB(1), NOWT
4014 FORMAT(/5X'SUBROUTINE MGT3 ERROR, NKT='I5' AGE='I5' AT DAY='I5)
5000 CONTINUE
C GATHER SOW DAYS IN MAINTENANCE AND LDBR MINUTES HERE.
C COST(1)=SOW DAYS, (2)=FARROW BLD. MIN, (3)=NURSERY BLD. MIN,
C (4)=MAINT. BLD. MIN., (5)=FINISHING BLD.MIN.
C REPORT WRITER IS IN SUB. REPT2.
C SOWS INCLUDE CULLS IN CULL PEN (IGNORES BOARS)
RNH = KL4
COST(1) = COST(1) + RNH + NH(3) + NH(6)
C LABOUR IN MINUTES
COST(2) = COST(2) + RNH * TFAR
COST(3) = COST(3) + NH(2) * TNUR
COST(4) = COST(4) + (NH(3) + NH(6)) * TSOW
COST(5) = COST(5) + NH(4) * TFIN
RETURN
END