-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathFILEM.F
96 lines (81 loc) · 3.13 KB
/
FILEM.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
SUBROUTINE FILEM(IN, VEN, JJ)
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
COMMON /KRS/ KRS1, KRS2, KRS3
DIMENSION IN(3, 1), VEN(2, 1)
JH = JJ
C ITOT= TOTAL NUMBER, AND NH()= NUMBER IN EACH HOUSE FILE, INCREMENTED.
C JH IMPLIES THE J HOUSE=J FILE OF COLUMNS IN ARRAYS IN, VEN.
C PLACES ATTRIBUTES IATRIB(4) AND ATRIB(2) INTO JH FILES OF IN AND VEN
C ATRIB(I)-1=IAGE,2=JSEX,3=KLAS,4=LTAL,5=MNUM,6=LCC,7=PEN NO.,
C 8=SOW NO. (OR NO. OF PIGS)
C ATRIB(I) -1=WT
C IATRIB AND ATRIB ARE ZEROED BEFORE RETURN.
NTOT = 0
DO 13 IK = 1,6
13 NTOT = NTOT + NH(IK)
IF(NTOT .NE. ITOT) WRITE(ND, 1301) JH, (NH(KI), KI = 1,6), ITOT
1301 FORMAT(' ERROR FILE, ITOT .NE. TOTAL IN FILES, JH='I2' NH()='6I6' ITOT='I7)
JH = JH - 3
IF(JH .LT. 1 .OR. JH .GT. 6) GO TO 99
NH(JH) = NH(JH) + 1
JNH = NH(JH)
C INCREMENT TOTAL FILE SIZE ITOT AND LOAD AT END OF JH FILE.
C JNH NOW HOLDS THE TOTAL NUMBER IF FILE=NH(JH), AFTER INSERTION.
ITOT = ITOT + 1
C OVERLOAD PROTECTION FOR IN(), VEN() FILE STORAGE.
IF(ITOT-KRS3) 400, 400, 1387
400 IATRIB(6) = JH + 3
C PROVIDE FILE SPACE AT JNH OF FILE JH BY PUSHING ONE COLUMNS
IF(JH-2) 1, 2, 303
1 NP = ITOT - NH(1)
GO TO 704
2 NP = ITOT - NH(1) - NH(2)
GO TO 704
303 IF(JH-4) 3, 4, 505
3 NP = ITOT - NH(1) - NH(2) - NH(3)
GO TO 704
4 NP = ITOT - NH(1) - NH(2) - NH(3) - NH(4)
GO TO 704
505 IF(JH-6) 5, 6, 99
5 NP = ITOT - NH(1) - NH(2) - NH(3) - NH(4) - NH(5)
GO TO 704
6 NP = 0
GO TO 504
704 DO 410 K = 1,NP
DO 402 I = 1,3
402 IN(I, ITOT - K + 1) = IN(I, ITOT - K)
DO 403, II = 1,2
403 VEN(II, ITOT - K + 1) = VEN(II, ITOT - K)
410 CONTINUE
C PLACE ATTRIBUTES IN FILE SPACE PROVIDED BY PUSHING, COLUMN=ITOT-NP
C MTP: HAD TO DO SOME MULTIPLICATION HERE, OR FACE BIG INTEGER ERRORS
504 IN(1, ITOT - NP) = IATRIB(1) * (1000000000 * 10) + IATRIB(2) * 1000000000 + IATRIB(3) * 100000000 + IATRIB(4) * 100000 + IATRIB(5)
IN(2, ITOT - NP) = IATRIB(6) * (1000000000 * 10000) + IATRIB(7) * (1000000000 * 100) + IATRIB(8) * 1000000 + IATRIB(9)
IN(3, ITOT - NP) = IATRIB(10) * (1000000000 * 1000) + IATRIB(11) * 1000000 + IATRIB(12)
VEN(1, ITOT - NP) = ATRIB(1)
VEN(2, ITOT - NP) = ATRIB(2)
C MTP: REMOVED PRESUMABLY UNUSED LABEL 888 HERE
DO 88 IK = 1,12
88 IATRIB(IK) = 0
DO 89 IKK = 1,4
89 ATRIB(IKK) = 0.0
N1 = NH(1)
N2 = N1 + NH(2)
N3 = N2 + NH(3)
N4 = N3 + NH(4)
N5 = N4 + NH(5)
N6 = N5 + NH(6)
RETURN
99 JH = JH + 3
WRITE(ND, 98) JH, NOWT
98 FORMAT(' ERROR FILEM, JH REQUESTED HOUSE='I4' ,NOWT='I8)
WRITE(ND, 1399) (IATRIB(I), I = 1,12)
1399 FORMAT(4X'IATRIB(1-12)='12I7)
CALL OUT(IN, VEN, 1, ITOT, 161399.9)
RETURN
1387 WRITE(NW, 1389) KRS3, NOW5, ITOT
1389 FORMAT(1H2/////' ANIMALS TOTAL IS GREATER THAN THE DIMENSIONED SIZE OF IN(3,I),VEN(2,I) WHERE I='I8/' PROGRAM STOP AT DAY='I5', TOTAL ANIMALS='I10)
STOP
END