      Program hb2hippo
C     ----------------
C
C		Conversion of HBOOK4 data to Hippo data
C		By Paul Kunz, SLAC, August 1990
C
C		This is main program that parses command line arguments
C	
C	$Id: hb2hippo.f,v 1.4 1992/02/02 14:23:40 pfkeb Rel $
C
C	Compiled and tested on...
C	AIX 3.1, IBM FORTRAN 2.1
C	NeXT 2.1, Absoft FORTRAN 3.1
C	NeXT 2.1, f2c Oct 15, 1991 (but not tested)
C	SunOS 4.0.3, Sun FORTRAN 1.2
C
C      Implicit none
C
C       External functions...
      Integer hb2copen
      Integer iargc
C
C	Standard UNIX codes...
      Integer    EXIT_SUCCESS,     EXIT_FAILURE
      Parameter( EXIT_SUCCESS = 0, EXIT_FAILURE = 1 )
      Integer    FILENAME_MAX
      Parameter( FILENAME_MAX = 1024 )
C others      Parameter( FILENAME_MAX = 255 )
C      
      Character*(FILENAME_MAX)  hbfn
      Character*(FILENAME_MAX)  hifn
      Integer nargs
      Integer irc
C
      nargs = iargc()
C
      if ( nargs .lt. 1  .or.  nargs .ge. 3 ) then
         Print *, 'Useage: hb2hippo hbook_file hippo_file'
         irc = EXIT_FAILURE
         Go to 100
      Elseif ( nargs .eq. 1 ) then
         Call getarg( 1, hbfn )
         hifn = 'out.hippo'
      Elseif ( nargs .eq. 2 ) then
         call getarg( 1, hbfn )
         call getarg( 2, hifn )
      Endif
         
      irc = hb2copen( hbfn, hifn )
      
  100 Continue
      End

      Integer Function hb2cdir(dirname)
C     ---------------------------------
C      
C		Conversion of HBOOK4 data to Hippo data
C		By Paul Kunz, SLAC, August 1990
C
C		This routine reads the HBOOK directory and steers the work
C
C         Implicit none
      
      Character *(*) dirname
C
C	Standard UNIX exit codes
      Integer EXIT_SUCCESS, EXIT_FAILURE
      Parameter( EXIT_SUCCESS = 0, EXIT_FAILURE = 1 ) 
C      
C	External functions...
      Integer hb2c1d, hb2c2d, hb2cnt
C
      Character*1 CHANGE_CWD
      Parameter(  CHANGE_CWD = ' ')
      Integer     ALL_IDS
      Parameter(  ALL_IDS = 0 )
C      
      Integer id, ih, nid	
      Integer    MAXVEC
      Parameter( MAXVEC = 100 )
      Integer idvec(MAXVEC)	
C      
      Integer idim, iofset, icycle
      Character*80 tdir
      Character*10 tname
C      
      tdir = "//dummy/"//dirname
C	go to subdirectory      
      Call hcdir( tdir, CHANGE_CWD )	
C	just to check its there      
      Call hldir( ' ', 'T')	
      iofset = 0
      icycle = 9999
C	read in all the histos      
      Call hrin(ALL_IDS, icycle, iofset) 
C      
C		Do 1D and 2D histograms...
C
      Do  idim = 1, 2	
	 If ( idim .eq. 1 ) Call hid1( idvec, nid )
	 If ( idim .eq. 2 ) Call hid2( idvec, nid )
	 If ( nid .gt. MAXVEC ) then
		Write(*,6000) dirname, nid, idim, MAXVEC
 6000  		Format(
     + 		" Directory ", A, " has ", I4, I2, "D histograms," /
     + 		" while hb2cdir compiled for", I4, " histograms."/
     + 		" An array overflow has thus occured, job aborting.")
		hb2cdir = EXIT_FAILURE
		Return
	 endif
C
	 Do ih = 1, nid
	    id = idvec(ih)
	    If ( idim .eq. 1 ) hb2cdir = hb2c1d( id )	
	    If ( idim .eq. 2 ) hb2cdir = hb2c2d( id )	
	    If ( hb2cdir .eq. EXIT_SUCCESS ) then
		Write(tname, 6010)  id, '.histo'
 6010 		format( I4.4, A6)
C			histograms not handled currently
C			Here is where the code would go to add histograms
C			to the display list
	    endif
C
         End do 
      End Do 
C
C		Do n-tuples...
C      
      Call hidall( idvec, nid)
      If ( nid .gt. MAXVEC ) then
	 Write(*,6000) dirname, nid, MAXVEC
 6020    Format(
     +   " Directory ", A, " has ", I4, I2, "histograms," /
     +   " while hb2cdir compiled for", I4, " histograms."/
     +   " An array overflow has thus occured, job aborting.")
	 hb2cdir = EXIT_FAILURE
	 Return
      endif
C
      Do ih = 1, nid
	 id = idvec(ih)
	 hb2cdir = hb2cnt(dirname, id)	
      End do 
C
C		All done
C	  
      Call hdelet(ALL_IDS)	
      hb2cdir = EXIT_SUCCESS
      Return 
      end
      
      Integer Function hb2cnt(dirname, id)
C     ------------------------------------      
C      
C		Conversion of HBOOK4 data to Hippo data
C		By Paul Kunz, SLAC, June 1991
C
C		This routine converts n-tuple to Hippo file
C
C          Implicit none
C
      Character *(*) dirname
      Integer id

C
C	hippo functions used...
      Integer ipnew, ipsetnttitle, ipsetntlabel, iparrayfill
C
      Integer         nt, ntlist, NNTLIST
      Parameter(                  NNTLIST = 100 )
      Common /hippoc/ nt, ntlist(NNTLIST)
C
C	Standard UNIX exit codes
      Integer    EXIT_SUCCESS,     EXIT_FAILURE
      Parameter( EXIT_SUCCESS = 0, EXIT_FAILURE = 1 ) 
C      
      Character*1 CHANGE_CWD
      Parameter(  CHANGE_CWD = ' ')
      Integer     ALL_IDS
      Parameter(  ALL_IDS = 0 )
C      
C	N-tuple information returned by HGIVEN...
      Character*80 tname
      Integer     NVARS
      Parameter ( NVARS = 100)      
      Character*8 tags(NVARS) 	
      Real xlow(NVARS), xhigh(NVARS) 
      Real x(NVARS)                  
C      
      Integer     ie, iv
      Integer     ninout, numvars, ierror
      Integer     nidn	
C      
      Integer ntuple		
      Integer irc
C      
C	Careful: ninout is in and out variable
      ninout = NVARS		
      Call hgiven( id, tname, ninout, tags, xlow, xhigh )
      numvars = ninout
      If ( numvars .eq. 0 ) then
	  hb2cnt = EXIT_FAILURE
          Return
      Endif
C
      ntuple = ipnew( numvars)
      irc = ipsetNtTitle( ntuple, tname )	  
C
      Do iv = 1, numvars
         irc = ipsetNtLabel( ntuple, iv, tags(iv) )
      End do 
C      
      nidn = 0
      ie = 0
   10 Continue
      ie = ie + 1
      Call hgn( id, nidn,  ie, x, ierror )
C	exit if end of file	 
      If ( ierror .lt. 0 ) Go to 100
      irc = iparrayFill( ntuple, x )
      Go to 10
  100 Continue
C
      nt = nt + 1
      If ( nt .lt. NNTLIST ) then
         ntlist(nt) = ntuple
      Else
         irc = NNTLIST -1
         Print *, "hb2hippo compiled for only", irc, "hippo ntuples."
         Print *, "This HBOOK ntuple ignored."
         Print *, "Recompile hb2hippo.f with larger NNTLIST parameter."
      Endif
C     
      hb2cnt = EXIT_SUCCESS
      Return 
      end

      Integer Function hb2copen( inname, outname)
C     ---------------------------------------------
C      
C		Conversion of HBOOK4 data to Hippo data
C		By Paul Kunz, SLAC, August 1990
C
C		This routine reads the HBOOK file directory
C
C         Implicit none

      Character *(*) inname           
      Character *(*) outname            
C      
C	Standard UNIX exit codes
      Integer    EXIT_SUCCESS,     EXIT_FAILURE
      Parameter( EXIT_SUCCESS = 0, EXIT_FAILURE = 1 )
C
C       External functions...
      Integer hb2cdir	
      Integer ipwrite   
C
      Integer         nt, ntlist, NNTLIST
      Parameter(                  NNTLIST = 100 )
      Common /hippoc/ nt, ntlist(NNTLIST)
C
C	no way to know NWPAW ahead of time
      Integer    NWPAW
      Parameter( NWPAW = 500000)	
      Real          h
      common /pawc/ h(NWPAW)
C
C	error codes for RZ package
      Integer        iquest
      common /quest/ iquest(100)	
C      
      Integer    MAXDIR, idir, ndir
      Parameter( MAXDIR = 10 )		
      Character*80 dirname(MAXDIR)
C      
      Integer    LREC, irc, istat
C	recommended record lenght to HROPEN      
      Parameter (LREC = 1024)	
C      
C
      Print *, " HBOOK4 to Hippo converter" 
C      Print *, " Converting file: ", inname
C      Print *, " to output file:  ", outname
C
C	initialize Hippo
      nt = 0            
C	initialize HBOOK and ZEBRA
      Call hlimit(NWPAW)		
C      
      Call hropen( 1, 'dummy', inname, ' ', LREC, istat )
      If ( istat .ne. 0 ) then
         Print *, " Failure to open file: ", inname
	 hb2copen = EXIT_FAILURE
	 Return
      Endif
C	     
      Do idir = 1, MAXDIR
C		avoid trailing x00      
         dirname(idir) = ' '	
      End do
C
C	find subdirectories
      Call rzrdir(MAXDIR, dirname, ndir ) 
      If ( iquest(1) .ne. 0 ) then
         Print *, " There are ", iquest(11), " directories,"
	 Print *, " while hb2hippo was compiled for", ndir, 
     +		    " directories."
         Print *, " Only the first ", ndir,
     + 	            " directories processed."
      Endif
C
C	handle case of no directories
      if ( ndir .le. 0 ) ndir = 1	
      Do idir = 1, ndir
	 hb2copen = hb2cdir( dirname(idir) )	
	 If ( hb2copen .ne. EXIT_SUCCESS ) Return
      End do
C
      if ( nt .lt. NNTLIST ) then
         nt = nt + 1
      else
         irc = NNTLIST -1
         Print *, "There are", nt, "HBOOK ntuples while,"
         Print *, "hb2hippo compiled for only", irc, "hippo ntuples."
         Print *, "Recompile hb2hippo.f with larger NNTLIST parameter."
         nt = NNTLIST
      endif
C
      ntlist(nt) = 0
      irc = ipwrite( outname, 0, ntlist )
C
      hb2copen = EXIT_SUCCESS
      Return 
      end

      Integer Function hb2c1d(id)
C     ---------------------------
C      
C		Conversion of HBOOK4 data to Hippo data
C		By Paul Kunz, SLAC, June 1991
C
C		This routine processes 1D histogram id
C
C     Implicit none
      Integer id
C      
C	External functions..
      Real   hi
C
C	Standard UNIX exit codes
      Integer EXIT_SUCCESS, EXIT_FAILURE
      Parameter( EXIT_SUCCESS = 0, EXIT_FAILURE = 1 ) 
C      
C	This Common block holds results of HGIVE
      Integer nx, ny, nwt, loc
      Real*4 xmi, xma, ymi, yma
      Character*80 chtitl
      Common /give/ chtitl, nx, xmi, xma, ny, ymi, yma, nwt, loc
C      
      Integer    MXSIZE
      Parameter( MXSIZE = 1000 )
      Real*4 conten
      common /unpak/ conten(0:(MXSIZE+2)*(MXSIZE+2) )

      Real*4 xwidth
      
      hb2c1d = EXIT_FAILURE
      Call hgive ( id, chtitl, nx, xmi, xma,
     +                         ny, ymi, yma, nwt, loc)
      If ( nx .eq. 0 ) Return
      If ( nx .gt. MXSIZE*MXSIZE ) then
	 	 Print *, " Too many bins, histogram ignored"
         Return
      endif
C      
      xwidth = (xma - xmi) / nx
C		histograms are not handled currently
C		Here is where to put the code to create new display
      Call hunpak( id, conten(1), 'HIST', 1 )
      conten(0)    = hi( id, 0 )
      conten(nx+1) = hi( id, nx+1)
C		Here is where to put the code to fill the bins
      hb2c1d = EXIT_SUCCESS
      Return 
      end

      Integer Function hb2c2d(id)
C     ---------------------------      
C      
C		Conversion of HBOOK4 data to Hippo data
C		By Paul Kunz, SLAC, June 1991
C
C		This routine processes 2D histogram id
C
C      Implicit none
C      
      Integer id
C      
C	Standard UNIX exit codes
      Integer    EXIT_SUCCESS,     EXIT_FAILURE
      Parameter( EXIT_SUCCESS = 0, EXIT_FAILURE = 1 ) 
C      
C	External Functions...
      Real hij	

C	This Common block holds results of HGIVE
      Integer       nx, ny, nwt, loc
      Real          xmi, xma, ymi, yma
      Character*80  chtitl
      Common /give/ chtitl, nx, xmi, xma, ny, ymi, yma, nwt, loc
C
C	This Common block holds the results of HUNPAK
      integer   MXSIZE
      Parameter(MXSIZE=1000)
      Real           conten
      common /unpak/ conten(0:(MXSIZE+2)*(MXSIZE+2) )

      Real xwidth, ywidth
      Integer i, ix, iy, ntotal
      
      hb2c2d = EXIT_FAILURE
      Call hgive ( id, chtitl, nx, xmi, xma,
     +                         ny, ymi, yma, nwt, loc)
      If ( nx .eq. 0  .or.
     +     ny .eq. 0        ) Return
      If ( nx .gt. MXSIZE .or.
     +     ny .gt. MXSIZE      ) then
         Print *, " Too many bins, histogram id", id, " ignored"
         Return
      endif
      xwidth = (xma - xmi) / nx
      ywidth = (yma - ymi) / ny
C		Here is where to put the code to create new display
      i = 0			
      Do 150 iy = 0, ny+1
	 Do 150 ix = 0, nx + 1
	    conten(i) = hij( id, ix, iy)
	    i = i + 1
  150 Continue		
      ntotal = (nx+2)*(ny+2) 
C		Here is where to put the code to fill the bins 
      hb2c2d = EXIT_SUCCESS
      Return
      end
