NCEPLIBS-g2  3.4.5
reduce.f
Go to the documentation of this file.
1 C> @file
2 C> @brief This subroutine determines groups of variable size.
3 C> @author Harry Glahn @date 2001-11-01
4 C>
5 
6 C> This subroutine determines whether the number of groups should be
7 C> increased in order to reduce the size of the large groups, and to
8 C> make that adjustment. By reducing the size of the large groups,
9 C> less bits may be necessary for packing the group sizes and all the
10 C> information about the groups. The reference for NOV was removed in
11 C> the calling routine so that kbit could be determined. This
12 C> furnishes a starting point for the iterations in reduce.
13 C>
14 C> @param[in] KFILDO unit number for output/print file.
15 C> @param[inout] JMIN the minimum of each group (j=1,lx). JMIN is
16 C> really the group reference and doesn't have to be the smallest
17 C> value.
18 C> @param[inout] JMAX the maximum of each group (j=1,lx).
19 C> @param[inout] LBIT the number of bits necessary to pack each group
20 C> (j=1,lx).
21 C> @param[inout] NOV the number of values in each group (j=1,lx).
22 C> @param[inout] LX the number of groups. This will be increased, if
23 C> groups are split.
24 C> @param[in] NDG the dimension of JMIN, JMAX, LBIT, and NOV.
25 C> @param[in] IBIT the number of bits necessary to pack the JMIN(j)
26 C> values, j=1,LX.
27 C> @param[in] JBIT the number of bits necessary to pack the LBIT(j)
28 C> values, j=1,LX.
29 C> @param[inout] KBIT the number of bits necessary to pack the NOV(j)
30 C> values, j=1,LX. If the groups are split, kbit is reduced.
31 C> @param[in] NOVREF reference value for NOV.
32 C> @param[in] IBXX2 ibxx2(j) = 2**j (j=0,30).
33 C> @param[out] IER error return.
34 C> - 0 good return.
35 C> - 714 error in reduce--non-fatal
36 C> - 715 ngp not large enough in reduce--non-fatal
37 C>
38 C> @author Harry Glahn @date 2001-11-01
39 C>
40 
41  SUBROUTINE reduce(KFILDO,JMIN,JMAX,LBIT,NOV,LX,NDG,IBIT,JBIT,KBIT,
42  1 NOVREF,IBXX2,IER)
43 
44  CHARACTER*1 CFEED
45 C
46  dimension jmin(ndg),jmax(ndg),lbit(ndg),nov(ndg)
47  dimension newbox(ndg),newboxp(ndg)
48 C NEWBOX( ) AND NEWBOXP( ) ARE AUTOMATIC ARRAYS.
49  dimension ntotbt(0:31),nboxj(0:31)
50  dimension ibxx2(0:30)
51 C
52  DATA ifeed/12/
53 C
54  ier=0
55  IF(lx.EQ.1)GO TO 410
56 C IF THERE IS ONLY ONE GROUP, RETURN.
57 C
58  cfeed=char(ifeed)
59 C
60 C INITIALIZE NUMBER OF NEW BOXES PER GROUP TO ZERO.
61 C
62  DO 110 l=1,lx
63  newbox(l)=0
64  110 CONTINUE
65 C
66 C INITIALIZE NUMBER OF TOTAL NEW BOXES PER J TO ZERO.
67 C
68  DO 112 j=0,31
69  ntotbt(j)=999999999
70  nboxj(j)=0
71  112 CONTINUE
72 C
73  iorigb=(ibit+jbit+kbit)*lx
74 C IBIT = BITS TO PACK THE JMIN( ).
75 C JBIT = BITS TO PACK THE LBIT( ).
76 C KBIT = BITS TO PACK THE NOV( ).
77 C LX = NUMBER OF GROUPS.
78  ntotbt(kbit)=iorigb
79 C THIS IS THE VALUE OF TOTAL BITS FOR THE ORIGINAL LX
80 C GROUPS, WHICH REQUIRES KBITS TO PACK THE GROUP
81 C LENGHTS. SETTING THIS HERE MAKES ONE LESS LOOPS
82 C NECESSARY BELOW.
83 C
84 C COMPUTE BITS NOW USED FOR THE PARAMETERS DEFINED.
85 C
86 C DETERMINE OTHER POSSIBILITES BY INCREASING LX AND DECREASING
87 C NOV( ) WITH VALUES GREATER THAN THRESHOLDS. ASSUME A GROUP IS
88 C SPLIT INTO 2 OR MORE GROUPS SO THAT KBIT IS REDUCED WITHOUT
89 C CHANGING IBIT OR JBIT.
90 C
91  jj=0
92 C
93  DO 200 j=min(30,kbit-1),2,-1
94 C VALUES GE KBIT WILL NOT REQUIRE SPLITS. ONCE THE TOTAL
95 C BITS START INCREASING WITH DECREASING J, STOP. ALSO, THE
96 C NUMBER OF BITS REQUIRED IS KNOWN FOR KBITS = NTOTBT(KBIT).
97 C
98  newboxt=0
99 C
100  DO 190 l=1,lx
101 C
102  IF(nov(l).LT.ibxx2(j))THEN
103  newbox(l)=0
104 C NO SPLITS OR NEW BOXES.
105  GO TO 190
106  ELSE
107  novl=nov(l)
108 C
109  m=(nov(l)-1)/(ibxx2(j)-1)+1
110 C M IS FOUND BY SOLVING THE EQUATION BELOW FOR M:
111 C (NOV(L)+M-1)/M LT IBXX2(J)
112 C M GT (NOV(L)-1)/(IBXX2(J)-1)
113 C SET M = (NOV(L)-1)/(IBXX2(J)-1)+1
114  130 novl=(nov(l)+m-1)/m
115 C THE +M-1 IS NECESSARY. FOR INSTANCE, 15 WILL FIT
116 C INTO A BOX 4 BITS WIDE, BUT WON'T DIVIDE INTO
117 C TWO BOXES 3 BITS WIDE EACH.
118 C
119  IF(novl.LT.ibxx2(j))THEN
120  GO TO 185
121  ELSE
122  m=m+1
123 C*** WRITE(KFILDO,135)L,NOV(L),NOVL,M,J,IBXX2(J)
124 C*** 135 FORMAT(/' AT 135--L,NOV(L),NOVL,M,J,IBXX2(J)',6I10)
125  GO TO 130
126  ENDIF
127 C
128 C THE ABOVE DO LOOP WILL NEVER COMPLETE.
129  ENDIF
130 C
131  185 newbox(l)=m-1
132  newboxt=newboxt+m-1
133  190 CONTINUE
134 C
135  nboxj(j)=newboxt
136  ntotpr=ntotbt(j+1)
137  ntotbt(j)=(ibit+jbit)*(lx+newboxt)+j*(lx+newboxt)
138 C
139  IF(ntotbt(j).GE.ntotpr)THEN
140  jj=j+1
141 C THE PLUS IS USED BECAUSE J DECREASES PER ITERATION.
142  GO TO 250
143  ELSE
144 C
145 C SAVE THE TOTAL NEW BOXES AND NEWBOX( ) IN CASE THIS
146 C IS THE J TO USE.
147 C
148  newboxtp=newboxt
149 C
150  DO 195 l=1,lx
151  newboxp(l)=newbox(l)
152  195 CONTINUE
153 C
154 C WRITE(KFILDO,197)NEWBOXT,IBXX2(J)
155 C197 FORMAT(/' *****************************************'
156 C 1 /' THE NUMBER OF NEWBOXES PER GROUP OF THE TOTAL',
157 C 2 I10,' FOR GROUP MAXSIZE PLUS 1 ='I10
158 C 3 /' *****************************************')
159 C WRITE(KFILDO,198) (NEWBOX(L),L=1,LX)
160 C198 FORMAT(/' '20I6/(' '20I6))
161 
162  ENDIF
163 C
164 C205 WRITE(KFILDO,209)KBIT,IORIGB
165 C209 FORMAT(/' ORIGINAL BITS WITH KBIT OF',I5,' =',I10)
166 C WRITE(KFILDO,210)(N,N=2,10),(IBXX2(N),N=2,10),
167 C 1 (NTOTBT(N),N=2,10),(NBOXJ(N),N=2,10),
168 C 2 (N,N=11,20),(IBXX2(N),N=11,20),
169 C 3 (NTOTBT(N),N=11,20),(NBOXJ(N),N=11,20),
170 C 4 (N,N=21,30),(IBXX2(N),N=11,20),
171 C 5 (NTOTBT(N),N=21,30),(NBOXJ(N),N=21,30)
172 C210 FORMAT(/' THE TOTAL BYTES FOR MAXIMUM GROUP LENGTHS BY ROW'//
173 C 1 ' J = THE NUMBER OF BITS PER GROUP LENGTH'/
174 C 2 ' IBXX2(J) = THE MAXIMUM GROUP LENGTH PLUS 1 FOR THIS J'/
175 C 3 ' NTOTBT(J) = THE TOTAL BITS FOR THIS J'/
176 C 4 ' NBOXJ(J) = THE NEW GROUPS FOR THIS J'/
177 C 5 4(/10X,9I10)/4(/10I10)/4(/10I10))
178 C
179  200 CONTINUE
180 C
181  250 pimp=((iorigb-ntotbt(jj))/float(iorigb))*100.
182 C WRITE(KFILDO,252)PIMP,KBIT,JJ
183 C252 FORMAT(/' PERCENT IMPROVEMENT =',F6.1,
184 C 1 ' BY DECREASING GROUP LENGTHS FROM',I4,' TO',I4,' BITS')
185  IF(pimp.GE.2.)THEN
186 C
187 C WRITE(KFILDO,255)CFEED,NEWBOXTP,IBXX2(JJ)
188 C255 FORMAT(A1,/' *****************************************'
189 C 1 /' THE NUMBER OF NEWBOXES PER GROUP OF THE TOTAL',
190 C 2 I10,' FOR GROUP MAXSIZE PLUS 1 ='I10
191 C 2 /' *****************************************')
192 C WRITE(KFILDO,256) (NEWBOXP(L),L=1,LX)
193 C256 FORMAT(/' '20I6)
194 C
195 C ADJUST GROUP LENGTHS FOR MAXIMUM LENGTH OF JJ BITS.
196 C THE MIN PER GROUP AND THE NUMBER OF BITS REQUIRED
197 C PER GROUP ARE NOT CHANGED. THIS MAY MEAN THAT A
198 C GROUP HAS A MIN (OR REFERENCE) THAT IS NOT ZERO.
199 C THIS SHOULD NOT MATTER TO THE UNPACKER.
200 C
201  lxnkp=lx+newboxtp
202 C LXNKP = THE NEW NUMBER OF BOXES
203 C
204  IF(lxnkp.GT.ndg)THEN
205 C DIMENSIONS NOT LARGE ENOUGH. PROBABLY AN ERROR
206 C OF SOME SORT. ABORT.
207 C WRITE(KFILDO,257)NDG,LXNPK
208 C 1 2 3 4 5 6 7 X
209 C257 FORMAT(/' DIMENSIONS OF JMIN, ETC. IN REDUCE =',I8,
210 C 1 ' NOT LARGE ENOUGH FOR THE EXPANDED NUMBER OF',
211 C 2 ' GROUPS =',I8,'. ABORT REDUCE.')
212  ier=715
213  GO TO 410
214 C AN ABORT CAUSES THE CALLING PROGRAM TO REEXECUTE
215 C WITHOUT CALLING REDUCE.
216  ENDIF
217 C
218  lxn=lxnkp
219 C LXN IS THE NUMBER OF THE BOX IN THE NEW SERIES BEING
220 C FILLED. IT DECREASES PER ITERATION.
221  ibxx2m1=ibxx2(jj)-1
222 C IBXX2M1 IS THE MAXIMUM NUMBER OF VALUES PER GROUP.
223 C
224  DO 300 l=lx,1,-1
225 C
226 C THE VALUES IS NOV( ) REPRESENT THOSE VALUES + NOVREF.
227 C WHEN VALUES ARE MOVED TO ANOTHER BOX, EACH VALUE
228 C MOVED TO A NEW BOX REPRESENTS THAT VALUE + NOVREF.
229 C THIS HAS TO BE CONSIDERED IN MOVING VALUES.
230 C
231  IF(newboxp(l)*(ibxx2m1+novref)+novref.GT.nov(l)+novref)THEN
232 C IF THE ABOVE TEST IS MET, THEN MOVING IBXX2M1 VALUES
233 C FOR ALL NEW BOXES WILL LEAVE A NEGATIVE NUMBER FOR
234 C THE LAST BOX. NOT A TOLERABLE SITUATION.
235  movmin=(nov(l)-(newboxp(l))*novref)/newboxp(l)
236  left=nov(l)
237 C LEFT = THE NUMBER OF VALUES TO MOVE FROM THE ORIGINAL
238 C BOX TO EACH NEW BOX EXCEPT THE LAST. LEFT IS THE
239 C NUMBER LEFT TO MOVE.
240  ELSE
241  movmin=ibxx2m1
242 C MOVMIN VALUES CAN BE MOVED FOR EACH NEW BOX.
243  left=nov(l)
244 C LEFT IS THE NUMBER OF VALUES LEFT TO MOVE.
245  ENDIF
246 C
247  IF(newboxp(l).GT.0)THEN
248  IF((movmin+novref)*newboxp(l)+novref.LE.nov(l)+novref.
249  1 and.(movmin+novref)*(newboxp(l)+1).GE.nov(l)+novref)THEN
250  GO TO 288
251  ELSE
252 C***D WRITE(KFILDO,287)L,MOVMIN,NOVREF,NEWBOXP(L),NOV(L)
253 C***D287 FORMAT(/' AT 287 IN REDUCE--L,MOVMIN,NOVREF,',
254 C***D 1 'NEWBOXP(L),NOV(L)',5I12
255 C***D 2 ' REDUCE ABORTED.')
256 C WRITE(KFILDO,2870)
257 C2870 FORMAT(/' AN ERROR IN REDUCE ALGORITHM. ABORT REDUCE.')
258  ier=714
259  GO TO 410
260 C AN ABORT CAUSES THE CALLING PROGRAM TO REEXECUTE
261 C WITHOUT CALLING REDUCE.
262  ENDIF
263 C
264  ENDIF
265 C
266  288 DO 290 j=1,newboxp(l)+1
267  move=min(movmin,left)
268  jmin(lxn)=jmin(l)
269  jmax(lxn)=jmax(l)
270  lbit(lxn)=lbit(l)
271  nov(lxn)=move
272  lxn=lxn-1
273  left=left-(move+novref)
274 C THE MOVE OF MOVE VALUES REALLY REPRESENTS A MOVE OF
275 C MOVE + NOVREF VALUES.
276  290 CONTINUE
277 C
278  IF(left.NE.-novref)THEN
279 C*** WRITE(KFILDO,292)L,LXN,MOVE,LXNKP,IBXX2(JJ),LEFT,NOV(L),
280 C*** 1 MOVMIN
281 C*** 292 FORMAT(' AT 292 IN REDUCE--L,LXN,MOVE,LXNKP,',
282 C*** 1 'IBXX2(JJ),LEFT,NOV(L),MOVMIN'/8I12)
283  ENDIF
284 C
285  300 CONTINUE
286 C
287  lx=lxnkp
288 C LX IS NOW THE NEW NUMBER OF GROUPS.
289  kbit=jj
290 C KBIT IS NOW THE NEW NUMBER OF BITS REQUIRED FOR PACKING
291 C GROUP LENGHTS.
292  ENDIF
293 C
294 C WRITE(KFILDO,406)CFEED,LX
295 C406 FORMAT(A1,/' *****************************************'
296 C 1 /' THE GROUP SIZES NOV( ) AFTER REDUCTION IN SIZE',
297 C 2 ' FOR'I10,' GROUPS',
298 C 3 /' *****************************************')
299 C WRITE(KFILDO,407) (NOV(J),J=1,LX)
300 C407 FORMAT(/' '20I6)
301 C WRITE(KFILDO,408)CFEED,LX
302 C408 FORMAT(A1,/' *****************************************'
303 C 1 /' THE GROUP MINIMA JMIN( ) AFTER REDUCTION IN SIZE',
304 C 2 ' FOR'I10,' GROUPS',
305 C 3 /' *****************************************')
306 C WRITE(KFILDO,409) (JMIN(J),J=1,LX)
307 C409 FORMAT(/' '20I6)
308 C
309  410 RETURN
310  END
311 
reduce
subroutine reduce(KFILDO, JMIN, JMAX, LBIT, NOV, LX, NDG, IBIT, JBIT, KBIT, NOVREF, IBXX2, IER)
This subroutine determines whether the number of groups should be increased in order to reduce the si...
Definition: reduce.f:43