1 | SUBROUTINE REDUCE(KFILDO,JMIN,JMAX,LBIT,NOV,LX,NDG,IBIT,JBIT,KBIT, |
---|
2 | 1 NOVREF,IBXX2,IER) |
---|
3 | C |
---|
4 | C NOVEMBER 2001 GLAHN TDL GRIB2 |
---|
5 | C MARCH 2002 GLAHN COMMENT IER = 715 |
---|
6 | C MARCH 2002 GLAHN MODIFIED TO ACCOMMODATE LX=1 ON ENTRY |
---|
7 | C |
---|
8 | C PURPOSE |
---|
9 | C DETERMINES WHETHER THE NUMBER OF GROUPS SHOULD BE |
---|
10 | C INCREASED IN ORDER TO REDUCE THE SIZE OF THE LARGE |
---|
11 | C GROUPS, AND TO MAKE THAT ADJUSTMENT. BY REDUCING THE |
---|
12 | C SIZE OF THE LARGE GROUPS, LESS BITS MAY BE NECESSARY |
---|
13 | C FOR PACKING THE GROUP SIZES AND ALL THE INFORMATION |
---|
14 | C ABOUT THE GROUPS. |
---|
15 | C |
---|
16 | C THE REFERENCE FOR NOV( ) WAS REMOVED IN THE CALLING |
---|
17 | C ROUTINE SO THAT KBIT COULD BE DETERMINED. THIS |
---|
18 | C FURNISHES A STARTING POINT FOR THE ITERATIONS IN REDUCE. |
---|
19 | C HOWEVER, THE REFERENCE MUST BE CONSIDERED. |
---|
20 | C |
---|
21 | C DATA SET USE |
---|
22 | C KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) |
---|
23 | C |
---|
24 | C VARIABLES IN CALL SEQUENCE |
---|
25 | C KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE. (INPUT) |
---|
26 | C JMIN(J) = THE MINIMUM OF EACH GROUP (J=1,LX). IT IS |
---|
27 | C POSSIBLE AFTER SPLITTING THE GROUPS, JMIN( ) |
---|
28 | C WILL NOT BE THE MINIMUM OF THE NEW GROUP. |
---|
29 | C THIS DOESN'T MATTER; JMIN( ) IS REALLY THE |
---|
30 | C GROUP REFERENCE AND DOESN'T HAVE TO BE THE |
---|
31 | C SMALLEST VALUE. (INPUT/OUTPUT) |
---|
32 | C JMAX(J) = THE MAXIMUM OF EACH GROUP (J=1,LX). |
---|
33 | C (INPUT/OUTPUT) |
---|
34 | C LBIT(J) = THE NUMBER OF BITS NECESSARY TO PACK EACH GROUP |
---|
35 | C (J=1,LX). (INPUT/OUTPUT) |
---|
36 | C NOV(J) = THE NUMBER OF VALUES IN EACH GROUP (J=1,LX). |
---|
37 | C (INPUT/OUTPUT) |
---|
38 | C LX = THE NUMBER OF GROUPS. THIS WILL BE INCREASED |
---|
39 | C IF GROUPS ARE SPLIT. (INPUT/OUTPUT) |
---|
40 | C NDG = THE DIMENSION OF JMIN( ), JMAX( ), LBIT( ), AND |
---|
41 | C NOV( ). (INPUT) |
---|
42 | C IBIT = THE NUMBER OF BITS NECESSARY TO PACK THE JMIN(J) |
---|
43 | C VALUES, J=1,LX. (INPUT) |
---|
44 | C JBIT = THE NUMBER OF BITS NECESSARY TO PACK THE LBIT(J) |
---|
45 | C VALUES, J=1,LX. (INPUT) |
---|
46 | C KBIT = THE NUMBER OF BITS NECESSARY TO PACK THE NOV(J) |
---|
47 | C VALUES, J=1,LX. IF THE GROUPS ARE SPLIT, KBIT |
---|
48 | C IS REDUCED. (INPUT/OUTPUT) |
---|
49 | C NOVREF = REFERENCE VALUE FOR NOV( ). (INPUT) |
---|
50 | C IBXX2(J) = 2**J (J=0,30). (INPUT) |
---|
51 | C IER = ERROR RETURN. (OUTPUT) |
---|
52 | C 0 = GOOD RETURN. |
---|
53 | C 714 = PROBLEM IN ALGORITHM. REDUCE ABORTED. |
---|
54 | C 715 = NGP NOT LARGE ENOUGH. REDUCE ABORTED. |
---|
55 | C NTOTBT(J) = THE TOTAL BITS USED FOR THE PACKING BITS J |
---|
56 | C (J=1,30). (INTERNAL) |
---|
57 | C NBOXJ(J) = NEW BOXES NEEDED FOR THE PACKING BITS J |
---|
58 | C (J=1,30). (INTERNAL) |
---|
59 | C NEWBOX(L) = NUMBER OF NEW BOXES (GROUPS) FOR EACH ORIGINAL |
---|
60 | C GROUP (L=1,LX) FOR THE CURRENT J. (AUTOMATIC) |
---|
61 | C (INTERNAL) |
---|
62 | C NEWBOXP(L) = SAME AS NEWBOX( ) BUT FOR THE PREVIOUS J. |
---|
63 | C THIS ELIMINATES RECOMPUTATION. (AUTOMATIC) |
---|
64 | C (INTERNAL) |
---|
65 | C CFEED = CONTAINS THE CHARACTER REPRESENTATION |
---|
66 | C OF A PRINTER FORM FEED. (CHARACTER) (INTERNAL) |
---|
67 | C IFEED = CONTAINS THE INTEGER VALUE OF A PRINTER |
---|
68 | C FORM FEED. (INTERNAL) |
---|
69 | C IORIGB = THE ORIGINAL NUMBER OF BITS NECESSARY |
---|
70 | C FOR THE GROUP VALUES. (INTERNAL) |
---|
71 | C 1 2 3 4 5 6 7 X |
---|
72 | C |
---|
73 | C NON SYSTEM SUBROUTINES CALLED |
---|
74 | C NONE |
---|
75 | c |
---|
76 | CHARACTER*1 CFEED |
---|
77 | C |
---|
78 | DIMENSION JMIN(NDG),JMAX(NDG),LBIT(NDG),NOV(NDG) |
---|
79 | DIMENSION NEWBOX(NDG),NEWBOXP(NDG) |
---|
80 | C NEWBOX( ) AND NEWBOXP( ) ARE AUTOMATIC ARRAYS. |
---|
81 | DIMENSION NTOTBT(31),NBOXJ(31) |
---|
82 | DIMENSION IBXX2(0:30) |
---|
83 | C |
---|
84 | DATA IFEED/12/ |
---|
85 | C |
---|
86 | IER=0 |
---|
87 | IF(LX.EQ.1)GO TO 410 |
---|
88 | C IF THERE IS ONLY ONE GROUP, RETURN. |
---|
89 | C |
---|
90 | CFEED=CHAR(IFEED) |
---|
91 | C |
---|
92 | C INITIALIZE NUMBER OF NEW BOXES PER GROUP TO ZERO. |
---|
93 | C |
---|
94 | DO 110 L=1,LX |
---|
95 | NEWBOX(L)=0 |
---|
96 | 110 CONTINUE |
---|
97 | C |
---|
98 | C INITIALIZE NUMBER OF TOTAL NEW BOXES PER J TO ZERO. |
---|
99 | C |
---|
100 | DO 112 J=1,31 |
---|
101 | NTOTBT(J)=999999999 |
---|
102 | NBOXJ(J)=0 |
---|
103 | 112 CONTINUE |
---|
104 | C |
---|
105 | IORIGB=(IBIT+JBIT+KBIT)*LX |
---|
106 | C IBIT = BITS TO PACK THE JMIN( ). |
---|
107 | C JBIT = BITS TO PACK THE LBIT( ). |
---|
108 | C KBIT = BITS TO PACK THE NOV( ). |
---|
109 | C LX = NUMBER OF GROUPS. |
---|
110 | NTOTBT(KBIT)=IORIGB |
---|
111 | C THIS IS THE VALUE OF TOTAL BITS FOR THE ORIGINAL LX |
---|
112 | C GROUPS, WHICH REQUIRES KBITS TO PACK THE GROUP |
---|
113 | C LENGHTS. SETTING THIS HERE MAKES ONE LESS LOOPS |
---|
114 | C NECESSARY BELOW. |
---|
115 | C |
---|
116 | C COMPUTE BITS NOW USED FOR THE PARAMETERS DEFINED. |
---|
117 | C |
---|
118 | C DETERMINE OTHER POSSIBILITES BY INCREASING LX AND DECREASING |
---|
119 | C NOV( ) WITH VALUES GREATER THAN THRESHOLDS. ASSUME A GROUP IS |
---|
120 | C SPLIT INTO 2 OR MORE GROUPS SO THAT KBIT IS REDUCED WITHOUT |
---|
121 | C CHANGING IBIT OR JBIT. |
---|
122 | C |
---|
123 | JJ=0 |
---|
124 | C |
---|
125 | DO 200 J=MIN(30,KBIT-1),2,-1 |
---|
126 | C VALUES GE KBIT WILL NOT REQUIRE SPLITS. ONCE THE TOTAL |
---|
127 | C BITS START INCREASING WITH DECREASING J, STOP. ALSO, THE |
---|
128 | C NUMBER OF BITS REQUIRED IS KNOWN FOR KBITS = NTOTBT(KBIT). |
---|
129 | C |
---|
130 | NEWBOXT=0 |
---|
131 | C |
---|
132 | DO 190 L=1,LX |
---|
133 | C |
---|
134 | IF(NOV(L).LT.IBXX2(J))THEN |
---|
135 | NEWBOX(L)=0 |
---|
136 | C NO SPLITS OR NEW BOXES. |
---|
137 | GO TO 190 |
---|
138 | ELSE |
---|
139 | NOVL=NOV(L) |
---|
140 | C |
---|
141 | M=(NOV(L)-1)/(IBXX2(J)-1)+1 |
---|
142 | C M IS FOUND BY SOLVING THE EQUATION BELOW FOR M: |
---|
143 | C (NOV(L)+M-1)/M LT IBXX2(J) |
---|
144 | C M GT (NOV(L)-1)/(IBXX2(J)-1) |
---|
145 | C SET M = (NOV(L)-1)/(IBXX2(J)-1)+1 |
---|
146 | 130 NOVL=(NOV(L)+M-1)/M |
---|
147 | C THE +M-1 IS NECESSARY. FOR INSTANCE, 15 WILL FIT |
---|
148 | C INTO A BOX 4 BITS WIDE, BUT WON'T DIVIDE INTO |
---|
149 | C TWO BOXES 3 BITS WIDE EACH. |
---|
150 | C |
---|
151 | IF(NOVL.LT.IBXX2(J))THEN |
---|
152 | GO TO 185 |
---|
153 | ELSE |
---|
154 | M=M+1 |
---|
155 | C*** WRITE(KFILDO,135)L,NOV(L),NOVL,M,J,IBXX2(J) |
---|
156 | C*** 135 FORMAT(/' AT 135--L,NOV(L),NOVL,M,J,IBXX2(J)',6I10) |
---|
157 | GO TO 130 |
---|
158 | ENDIF |
---|
159 | C |
---|
160 | C THE ABOVE DO LOOP WILL NEVER COMPLETE. |
---|
161 | ENDIF |
---|
162 | C |
---|
163 | 185 NEWBOX(L)=M-1 |
---|
164 | NEWBOXT=NEWBOXT+M-1 |
---|
165 | 190 CONTINUE |
---|
166 | C |
---|
167 | NBOXJ(J)=NEWBOXT |
---|
168 | NTOTPR=NTOTBT(J+1) |
---|
169 | NTOTBT(J)=(IBIT+JBIT)*(LX+NEWBOXT)+J*(LX+NEWBOXT) |
---|
170 | C |
---|
171 | IF(NTOTBT(J).GE.NTOTPR)THEN |
---|
172 | JJ=J+1 |
---|
173 | C THE PLUS IS USED BECAUSE J DECREASES PER ITERATION. |
---|
174 | GO TO 250 |
---|
175 | ELSE |
---|
176 | C |
---|
177 | C SAVE THE TOTAL NEW BOXES AND NEWBOX( ) IN CASE THIS |
---|
178 | C IS THE J TO USE. |
---|
179 | C |
---|
180 | NEWBOXTP=NEWBOXT |
---|
181 | C |
---|
182 | DO 195 L=1,LX |
---|
183 | NEWBOXP(L)=NEWBOX(L) |
---|
184 | 195 CONTINUE |
---|
185 | C |
---|
186 | C WRITE(KFILDO,197)NEWBOXT,IBXX2(J) |
---|
187 | C197 FORMAT(/' *****************************************' |
---|
188 | C 1 /' THE NUMBER OF NEWBOXES PER GROUP OF THE TOTAL', |
---|
189 | C 2 I10,' FOR GROUP MAXSIZE PLUS 1 ='I10 |
---|
190 | C 3 /' *****************************************') |
---|
191 | C WRITE(KFILDO,198) (NEWBOX(L),L=1,LX) |
---|
192 | C198 FORMAT(/' '20I6/(' '20I6)) |
---|
193 | |
---|
194 | ENDIF |
---|
195 | C |
---|
196 | C205 WRITE(KFILDO,209)KBIT,IORIGB |
---|
197 | C209 FORMAT(/' ORIGINAL BITS WITH KBIT OF',I5,' =',I10) |
---|
198 | C WRITE(KFILDO,210)(N,N=2,10),(IBXX2(N),N=2,10), |
---|
199 | C 1 (NTOTBT(N),N=2,10),(NBOXJ(N),N=2,10), |
---|
200 | C 2 (N,N=11,20),(IBXX2(N),N=11,20), |
---|
201 | C 3 (NTOTBT(N),N=11,20),(NBOXJ(N),N=11,20), |
---|
202 | C 4 (N,N=21,30),(IBXX2(N),N=11,20), |
---|
203 | C 5 (NTOTBT(N),N=21,30),(NBOXJ(N),N=21,30) |
---|
204 | C210 FORMAT(/' THE TOTAL BYTES FOR MAXIMUM GROUP LENGTHS BY ROW'// |
---|
205 | C 1 ' J = THE NUMBER OF BITS PER GROUP LENGTH'/ |
---|
206 | C 2 ' IBXX2(J) = THE MAXIMUM GROUP LENGTH PLUS 1 FOR THIS J'/ |
---|
207 | C 3 ' NTOTBT(J) = THE TOTAL BITS FOR THIS J'/ |
---|
208 | C 4 ' NBOXJ(J) = THE NEW GROUPS FOR THIS J'/ |
---|
209 | C 5 4(/10X,9I10)/4(/10I10)/4(/10I10)) |
---|
210 | C |
---|
211 | 200 CONTINUE |
---|
212 | C |
---|
213 | 250 PIMP=((IORIGB-NTOTBT(JJ))/FLOAT(IORIGB))*100. |
---|
214 | C WRITE(KFILDO,252)PIMP,KBIT,JJ |
---|
215 | C252 FORMAT(/' PERCENT IMPROVEMENT =',F6.1, |
---|
216 | C 1 ' BY DECREASING GROUP LENGTHS FROM',I4,' TO',I4,' BITS') |
---|
217 | IF(PIMP.GE.2.)THEN |
---|
218 | C |
---|
219 | C WRITE(KFILDO,255)CFEED,NEWBOXTP,IBXX2(JJ) |
---|
220 | C255 FORMAT(A1,/' *****************************************' |
---|
221 | C 1 /' THE NUMBER OF NEWBOXES PER GROUP OF THE TOTAL', |
---|
222 | C 2 I10,' FOR GROUP MAXSIZE PLUS 1 ='I10 |
---|
223 | C 2 /' *****************************************') |
---|
224 | C WRITE(KFILDO,256) (NEWBOXP(L),L=1,LX) |
---|
225 | C256 FORMAT(/' '20I6) |
---|
226 | C |
---|
227 | C ADJUST GROUP LENGTHS FOR MAXIMUM LENGTH OF JJ BITS. |
---|
228 | C THE MIN PER GROUP AND THE NUMBER OF BITS REQUIRED |
---|
229 | C PER GROUP ARE NOT CHANGED. THIS MAY MEAN THAT A |
---|
230 | C GROUP HAS A MIN (OR REFERENCE) THAT IS NOT ZERO. |
---|
231 | C THIS SHOULD NOT MATTER TO THE UNPACKER. |
---|
232 | C |
---|
233 | LXNKP=LX+NEWBOXTP |
---|
234 | C LXNKP = THE NEW NUMBER OF BOXES |
---|
235 | C |
---|
236 | IF(LXNKP.GT.NDG)THEN |
---|
237 | C DIMENSIONS NOT LARGE ENOUGH. PROBABLY AN ERROR |
---|
238 | C OF SOME SORT. ABORT. |
---|
239 | C WRITE(KFILDO,257)NDG,LXNPK |
---|
240 | C 1 2 3 4 5 6 7 X |
---|
241 | C257 FORMAT(/' DIMENSIONS OF JMIN, ETC. IN REDUCE =',I8, |
---|
242 | C 1 ' NOT LARGE ENOUGH FOR THE EXPANDED NUMBER OF', |
---|
243 | C 2 ' GROUPS =',I8,'. ABORT REDUCE.') |
---|
244 | IER=715 |
---|
245 | GO TO 410 |
---|
246 | C AN ABORT CAUSES THE CALLING PROGRAM TO REEXECUTE |
---|
247 | C WITHOUT CALLING REDUCE. |
---|
248 | ENDIF |
---|
249 | C |
---|
250 | LXN=LXNKP |
---|
251 | C LXN IS THE NUMBER OF THE BOX IN THE NEW SERIES BEING |
---|
252 | C FILLED. IT DECREASES PER ITERATION. |
---|
253 | IBXX2M1=IBXX2(JJ)-1 |
---|
254 | C IBXX2M1 IS THE MAXIMUM NUMBER OF VALUES PER GROUP. |
---|
255 | C |
---|
256 | DO 300 L=LX,1,-1 |
---|
257 | C |
---|
258 | C THE VALUES IS NOV( ) REPRESENT THOSE VALUES + NOVREF. |
---|
259 | C WHEN VALUES ARE MOVED TO ANOTHER BOX, EACH VALUE |
---|
260 | C MOVED TO A NEW BOX REPRESENTS THAT VALUE + NOVREF. |
---|
261 | C THIS HAS TO BE CONSIDERED IN MOVING VALUES. |
---|
262 | C |
---|
263 | IF(NEWBOXP(L)*(IBXX2M1+NOVREF)+NOVREF.GT.NOV(L)+NOVREF)THEN |
---|
264 | C IF THE ABOVE TEST IS MET, THEN MOVING IBXX2M1 VALUES |
---|
265 | C FOR ALL NEW BOXES WILL LEAVE A NEGATIVE NUMBER FOR |
---|
266 | C THE LAST BOX. NOT A TOLERABLE SITUATION. |
---|
267 | MOVMIN=(NOV(L)-(NEWBOXP(L))*NOVREF)/NEWBOXP(L) |
---|
268 | LEFT=NOV(L) |
---|
269 | C LEFT = THE NUMBER OF VALUES TO MOVE FROM THE ORIGINAL |
---|
270 | C BOX TO EACH NEW BOX EXCEPT THE LAST. LEFT IS THE |
---|
271 | C NUMBER LEFT TO MOVE. |
---|
272 | ELSE |
---|
273 | MOVMIN=IBXX2M1 |
---|
274 | C MOVMIN VALUES CAN BE MOVED FOR EACH NEW BOX. |
---|
275 | LEFT=NOV(L) |
---|
276 | C LEFT IS THE NUMBER OF VALUES LEFT TO MOVE. |
---|
277 | ENDIF |
---|
278 | C |
---|
279 | IF(NEWBOXP(L).GT.0)THEN |
---|
280 | IF((MOVMIN+NOVREF)*NEWBOXP(L)+NOVREF.LE.NOV(L)+NOVREF. |
---|
281 | 1 AND.(MOVMIN+NOVREF)*(NEWBOXP(L)+1).GE.NOV(L)+NOVREF)THEN |
---|
282 | GO TO 288 |
---|
283 | ELSE |
---|
284 | C***D WRITE(KFILDO,287)L,MOVMIN,NOVREF,NEWBOXP(L),NOV(L) |
---|
285 | C***D287 FORMAT(/' AT 287 IN REDUCE--L,MOVMIN,NOVREF,', |
---|
286 | C***D 1 'NEWBOXP(L),NOV(L)',5I12 |
---|
287 | C***D 2 ' REDUCE ABORTED.') |
---|
288 | C WRITE(KFILDO,2870) |
---|
289 | C2870 FORMAT(/' AN ERROR IN REDUCE ALGORITHM. ABORT REDUCE.') |
---|
290 | IER=714 |
---|
291 | GO TO 410 |
---|
292 | C AN ABORT CAUSES THE CALLING PROGRAM TO REEXECUTE |
---|
293 | C WITHOUT CALLING REDUCE. |
---|
294 | ENDIF |
---|
295 | C |
---|
296 | ENDIF |
---|
297 | C |
---|
298 | 288 DO 290 J=1,NEWBOXP(L)+1 |
---|
299 | MOVE=MIN(MOVMIN,LEFT) |
---|
300 | JMIN(LXN)=JMIN(L) |
---|
301 | JMAX(LXN)=JMAX(L) |
---|
302 | LBIT(LXN)=LBIT(L) |
---|
303 | NOV(LXN)=MOVE |
---|
304 | LXN=LXN-1 |
---|
305 | LEFT=LEFT-(MOVE+NOVREF) |
---|
306 | C THE MOVE OF MOVE VALUES REALLY REPRESENTS A MOVE OF |
---|
307 | C MOVE + NOVREF VALUES. |
---|
308 | 290 CONTINUE |
---|
309 | C |
---|
310 | IF(LEFT.NE.-NOVREF)THEN |
---|
311 | C*** WRITE(KFILDO,292)L,LXN,MOVE,LXNKP,IBXX2(JJ),LEFT,NOV(L), |
---|
312 | C*** 1 MOVMIN |
---|
313 | C*** 292 FORMAT(' AT 292 IN REDUCE--L,LXN,MOVE,LXNKP,', |
---|
314 | C*** 1 'IBXX2(JJ),LEFT,NOV(L),MOVMIN'/8I12) |
---|
315 | ENDIF |
---|
316 | C |
---|
317 | 300 CONTINUE |
---|
318 | C |
---|
319 | LX=LXNKP |
---|
320 | C LX IS NOW THE NEW NUMBER OF GROUPS. |
---|
321 | KBIT=JJ |
---|
322 | C KBIT IS NOW THE NEW NUMBER OF BITS REQUIRED FOR PACKING |
---|
323 | C GROUP LENGHTS. |
---|
324 | ENDIF |
---|
325 | C |
---|
326 | C WRITE(KFILDO,406)CFEED,LX |
---|
327 | C406 FORMAT(A1,/' *****************************************' |
---|
328 | C 1 /' THE GROUP SIZES NOV( ) AFTER REDUCTION IN SIZE', |
---|
329 | C 2 ' FOR'I10,' GROUPS', |
---|
330 | C 3 /' *****************************************') |
---|
331 | C WRITE(KFILDO,407) (NOV(J),J=1,LX) |
---|
332 | C407 FORMAT(/' '20I6) |
---|
333 | C WRITE(KFILDO,408)CFEED,LX |
---|
334 | C408 FORMAT(A1,/' *****************************************' |
---|
335 | C 1 /' THE GROUP MINIMA JMIN( ) AFTER REDUCTION IN SIZE', |
---|
336 | C 2 ' FOR'I10,' GROUPS', |
---|
337 | C 3 /' *****************************************') |
---|
338 | C WRITE(KFILDO,409) (JMIN(J),J=1,LX) |
---|
339 | C409 FORMAT(/' '20I6) |
---|
340 | C |
---|
341 | 410 RETURN |
---|
342 | END |
---|
343 | |
---|