-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathOPEN_NDAT.F
220 lines (194 loc) · 6.46 KB
/
OPEN_NDAT.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
SUBROUTINE OPEN_NDAT(IN, VEN)
COMMON /INIT/ NR, NW, ND, NT7, NT8, NDAT, NS1, NS2
COMMON /STAT/ SUM(5, 20), SUM2(5, 10), SUM3(5, 10), SUM4(5, 10)
COMMON /GEN/ ITOT, ISIZE, NOWT, NOWY, NDAYS, NRUNS, IATRIB(18), ATRIB(4)
COMMON /HOUSE/ NH(6), N1, N2, N3, N4, N5, N6
COMMON /CLEAN/ DUM(5), KL4
COMMON /BIRTH/ BRNM, BRNS, BMIN, BMAX, BWTM, BWTS, BWMIN, BWMAX, NOBRN
COMMON /BRED2/ ABNORG, GESM, GESS, GMIN, GMAX, ESTM, ESTS, EMIN, EMAX
COMMON /GAIN/ GW1, GW23, GSRT, GFIN1, GFIN2, GSOWM, GSOWL, SDP, SSOWM, SSOWL
COMMON /GAIN2/ SOP(6), HOP(6), SSLD(6), HSLD(6), SEND(6), HEND(6)
COMMON /SALES/ DUMMY(15), PRIH, PRIS
DIMENSION IN(3,1),VEN(2,1)
C READ IN BASIC HERD DATA FROM TAPE NDAT
C BASE HERD IS 30 SOW AND 219 FINISHING HOGS.,
C SOWS ARE READY TO FARROW, HOGS ARE 5.5-6.0 MONTHS.
C CREATE OPENING INVENTORY FOR 6 FARROWING SYSTEM, AT T=0.
C -ADJUST ATTRIBUTES TO T=0 FOR SOWS AN FINISHING, CREATE
C BABY PIGS FOR HERD GROUP NUMBER THREE.
C - ADJUSTMENTS FOR 3 HERD GROUPS TO FARROW BEGINNING-
C HERD 1 JANUARY 15(T=15), AND JULY 15(T=196)
C HERD 2 MARCH 1(T=60), AND SEPTEMBER 1(T=244)
C HERD 3 JUNE 1(T=152), AND DECEMBER 1(T=335)
C
C LET ITOT= TOTAL NUMBER OF ANIMALS AT ANY TIME DURING SIMULATION
C LET ISIZE= NO. OF SOWS IN EACH HERD GROUP CREATED.
C ATTRIBUTES ARE CONTROL PARAMETER DEPENDENT.
SIZE = ISIZE
IFIN = SIZE * (BRNM * 0.78) + 0.5
C LOOP 3 HERDS, ID=1 IMPLIES SOW ADJUSTMENT, ID=2 FINISHING.
DO 9999 IHERD = 1,3
REWIND NDAT
ID = 1
550 READ(NDAT, 500) IAGE, JSEX, KLAS, LTAL, LOCA, MNUM, WT
500 FORMAT(I4, I1, I1, I3, I3, I6, 7X, F5.0)
IF(IAGE .NE. 6666) GO TO 449
REWIND NDAT
GO TO 550
449 IF(IAGE .NE. 7777) GO TO 551
REWIND NDAT
DO 776 KI = 1,31
776 READ(NDAT, 6666)
GO TO 550
551 IF(LOCA .GT. 10) LOCA = LOCA / 100
GO TO (1001, 2001, 3001) IHERD
C HERD 1, ADJUST BACK 15 DAYS
1001 IF (ID .EQ. 2) GO TO 1031
LTAL = LTAL - 15
WT = WT - 12.0
131 IAGE = IAGE - 15
MNUM = ITOT + 1 + 10000
3 IATRIB(1) = IAGE
IATRIB(2) = JSEX
IATRIB(3) = KLAS
IATRIB(4) = LTAL
IATRIB(5) = MNUM
ATRIB(1) = WT
ATRIB(2) = G
CALL FILEM(IN, VEN, LOCA)
IF(IHERD .EQ. 2) GO TO 550
IF(NH(3) .GE. ISIZE .AND. ID .EQ. 1) GO TO 77
IF(NHOGS .GE. IFIN) GO TO 9999
GO TO 550
1031 NHOGS = NHOGS + 1
IF(IAGE-149) 1032, 1032, 1033
1032 G = RNORM(GFIN1, GFIN1 * SDP, -5.0, 10.0)
GO TO 131
1033 G = RNORM(GFIN2, GFIN2 * SDP, -5.0, 10.0)
GO TO 131
C HERD I, ADJUST BACK 60 DAYS
2001 IF(ID .EQ. 2) GO TO 2031
IH2 = IH2 + 1
IF(IH2 .GT. ISIZE) GO TO 77
LTAL = LTAL - 60
WT = WT - 48.0
231 IAGE = IAGE - 60
MNUM = ITOT + 1 + 20000
G = RNORM(GFIN1, GFIN1 * SDP, -5.0, 10.0)
GO TO 3
2031 NHOGS = NHOGS + 1
IF(NHOGS .GT. IFIN) GO TO 9999
WT = WT - 107.1
GO TO 231
C HERD 3, ADD 30 DAYS TO AGE, CREATE BABY PIGS FOR EACH SOW
3001 DO 333 II = 1,ISIZE
IAGE = IAGE + 30
KLAS = KLAS + 1
LTAL = 30 + LTAL - 114
LOCA = LOCA - 2
WT = WT - 0.8 * LTAL
MNUM = ITOT + 1 + 30000
NOSOW = MNUM
AGE = IAGE + GESM
C ADJUST NO. PIGS FOR AGE SOW, DEVIATION OF MEAN -BRNM- FROM 10 INTERCE
C ASSUME NO SOWS OVER 1300 DAYS IN OPENING INVENTORY.
V = BRNM - 10.0
BR = V + 5.867 + 0.01 * AGE -.00000446 * AGE ** 2.0
IPIGS = RNORM(BR, BRNS, BMIN, BMAX) + 0.5
IATRIB(1) = IAGE
IATRIB(2) = JSEX
IATRIB(3) = KLAS
IATRIB(4) = LTAL
IATRIB(5) = MNUM
IATRIB(8) = IPIGS
ATRIB(1) = WT
CALL FILEM(IN, VEN, LOCA)
C CREATE BABY PIGS FOR SOW II LOOP
DO 380 IK = 1,IPIGS
IAGE = LTAL
C MTP: THIS LINE USED TO JUST HAVE 101,102 AFTER THE IF
C CHANGED BECAUSE IT WAS AN APPARENT QUIRK OF CDC FORTRAN IV
IF(RANUM(0) .GT. 0.5) THEN
JSEX = 2
KLAS = 1
ELSE
JSEX = 3
KLAS = 0
ENDIF
C CALCULATE WEIGHT BY BIRTH WT. + .5 LB. DAY, STD=3.6
BTWT = RNORM(BWTM, BWTS, BWMIN, BWMAX)
WT = BTWT + RNORM(0.5 * IAGE, 3.6, 5.0, 25.0)
MNUM = ITOT + 1 + 30000
IBT = BTWT * 100.0
IATRIB(1) = IAGE
IATRIB(2) = JSEX
IATRIB(3) = KLAS
IATRIB(5) = MNUM
IATRIB(8) = NOSOW
IATRIB(11) = IBT
ATRIB(1) = WT
CALL FILEM(IN, VEN, 4)
380 CONTINUE
381 READ(NDAT, 500) IAGE, JSEX, KLAS, LTAL, LOCA, MNUM, WT
IF(IAGE .NE. 6666) GO TO 331
REWIND NDAT
GO TO 381
331 LOCA = LOCA / 100
333 CONTINUE
GO TO 9999
C DUMMY READ SKIPS SOW DATA RECORDS
77 READ(NDAT, 6666) NSTOP
6666 FORMAT(I4)
IF(NSTOP .EQ. 6666) GO TO 6667
GO TO 77
6667 ID = 2
NHOGS = 0
IH2 = 0
GO TO 550
C SET FARROWING HOUSE LITTER COUNT KL4.
9999 KL4 = ISIZE
C ADD ESTRUS CYCLES TO OPENING INVENTORY SOWS IN PRODUCTION.
LNH4 = NH(1)
DO 678 K4 = 1,LNH4
CALL REMOV(IN, VEN, 1)
IF(IATRIB(1)-21) 673, 673, 671
C MTP: LABEL 623 ISN'T USED. MAYBE SHOULD BE IN IF STATEMENT ABOVE?
623 ATRIB(2) = RNORM(GW23, GW23 * SDP, -5.0, 10.0)
GO TO 678
671 IF(IATRIB(1)-200) 673, 673, 675
673 ATRIB(2) = RNORM(GSRT, GSRT * SDP, -5.0, 10.0)
GO TO 678
675 IATRIB(10) = RNORM(ESTM, ESTS, EMIN, EMAX) + 0.5
ATRIB(2) = RNORM(GSOWL, SSOWL, -5.0, 10.0)
678 CALL FILEM(IN, VEN, 4)
LNH6 = NH(3)
DO 567 K6 = 1,LNH6
CALL REMOV(IN, VEN, N2 + 1)
A = IATRIB(1)
C = BRNM - 10.0
BR = C + 5.867 + 0.01 * A - 0.00000446 * A ** 2.0
IATRIB(8) = RNORM(BR, BRNS, BMIN, BMAX) + 0.5
IATRIB(10) = RNORM(ESTM, ESTS, EMIN, EMAX) + 0.5
IATRIB(11) = RNORM(GESM, GESS, GMIN, GMAX) + 0.5
ATRIB(2) = RNORM(GSOWM, SSOWM, -5.0, 10.0)
567 CALL FILEM(IN, VEN, 6)
C OPENING INVENTORY WEIGHTS AND VALUE
C SOWS AND HOGS COUNT AND WT. ONLY.
C ARRAYS GAIN2- 1=NO., 2=WT., 3=VALUE OF WT.
DO 7009 I = 1,ITOT
C MTP: DID SOME MULTIPLICATION HERE TO AVOID INTEGER SIZE LIMIT
ICHK = IN(I, 1) / (1000000000 * 10)
IF(ICHK-240) 7001, 7005, 7005
C HOGS AND PIGS .LT. 240 DAYS OF AGE.
7001 HOP(1) = HOP(1) + 1.0
HOP(2) = HOP(2) + VEN(1, I)
HOP(3) = HOP(3) + VEN(1, I) * PRIH / 100.0
GO TO 7009
C OVER 240 DAYS OF AGE.
7005 SOP(1) = SOP(1) + 1.0
SOP(2) = SOP(2) + VEN(1, I)
SOP(3) = SOP(3) + VEN(1, I) * PRIS / 100.0
7009 CONTINUE
IF(NS1 .EQ. 13) CALL OUT(IN, VEN, 1, ITOT, 131313.9)
RETURN
END