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
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
|
SUBROUTINE SORTI (INPFL,OUTFL,NWDS,KEYWRD,L,NX)
C
C WITH ENTRY POINT SORTI2 TO SORT TABLE BY 2 KEY WORDS
C
C THIS SORTING ROUTINE WAS CALLED SORT BEFORE, AND IS NOW RENAMED
C SORTI. IT IS CAPABLE FOR IN-CORE SORTING AND FILE SORT.
C
C THE NEW SUBROUTINE SORT IS A TRUNCATED VERSION OF THIS ROUTINE
C ONLY FOR IN-CORE SORTING. IT CAN HANDLE INTEGER, REAL, BCD(A4),
C BCD(A8), BCD(A7), AND 2-KEY SORTINGS.
C
C (95 PERCENT OF NASTRAN ROUTINES ACTUALLY CALL SORT. THE REMAINING
C 5 PERCENT CALL SORTI)
C
C IF INPFL AND OUTFL ARE ZERO, CALLING ROUTINE SHOULD CALL SORT
C FOR EFFICIENCY
C
C THE OLD SHUTTLE EXCHANGE, WHICH WAS VERY SLOW, IS NOW REPLACED BY
C A SUPER FAST SORTER, A MODIFIED SHELL SORT.
C
C THIS MODIFIED VERSION ALSO SORTS TABLE OF ANY LENGTH (PREVIOUSLY N
C OF WORDS PER ENTRY, NWDS, WAS LIMITED TO 20)
C
INTEGER OUTFL,SCRA,SCRB,SCRC,DIST1,DIST2,DUMMY,TOTAL,OUT,
1 SUBR(2),L(NWDS,2),TEMP,FILE,R,BUFA,BUFB,BUFC,
2 SYSBUF,BUFIN,TWO,TWO31
COMMON /SETUP / NFILE(6),BUFIN
COMMON /SYSTEM/ SYSBUF,DUM38(38),NBPW
COMMON /TWO / TWO(16)
EQUIVALENCE (NFILE(1),SCRB),(NFILE(2),SCRC),(NFILE(3),SCRA)
DATA SUBR / 4HSORT, 4HI /
C
KEY2 = 1
GO TO 10
C
C
ENTRY SORTI2 (INPFL,OUTFL,NWDS,KEYWRD,L,NX)
C ==========================================
C
KEY2 = 2
C
C IF INPFL EQ 0, CORE BLOCK L OF LENGTH NX IS TO BE SORTED
C IF INPFL NE 0, INPFL IS TO BE SORTED USING BLOCK L
C
10 KEYWD = IABS(KEYWRD)
NNN = NX
IF (NNN .LT. NWDS) GO TO 350
J = 30
IF (NBPW .GE. 60) J = 62
TWO31 = 2**J
IF (INPFL .EQ. 0) GO TO 30
BUFA = NX - SYSBUF + 1
C
C MINIMUM CORE REQUIREMENT = 2 X NUMBER OF WORDS PER ENTRY
C
NZ = BUFA - 1
IF (NZ .LT. NWDS+NWDS) GO TO 360
CALL OPEN (*370,SCRA,L(BUFA,1),1)
NN = (NZ/NWDS)*NWDS
NNN = NN
OUT = SCRA
NREC= 0
20 CALL READ (*430,*170,INPFL,L,NN,0,NNN)
C
C SORT PHASE --
C
30 LEN = NNN/NWDS
IF (LEN*NWDS .NE. NNN) GO TO 365
M = LEN
IF (KEYWRD .GE. 0) GO TO 40
C
C - INTEGER SORT ONLY -
C IF ORIGINAL ORDER IS TO BE MAINTAINED WHERE DUPLICATE KEYWORDS MAY
C OCCUR, ADD INDICES TO THE KEYWORDS (GOOD FOR BOTH POSITIVE AND
C NEGATIVE RANGES, AND BE SURE THAT KEYWORDS ARE NOT OVERFLOWED),
C SORT THE DATA, AND REMOVE THE INDICES LATER
C
C IF ANY KEYWORD OVERFLOWS, SWITCH TO SHUTTLE EXCHANGE METHOD
C LIMIT IS THE MAX VALUE BEFORE INTEGER OVERFLOW
C
IF (LEN.GE.TWO(16) .AND. NBPW.LE.32) GO TO 130
LIMIT = (TWO31-LEN)/LEN
DO 35 I = 1,LEN
J = L(KEYWD,I)
IF (IABS(J) .GT. LIMIT) GO TO 124
J = J*LEN + I
K = -1
IF (J .LT. 0) K = -LEN
35 L(KEYWD,I) = J + K
IF (KEY2 .EQ. 1) GO TO 40
DO 37 I = 1,LEN
J = L(KEYWD+1,I)
IF (IABS(J) .GT. LIMIT) GO TO 120
J = J*LEN + I
K = -1
IF (J .LT. 0) K = -LEN
37 L(KEYWD+1,I) = J + K
C
C SORT BY
C MODIFIED SHELL METHOD, A SUPER FAST SORTER
C
40 M = M/2
IF (M .EQ. 0) GO TO 110
J = 1
K = LEN - M
45 I = J
50 N = I + M
IF (L(KEYWD,I)-L(KEYWD,N)) 105, 60,95
60 IF (KEY2 .EQ. 1) GO TO 105
IF (L(KEYWD+1,I)-L(KEYWD+1,N)) 105,105,95
95 DO 100 R = 1,NWDS
TEMP = L(R,I)
L(R,I) = L(R,N)
100 L(R,N) = TEMP
I = I - M
IF (I .GE. 1) GO TO 50
105 J = J + 1
IF (J-K) 45,45,40
110 IF (KEYWRD .GE. 0) GO TO 160
DO 115 I = 1,LEN
L(KEYWD,I) = L(KEYWD,I)/LEN
IF (KEY2 .EQ. 2) L(KEYWD+1,I) = L(KEYWD+1,I)/LEN
115 CONTINUE
GO TO 160
C
C SORT BY
C SHUTTLE EXCHANGE METHOD, A SLOW SORTER
C (THIS WAS NASTRAN ORIGINAL SORTER, MODIFIED FOR 2-D ARRAY
C OPERATION WITH 20-COLUMN LIMITATION REMOVED)
C
120 IF (I .LE. 1) GO TO 123
J = I - 1
DO 121 I = 1,J
121 L(KEYWD+1,I) = L(KEYWD+1,I)/LEN
123 I = LEN
124 IF (I .LE. 1) GO TO 130
J = I - 1
DO 125 I = 1,J
125 L(KEYWD,I) = L(KEYWD,I)/LEN
C
130 DO 155 II = 2,LEN
JJ = II - 1
IF (L(KEYWD,II)-L(KEYWD,JJ)) 135,133,155
133 IF (KEY2 .EQ. 1) GO TO 155
IF (L(KEYWD+1,II) .GE. L(KEYWD+1,JJ)) GO TO 155
135 JJ = JJ - 1
IF (JJ .LE. 0) GO TO 140
IF (L(KEYWD,II)-L(KEYWD,JJ)) 135,137,140
137 IF (KEY2 .EQ. 2) IF (L(KEYWD+1,II)-L(KEYWD+1,JJ)) 135,140,140
140 JJ = JJ + 2
DO 150 I = 1,NWDS
TEMP = L(I,II)
M = II
DO 145 J = JJ,II
L(I,M) = L(I,M-1)
145 M = M - 1
150 L(I,JJ-1) = TEMP
155 CONTINUE
C
C IF CORE SORT, SORT IS COMPLETED. IF FILE SORT, WRITE BLOCK ON
C SCRATCH FILE TO BE MERGED LATER.
C
160 IF (INPFL .EQ. 0) GO TO 350
165 CALL WRITE (SCRA,L,NNN,1)
NREC = NREC + 1
IF (NNN-NN) 180,20,180
170 IF (NNN) 180,180,175
175 IF (NNN-NWDS-NWDS) 165,30,30
180 CALL CLOSE (SCRA,1)
C
C IF ONLY ONE RECORD, BYPASS MERGE
C
IF (NREC .EQ. 1) GO TO 320
C
C COMPUTE OPTIMUM DISTRIBUTION OF SORTED RECORDS ON TWO SCRATCH
C FILES FOR MERGE PHASE USING FIBONACCI SEQUENCE
C
LEVEL = 0
DIST1 = 1
DIST2 = 0
TOTAL = 1
190 DUMMY = TOTAL - NREC
IF (DUMMY .GE. 0) GO TO 195
DIST1 = DIST1 + DIST2
DIST2 = DIST1 - DIST2
TOTAL = DIST1 + DIST2
LEVEL = LEVEL + 1
GO TO 190
195 BUFB = BUFA - SYSBUF
BUFC = BUFB - SYSBUF
IF (BUFC .LT. 1) GO TO 360
NN = BUFB - 1
C
C COPY N SORTED RECORDS ONTO SECOND SCRATCH FILE
C
CALL OPEN (*370,SCRA,L(BUFA,1),0)
CALL OPEN (*380,SCRB,L(BUFB,1),1)
N = DIST2 - DUMMY
DO 205 I = 1,N
200 CALL READ (*440,*205,SCRA,L,NN,0,NFLAG)
CALL WRITE (SCRB,L,NN,0)
GO TO 200
205 CALL WRITE (SCRB,L,NFLAG,1)
CALL CLOSE (SCRB,1)
CALL CLOSE (SCRA,2)
NFILE(4) = SCRB
NFILE(5) = SCRC
K = 4
C
C MERGE PHASE ---
C INPUT FILE WITH GREATER NUMBER IF RECORDS = IN1
C INPUT FILE WITH LESSER NUMBER OF RECORDS = IN2
C EACH PASS MERGES ALL RECORDS FROM IN2 WITH LIKE NUMBER OF RECORDS
C (INCLUDING DUMMY RECORDS) FROM IN1 ONTO OUT. FOR NEXT PASS IN1
C BECOMES IN2, IN2 BECOMES OUT, AND OUT BECOMES IN1.
C
DO 310 I = 1,LEVEL
K = K - 1
IF (K .EQ. 0) K = 3
IN1 = NFILE(K)
IN2 = NFILE(K+1)
OUT = NFILE(K+2)
LAST= 2
CALL OPEN (*390,IN1,L(BUFA,1),2)
CALL OPEN (*400,IN2,L(BUFB,1),2)
CALL OPEN (*410,OUT,L(BUFC,1),1)
DO 300 J = 1,DIST2
IF1 = NWDS
IF2 = NWDS
CALL READ (*450,*275,IN1,L,NWDS,0,IF1)
IF (DUMMY) 210,210,280
210 CALL READ (*460,*290,IN2,L(1,2),NWDS,0,IF2)
220 IF (L(KEYWD,1)-L(KEYWD,2)) 260,230,270
230 IF (KEY2 .EQ. 2) IF (L(KEYWD+1,1)-L(KEYWD+1,2)) 260,260,270
260 CALL WRITE (OUT,L,NWDS,0)
CALL READ (*450,*275,IN1,L,NWDS,0,IF1)
IF (IF2) 260,260,220
270 CALL WRITE (OUT,L(1,2),NWDS,0)
CALL READ (*460,*290,IN2,L(1,2),NWDS,0,IF2)
IF (IF1) 270,270,220
275 IF (IF2) 300,300,270
280 DUMMY = DUMMY - 1
IF2 = 0
290 IF (IF1) 300,300,260
300 CALL WRITE (OUT,0,0,1)
DIST2 = DIST1 - DIST2
DIST1 = DIST1 - DIST2
IF (DIST2 .EQ. 0) LAST = 1
CALL CLOSE (IN1,LAST)
CALL CLOSE (IN2,1)
310 CALL CLOSE (OUT,1)
C
C COPY PHASE ---
C IF OUTPUT FILE IS NOT SPECIFIED, NFILE(6) WILL CONTAIN NAME OF
C SCRATCH FILE CONTAINING OUTPUT
C
320 NFILE(6) = OUT
IF (OUTFL .EQ. 0) GO TO 350
CALL OPEN (*410,OUT,L(BUFA,1),0)
IF (INPFL .NE. OUTFL) GO TO 330
CALL CLOSE (INPFL,1)
CALL OPEN (*420,INPFL,L(BUFIN,1),1)
330 CALL READ (*470,*340,OUT,L,NZ,0,NFLAG)
CALL WRITE (OUTFL,L,NZ,0)
GO TO 330
340 CALL WRITE (OUTFL,L,NFLAG,1)
CALL CLOSE (OUT,1)
350 RETURN
C
C ERRORS
C
360 J = -8
FILE = 0
GO TO 500
365 J = -37
GO TO 500
370 FILE = SCRA
GO TO 480
380 FILE = SCRB
GO TO 480
390 FILE = IN1
GO TO 480
400 FILE = IN2
GO TO 480
410 FILE = OUT
GO TO 480
420 FILE = INPFL
GO TO 480
430 FILE = INPFL
GO TO 490
440 FILE = SCRA
GO TO 490
450 FILE = IN1
GO TO 490
460 FILE = IN2
GO TO 490
470 FILE = OUT
GO TO 490
480 J = -1
GO TO 500
490 J = -2
500 CALL MESAGE (J,FILE,SUBR)
RETURN
END
|
