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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
|
SUBROUTINE GSCALE(TEST, OTHER, ASTART, A1, L1, A2, A3, IFAULT)
C
C ALGORITHM AS 93 APPL. STATIST. (1976) VOL.25, NO.1
C
C FROM THE SIZES OF TWO SAMPLES THE DISTRIBUTION OF THE
C ANSARI-BRADLEY TEST FOR SCALE IS GENERATED IN ARRAY A1.
C
REAL ASTART, A1(L1), A2(L1), A3(L1), AI, ONE, FPOINT
INTEGER TEST, OTHER
LOGICAL SYMM
DATA ONE /1.0/
C
C TYPE CONVERSION (EFFECT DEPENDS ON TYPE STATEMENT ABOVE).
C
FPOINT(I) = I
C
C CHECK PROBLEM SIZE AND DEFINE BASE VALUE OF THE DISTRIBUTION.
C
M = MIN0(TEST, OTHER)
IFAULT = 2
IF (M. LT. 0) RETURN
ASTART = FPOINT((TEST + 1) / 2) * FPOINT(1 + TEST / 2)
N = MAX0(TEST, OTHER)
C
C CHECK SIZE OF RESULT ARRAY.
C
IFAULT = 1
LRES = 1 + (M * N) / 2
IF (L1 .LT. LRES) RETURN
SYMM = MOD(M + N, 2) .EQ. 0
C
C TREAT SMALL SAMPLES SEPARATELY.
C
MM1 = M - 1
IF (M .GT. 2) GOTO 5
C
C START-UP PROCEDURES ONLY NEEDED.
C
IF (MM1) 1, 2, 3
C
C ONE SAMPLE ONLY.
C
1 A1(1) = ONE
GOTO 15
C
C SMALLER SAMPLE SIZE = 1.
C
2 CALL START1(N, A1, L1, LN1)
GOTO 4
C
C SMALLER SAMPLE SIZE = 2.
C
3 CALL START2(N, A1, L1, LN1)
C
C RETURN IF A1 IS NOT IN REVERSE ORDER.
C
4 IF (SYMM .OR. (OTHER .GT. TEST)) GOTO 15
GOTO 13
C
C FULL GENERATOR NEEDED
C SET UP INITIAL CONDITIONS (DEPENDS ON MOD(N, 2)).
C
5 NM1 = N - 1
NM2 = N - 2
MNOW = 3
NC = 3
IF (MOD(N, 2) .EQ. 1) GOTO 6
C SET UP FOR EVEN N.
C
N2B1 = 3
N2B2 = 2
CALL START2(N, A1, L1, LN1)
CALL START2(NM2, A3, L1, LN3)
CALL START1(NM1, A2, L1, LN2)
GOTO 8
C
C SET UP FOR ODD N.
C
6 N2B1 = 2
N2B2 = 3
CALL START1(N, A1, L1, LN1)
CALL START2(NM1, A2, L1, LN2)
C
C INCREASE ORDER OF DISTRIBUTION IN A1 BY 2
C (USING A2 AND IMPLYING A3).
C
7 CALL FRQADD(A1, LN1, L1OUT, L1, A2, LN2, N2B1)
LN1 = LN1 + N
CALL IMPLY(A1, L1OUT, LN1, A3, LN3, L1, NC)
NC = NC + 1
IF (MNOW .EQ. M) GOTO 9
MNOW = MNOW + 1
C
C INCREASE ORDER OF DISTRIBUTION IN A2 BY 2 (USING A3).
C
8 CALL FRQADD(A2, LN2, L2OUT, L1, A3, LN3, N2B2)
LN2 = LN2 + NM1
CALL IMPLY(A2, L2OUT, LN2, A3, J, L1, NC)
NC = NC + 1
IF (MNOW .EQ. M) GOTO 9
MNOW = MNOW + 1
GOTO 7
C
C IF SYMMETRICAL, RESULTS IN A1 ARE COMPLETE.
C
9 IF (SYMM) GOTO 15
C
C FOR A SKEW RESULT ADD A2 (OFFSET) INTO A1.
C
KS = (M + 3) / 2
J = 1
DO 12 I = KS, LRES
IF (I .GT. LN1) GOTO 10
A1(I) = A1(I) + A2(J)
GOTO 11
10 A1(I) = A2(J)
11 J = J + 1
12 CONTINUE
C
C DISTRIBUTION IN A1 POSSIBLY IN REVERSE ORDER.
C
IF (OTHER .LT. TEST) GOTO 15
C
C REVERSE THE RESULTS IN A1.
C
13 J = LRES
NDO = LRES / 2
DO 14 I = 1, NDO
AI = A1(I)
A1(I) =A1(J)
A1(J) = AI
J = J - 1
14 CONTINUE
C
C FINAL RESULTS NOW IN A1.
C
15 IFAULT = 0
RETURN
END
SUBROUTINE START1(N, F, L, LOUT)
C
C ALGORITHM AS 93.1 APPL. STATIST. (1976) VOL.25, NO.1
C
C GENERATES A 1,N ANSARI-BRADLEY DISTRIBUTION IN F.
C
REAL F(L), ONE, TWO
DATA ONE, TWO /1.0, 2.0/
LOUT = 1 + N / 2
DO 1 I = 1, LOUT
1 F(I) = TWO
IF (MOD(N, 2) .EQ. 0) F(LOUT) = ONE
RETURN
END
C
SUBROUTINE START2(N, F, L, LOUT)
C
C ALGORITHM AS 93.2 APPL. STATIST. (1976) VOL.25, NO.1
C
C GENERATES A 2,N ANSARI-BRADLEY DISTRIBUTION IN F.
C
REAL F(L), ONE, TWO, THREE, FOUR
DATA ONE, TWO, THREE, FOUR /1.0, 2.0, 3.0, 4.0/
C
C DERIVE F FOR 2, NU, WHERE NU IS HIGHEST EVEN INTEGER
C LESS THAN OR EQUAL TO N.
C DEFINE NU AND ARRAY LIMITS.
C
NU = N - MOD(N, 2)
J = NU + 1
LOUT = J
LT1 = LOUT + 1
NDO = LT1 / 2
A = ONE
B = THREE
C
C GENERATE THE SYMMETRICAL 2,NU DISTRIBUTION.
C
DO 1 I = 1, NDO
F(I) = A
F(J) = A
J = J - 1
A = A + B
B = FOUR - B
1 CONTINUE
IF (NU .EQ. N) RETURN
C
C ADD AN OFFSET 1,N DISTRIBUTION INTO F TO GIVE 2,N RESULT.
C
NU = NDO + 1
DO 2 I = NU, LOUT
2 F(I) = F(I) + TWO
F(LT1) = TWO
LOUT = LT1
RETURN
END
C
SUBROUTINE FRQADD(F1, L1IN, L1OUT, L1, F2, L2, NSTART)
C
C ALGORITHM AS 93.3 APPL. STATIST. (1976) VOL.25, NO.1
C
C ARRAY F1 HAS TWICE THE CONTENTS OF ARRAY F2 ADDED INTO IT
C STARTING WITH ELEMENTS NSTART AND 1 IN F1 AND F2 RESPECTIVELY.
C
REAL F1(L1), F2(L2), MUL2
DATA MUL2 /2.0/
I2 = 1
DO 1 I1 = NSTART, L1IN
F1(I1) = F1(I1) + MUL2 * F2(I2)
I2 = I2 + 1
1 CONTINUE
NXT = L1IN + 1
L1OUT = L2 + NSTART - 1
DO 2 I1 = NXT, L1OUT
F1(I1) = MUL2 * F2(I2)
I2 = I2 + 1
2 CONTINUE
NSTART = NSTART + 1
RETURN
END
C
SUBROUTINE IMPLY(F1, L1IN, L1OUT, F2, L2, L2MAX, NOFF)
C
C ALGORITHM AS 93.4 APPL. STATIST. (1976) VOL.25, NO.1
C
C GIVEN L1IN ELEMENTS OF AN ARRAY F1, A SYMMETRICAL
C ARRAY F2 IS DERIVED AND ADDED ONTO F1, LEAVING THE
C FIRST NOFF ELEMENTS OF F1 UNCHANGED AND GIVING A
C SYMMETRICAL RESULT OF L1OUT ELEMENTS IN F1.
C
REAL F1(L1OUT), F2(L2MAX), SUM, DIFF
C
C SET-UP SUBSCRIPTS AND LOOP COUNTER.
C
I2 = 1 - NOFF
J1 = L1OUT
J2 = L1OUT - NOFF
L2 = J2
J2MIN = (J2 + 1) / 2
NDO = (L1OUT + 1) / 2
C
C DERIVE AND IMPLY NEW VALUES FROM OUTSIDE INWARDS.
C
DO 6 I1 = 1, NDO
C
C GET NEW F1 VALUE FROM SUM OF L/H ELEMENTS OF
C F1 + F2 (IF F2 IS IN RANGE).
C
IF (I2 .GT. 0) GOTO 1
SUM = F1(I1)
GOTO 2
1 SUM = F1(I1) + F2(I2)
C
C REVISE LEFT ELEMENT OF F1.
C
F1(I1) = SUM
C
C IF F2 NOT COMPLETE IMPLY AND ASSIGN F2 VALUES
C AND REVISE SUBSCRIPTS.
C
2 I2 = I2 + 1
IF (J2 .LT. J2MIN) GOTO 5
IF (J1 .LE. L1IN) GOTO 3
DIFF = SUM
GOTO 4
3 DIFF = SUM - F1(J1)
4 F2(I1) = DIFF
F2(J2) = DIFF
J2 = J2 - 1
C
C ASSIGN R/H ELEMENT OF F1 AND REVISE SUBSCRIPT.
C
5 F1(J1) = SUM
J1 = J1 - 1
6 CONTINUE
RETURN
END
|
