1 subroutine genbtf ( nrows , ncols , colstr, rowidx, rowstr,
2 $ colidx, w , rnto , cnto , nhrows,
3 $ nhcols, hrzcmp, nsrows, sqcmpn, nvrows,
4 $ nvcols, vrtcmp, rcmstr, ccmstr, msglvl,
122 integer nrows , ncols , nhrows, nhcols, hrzcmp, nsrows,
123 $ sqcmpn, nvrows, nvcols, vrtcmp, msglvl, output
125 integer colstr (ncols+1), rowidx (*),
126 $ rowstr(nrows+1), colidx(*),
128 $ cnto(ncols) , rnto(nrows),
129 $ rcmstr(nrows+1), ccmstr(ncols+1)
135 integer cmk , cmbase, cnbase, cst , cw1 , cw2 ,
136 $ cw3 , i , hindex, ncompn, nscols, rmk ,
137 $ rnbase, rst , rw1 , rw2 , rw3 , sqindx,
140 real timeh , timem , times , timev , tmstrt
166 call izero ( cw3 + ncols - 1, w, 1 )
179 if ( msglvl .ge. 1 )
then
180 tmstrt = etime( tarray )
183 call maxmatch ( nrows , ncols , colstr, rowidx, w(cw1), w(cmk),
184 $ w(rw2), w(cw2), w(cw3), w(rst), w(cst) )
187 w(rmk + i - 1) = sqindx
191 w(cmk + i - 1) = sqindx
194 if ( msglvl .ge. 1 )
then
195 timem = etime( tarray ) - tmstrt
196 if ( msglvl .ge. 3 )
then
197 call prtivs (
'rowset', nrows, w(rst), output )
198 call prtivs (
'colset', ncols, w(cst), output )
211 if ( msglvl .ge. 1 )
then
212 tmstrt = etime( tarray )
215 call rectblk ( nrows , ncols , hindex, sqindx, colstr, rowidx,
216 $ w(cst), w(rst), w(cw1), w(cw2), w(cmk), w(rmk),
219 if ( msglvl .ge. 1 )
then
220 timeh = etime( tarray ) - tmstrt
221 if ( msglvl .ge. 3 )
then
222 write ( output, * )
'0nhrows, nhcols', nhrows, nhcols
231 if ( msglvl .ge. 1 )
then
232 tmstrt = etime( tarray )
235 tmstrt = etime( tarray )
237 call rectblk ( ncols , nrows , vindex, sqindx, rowstr, colidx,
238 $ w(rst), w(cst), w(rw1), w(rw2), w(rmk), w(cmk),
241 if ( msglvl .ge. 1 )
then
242 timev = etime( tarray ) - tmstrt
243 if ( msglvl .ge. 3 )
then
244 write ( output, * )
'0nvrows, nvcols', nvrows, nvcols
252 nscols = ncols - nhcols - nvcols
253 nsrows = nrows - nhrows - nvrows
255 if ( msglvl .ge. 1 )
then
256 call corsum ( timem , timeh , timev , nhrows, nhcols, nsrows,
257 $ nscols, nvrows, nvcols, output )
269 if ( nhcols .gt. 0 )
then
271 if ( msglvl .ge. 1 )
then
272 tmstrt = etime( tarray )
279 call concmp ( cmbase, cnbase, rnbase, hindex, ncols , nrows ,
280 $ nhcols, nhrows, colstr, rowidx, rowstr, colidx,
281 $ w(rw1), w(cw1), w(cw2), w(rw2), w(rw3), w(cw3),
282 $ w(rmk), w(cmk), rcmstr, ccmstr, rnto , cnto ,
285 if ( msglvl .ge. 1 )
then
286 timeh = etime( tarray ) - tmstrt
287 if ( msglvl .ge. 3 )
then
288 write ( output, * )
'0hrzcmp', hrzcmp
289 call prtivs (
'rcmstr', hrzcmp + 1, rcmstr, output )
290 call prtivs (
'ccmstr', hrzcmp + 1, ccmstr, output )
291 call prtivs (
'rnto', nrows, rnto, output )
292 call prtivs (
'cnto', ncols, cnto, output )
303 if ( nsrows .gt. 0 )
then
305 if ( msglvl .ge. 1 )
then
306 tmstrt = etime( tarray )
314 call mmc13e ( nrows , ncols , nhcols, nhrows, nsrows, sqindx,
315 $ hrzcmp, rowstr, colidx, w(cst), w(rw1), w(rw2),
316 $ w(cw1), w(cw2), w(cmk), ccmstr, rcmstr, cnto ,
319 if ( msglvl .ge. 1 )
then
320 call strchk ( nrows , ncols , colstr, rowidx, nhrows,
321 $ nhcols, nsrows, rnto , cnto , w(cst),
326 if ( msglvl .ge. 1 )
then
327 times = etime( tarray ) - tmstrt
328 if ( msglvl .ge. 3 )
then
329 ncompn = hrzcmp + sqcmpn + 1
330 write ( output, * )
'0sqcmpn', sqcmpn
331 call prtivs (
'rcmstr', ncompn, rcmstr, output )
332 call prtivs (
'ccmstr', ncompn, ccmstr, output )
333 call prtivs (
'rnto', nrows, rnto, output )
334 call prtivs (
'cnto', ncols, cnto, output )
345 if ( nvrows .gt. 0 )
then
347 cmbase = hrzcmp + sqcmpn
348 rnbase = nhrows + nscols
349 cnbase = nhcols + nscols
355 if ( msglvl .ge. 1 )
then
356 tmstrt = etime( tarray )
359 call concmp ( cmbase, rnbase, cnbase, vindex, nrows , ncols ,
360 $ nvrows, nvcols, rowstr, colidx, colstr, rowidx,
361 $ w(cw1), w(rw1), w(rw2), w(cw2), w(cw3), w(rw3),
362 $ w(cmk), w(rmk), ccmstr, rcmstr, cnto , rnto ,
365 if ( msglvl .ge. 1 )
then
367 timev = etime( tarray ) - tmstrt
369 if ( msglvl .ge. 2 )
then
370 call prtivs (
'rnto', nrows, rnto, output )
371 call prtivs (
'cnto', ncols, cnto, output )
373 if ( msglvl .ge. 3 )
then
374 ncompn = hrzcmp + sqcmpn + vrtcmp + 1
375 write ( output, * )
'0vrtcmp', vrtcmp
376 call prtivs (
'rcmstr', ncompn, rcmstr, output )
377 call prtivs (
'ccmstr', ncompn, ccmstr, output )
390 if ( msglvl .ge. 1 )
then
391 call finsum ( timeh , times , timev , hrzcmp, sqcmpn,
392 $ vrtcmp, ccmstr, rcmstr, output )
subroutine concmp(cmbase, rnbase, cnbase, vindex, nrows, ncols, nvrows, nvcols, rowstr, colidx, colstr, rowidx, predrw, nextrw, predcl, nextcl, ctab, rtab, colmrk, rowmrk, cmclad, cmrwad, cnto, rnto, numcmp)
subroutine corsum(tmmtch, timhrz, timvrt, nhrows, nhcols, nsrows, nscols, nvrows, nvcols, output)
subroutine finsum(timhrz, timesq, timvrt, hrzcmp, sqcmpn, vrtcmp, ccmstr, rcmstr, output)
subroutine genbtf(nrows, ncols, colstr, rowidx, rowstr, colidx, w, rnto, cnto, nhrows, nhcols, hrzcmp, nsrows, sqcmpn, nvrows, nvcols, vrtcmp, rcmstr, ccmstr, msglvl, output)
subroutine izero(n, x, incx)
subroutine maxmatch(nrows, ncols, colstr, rowind, prevcl, prevrw, marker, tryrow, nxtchp, rowset, colset)
subroutine mmc13e(nrows, ncols, nhcols, nhrows, nscols, sqindx, hrzcmp, rowstr, colind, colset, trycol, cbegin, lowlnk, prev, colmrk, ccmstr, rcmstr, cnto, rnto, sqcmpn)
subroutine prtivs(title, n, x, output)
subroutine rectblk(nrows, ncols, marked, unmrkd, colstr, rowidx, colset, rowset, prevcl, tryrow, colmrk, rowmrk, nhrows, nhcols)
subroutine strchk(nrows, ncols, colstr, rowidx, nhrows, nhcols, nsrows, rnto, cnto, colset, rowset, output)