      SUBROUTINE OPEN_NEW_XAS_FILE(lu,file,type,recl,nrec,xasno,zoff)
C
C----------------------------------------------------------------------
C
C.IDENTIFICATION: Subroutine OPEN_NEW_XAS_FILE             
C.LIBRARY:        GENERAL
C.AUTHOR:         L.Chiappetti - IFCTR Milano
C.VERSIONS:       0.0 - 11 Aug 92 - First version
C                 0.1 - 20 Aug 92 - Uses HANDLE for Z_ALLOC
C.VERSIONS:       1.0 -  6 Nov 92 - New error handling codes
C                                   plus operating system code
C.PURPOSE:        open a NEW  XAS file                 
C.METHOD:         open via Z_OPEN then create mini-header and ??? full
C                 header in common HCOMMON. 
C                 error code ir returned thru VOSCOMMON               
C.SYNTAX:         CALL OPEN_NEW_XAS_FILE(lu,file,type,recl,nrec,xasno,zoff)           
C
C.PARAMETERS:     INTEGER       lu            logical unit (input)
C                 CHARACTER*(*) file          VOS filename (input)
C                 CHARCATER*(*) type          XAS filetype (input) 
C                 INTEGER       recl          record length (bytes, input) 
C                 INTEGER       nrec          no of data records (input) 
C                 INTEGER       xasno         XAS file number (output)
C                 INTEGER       zoff          zero-record offset (output)
C.RESTRICTIONS:   none 
C.NOTES:          the first data record is zoff+1, the second zoff+2, etc.
C.FILES:          none
C.REFERENCES:     H_FLUSH_MINIH in same library
C
C----------------------------------------------------------------------
C
C      INCLUDE 'implicit_none.inc'
       CHARACTER*(*) file
       CHARACTER*3   type,SYS
       INTEGER       lu,recl,nrec,zoff,xasno
       INTEGER       IERR,LREC,I,OLDFILE,MR    
       character     debug*28,val1*8
       INCLUDE       'voscommon.inc'
       INCLUDE       'errors.inc'
       INCLUDE       'hcommon.inc'
       EXTERNAL       BLKHCOMMON
C
C     test if there are enough XAS files to be opened
C
      IF (HCOMMON_NFILES+1.LE.HCOMMON_MAXFILES)THEN
         OLDFILE=HCOMMON_CURFILE
         HCOMMON_NFILES=HCOMMON_NFILES+1
         HCOMMON_CURFILE=HCOMMON_NFILES
      ELSE
C-->    shall return a VOS error  XE_TOOXAS
         STOP ' ERROR : Too many XAS file open'
      ENDIF
C
C     Try to open
C
C-->  CALL Z_OPEN(lu,file,'DIRECT','NEW',RECL)
C-->  temporary ? a NEW file is deleted if existing
      CALL Z_OPEN(lu,file,'DIRECT','OVE',RECL)
C     write(*,*)' zopen ',voscommon_error
      IF (VOSCOMMON_ERROR.NE.0)GOTO 900
C
C     even if all is not yet OK, save LU in common
C
      HCOMMON_LU(HCOMMON_CURFILE)=LU
C
C     generate mini header 
C
      MINIH_MAGIC( 1: 4)='XAS'//CHAR(1)
      IF(TYPE.EQ.'FLO'.OR.TYPE.EQ.'MAT'.OR.TYPE.EQ.'INT')THEN
        MINIH_MAGIC( 5: 8)='IMG'//CHAR(2)
        MINIH_MAGIC( 9:12)=TYPE(1:3)//CHAR(3)
      ELSEIF(TYPE.EQ.'GEN'.OR.TYPE.EQ.'SPE'.OR.
     .       TYPE.EQ.'TIM'.OR.TYPE.EQ.'PHO')THEN
        MINIH_MAGIC( 5: 8)='BIN'//CHAR(2)
        MINIH_MAGIC( 9:12)=TYPE(1:3)//CHAR(3)
       ELSE
           GOTO 901       
       ENDIF
C      shall also assigni magic(13:16) with system//char(4)
       CALL Z_OP_SYS(SYS)
       MINIH_MAGIC(13:16)=SYS//CHAR(4)
       MINIH_RECLEN=RECL
       MINIH_DATASIZE=NREC
       MINIH_HDRSIZE=0
C
C     write mini header to disk
C
      CALL H_FLUSH_MINIH(zoff)
C     write (*,*)' hflush ',voscommon_error
      IF (VOSCOMMON_ERROR.NE.0)GOTO 900
C
C     main header is NOT created here but by calling program
C     however, if record length is greater than default buffer
C     HCOMMON_TOP, currently 2kbytes, one shall allocate with
C     Z_ALLOC a buffer at least as great as one record
C
      IF(MINIH_RECLEN.GT.HCOMMON_TOP)THEN
         CALL Z_ALLOC(MINIH_RECLEN,1,
     .   HCOMMON_HANDLE(1,HCOMMON_CURFILE),
     .   HCOMMON_EXTADDR(HCOMMON_CURFILE),
     .   HCOMMON_EXTOFFSET(HCOMMON_CURFILE))
C        write (*,*) ' zalloc ',voscommon_error
C        write(*,*) ' addr ',hcommon_extaddr(hcommon_curfile)
         IF(VOSCOMMON_ERROR.NE.0)GOTO 900
C        write(*,*)' header in extension of ',MINIH_RECLEN
         HCOMMON_MAXLOC(HCOMMON_CURFILE)=MINIH_RECLEN
      ELSE
C
C        how many records used for main header ?
C        maxloc shall be a multiple of the record length
         MR=MAX(1,HCOMMON_TOP/MINIH_RECLEN) 
         HCOMMON_MAXLOC(HCOMMON_CURFILE)=
     .   MIN(MR*MINIH_RECLEN,HCOMMON_TOP)
      ENDIF
C     write (*,*)' mxloc ',hcommon_maxloc
C     anyhow save here a pointer to last record written
C
C     HCOMMON_LASTREC=0 set to 1 with new version of H-add-header
      HCOMMON_LASTREC(HCOMMON_CURFILE)=1

C     all was OK, return XASNO
C
      XASNO=HCOMMON_CURFILE
C
 999  RETURN
C
C     provisional error handling
C
C     generic catch-all : restore hcommon properly
 900  CONTINUE
      HCOMMON_NFILES=HCOMMON_NFILES-1
      HCOMMON_CURFILE=OLDFILE
C-->  so far does not restore LU, EXTADDR and EXTOFFSET !
      GOTO 999
C     file is not a valid XAS file
 901  VOSCOMMON_ERROR=XE_ILLXAS
      GOTO 900
      END
