-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathFIND.F
140 lines (126 loc) · 3.79 KB
/
FIND.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
SUBROUTINE FIND(NXVA, MXCOD, J, JAT, KCO, IN, VEN)
C LOCATES THE COLUMN CALLED KCOL IN FILE JH.
C DESIGNATE AN MXCODE RELATIONSHIP TO VALUE XVAR FROM-
C FOLLOWING OPTIONS, .LT. 10= FOR IATRIB(), .GT. 10 FOR ATRIB().
C MXCODE=1,11 MAX GREATER THAN XVAL
C 2,12 MIN GREATER THAN XVAR
C 3,13 MAX LESS THAN XVAR
C 4,14 MIN LESS THAN XVAR
C 5,15 VALUE EQULA TO XVAL
C 6,16 FIRST FIND GREATER THAN XVAL
C 7,17 FIRST FIND LESS THAN XVAL
C JATT IS THE ATTRIBUTE NUMBER I IN IATRIB(I) OR ATRIB(I).
C KCOL IS THE COLUMN NUMBER OF THE LOCATED ENTRY, SEE P. 70 GASPII.
DIMENSION IN(3, 1), VEN(2, 1), IA(18)
COMMON /INIT/ NR, NW, ND, NT7, NT8, NDAT, NS1, NS2
COMMON /HOUSE/ NH(6), N1, N2, N3, N4, N5, N6
EQUIVALENCE(NVAL, XVA)
NVAL = NXVA
MXCODE = MXCOD
JH = J - 3
JATT = JAT
KCOL = KCO
C HANDLE INTEGERS OF IATRIB HERE, REAL IN SECTION GO TO NO. 1000.
C BEST CANDIDATE COLUMN IS KBEST.
KBEST = 0
C NEXT TO CONSIDER IS NEXTK
NHH = 0
DO 500 KK = 1,JH
500 NHH = NHH + NH(KK)
NH1 = NHH - NH(JH) + 1
NEXTK = NH1
IF(NH(JH) .LE. 0) GO TO 160
IF(MXCODE .GT. 10) GO TO 1000
IF(NEXTK) 160, 10, 2
10 KCO = KBEST
RETURN
C MTP: HAD TO DO SOME MULTIPLICATIONS TO GET AROUND THE INTEGER SIZE LIMIT HERE
2 GO TO (1, 102, 3, 104, 5, 106, 7, 8, 109, 110, 111, 112) JATT
1 IA(1) = IN(1, NEXTK) / (1000000000*10)
GO TO 21
102 IA(2) = MOD(IN(1, NEXT) / 1000000000, 10)
GO TO 21
3 IA(3) = MOD(IN(1, NEXTK) / 100000000, 10)
GO TO 21
104 IA(4) = MOD(IN(1, NEXTK) / 100000, 1000)
GO TO 21
5 IA(5) = MOD(IN(1, NEXTK), 100000)
GO TO 21
106 IA(6) = IN(2, NEXTK) / (1000000000 * 10000)
GO TO 21
7 IA(7) = MOD(IN(2, NEXTK) / (1000000000 * 100), 100)
GO TO 21
8 IA(8) = MOD(IN(2, NEXTK) / 1000000, 100000)
GO TO 21
109 IA(9) = MOD(IN(2, NEXTK), 1000000)
GO TO 21
110 IA(10) = IN(3, NEXTK) / (1000000000 * 1000)
GO TO 21
111 IA(11) = MOD(IN(3, NEXTK) / 1000000, 1000000)
GO TO 21
112 IA(12) = MOD(IN(3, NEXTK), 1000000)
GO TO 21
21 GO TO (11, 12, 13, 14, 11, 16, 17) MXCODE
11 MGRNV = 1
NMAMN = 1
GO TO 20
12 MGRNV = 1
NMAMN = -1
GO TO 20
13 MGRNV = -1
NMAMN = 1
GO TO 20
14 MGRNV = -1
NMAMN = -1
GO TO 20
16 IF(IA(JATT) .GT. NVAL) GO TO 15
166 NEXTK = NEXTK + 1
IF(NEXTK-NHH) 2, 2, 666
666 KCO = 0
GO TO 160
17 IF(IA(JATT) .LT. NVAL) GO TO 15
GO TO 166
20 IF(MGRNV * (IA(JATT) - NVAL)) 4, 201, 66
C WHEN EQUALITY OBTAINED, TEST FOR MXCODE=5
201 IF(MXCODE-5) 4, 15, 4
66 IF(MXCODE-5) 6, 4, 6
6 IF(KBEST) 160, 80, 70
70 IF(NMAMN * (IA(JATT) - KBHLD)) 4, 4, 80
80 KBEST = NEXTK
KBHLD = IA(JATT)
4 NEXTK = NEXTK + 1
IF(NEXTK-NHH) 2, 10, 10
15 KCO = NEXTK
RETURN
160 WRITE(ND, 1305) KBEST, NEXTK, MXCODE, JH, JATT, KCOL, NHH
1305 FORMAT(' ERROR FIND, KBEST='I8' NEXTK='I8' PARMS='5I8)
C REAL COMPARISONS FOR THE ARRAY VEN()
RETURN
1000 XVAL = XVA
MXCODE = MXCODE - 10
GO TO (1100, 1200, 1300, 1400, 1100, 1600, 1700) MXCODE
1100 RNV = 1.0
AMN = 1.0
GO TO 2000
1200 RNV = 1.0
AMN = -1.0
GO TO 2000
1300 RNV = -1.0
AMN = 1.0
GO TO 2000
1400 RNV = -1.0
AMN = -1.0
2000 IF(RNV * (VEN(JATT, NEXTK) - XVAL)) 400, 2100, 6600
2100 IF(MXCODE-5) 400, 15, 400
6600 IF(MXCODE-5) 600, 400, 600
600 IF(KBEST) 1600, 800, 700
700 IF(AMN * (VEN(JATT, NEXTK) - VEN(JATT, KBEST))) 400, 400, 800
800 KBEST = NEXTK
400 NEXTK = NEXTK + 1
IF(NEXTK-NHH) 2000, 10, 10
1600 IF(VEN(JATT, NEXTK) .GT. XVAL) GO TO 15
1660 NEXTK = NEXTK + 1
IF(NEXTK-NHH) 1600, 1600, 666
1700 IF(VEN(JATT, NEXTK) .LT. XVAL) GO TO 15
GO TO 1660
END