C
C       FORTRAN Binding for Hippo
C
C       By Paul Kunz, SLAC, November 1991
C
C       Copyright (C)  1991  The Board of Trustees of
C       The Leland Stanford Junior University.  All Rights Reserved.
C
C       $Id: hfstubs.f,v 5.0 1993/08/17 21:54:50 rensing Exp $
C     
C       This set of functions is the first level interface between
C       FORTRAN user and the Hippo package which is written in C.
C       All the functions the user sees are defined here and there
C       is no need for the user to know the underlying C routines
C       (defined in hcstubs.c) used to support them.   Also system
C       dependencies on how C is called from FORTRAN should be
C       found in versions of this file.
C
C       While the method used to convert strings does limit the length
C       of allowed strings, it increases portability by passing the
C       string as an integer and by handling the length in FORTRAN.
C                          Paul Rensing, Mar 1993
C
C       Report bugs to hippo_bug@ebnextk.slac.stanford.edu
C
C
      Integer Function iparrayFill( nt, x )
C     -------------------------------------
      Implicit None
      Integer nt
      Real    x(*)
C
      Integer hfafl
C      
      iparrayFill = hfafl( nt, x )
      return
      end
C
C        
      Integer Function ipclrNt( nt )
C     -------------------------------
      Implicit None
      Integer nt
C
      Integer hfcnt
C      
      ipclrNt = hfcnt( nt )
      return
      end
C
C        
      Integer Function ipfreeNt( nt )
C     -------------------------------
      Implicit None
      Integer nt
C
      Integer hffnt
C      
      ipfreeNt = hffnt( nt )
      return
      end
C
C                      
      Integer Function ipnew( ndim )
C     ------------------------------
      Implicit None
      Integer ndim
C
      Integer hfnew
C      
      ipnew = hfnew( ndim )
      return
      end
C
C            
      Integer Function ipsetNtLabel( nt, ndim, label )
C     ------------------------------------------------
      Implicit None
      Integer       nt
      Integer       ndim
      Character*(*) label
C
      Integer hfslb
      Integer ndimc, lenc
      Integer i
      Character*256 llabel
      Integer ilabel
      Equivalence (llabel, ilabel)
C
C       Note: in C, ndim counting is one less then FORTRAN
C
      if ( ndim .le. 0 ) then
C         Print *, 'ipsetNtLabel error: column index must be > 0'
         ipsetNtLabel = -1
         return
      endif
      ndimc = ndim -1
C
      lenc = len(label)  
      if (lenc .ge. 256) lenc = 255 
      do 10 i = lenc, 1, -1
         if ( label(i:i) .ne. ' ' ) goto 20
10    continue
20    llabel = label(1:i)//CHAR(0)
      ipsetNtLabel = hfslb( nt, ndimc, ilabel )
      return
      end
C
C
      Integer Function ipsetNtTitle( nt, title )
C     ------------------------------------------
      Implicit None
      Integer       nt
      Character*(*) title
C
      Integer hfstt
      Integer lenc
      Integer i
      Character*256 ltitle
      Integer ititle
      Equivalence (ltitle, ititle)
C
      lenc = len(title) 
      if (lenc .ge. 256) lenc = 255 
      do 10 i = lenc, 1, -1
         if ( title(i:i) .ne. ' ' ) goto 20
10    continue
20    ltitle = title(1:i)//CHAR(0)
      ipsetNtTitle = hfstt( nt, ititle )
      return
      end
C
C
      Integer Function ipwrite( file, dlist, ntlist )
C     -----------------------------------------------
      Implicit None
      Character*(*) file
      Integer       dlist(*)
      Integer       ntlist(*)
C
      Integer hfwrt
      Integer lenc
      Integer i
      Character*256 lfile
      Integer ifile
      Equivalence (lfile, ifile)
C
      lenc = len(file)
      if (lenc .ge. 256) lenc = 255 
      do 10 i = lenc, 1, -1
         if ( file(i:i) .ne. ' ' ) goto 20
10    continue
20    lfile = file(1:i)//CHAR(0)
C
      ipwrite = hfwrt( ifile, dlist, ntlist )
      return
      end
