#include "HepTuple/hbook/pilot.h"
      subroutine formatcwn(id1,numblk,nameblk,formblk)
*.
*.           To reconstruct the format string for an ntuple
*.
      implicit none
*
#include "HepTuple/hbook/hcntpar.inc"
#include "HepTuple/hbook/hcnt.inc"
#include "HepTuple/hbook/hcflag.inc"
#include "HepTuple/hbook/hcbook.inc"
#include "HepTuple/hbook/hcbits.inc"
#include "HepTuple/hbook/hcunit.inc"
*
      integer id1,numblk
*
      character*1301 chform
      character*(*)  formblk
      character*50   chunk
      character*(*)  nameblk
      character*80   var, title
      character*32   name, subs, range, smin, smax
      character*8    blknam
      character*9    snoent
      character*5    sid, scol
      character*4    sblok, sdim
      character*2    size, bits
      character*1    type,null
      logical        vtup, ldum
      real           fmin,fmax
      integer        idpos, numblocks, ll1, ie, lp, j, nelem
      integer        lv, nbits, isize, itype, nsub, i, lenname
      integer        lenocc, ndim, ioff, ll, nwtit, itit1, ls
      integer        noent, icols, ielem, lsi, lsa, imin, imax
      integer        lenform
      integer        jbit, locati
*
      null = char(0)
      id    = id1
      idpos = locati(iq(ltab+1),iq(lcdir+knrh),id)
      if (idpos .le. 0) then
         call hbug('Unknown N-tuple','HPRNT',id1)
         return
      endif
      lcid  = lq(ltab-idpos)
      i4 = jbit(iq(lcid+kbits),4)
      if (i4 .eq. 0) return
      if (iq(lcid-2) .ne. zlink) then
         call hbug('Old N-tuple, print statistics with HPRNTU',
     +             'HPRNT',id)
         return
      endif
*
      numBlocks = 0
      var   = ' '
      title = ' '
      icols = 0
      vtup  = .false.
*
      lblok = lq(lcid-1)
      lchar = lq(lcid-2)
      lint  = lq(lcid-3)
      lreal = lq(lcid-4)
*
      noent = iq(lcid+znoent)
      itit1 = iq(lcid+zitit1)
      nwtit = iq(lcid+znwtit)
*
      call hitoc(id1, sid, ll, ierr)
      call hitoc(noent, snoent, ll, ierr)
      call uhtoc(iq(lcid+itit1), 4, title, nwtit*4)
*
*-- loop over all blocks
*
  5   lname = lq(lblok-1)
*
      ioff = 0
      numBlocks = numBlocks + 1
      if(numBlocks.ne.numblk) go to 90
      ndim = iq(lblok+zndim)
      call uhtoc(iq(lblok+ziblok), 4, blknam, 8)
*
      lenname = lenocc(blknam)+1
      nameblk = blknam(1:lenocc(blknam))//null
      chform = ' '
      do 10 i = 1, ndim
         if(i.ne.1)  chform = chform(1:lenocc(chform))//','
         call hndesc(ioff, nsub, itype, isize, nbits, ldum)
         ll = iq(lname+ioff+zlname)
         lv = iq(lname+ioff+zname)
         call uhtoc(iq(lchar+lv), 4, name, ll)
         ielem = 1
         if (nsub .gt. 0) then
            var = name(1:ll)//'('
            do 20 j = 1, nsub
               lp = iq(lint+iq(lname+ioff+zarind)+(j-1))
               if (lp .lt. 0) then
                  ie = -lp
                  call hitoc(ie, subs, ll, ierr)
               else
                  ll = iq(lname+lp-1+zlname)
                  lv = iq(lname+lp-1+zname)
                  call uhtoc(iq(lchar+lv), 4, subs, ll)
                  ll1 = iq(lname+lp-1+zrange)
                  ie  = iq(lint+ll1+1)
                  vtup = .true.
               endif
               ielem = ielem*ie
*
               if (j .eq. 1) then
                  var = var(1:lenocc(var))//subs(1:ll)
               else
                  var = var(1:lenocc(var))//','//subs(1:ll)
               endif
  20        continue
            var = var(1:lenocc(var))//')'
         else
            var = name(1:ll)
         endif
*
         if (iq(lname+ioff+zrange) .eq. 0) then
            range = ' '
         else
            lp = iq(lname+ioff+zrange)
            if (itype .eq. 1) then
               fmin = q(lreal+lp)
               fmax = q(lreal+lp+1)
               call hcleft(smin, 1, 15)
               call hcleft(smax, 1, 15)
               lsi = lenocc(smin)
               lsa = lenocc(smax)
            elseif (itype.eq.2 .or. itype.eq.3) then
               imin = iq(lint+lp)
               imax = iq(lint+lp+1)
               call hitoc(imin, smin, lsi, ierr)
               call hitoc(imax, smax, lsa, ierr)
            endif
            range = '['//smin(1:lsi)//','//smax(1:lsa)//']'
         endif
*
         if (itype .eq. 1) then
            type = 'R'
         elseif (itype .eq. 2) then
            type = 'I'
         elseif (itype .eq. 3) then
            TYPE = 'U'
         elseif (itype .eq. 4) then
            type = 'L'
         elseif (itype .eq. 5) then
            type = 'C'
         endif
         call hitoc(isize, size, ls, ierr)
         if (nbits .eq. ibipb*isize) then
            bits = ' '
         else
            call hitoc(nbits, bits, ls, ierr)
         endif
*
         chunk = var(1:lenocc(var))//':'//type//'*'//size
         if(range(1:1).eq.'[')  then
            chunk = chunk(1:lenocc(chunk))//'::'//range(1:lenocc(range))
         endif
         chform = chform(1:lenocc(chform))//chunk(1:lenocc(chunk))
         formblk = chform
*
         icols = icols + ielem
         ioff  = ioff + znaddr
  10  continue
*
  90  lblok = lq(lblok)
      if (lblok .ne. 0) goto 5
*
      lenform = lenocc(formblk)+1
      formblk = formblk(1:lenocc(formblk))//null
  99  return
      end