-
Notifications
You must be signed in to change notification settings - Fork 8
/
Copy path12.FOR
176 lines (160 loc) · 4.25 KB
/
12.FOR
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
* MODULE 12
SUBROUTINE INITIA
IMPLICIT INTEGER(A-Z)
REAL RAN,C1
INTEGER X(70),Z6,D(300)
COMMON/X/X
COMMON/MAP/MAPS(2574),D,KLIP
DO 10 I=1,6000
P=D1F(I)
CALL CHANGE(I,P,1)
IF(P#'*') GOTO 10
N1=INT(RAN(C1)*70.+1.)
DO 100 N3=N1,N1+70
N=N3; IF(N>70) N=N-70
100 IF(X(N)==0) GOTO 101
101 X(N)=I
10 CONTINUE
RETURN
END
SUBROUTINE CHANGE(Z6,TYPE,MAP)
IMPLICIT INTEGER(A-Z)
LOGICAL PASS
COMMON/PASS/PASS
D IF((Z6>=1).AND.(Z6<=6000)) GOTO 100
D IF(PASS) TYPE 1598,Z6
D1598 FORMAT(' CHANGE, Z6=',G)
D RETURN
100 CALL CHAMAP(Z6,TYPE,MAP)
RETURN
END
INTEGER FUNCTION A(MAP,Z6)
IMPLICIT INTEGER(A-Z)
LOGICAL PASS
COMMON/PASS/PASS
D IF((Z6>=1).AND.(Z6<=6000)) GOTO 100
D IF(PASS) TYPE 1598,Z6
D1598 FORMAT(1X,/,' A(MAP,Z6), Z6=',G)
D A='+'
D RETURN
100 A=AMAPP(MAP,Z6)
RETURN
END
INTEGER FUNCTION D1(Z6)
IMPLICIT INTEGER(A-Z)
LOGICAL PASS
C INTEGER ASCII(0:2),D(0:299),Z6,ZEE6
COMMON/PASS/PASS
C COMMON/MAP/MAPS(2574),D,KLIP
C DATA ASCII/'.','+','*'/
C ZEE6=Z6-1
*REMOVED FEATURE: IF(KLIP==1) ZEE6=ZEE6+99-2*MOD(ZEE6,100)
D IF((Z6>=1).AND.(Z6<=6000)) GOTO 100
D IF(PASS) TYPE 1598,Z6
D D1='+'
D1598 FORMAT(' D1(Z6), Z6=',G)
D RETURN
C 100 IP=3**MOD(ZEE6,20)
C D1=ASCII(MOD(D(ZEE6/20),IP*3)/IP)
100 D1=D1F(Z6) !REPLACEMENT MACRO ROUTINE
RETURN
END
INTEGER FUNCTION MYCODE(IB)
LOGICAL PASS
COMMON/MYCOD/MYCOD2(750)
COMMON/PASS/PASS
D IF((IB>=1).AND.(IB<=1500)) GOTO 200
D IF(PASS) TYPE 1598,IB
D1598 FORMAT(' MYCODE(Y); Y=',G)
D MYCODE=0
D RETURN
200 ITMP1=(IB+1)/2
IX=MYCOD2(ITMP1)
ITMP2=IB-ITMP1*2
IF(ITMP2==0) GOTO 100
MYCODE=IX/10000
RETURN
100 MYCODE=IX-IX/10000*10000
RETURN
END
SUBROUTINE CMYCOD(IB,NEW)
LOGICAL PASS
COMMON /MYCOD/MYCOD2(750)
COMMON/PASS/PASS
D IF((IB>=1).AND.(IB<=1500).AND.(NEW>=0).AND.(NEW<=9999))
D & GOTO 101
D IF(PASS) TYPE 1598,IB,NEW
D1598 FORMAT(' CMYCOD(IB,NEW):',2G)
D RETURN
101 ITMP1=(IB+1)/2
IX=MYCOD2(ITMP1)
ITMP2=IB-ITMP1*2
IF(ITMP2==0) GOTO 100
MYCOD2(ITMP1)=IX-IX/10000*10000+NEW*10000
RETURN
100 MYCOD2(ITMP1)=IX/10000*10000+NEW
RETURN
END
INTEGER FUNCTION S(IB)
LOGICAL PASS
INTEGER SMAC
COMMON/PASS/PASS
COMMON /LOCS/LOCS(1200)
D IF((IB>=1).AND.(IB<=3000)) GOTO 101
D IF(PASS) TYPE 100,IB
D 100 FORMAT(' S: NUMBER=',G)
D S=0
D RETURN
101 S=SMAC(IB,LOCS)
D IF((S<0).OR.(S>6000)) TYPE 200, S
D 200 FORMAT(' S: LOC RETURNED='G)
RETURN
END
INTEGER FUNCTION H(IB)
LOGICAL PASS
COMMON/PASS/PASS
COMMON /J1TS/J1TS(178)
J=IB
D IF((J>=1).AND.(J<=1600)) GOTO 100
D IF(PASS) TYPE 1598,J
D1598 FORMAT(' H(IB), IB=',G)
D H=1
D RETURN
100 IX=(J+8)/9
IY=MOD(J-1,9)
IY=13^IY
H=MOD(J1TS(IX),IY*13)/IY
RETURN
END
SUBROUTINE CHITS(IB,NEW)
* PACKS HITS FROM 178 WORD ARRAY, WORDS ARE PACKED IN BASE 12
* J1TS IS THE ARRAY, IX IS WHICH ELEMENT IN THE ARRAY, IY IS THE
* POSITION OF THE DATA IN THE ARRAY ELEMENT
LOGICAL PASS
COMMON/PASS/PASS
COMMON /J1TS/J1TS(178)
J=IB
D IF((J>=1).AND.(J<=6000).AND.(NEW>=0).AND.(NEW<=12))
D & GOTO 100
D IF(PASS) TYPE 1598, IB, NEW
D1598 FORMAT(' CHITS(IB,NEW):',2G)
D RETURN
100 IX=(J+8)/9
IY=MOD(J-1,9)
IY=13^IY
J1TS(IX)=NEW*IY+J1TS(IX)/(13*IY)*13*IY
&+MOD(J1TS(IX),IY)
RETURN
END
SUBROUTINE CHAS(IB,NEW)
LOGICAL PASS
COMMON/PASS/PASS
COMMON/LOCS/LOCS(1200)
D IF((IB>=1).AND.(IB<=3000).AND.(NEW>=0).AND.(NEW<=6000))
D & GOTO 100
D IF(PASS) TYPE 1598,IB,NEW
D1598 FORMAT(' CHAS(IB,NEW):',2G)
D RETURN
100 CALL CHSMAC(IB,LOCS,NEW)
RETURN
END