-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathSELECT.F
99 lines (85 loc) · 2.93 KB
/
SELECT.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
SUBROUTINE SELECT(IN, VEN, JSLT, MAGE)
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
COMMON /GAIN/ GW1, GW23, GSRT, GFIN1, GFIN2, GSOWM, GSOWL, SDP, SSOWM, SSOWL
COMMON /BRED2/ ABNORG, GESM, GESS, GMIN, GMAX, ESTM, ESTS, EMIN, EMAX
COMMON /BRED4/ KBRD, KSWGT(4), NONB(4)
COMMON /CULL/ NGLTS, MXSRV, MXAGS, PCULG, PCULS, PSSR, PRGT, MXBOR, LDP
COMMON /RPT3/ MJEV, ISALS, IFARS, IBRDS
DIMENSION IN(3, 1), VEN(2, 1)
C AGE .GT. 208 DAYS IS NEVER SELECTED, OLDEST SELECTED FIRST.
C -JSLT- =NO. DESIRED, -MAGE- = MINUM AGE CRITERIA.
KSLT = JSLT
NAGE = MAGE
NH4 = NH(4)
TWT = 0
KAGE = 0
NUM = 0
C CHECK FEASIBILITY.
IF(NH4 .LT. 1) GO TO 1308
IF(KSLT .LT. 1) GO TO 1308
C LOOP TO SELECT GILTS.
DO 1010 KI = 1,NH4
CALL REMOV(IN, VEN, N3 + 1)
IAT1 = IATRIB(1)
J = IATRIB(2)
IF(J .NE. 2) GO TO 1008
IF(IAT1 .LT. NAGE) GO TO 1008
IF(IAT1 .LT. 209) GO TO 1018
1008 CALL FILEM(IN, VEN, 7)
GO TO 1010
1018 IATRIB(8) = 0
C ESTRUS=99 MEANS ABNORMAL, OTHERWISE SOURCE IS RNORM.
RN = RANUM(0)
IF(ABNORG-RN) 1103, 1103, 1101
1101 IATRIB(10) = 99
C SET AGE FOR AUTOMATIC CULL IN LDP DAYS.
IATRIB(1) = MXAGS - LDP
GO TO 1109
1103 IATRIB(10) = RNORM(ESTM, ESTS, EMIN, EMAX)
RIA10 = IATRIB(10)
IATRIB(4) = RANUM(0) * RIA10
1109 IATRIB(11) = 0
ATRIB(2) = RNORM(GSOWM, SSOWM, -5.0, 10.0)
KAGE = KAGE + IAT1
TWT = TWT + ATRIB(1)
NUM = NUM + 1
CALL FILEM(IN, VEN, 6)
IF(NUM .GE. KSLT) GO TO 1012
1010 CONTINUE
1012 RNUM = NUM
AGE = KAGE
AGE = AGE / RNUM
TWT = TWT / RNUM
IF(IBRDS) 1308, 1308, 1049
1049 WRITE(ND, 1050) KSLT, NUM, NOWT, AGE, TWT
1050 FORMAT(//5X'SELECTION OF GILT REPLACEMENTS WITH A TARGET OF'I4' RESULTED IN'I4' MOVED TO THE MAINTENANCE BUILDING ON DAY'I6/20X' AVERAGE AGE='F6.0', AVERAGE WT.='F8.1' POUNDS'/)
C BREEDING SEASONAL REPORT PART 1 FOR NO. ANIMALS AVAIL.
C THIS CALL TO SELECT IS BEGINNING OF SEASON.
1308 KBRD = 0
DO 1319 I = 1,3
NONB(I) = 0
1319 KSWGT(I) = 0
NONB(4) = -999
C COUNT KSWGT(1)= OPEN GILTS, KSWGT(2)=OPEN SOWS, KSWGT(3)=
C ALL OTHERS IN MAINT. BLD., ESWGT(4)=NOWT
KSWGT(4) = NOWT
NH3 = NH(3)
IF(NH3) 1378, 1378, 1321
1321 DO 1341 I = 1,NH3
CALL REMOV(IN, VEN, N2 + 1)
IF(IATRIB(3)-2) 1325, 1323, 1329
1323 IF(IATRIB(1)-365) 1325, 1337, 1337
1325 KSWGT(1) = KSWGT(1) + 1
GO TO 1327
1337 KSWGT(2) = KSWGT(2) + 1
GO TO 1327
1329 KSWGT(3) = KSWGT(3) + 1
1327 CALL FILEM(IN, VEN, 6)
1341 CONTINUE
RETURN
1378 WRITE(ND, 1309) NH(4), NOWT, KSLT, NAGE
1309 FORMAT(//' SELECT INFEASIBLE, HOUSE 7 HAS'I5' HOGS AT NOWT='I6' REQUESTED KSLT='I3' MIN AGE='I3)
RETURN
END