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 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410
|
/* reduce.f -- translated by f2c (version 20031025).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
*/
/*#include "f2c.h"*/
#include <stdlib.h>
#include "grib2.h"
typedef g2int integer;
typedef g2float real;
/* Subroutine */ int reduce(integer *kfildo, integer *jmin, integer *jmax,
integer *lbit, integer *nov, integer *lx, integer *ndg, integer *ibit,
integer *jbit, integer *kbit, integer *novref, integer *ibxx2,
integer *ier)
{
/* Initialized data */
static integer ifeed = 12;
/* System generated locals */
integer i__1, i__2;
/* Local variables */
static integer newboxtp, j, l, m, jj, lxn, left;
static real pimp;
static integer move, novl;
static char cfeed[1];
static integer nboxj[31], lxnkp, iorigb, ibxx2m1, movmin,
ntotbt[31], ntotpr, newboxt;
integer *newbox, *newboxp;
/* NOVEMBER 2001 GLAHN TDL GRIB2 */
/* MARCH 2002 GLAHN COMMENT IER = 715 */
/* MARCH 2002 GLAHN MODIFIED TO ACCOMMODATE LX=1 ON ENTRY */
/* PURPOSE */
/* DETERMINES WHETHER THE NUMBER OF GROUPS SHOULD BE */
/* INCREASED IN ORDER TO REDUCE THE SIZE OF THE LARGE */
/* GROUPS, AND TO MAKE THAT ADJUSTMENT. BY REDUCING THE */
/* SIZE OF THE LARGE GROUPS, LESS BITS MAY BE NECESSARY */
/* FOR PACKING THE GROUP SIZES AND ALL THE INFORMATION */
/* ABOUT THE GROUPS. */
/* THE REFERENCE FOR NOV( ) WAS REMOVED IN THE CALLING */
/* ROUTINE SO THAT KBIT COULD BE DETERMINED. THIS */
/* FURNISHES A STARTING POINT FOR THE ITERATIONS IN REDUCE. */
/* HOWEVER, THE REFERENCE MUST BE CONSIDERED. */
/* DATA SET USE */
/* KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) */
/* VARIABLES IN CALL SEQUENCE */
/* KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE. (INPUT) */
/* JMIN(J) = THE MINIMUM OF EACH GROUP (J=1,LX). IT IS */
/* POSSIBLE AFTER SPLITTING THE GROUPS, JMIN( ) */
/* WILL NOT BE THE MINIMUM OF THE NEW GROUP. */
/* THIS DOESN'T MATTER; JMIN( ) IS REALLY THE */
/* GROUP REFERENCE AND DOESN'T HAVE TO BE THE */
/* SMALLEST VALUE. (INPUT/OUTPUT) */
/* JMAX(J) = THE MAXIMUM OF EACH GROUP (J=1,LX). */
/* (INPUT/OUTPUT) */
/* LBIT(J) = THE NUMBER OF BITS NECESSARY TO PACK EACH GROUP */
/* (J=1,LX). (INPUT/OUTPUT) */
/* NOV(J) = THE NUMBER OF VALUES IN EACH GROUP (J=1,LX). */
/* (INPUT/OUTPUT) */
/* LX = THE NUMBER OF GROUPS. THIS WILL BE INCREASED */
/* IF GROUPS ARE SPLIT. (INPUT/OUTPUT) */
/* NDG = THE DIMENSION OF JMIN( ), JMAX( ), LBIT( ), AND */
/* NOV( ). (INPUT) */
/* IBIT = THE NUMBER OF BITS NECESSARY TO PACK THE JMIN(J) */
/* VALUES, J=1,LX. (INPUT) */
/* JBIT = THE NUMBER OF BITS NECESSARY TO PACK THE LBIT(J) */
/* VALUES, J=1,LX. (INPUT) */
/* KBIT = THE NUMBER OF BITS NECESSARY TO PACK THE NOV(J) */
/* VALUES, J=1,LX. IF THE GROUPS ARE SPLIT, KBIT */
/* IS REDUCED. (INPUT/OUTPUT) */
/* NOVREF = REFERENCE VALUE FOR NOV( ). (INPUT) */
/* IBXX2(J) = 2**J (J=0,30). (INPUT) */
/* IER = ERROR RETURN. (OUTPUT) */
/* 0 = GOOD RETURN. */
/* 714 = PROBLEM IN ALGORITHM. REDUCE ABORTED. */
/* 715 = NGP NOT LARGE ENOUGH. REDUCE ABORTED. */
/* NTOTBT(J) = THE TOTAL BITS USED FOR THE PACKING BITS J */
/* (J=1,30). (INTERNAL) */
/* NBOXJ(J) = NEW BOXES NEEDED FOR THE PACKING BITS J */
/* (J=1,30). (INTERNAL) */
/* NEWBOX(L) = NUMBER OF NEW BOXES (GROUPS) FOR EACH ORIGINAL */
/* GROUP (L=1,LX) FOR THE CURRENT J. (AUTOMATIC) */
/* (INTERNAL) */
/* NEWBOXP(L) = SAME AS NEWBOX( ) BUT FOR THE PREVIOUS J. */
/* THIS ELIMINATES RECOMPUTATION. (AUTOMATIC) */
/* (INTERNAL) */
/* CFEED = CONTAINS THE CHARACTER REPRESENTATION */
/* OF A PRINTER FORM FEED. (CHARACTER) (INTERNAL) */
/* IFEED = CONTAINS THE INTEGER VALUE OF A PRINTER */
/* FORM FEED. (INTERNAL) */
/* IORIGB = THE ORIGINAL NUMBER OF BITS NECESSARY */
/* FOR THE GROUP VALUES. (INTERNAL) */
/* 1 2 3 4 5 6 7 X */
/* NON SYSTEM SUBROUTINES CALLED */
/* NONE */
/* NEWBOX( ) AND NEWBOXP( ) were AUTOMATIC ARRAYS. */
newbox = (integer *)calloc(*ndg,sizeof(integer));
newboxp = (integer *)calloc(*ndg,sizeof(integer));
/* Parameter adjustments */
--nov;
--lbit;
--jmax;
--jmin;
/* Function Body */
*ier = 0;
if (*lx == 1) {
goto L410;
}
/* IF THERE IS ONLY ONE GROUP, RETURN. */
*(unsigned char *)cfeed = (char) ifeed;
/* INITIALIZE NUMBER OF NEW BOXES PER GROUP TO ZERO. */
i__1 = *lx;
for (l = 1; l <= i__1; ++l) {
newbox[l - 1] = 0;
/* L110: */
}
/* INITIALIZE NUMBER OF TOTAL NEW BOXES PER J TO ZERO. */
for (j = 1; j <= 31; ++j) {
ntotbt[j - 1] = 999999999;
nboxj[j - 1] = 0;
/* L112: */
}
iorigb = (*ibit + *jbit + *kbit) * *lx;
/* IBIT = BITS TO PACK THE JMIN( ). */
/* JBIT = BITS TO PACK THE LBIT( ). */
/* KBIT = BITS TO PACK THE NOV( ). */
/* LX = NUMBER OF GROUPS. */
ntotbt[*kbit - 1] = iorigb;
/* THIS IS THE VALUE OF TOTAL BITS FOR THE ORIGINAL LX */
/* GROUPS, WHICH REQUIRES KBITS TO PACK THE GROUP */
/* LENGHTS. SETTING THIS HERE MAKES ONE LESS LOOPS */
/* NECESSARY BELOW. */
/* COMPUTE BITS NOW USED FOR THE PARAMETERS DEFINED. */
/* DETERMINE OTHER POSSIBILITES BY INCREASING LX AND DECREASING */
/* NOV( ) WITH VALUES GREATER THAN THRESHOLDS. ASSUME A GROUP IS */
/* SPLIT INTO 2 OR MORE GROUPS SO THAT KBIT IS REDUCED WITHOUT */
/* CHANGING IBIT OR JBIT. */
jj = 0;
/* Computing MIN */
i__1 = 30, i__2 = *kbit - 1;
/*for (j = min(i__1,i__2); j >= 2; --j) {*/
for (j = (i__1 < i__2) ? i__1 : i__2; j >= 2; --j) {
/* VALUES GE KBIT WILL NOT REQUIRE SPLITS. ONCE THE TOTAL */
/* BITS START INCREASING WITH DECREASING J, STOP. ALSO, THE */
/* NUMBER OF BITS REQUIRED IS KNOWN FOR KBITS = NTOTBT(KBIT). */
newboxt = 0;
i__1 = *lx;
for (l = 1; l <= i__1; ++l) {
if (nov[l] < ibxx2[j]) {
newbox[l - 1] = 0;
/* NO SPLITS OR NEW BOXES. */
goto L190;
} else {
novl = nov[l];
m = (nov[l] - 1) / (ibxx2[j] - 1) + 1;
/* M IS FOUND BY SOLVING THE EQUATION BELOW FOR M: */
/* (NOV(L)+M-1)/M LT IBXX2(J) */
/* M GT (NOV(L)-1)/(IBXX2(J)-1) */
/* SET M = (NOV(L)-1)/(IBXX2(J)-1)+1 */
L130:
novl = (nov[l] + m - 1) / m;
/* THE +M-1 IS NECESSARY. FOR INSTANCE, 15 WILL FIT */
/* INTO A BOX 4 BITS WIDE, BUT WON'T DIVIDE INTO */
/* TWO BOXES 3 BITS WIDE EACH. */
if (novl < ibxx2[j]) {
goto L185;
} else {
++m;
/* *** WRITE(KFILDO,135)L,NOV(L),NOVL,M,J,IBXX2(J) */
/* *** 135 FORMAT(/' AT 135--L,NOV(L),NOVL,M,J,IBXX2(J)',6I10) */
goto L130;
}
/* THE ABOVE DO LOOP WILL NEVER COMPLETE. */
}
L185:
newbox[l - 1] = m - 1;
newboxt = newboxt + m - 1;
L190:
;
}
nboxj[j - 1] = newboxt;
ntotpr = ntotbt[j];
ntotbt[j - 1] = (*ibit + *jbit) * (*lx + newboxt) + j * (*lx +
newboxt);
if (ntotbt[j - 1] >= ntotpr) {
jj = j + 1;
/* THE PLUS IS USED BECAUSE J DECREASES PER ITERATION. */
goto L250;
} else {
/* SAVE THE TOTAL NEW BOXES AND NEWBOX( ) IN CASE THIS */
/* IS THE J TO USE. */
newboxtp = newboxt;
i__1 = *lx;
for (l = 1; l <= i__1; ++l) {
newboxp[l - 1] = newbox[l - 1];
/* L195: */
}
/* WRITE(KFILDO,197)NEWBOXT,IBXX2(J) */
/* 197 FORMAT(/' *****************************************' */
/* 1 /' THE NUMBER OF NEWBOXES PER GROUP OF THE TOTAL', */
/* 2 I10,' FOR GROUP MAXSIZE PLUS 1 ='I10 */
/* 3 /' *****************************************') */
/* WRITE(KFILDO,198) (NEWBOX(L),L=1,LX) */
/* 198 FORMAT(/' '20I6/(' '20I6)) */
}
/* 205 WRITE(KFILDO,209)KBIT,IORIGB */
/* 209 FORMAT(/' ORIGINAL BITS WITH KBIT OF',I5,' =',I10) */
/* WRITE(KFILDO,210)(N,N=2,10),(IBXX2(N),N=2,10), */
/* 1 (NTOTBT(N),N=2,10),(NBOXJ(N),N=2,10), */
/* 2 (N,N=11,20),(IBXX2(N),N=11,20), */
/* 3 (NTOTBT(N),N=11,20),(NBOXJ(N),N=11,20), */
/* 4 (N,N=21,30),(IBXX2(N),N=11,20), */
/* 5 (NTOTBT(N),N=21,30),(NBOXJ(N),N=21,30) */
/* 210 FORMAT(/' THE TOTAL BYTES FOR MAXIMUM GROUP LENGTHS BY ROW'// */
/* 1 ' J = THE NUMBER OF BITS PER GROUP LENGTH'/ */
/* 2 ' IBXX2(J) = THE MAXIMUM GROUP LENGTH PLUS 1 FOR THIS J'/ */
/* 3 ' NTOTBT(J) = THE TOTAL BITS FOR THIS J'/ */
/* 4 ' NBOXJ(J) = THE NEW GROUPS FOR THIS J'/ */
/* 5 4(/10X,9I10)/4(/10I10)/4(/10I10)) */
/* L200: */
}
L250:
pimp = (iorigb - ntotbt[jj - 1]) / (real) iorigb * 100.f;
/* WRITE(KFILDO,252)PIMP,KBIT,JJ */
/* 252 FORMAT(/' PERCENT IMPROVEMENT =',F6.1, */
/* 1 ' BY DECREASING GROUP LENGTHS FROM',I4,' TO',I4,' BITS') */
if (pimp >= 2.f) {
/* WRITE(KFILDO,255)CFEED,NEWBOXTP,IBXX2(JJ) */
/* 255 FORMAT(A1,/' *****************************************' */
/* 1 /' THE NUMBER OF NEWBOXES PER GROUP OF THE TOTAL', */
/* 2 I10,' FOR GROUP MAXSIZE PLUS 1 ='I10 */
/* 2 /' *****************************************') */
/* WRITE(KFILDO,256) (NEWBOXP(L),L=1,LX) */
/* 256 FORMAT(/' '20I6) */
/* ADJUST GROUP LENGTHS FOR MAXIMUM LENGTH OF JJ BITS. */
/* THE MIN PER GROUP AND THE NUMBER OF BITS REQUIRED */
/* PER GROUP ARE NOT CHANGED. THIS MAY MEAN THAT A */
/* GROUP HAS A MIN (OR REFERENCE) THAT IS NOT ZERO. */
/* THIS SHOULD NOT MATTER TO THE UNPACKER. */
lxnkp = *lx + newboxtp;
/* LXNKP = THE NEW NUMBER OF BOXES */
if (lxnkp > *ndg) {
/* DIMENSIONS NOT LARGE ENOUGH. PROBABLY AN ERROR */
/* OF SOME SORT. ABORT. */
/* WRITE(KFILDO,257)NDG,LXNPK */
/* 1 2 3 4 5 6 7 X */
/* 257 FORMAT(/' DIMENSIONS OF JMIN, ETC. IN REDUCE =',I8, */
/* 1 ' NOT LARGE ENOUGH FOR THE EXPANDED NUMBER OF', */
/* 2 ' GROUPS =',I8,'. ABORT REDUCE.') */
*ier = 715;
goto L410;
/* AN ABORT CAUSES THE CALLING PROGRAM TO REEXECUTE */
/* WITHOUT CALLING REDUCE. */
}
lxn = lxnkp;
/* LXN IS THE NUMBER OF THE BOX IN THE NEW SERIES BEING */
/* FILLED. IT DECREASES PER ITERATION. */
ibxx2m1 = ibxx2[jj] - 1;
/* IBXX2M1 IS THE MAXIMUM NUMBER OF VALUES PER GROUP. */
for (l = *lx; l >= 1; --l) {
/* THE VALUES IS NOV( ) REPRESENT THOSE VALUES + NOVREF. */
/* WHEN VALUES ARE MOVED TO ANOTHER BOX, EACH VALUE */
/* MOVED TO A NEW BOX REPRESENTS THAT VALUE + NOVREF. */
/* THIS HAS TO BE CONSIDERED IN MOVING VALUES. */
if (newboxp[l - 1] * (ibxx2m1 + *novref) + *novref > nov[l] + *
novref) {
/* IF THE ABOVE TEST IS MET, THEN MOVING IBXX2M1 VALUES */
/* FOR ALL NEW BOXES WILL LEAVE A NEGATIVE NUMBER FOR */
/* THE LAST BOX. NOT A TOLERABLE SITUATION. */
movmin = (nov[l] - newboxp[l - 1] * *novref) / newboxp[l - 1];
left = nov[l];
/* LEFT = THE NUMBER OF VALUES TO MOVE FROM THE ORIGINAL */
/* BOX TO EACH NEW BOX EXCEPT THE LAST. LEFT IS THE */
/* NUMBER LEFT TO MOVE. */
} else {
movmin = ibxx2m1;
/* MOVMIN VALUES CAN BE MOVED FOR EACH NEW BOX. */
left = nov[l];
/* LEFT IS THE NUMBER OF VALUES LEFT TO MOVE. */
}
if (newboxp[l - 1] > 0) {
if ((movmin + *novref) * newboxp[l - 1] + *novref <= nov[l] +
*novref && (movmin + *novref) * (newboxp[l - 1] + 1)
>= nov[l] + *novref) {
goto L288;
} else {
/* ***D WRITE(KFILDO,287)L,MOVMIN,NOVREF,NEWBOXP(L),NOV(L) */
/* ***D287 FORMAT(/' AT 287 IN REDUCE--L,MOVMIN,NOVREF,', */
/* ***D 1 'NEWBOXP(L),NOV(L)',5I12 */
/* ***D 2 ' REDUCE ABORTED.') */
/* WRITE(KFILDO,2870) */
/* 2870 FORMAT(/' AN ERROR IN REDUCE ALGORITHM. ABORT REDUCE.') */
*ier = 714;
goto L410;
/* AN ABORT CAUSES THE CALLING PROGRAM TO REEXECUTE */
/* WITHOUT CALLING REDUCE. */
}
}
L288:
i__1 = newboxp[l - 1] + 1;
for (j = 1; j <= i__1; ++j) {
/*move = min(movmin,left);*/
move = (movmin < left) ? movmin : left;
jmin[lxn] = jmin[l];
jmax[lxn] = jmax[l];
lbit[lxn] = lbit[l];
nov[lxn] = move;
--lxn;
left -= move + *novref;
/* THE MOVE OF MOVE VALUES REALLY REPRESENTS A MOVE OF */
/* MOVE + NOVREF VALUES. */
/* L290: */
}
if (left != -(*novref)) {
/* *** WRITE(KFILDO,292)L,LXN,MOVE,LXNKP,IBXX2(JJ),LEFT,NOV(L), */
/* *** 1 MOVMIN */
/* *** 292 FORMAT(' AT 292 IN REDUCE--L,LXN,MOVE,LXNKP,', */
/* *** 1 'IBXX2(JJ),LEFT,NOV(L),MOVMIN'/8I12) */
}
/* L300: */
}
*lx = lxnkp;
/* LX IS NOW THE NEW NUMBER OF GROUPS. */
*kbit = jj;
/* KBIT IS NOW THE NEW NUMBER OF BITS REQUIRED FOR PACKING */
/* GROUP LENGHTS. */
}
/* WRITE(KFILDO,406)CFEED,LX */
/* 406 FORMAT(A1,/' *****************************************' */
/* 1 /' THE GROUP SIZES NOV( ) AFTER REDUCTION IN SIZE', */
/* 2 ' FOR'I10,' GROUPS', */
/* 3 /' *****************************************') */
/* WRITE(KFILDO,407) (NOV(J),J=1,LX) */
/* 407 FORMAT(/' '20I6) */
/* WRITE(KFILDO,408)CFEED,LX */
/* 408 FORMAT(A1,/' *****************************************' */
/* 1 /' THE GROUP MINIMA JMIN( ) AFTER REDUCTION IN SIZE', */
/* 2 ' FOR'I10,' GROUPS', */
/* 3 /' *****************************************') */
/* WRITE(KFILDO,409) (JMIN(J),J=1,LX) */
/* 409 FORMAT(/' '20I6) */
L410:
if ( newbox != 0 ) free(newbox);
if ( newboxp != 0 ) free(newboxp);
return 0;
} /* reduce_ */
|