1 : /* reduce.f -- translated by f2c (version 20031025).
2 : You must link the resulting object file with libf2c:
3 : on Microsoft Windows system, link with libf2c.lib;
4 : on Linux or Unix systems, link with .../path/to/libf2c.a -lm
5 : or, if you install libf2c.a in a standard place, with -lf2c -lm
6 : -- in that order, at the end of the command line, as in
7 : cc *.o -lf2c -lm
8 : Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
9 :
10 : http://www.netlib.org/f2c/libf2c.zip
11 : */
12 :
13 : /*#include "f2c.h"*/
14 : #include <stdlib.h>
15 : #include "grib2.h"
16 : typedef g2int integer;
17 : typedef g2float real;
18 :
19 0 : /* Subroutine */ int reduce(integer *kfildo, integer *jmin, integer *jmax,
20 : integer *lbit, integer *nov, integer *lx, integer *ndg, integer *ibit,
21 : integer *jbit, integer *kbit, integer *novref, integer *ibxx2,
22 : integer *ier)
23 : {
24 : /* Initialized data */
25 :
26 : static integer ifeed = 12;
27 :
28 : /* System generated locals */
29 : integer i__1, i__2;
30 :
31 : /* Local variables */
32 : static integer newboxtp, j, l, m, jj, lxn, left;
33 : static real pimp;
34 : static integer move, novl;
35 : static char cfeed[1];
36 : static integer nboxj[31], lxnkp, iorigb, ibxx2m1, movmin,
37 : ntotbt[31], ntotpr, newboxt;
38 : integer *newbox, *newboxp;
39 :
40 :
41 : /* NOVEMBER 2001 GLAHN TDL GRIB2 */
42 : /* MARCH 2002 GLAHN COMMENT IER = 715 */
43 : /* MARCH 2002 GLAHN MODIFIED TO ACCOMMODATE LX=1 ON ENTRY */
44 :
45 : /* PURPOSE */
46 : /* DETERMINES WHETHER THE NUMBER OF GROUPS SHOULD BE */
47 : /* INCREASED IN ORDER TO REDUCE THE SIZE OF THE LARGE */
48 : /* GROUPS, AND TO MAKE THAT ADJUSTMENT. BY REDUCING THE */
49 : /* SIZE OF THE LARGE GROUPS, LESS BITS MAY BE NECESSARY */
50 : /* FOR PACKING THE GROUP SIZES AND ALL THE INFORMATION */
51 : /* ABOUT THE GROUPS. */
52 :
53 : /* THE REFERENCE FOR NOV( ) WAS REMOVED IN THE CALLING */
54 : /* ROUTINE SO THAT KBIT COULD BE DETERMINED. THIS */
55 : /* FURNISHES A STARTING POINT FOR THE ITERATIONS IN REDUCE. */
56 : /* HOWEVER, THE REFERENCE MUST BE CONSIDERED. */
57 :
58 : /* DATA SET USE */
59 : /* KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) */
60 :
61 : /* VARIABLES IN CALL SEQUENCE */
62 : /* KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE. (INPUT) */
63 : /* JMIN(J) = THE MINIMUM OF EACH GROUP (J=1,LX). IT IS */
64 : /* POSSIBLE AFTER SPLITTING THE GROUPS, JMIN( ) */
65 : /* WILL NOT BE THE MINIMUM OF THE NEW GROUP. */
66 : /* THIS DOESN'T MATTER; JMIN( ) IS REALLY THE */
67 : /* GROUP REFERENCE AND DOESN'T HAVE TO BE THE */
68 : /* SMALLEST VALUE. (INPUT/OUTPUT) */
69 : /* JMAX(J) = THE MAXIMUM OF EACH GROUP (J=1,LX). */
70 : /* (INPUT/OUTPUT) */
71 : /* LBIT(J) = THE NUMBER OF BITS NECESSARY TO PACK EACH GROUP */
72 : /* (J=1,LX). (INPUT/OUTPUT) */
73 : /* NOV(J) = THE NUMBER OF VALUES IN EACH GROUP (J=1,LX). */
74 : /* (INPUT/OUTPUT) */
75 : /* LX = THE NUMBER OF GROUPS. THIS WILL BE INCREASED */
76 : /* IF GROUPS ARE SPLIT. (INPUT/OUTPUT) */
77 : /* NDG = THE DIMENSION OF JMIN( ), JMAX( ), LBIT( ), AND */
78 : /* NOV( ). (INPUT) */
79 : /* IBIT = THE NUMBER OF BITS NECESSARY TO PACK THE JMIN(J) */
80 : /* VALUES, J=1,LX. (INPUT) */
81 : /* JBIT = THE NUMBER OF BITS NECESSARY TO PACK THE LBIT(J) */
82 : /* VALUES, J=1,LX. (INPUT) */
83 : /* KBIT = THE NUMBER OF BITS NECESSARY TO PACK THE NOV(J) */
84 : /* VALUES, J=1,LX. IF THE GROUPS ARE SPLIT, KBIT */
85 : /* IS REDUCED. (INPUT/OUTPUT) */
86 : /* NOVREF = REFERENCE VALUE FOR NOV( ). (INPUT) */
87 : /* IBXX2(J) = 2**J (J=0,30). (INPUT) */
88 : /* IER = ERROR RETURN. (OUTPUT) */
89 : /* 0 = GOOD RETURN. */
90 : /* 714 = PROBLEM IN ALGORITHM. REDUCE ABORTED. */
91 : /* 715 = NGP NOT LARGE ENOUGH. REDUCE ABORTED. */
92 : /* NTOTBT(J) = THE TOTAL BITS USED FOR THE PACKING BITS J */
93 : /* (J=1,30). (INTERNAL) */
94 : /* NBOXJ(J) = NEW BOXES NEEDED FOR THE PACKING BITS J */
95 : /* (J=1,30). (INTERNAL) */
96 : /* NEWBOX(L) = NUMBER OF NEW BOXES (GROUPS) FOR EACH ORIGINAL */
97 : /* GROUP (L=1,LX) FOR THE CURRENT J. (AUTOMATIC) */
98 : /* (INTERNAL) */
99 : /* NEWBOXP(L) = SAME AS NEWBOX( ) BUT FOR THE PREVIOUS J. */
100 : /* THIS ELIMINATES RECOMPUTATION. (AUTOMATIC) */
101 : /* (INTERNAL) */
102 : /* CFEED = CONTAINS THE CHARACTER REPRESENTATION */
103 : /* OF A PRINTER FORM FEED. (CHARACTER) (INTERNAL) */
104 : /* IFEED = CONTAINS THE INTEGER VALUE OF A PRINTER */
105 : /* FORM FEED. (INTERNAL) */
106 : /* IORIGB = THE ORIGINAL NUMBER OF BITS NECESSARY */
107 : /* FOR THE GROUP VALUES. (INTERNAL) */
108 : /* 1 2 3 4 5 6 7 X */
109 :
110 : /* NON SYSTEM SUBROUTINES CALLED */
111 : /* NONE */
112 :
113 :
114 : /* NEWBOX( ) AND NEWBOXP( ) were AUTOMATIC ARRAYS. */
115 0 : newbox = (integer *)calloc(*ndg,sizeof(integer));
116 0 : newboxp = (integer *)calloc(*ndg,sizeof(integer));
117 :
118 : /* Parameter adjustments */
119 0 : --nov;
120 0 : --lbit;
121 0 : --jmax;
122 0 : --jmin;
123 :
124 : /* Function Body */
125 :
126 0 : *ier = 0;
127 0 : if (*lx == 1) {
128 0 : goto L410;
129 : }
130 : /* IF THERE IS ONLY ONE GROUP, RETURN. */
131 :
132 0 : *(unsigned char *)cfeed = (char) ifeed;
133 :
134 : /* INITIALIZE NUMBER OF NEW BOXES PER GROUP TO ZERO. */
135 :
136 0 : i__1 = *lx;
137 0 : for (l = 1; l <= i__1; ++l) {
138 0 : newbox[l - 1] = 0;
139 : /* L110: */
140 : }
141 :
142 : /* INITIALIZE NUMBER OF TOTAL NEW BOXES PER J TO ZERO. */
143 :
144 0 : for (j = 1; j <= 31; ++j) {
145 0 : ntotbt[j - 1] = 999999999;
146 0 : nboxj[j - 1] = 0;
147 : /* L112: */
148 : }
149 :
150 0 : iorigb = (*ibit + *jbit + *kbit) * *lx;
151 : /* IBIT = BITS TO PACK THE JMIN( ). */
152 : /* JBIT = BITS TO PACK THE LBIT( ). */
153 : /* KBIT = BITS TO PACK THE NOV( ). */
154 : /* LX = NUMBER OF GROUPS. */
155 0 : ntotbt[*kbit - 1] = iorigb;
156 : /* THIS IS THE VALUE OF TOTAL BITS FOR THE ORIGINAL LX */
157 : /* GROUPS, WHICH REQUIRES KBITS TO PACK THE GROUP */
158 : /* LENGHTS. SETTING THIS HERE MAKES ONE LESS LOOPS */
159 : /* NECESSARY BELOW. */
160 :
161 : /* COMPUTE BITS NOW USED FOR THE PARAMETERS DEFINED. */
162 :
163 : /* DETERMINE OTHER POSSIBILITES BY INCREASING LX AND DECREASING */
164 : /* NOV( ) WITH VALUES GREATER THAN THRESHOLDS. ASSUME A GROUP IS */
165 : /* SPLIT INTO 2 OR MORE GROUPS SO THAT KBIT IS REDUCED WITHOUT */
166 : /* CHANGING IBIT OR JBIT. */
167 :
168 0 : jj = 0;
169 :
170 : /* Computing MIN */
171 0 : i__1 = 30, i__2 = *kbit - 1;
172 : /*for (j = min(i__1,i__2); j >= 2; --j) {*/
173 0 : for (j = (i__1 < i__2) ? i__1 : i__2; j >= 2; --j) {
174 : /* VALUES GE KBIT WILL NOT REQUIRE SPLITS. ONCE THE TOTAL */
175 : /* BITS START INCREASING WITH DECREASING J, STOP. ALSO, THE */
176 : /* NUMBER OF BITS REQUIRED IS KNOWN FOR KBITS = NTOTBT(KBIT). */
177 :
178 0 : newboxt = 0;
179 :
180 0 : i__1 = *lx;
181 0 : for (l = 1; l <= i__1; ++l) {
182 :
183 0 : if (nov[l] < ibxx2[j]) {
184 0 : newbox[l - 1] = 0;
185 : /* NO SPLITS OR NEW BOXES. */
186 0 : goto L190;
187 : } else {
188 0 : novl = nov[l];
189 :
190 0 : m = (nov[l] - 1) / (ibxx2[j] - 1) + 1;
191 : /* M IS FOUND BY SOLVING THE EQUATION BELOW FOR M: */
192 : /* (NOV(L)+M-1)/M LT IBXX2(J) */
193 : /* M GT (NOV(L)-1)/(IBXX2(J)-1) */
194 : /* SET M = (NOV(L)-1)/(IBXX2(J)-1)+1 */
195 : L130:
196 0 : novl = (nov[l] + m - 1) / m;
197 : /* THE +M-1 IS NECESSARY. FOR INSTANCE, 15 WILL FIT */
198 : /* INTO A BOX 4 BITS WIDE, BUT WON'T DIVIDE INTO */
199 : /* TWO BOXES 3 BITS WIDE EACH. */
200 :
201 0 : if (novl < ibxx2[j]) {
202 0 : goto L185;
203 : } else {
204 0 : ++m;
205 : /* *** WRITE(KFILDO,135)L,NOV(L),NOVL,M,J,IBXX2(J) */
206 : /* *** 135 FORMAT(/' AT 135--L,NOV(L),NOVL,M,J,IBXX2(J)',6I10) */
207 0 : goto L130;
208 : }
209 :
210 : /* THE ABOVE DO LOOP WILL NEVER COMPLETE. */
211 : }
212 :
213 : L185:
214 0 : newbox[l - 1] = m - 1;
215 0 : newboxt = newboxt + m - 1;
216 : L190:
217 : ;
218 : }
219 :
220 0 : nboxj[j - 1] = newboxt;
221 0 : ntotpr = ntotbt[j];
222 0 : ntotbt[j - 1] = (*ibit + *jbit) * (*lx + newboxt) + j * (*lx +
223 : newboxt);
224 :
225 0 : if (ntotbt[j - 1] >= ntotpr) {
226 0 : jj = j + 1;
227 : /* THE PLUS IS USED BECAUSE J DECREASES PER ITERATION. */
228 0 : goto L250;
229 : } else {
230 :
231 : /* SAVE THE TOTAL NEW BOXES AND NEWBOX( ) IN CASE THIS */
232 : /* IS THE J TO USE. */
233 :
234 0 : newboxtp = newboxt;
235 :
236 0 : i__1 = *lx;
237 0 : for (l = 1; l <= i__1; ++l) {
238 0 : newboxp[l - 1] = newbox[l - 1];
239 : /* L195: */
240 : }
241 :
242 : /* WRITE(KFILDO,197)NEWBOXT,IBXX2(J) */
243 : /* 197 FORMAT(/' *****************************************' */
244 : /* 1 /' THE NUMBER OF NEWBOXES PER GROUP OF THE TOTAL', */
245 : /* 2 I10,' FOR GROUP MAXSIZE PLUS 1 ='I10 */
246 : /* 3 /' *****************************************') */
247 : /* WRITE(KFILDO,198) (NEWBOX(L),L=1,LX) */
248 : /* 198 FORMAT(/' '20I6/(' '20I6)) */
249 : }
250 :
251 : /* 205 WRITE(KFILDO,209)KBIT,IORIGB */
252 : /* 209 FORMAT(/' ORIGINAL BITS WITH KBIT OF',I5,' =',I10) */
253 : /* WRITE(KFILDO,210)(N,N=2,10),(IBXX2(N),N=2,10), */
254 : /* 1 (NTOTBT(N),N=2,10),(NBOXJ(N),N=2,10), */
255 : /* 2 (N,N=11,20),(IBXX2(N),N=11,20), */
256 : /* 3 (NTOTBT(N),N=11,20),(NBOXJ(N),N=11,20), */
257 : /* 4 (N,N=21,30),(IBXX2(N),N=11,20), */
258 : /* 5 (NTOTBT(N),N=21,30),(NBOXJ(N),N=21,30) */
259 : /* 210 FORMAT(/' THE TOTAL BYTES FOR MAXIMUM GROUP LENGTHS BY ROW'// */
260 : /* 1 ' J = THE NUMBER OF BITS PER GROUP LENGTH'/ */
261 : /* 2 ' IBXX2(J) = THE MAXIMUM GROUP LENGTH PLUS 1 FOR THIS J'/ */
262 : /* 3 ' NTOTBT(J) = THE TOTAL BITS FOR THIS J'/ */
263 : /* 4 ' NBOXJ(J) = THE NEW GROUPS FOR THIS J'/ */
264 : /* 5 4(/10X,9I10)/4(/10I10)/4(/10I10)) */
265 :
266 : /* L200: */
267 : }
268 :
269 : L250:
270 0 : pimp = (iorigb - ntotbt[jj - 1]) / (real) iorigb * 100.f;
271 : /* WRITE(KFILDO,252)PIMP,KBIT,JJ */
272 : /* 252 FORMAT(/' PERCENT IMPROVEMENT =',F6.1, */
273 : /* 1 ' BY DECREASING GROUP LENGTHS FROM',I4,' TO',I4,' BITS') */
274 0 : if (pimp >= 2.f) {
275 :
276 : /* WRITE(KFILDO,255)CFEED,NEWBOXTP,IBXX2(JJ) */
277 : /* 255 FORMAT(A1,/' *****************************************' */
278 : /* 1 /' THE NUMBER OF NEWBOXES PER GROUP OF THE TOTAL', */
279 : /* 2 I10,' FOR GROUP MAXSIZE PLUS 1 ='I10 */
280 : /* 2 /' *****************************************') */
281 : /* WRITE(KFILDO,256) (NEWBOXP(L),L=1,LX) */
282 : /* 256 FORMAT(/' '20I6) */
283 :
284 : /* ADJUST GROUP LENGTHS FOR MAXIMUM LENGTH OF JJ BITS. */
285 : /* THE MIN PER GROUP AND THE NUMBER OF BITS REQUIRED */
286 : /* PER GROUP ARE NOT CHANGED. THIS MAY MEAN THAT A */
287 : /* GROUP HAS A MIN (OR REFERENCE) THAT IS NOT ZERO. */
288 : /* THIS SHOULD NOT MATTER TO THE UNPACKER. */
289 :
290 0 : lxnkp = *lx + newboxtp;
291 : /* LXNKP = THE NEW NUMBER OF BOXES */
292 :
293 0 : if (lxnkp > *ndg) {
294 : /* DIMENSIONS NOT LARGE ENOUGH. PROBABLY AN ERROR */
295 : /* OF SOME SORT. ABORT. */
296 : /* WRITE(KFILDO,257)NDG,LXNPK */
297 : /* 1 2 3 4 5 6 7 X */
298 : /* 257 FORMAT(/' DIMENSIONS OF JMIN, ETC. IN REDUCE =',I8, */
299 : /* 1 ' NOT LARGE ENOUGH FOR THE EXPANDED NUMBER OF', */
300 : /* 2 ' GROUPS =',I8,'. ABORT REDUCE.') */
301 0 : *ier = 715;
302 0 : goto L410;
303 : /* AN ABORT CAUSES THE CALLING PROGRAM TO REEXECUTE */
304 : /* WITHOUT CALLING REDUCE. */
305 : }
306 :
307 0 : lxn = lxnkp;
308 : /* LXN IS THE NUMBER OF THE BOX IN THE NEW SERIES BEING */
309 : /* FILLED. IT DECREASES PER ITERATION. */
310 0 : ibxx2m1 = ibxx2[jj] - 1;
311 : /* IBXX2M1 IS THE MAXIMUM NUMBER OF VALUES PER GROUP. */
312 :
313 0 : for (l = *lx; l >= 1; --l) {
314 :
315 : /* THE VALUES IS NOV( ) REPRESENT THOSE VALUES + NOVREF. */
316 : /* WHEN VALUES ARE MOVED TO ANOTHER BOX, EACH VALUE */
317 : /* MOVED TO A NEW BOX REPRESENTS THAT VALUE + NOVREF. */
318 : /* THIS HAS TO BE CONSIDERED IN MOVING VALUES. */
319 :
320 0 : if (newboxp[l - 1] * (ibxx2m1 + *novref) + *novref > nov[l] + *
321 : novref) {
322 : /* IF THE ABOVE TEST IS MET, THEN MOVING IBXX2M1 VALUES */
323 : /* FOR ALL NEW BOXES WILL LEAVE A NEGATIVE NUMBER FOR */
324 : /* THE LAST BOX. NOT A TOLERABLE SITUATION. */
325 0 : movmin = (nov[l] - newboxp[l - 1] * *novref) / newboxp[l - 1];
326 0 : left = nov[l];
327 : /* LEFT = THE NUMBER OF VALUES TO MOVE FROM THE ORIGINAL */
328 : /* BOX TO EACH NEW BOX EXCEPT THE LAST. LEFT IS THE */
329 : /* NUMBER LEFT TO MOVE. */
330 : } else {
331 0 : movmin = ibxx2m1;
332 : /* MOVMIN VALUES CAN BE MOVED FOR EACH NEW BOX. */
333 0 : left = nov[l];
334 : /* LEFT IS THE NUMBER OF VALUES LEFT TO MOVE. */
335 : }
336 :
337 0 : if (newboxp[l - 1] > 0) {
338 0 : if ((movmin + *novref) * newboxp[l - 1] + *novref <= nov[l] +
339 0 : *novref && (movmin + *novref) * (newboxp[l - 1] + 1)
340 0 : >= nov[l] + *novref) {
341 : goto L288;
342 : } else {
343 : /* ***D WRITE(KFILDO,287)L,MOVMIN,NOVREF,NEWBOXP(L),NOV(L) */
344 : /* ***D287 FORMAT(/' AT 287 IN REDUCE--L,MOVMIN,NOVREF,', */
345 : /* ***D 1 'NEWBOXP(L),NOV(L)',5I12 */
346 : /* ***D 2 ' REDUCE ABORTED.') */
347 : /* WRITE(KFILDO,2870) */
348 : /* 2870 FORMAT(/' AN ERROR IN REDUCE ALGORITHM. ABORT REDUCE.') */
349 0 : *ier = 714;
350 0 : goto L410;
351 : /* AN ABORT CAUSES THE CALLING PROGRAM TO REEXECUTE */
352 : /* WITHOUT CALLING REDUCE. */
353 : }
354 :
355 : }
356 :
357 : L288:
358 0 : i__1 = newboxp[l - 1] + 1;
359 0 : for (j = 1; j <= i__1; ++j) {
360 : /*move = min(movmin,left);*/
361 0 : move = (movmin < left) ? movmin : left;
362 0 : jmin[lxn] = jmin[l];
363 0 : jmax[lxn] = jmax[l];
364 0 : lbit[lxn] = lbit[l];
365 0 : nov[lxn] = move;
366 0 : --lxn;
367 0 : left -= move + *novref;
368 : /* THE MOVE OF MOVE VALUES REALLY REPRESENTS A MOVE OF */
369 : /* MOVE + NOVREF VALUES. */
370 : /* L290: */
371 : }
372 :
373 0 : if (left != -(*novref)) {
374 : /* *** WRITE(KFILDO,292)L,LXN,MOVE,LXNKP,IBXX2(JJ),LEFT,NOV(L), */
375 : /* *** 1 MOVMIN */
376 : /* *** 292 FORMAT(' AT 292 IN REDUCE--L,LXN,MOVE,LXNKP,', */
377 : /* *** 1 'IBXX2(JJ),LEFT,NOV(L),MOVMIN'/8I12) */
378 : }
379 :
380 : /* L300: */
381 : }
382 :
383 0 : *lx = lxnkp;
384 : /* LX IS NOW THE NEW NUMBER OF GROUPS. */
385 0 : *kbit = jj;
386 : /* KBIT IS NOW THE NEW NUMBER OF BITS REQUIRED FOR PACKING */
387 : /* GROUP LENGHTS. */
388 : }
389 :
390 : /* WRITE(KFILDO,406)CFEED,LX */
391 : /* 406 FORMAT(A1,/' *****************************************' */
392 : /* 1 /' THE GROUP SIZES NOV( ) AFTER REDUCTION IN SIZE', */
393 : /* 2 ' FOR'I10,' GROUPS', */
394 : /* 3 /' *****************************************') */
395 : /* WRITE(KFILDO,407) (NOV(J),J=1,LX) */
396 : /* 407 FORMAT(/' '20I6) */
397 : /* WRITE(KFILDO,408)CFEED,LX */
398 : /* 408 FORMAT(A1,/' *****************************************' */
399 : /* 1 /' THE GROUP MINIMA JMIN( ) AFTER REDUCTION IN SIZE', */
400 : /* 2 ' FOR'I10,' GROUPS', */
401 : /* 3 /' *****************************************') */
402 : /* WRITE(KFILDO,409) (JMIN(J),J=1,LX) */
403 : /* 409 FORMAT(/' '20I6) */
404 :
405 : L410:
406 0 : if ( newbox != 0 ) free(newbox);
407 0 : if ( newboxp != 0 ) free(newboxp);
408 0 : return 0;
409 : } /* reduce_ */
410 :
|
