SUBROUTINE H_FLUSH_HEADER
C
C----------------------------------------------------------------------
C
C.IDENTIFICATION: Subroutine H_FLUSH_HEADER                 
C.LIBRARY:        GENERAL
C.AUTHOR:         L.Chiappetti - IFCTR Milano
C.VERSIONS:       0.0 - 12 Aug 92 - First version
C.VERSIONS:       1.0 - 29 Oct 92 - New error handling codes
C                                   plus provisional Sun fixup
C                 1.1 - 12 Nov 92 - corrected bug in Sun fixup
C.PURPOSE:        flush to  disk a file full header           
C.METHOD:         write last  record(s)
C                 error code ir returned thru VOSCOMMON               
C.SYNTAX:         CALL H_FLUSH_HEADER        
C
C.PARAMETERS:     none
C.RESTRICTIONS:   this routine is not intended to be called by the general
C                 use but will be called only by higher level routines
C.NOTES:          the first data record is zoff+1, the second zoff+2, etc.
C                 the first header record follows the last data record
C                 zoff is computed internally 
C.FILES:          none
C.REFERENCES:     noen
C
C----------------------------------------------------------------------
C
C      INCLUDE 'implicit_none.inc'
       INTEGER  ierr,i,IPTR,JPTR,zoff,curfil,off
       INCLUDE 'voscommon.inc'
       INCLUDE 'errors.inc'
       INCLUDE 'hcommon.inc'
C
       VOSCOMMON_ERROR=0
       CURFIL    = HCOMMON_CURFILE
       MINIH_ALL = HCOMMON_MINIH(CURFIL)
       OFF       = HCOMMON_EXTOFFSET(CURFIL)
       IF(MINIH_RECLEN.GT.28)THEN
         ZOFF=1
       ELSE
         ZOFF=28/MINIH_RECLEN
         IF(MOD(28,MINIH_RECLEN).NE.0)ZOFF=ZOFF+1
       ENDIF
C
C      write out all buffer in reclen chunks
       IPTR=1
 2     CONTINUE
       JPTR=MIN(IPTR+MINIH_RECLEN-1,HCOMMON_CURLOC(CURFIL))
C-->   this is a provisional fixup
C      the write statement below on Sun will not pad with zero
C      the last record if incomplete, therefore this is necessary
C      to put at least two binary zeros beyond the last word if
C      that is not the end of a record
C      BUT ONE SHOULD BE CAREFUL not to exceed the end of the
C      current record (in this case add a single zero ...
C      ...and do it one by one)
       IF(JPTR.EQ.HCOMMON_CURLOC(CURFIL))THEN
         IF(JPTR.NE.IPTR+MINIH_RECLEN-1)THEN
           HCOMMON_BUFFER(CURFIL)(JPTR+OFF+1:JPTR+OFF+1)=
     .     CHAR(0)
           JPTR=JPTR+1
           IF(JPTR.NE.IPTR+MINIH_RECLEN-1)THEN
              HCOMMON_BUFFER(CURFIL)(JPTR+OFF+1:JPTR+OFF+1)=
     .        CHAR(0)
              JPTR=JPTR+1
           ENDIF 
         ENDIF
       ENDIF 
C
       WRITE(HCOMMON_LU(CURFIL),
     . REC=MINIH_DATASIZE+HCOMMON_LASTREC(CURFIL)+zoff,
     . IOSTAT=IERR,ERR=999)HCOMMON_BUFFER(CURFIL)(iptr+OFF:jptr+OFF)
C
C      update pointer to next record to be written
C      this work only for sequantial writing ...
       HCOMMON_LASTREC(CURFIL)=HCOMMON_LASTREC(CURFIL)+1
C      update pointer within buffer
       IPTR=JPTR+1
C      and loop back
       IF(IPTR.LE.HCOMMON_CURLOC(CURFIL))GOTO 2
C      temporarily rest pointer to LAST record not NEXT
       HCOMMON_LASTREC(CURFIL)=HCOMMON_LASTREC(CURFIL)-1
C
       IF(HCOMMON_LASTREC(CURFIL).GT.MINIH_HDRSIZE)THEN
C        if last rec pointer .gt. hdrsize kept in common update miniheader
         MINIH_HDRSIZE=HCOMMON_LASTREC(CURFIL)
         CALL H_FLUSH_MINIH(i)
         IF(VOSCOMMON_ERROR.NE.0)RETURN
       ENDIF
C      until we are in the one-buffer regime, the entire buffer is
C      rewritten each time we flush, therefore reset pointer to start
       HCOMMON_LASTREC(CURFIL)=1 
       RETURN
C
C      Fortran error handling
C
 999   VOSCOMMON_SYSTEMERROR=IERR
       VOSCOMMON_ERROR=XE_WRITERR
       RETURN
       END