CLEAN4.F

      SUBROUTINE CLEAN4(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
      COMMON /CLEAN/ NDPREV, NH4CLN, LOSSL, SWTLP, SSLP, KL4
      COMMON /SCH/ DUMY(1000), IPT, IEVT, KODE, IWE, IWN(45), NKT
      COMMON /CULL/ NGLTS, MXSRV, MXAGS, PCULG, PCULS, PSSR, PRGT, MXBOR
      COMMON /SALES/ MDSELL, WTS, NXTSAL
      COMMON /GAIN/ GW1, GW23, GSRT, GFIN1, GFIN2, GSOWM, GSOWL, SDP, SSOWM, SSOWL
      COMMON /WRT1/ KW
      COMMON /RPT3/ MJEV, ISALS, IFARS, IBRDS

      TLTAL=0.0

      KS = 0
      KP = 0

C NS1 DIAGNOSTICS SWITCH.
      IF(NS1 .NE. 11) GO TO 1349
      WRITE(NT7, 1300) NOWT, NH(1)
1300  FORMAT(' ENTER CLEAN4 AT NOWT='I5' ,HOUSE4 HAS 'I5' ANIMALS')
      CALL OUT(IN, VEN, 1, N1, 11.2)

C CLEAN4 REMOVES ALL SOWS AND PIGS FROM HOUSE 4.
1349  MH = NH(1)
      IF(MH) 1399, 99, 50
50    DO 444 IM = 1,MH
      CALL REMOV(IN, VEN, 1)

C SORT FOR SOWS .GT. 199 DAYS, AND PIGS GO TO 5000
      IAGE = IATRIB(1)
      IF(IAGE .LT. 200) GO TO 5000

C SOWS
      KS = KS + 1

C SET TO OVULATE IN 4-6 DAYS AFTER WEANING.
      IATRIB(3) = 2
      IATRIB(4) = IATRIB(10) / 3 * 2 + 2
      IATRIB(8) = 0
      IATRIB(11) = 0
      ATRIB(2) = RNORM(GSOWM, SSOWM, -5.0, 10.0)

C FILE IN 6 OR IN 9 FOR SALE.
C PROB. CULL HERE AND SEE WEANING IN SUB. MGT3
C   FORM SOW AND GILT CULLING PATTERN
      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
4908  ISKIP = NXTSAL - NOWT
      SKIP = ISKIP
      IATRIB(9) = IATRIB(9) + ISKIP
      IATRIB(1) = IATRIB(1) + ISKIP
      ATRIB(1) = ATRIB(1) + SKIP * RNORM(GSOWM, SSOWM, -5.0, 10.0)
      CALL FILEM(IN, VEN, 9)
      GO TO 444
4909  CALL FILEM(IN, VEN, 6)
      GO TO 444

C PIGS MOVED TO HOUSE NO 5 I.E. FILE 5
5000  KP = KP + 1
      CALL FILEM(IN, VEN, 5)
444   CONTINUE

C SET CLEAN HOUSE FLAG -NH4CLN- =1
99    NH4CLN = 1

C KL4 I.E. LITTERS IN FARROWING HOUSE SET-0
      KL4 = 0

C IWE SET TO OFF, I.E.=2
      IWE = 2

C ISTOP4 SET UP TO ESTIMATED WEANING DATE.
      ISTOP4 = NOWT + NDPREV + KAGEW
      WRITE(ND, 1380) KS, KP, NOWT
1380  FORMAT(40X'NOTE(1) CLEANING MOVED'I4' SOWS, AND'I5' PIGS ON DAY='I6)


C FARROWING SEASON REPORTING CALL TO SUB. REPT1
C      STATS COLLECTED IN SUB. FARROW, REPORT VIA KW=2
      IF(IFARS) 999, 999, 200
200   KW = 2
      CALL REPT1(IN, VEN)
      KW = 0.0
999   RETURN
1399  WRITE(ND, 1398) NOWT, NH(1)
1398  FORMAT(3X'ERROR CLEAN4 AT NOWT='I5' NH(1)='I4)

      END