C
C $Header: /pita/work/HDF/dev/RCS/test/annotations/file_ann_testF.f,v 1.1 90/06/27 11:18:51 mfolk beta $
C
C $Log:	file_ann_testF.f,v $
c Revision 1.1  90/06/27  11:18:51  mfolk
c Initial revision
c 
C


      program file_ann_test

C Program to test routines for writing file IDs and file descriptions
C
C Mike Folk

C****||************************************************************

      integer dfile, i, ret, first, length
      character*64 filename
      character*7  baselabel
      character*10 outlabel, inlabel
      character*400 outdescr, indescr

      integer DFopen, DFclose, DFerrno, DFerror
      integer DFANaddfid, DFANaddfds, DFANgetfid, DFANgetfds
      integer DFANgetfidlen,  DFANgetfdslen

      integer DFE_NOERROR, DFACC_READ, DFACC_WRITE
      integer DFAN_LABEL,DFAN_DESC
      integer DFE_NOMATCH
      integer MAXLABLEN, MAXDESCLEN

      character*1 CR

      parameter (DFE_NOERROR = 0, 
     $           DFACC_READ  = 1, 
     $           DFACC_WRITE = 2, 
     $           DFAN_LABEL  = 0,  
     $           DFAN_DESC   = 1,
     $           MAXLABLEN   =10,
     $           MAXDESCLEN  =400,
     $           FIRST       = 1,
     $           NOTFIRST    = 0,
     $           DFE_NOMATCH = -29)

C****||***** store four file IDs in file ************************

      DFerror = DFE_NOERROR
      CR      = char(10)

      print *, 'Enter HDF file name:'
      read *, filename
  
      dfile = DFopen(filename, DFACC_WRITE, 0)
      if (dfile .eq. 0) call fatalerror('Error opening file to write')

      baselabel = 'Label #'
  
      do 100 i=1,4
          outlabel = baselabel//char(48+i)
          ret = DFANaddfid (dfile, outlabel) 
          if (ret .lt. 0) call fatalerror('Error adding label.')
  100 continue 

C****||***** get and store file description in file ************

      call getdescr(outdescr)
      ret = DFANaddfds (dfile, outdescr,len(outdescr))
      if (ret .lt. 0) call fatalerror('Error adding description.')

      ret = DFclose(dfile)
  
  
C****||***** read all file IDs from file *********************** 

      dfile = DFopen(filename, DFACC_READ, 0)
      if (dfile .eq. 0) call fatalerror('Error opening file to read.')

      print *, '***** Now reading file ID lengths and IDs ******'
C     *** first ID ***
      length = DFANgetfidlen(dfile, FIRST)
      ret = DFANgetfid(dfile,inlabel, MAXLABLEN, FIRST)
  
C     *** rest of IDs ***
      do 200 while ( ret .ge. 0) 
          print *,'Length: ',length,'  Ret:',ret,'  Label:',inlabel
          length = DFANgetfidlen(dfile, NOTFIRST)
          ret = DFANgetfid(dfile,inlabel, MAXLABLEN, NOTFIRST)
  200 continue 

      if (DFerrno() .ne. DFE_NOMATCH) then 
          call fatalerror('Error reading label.')
      endif
      print *, '*** End of file IDs ***'

C     *** read file description length and description ***
      length = DFANgetfdslen(dfile, FIRST)
      print *, 'Description length: ', length
      ret = DFANgetfds (dfile, indescr, MAXDESCLEN, 1) 
      if (ret .lt. 0) call fatalerror('Error reading description.')

      print *, '*** just read description.***'
      print *, 'Description:',CR,indescr
      print *, '*** End of description ***',CR
      ret = DFclose(dfile)
  
      print *
      print *
      print *, '+++++++++++++++++++++++++'
      print *
      print *

      stop
      end
  
C************************************************************
* fatalerror: subroutine to report fatal error and abort
*
C****||***********************************************************

      subroutine fatalerror(s)
      character*(*) s

      print *, s
      print *, 'DFerror:', DFerrno()
      print *, 'Program aborted.'
      print *, ' '
      stop
      end


C******************************************************************
* getdescr: subroutine to put description in array
*
C****||************************************************************

      subroutine getdescr(s)
      character*(*) s

      character*1  CR

      CR = char(10)

      s = ' This loop was used to write out labels.'//CR//CR
     * // '      do 100 i=1,4' // CR
     * // '        outlabel = baselabel//char(48+i)' // CR
     * // '        ret = DFANaddfid(dfile,outlabel,len(outlabel))'//CR
     * // '        if (ret.lt.0)fatalerror(''Error adding label.'')'//CR 
     * // '  100 continue' // CR // CR
     * // 'This is the end of the description.' // CR // CR

      return
      end
