SUBROUTINE CREATE_PHOTON(lu,filename,nbins,izoff)
C
C----------------------------------------------------------------------
C
C.IDENTIFICATION: Subroutine CREATE_PHOTON                   
C.LIBRARY:        GENERAL
C.AUTHOR:         L.Chiappetti - IFCTR Milano
C.VERSIONS:       0.0 - xx Aug 92 - Demo version in demo_xas_hot
C                 0.1 -  7 Sep 92 - moved to GENERAL library
C                 0.2 -  8 Sep 92 - added support to multiple tables
C.VERSIONS:       1.0 - 29 Oct 92 - New error handling codes
C.PURPOSE:        create a new     photon file         
C.METHOD:         open via OPEN_NEW_XAS_FILE and gets table description 
C                 from arrays in  common BINCOMMON. 
C                 error code ir returned thru VOSCOMMON               
C.SYNTAX:         CALL CREATE_PHOTON(lu,filename,nbins,izoff)                   
C
C.PARAMETERS:     INTEGER       lu            logical unit (input)
C                 CHARACTER*(*) filename      VOS filename (input)
C                 INTEGER       nbins         number of photons (input)    
C                 INTEGER       izoff         zero-record offset (output)
C.RESTRICTIONS:   none 
C.NOTES:          the arrays describing the file content should have been
C                 filled previously by caller ; the names of the columns are
C                 not relevant to this program           
C.FILES:          none
C.REFERENCES:     OPEN_NEW_XAS_FILE, H_ADD_xKEYWORD, MAKETFORM
C                 and LEFTNUMBER in same library
C
C----------------------------------------------------------------------
C
C
C     error return thru voscommon !!!
C
C     INCLUDE 'implicit_none.inc'
      CHARACTER*(*) FILENAME
      INTEGER       LU,I,IXAS,IZOFF,NBINS,NFIELDS,NAXIS1,K,NTAB
      CHARACTER     MAKETFORM*8,LEFTNUMBER*3,KEY*8,VAL*8
      INCLUDE      'voscommon.inc'
      INCLUDE      'errors.inc'
      INCLUDE      'hcommon.inc'
      INCLUDE      'bincommon.inc'
      EXTERNAL      BLKBINCOMMON
C
C     determine how many fields in table  ... yes but which table ?
C     it should be the NEXT XAS file number to be opened ...
C-->  pray that synchronization is mantained and that the descriptor
C     array just filled in the caller program is the right one
C-->  try as follows so far ...   
      IF (HCOMMON_NFILES+1.LE.HCOMMON_MAXFILES)THEN
         NTAB= HCOMMON_NFILES+1
      ELSE
C-->    shall return a VOS error  XE_TOOXAS
         STOP ' ERROR : Too many XAS file open'
      ENDIF
      NFIELDS=0
      NAXIS1=0
      DO 1 I=1,BINCOMMON_MAXFIELDS
         IF(BINCOMMON_OFFSET(NTAB,I).GT.0)THEN
            NFIELDS=NFIELDS+1
            NAXIS1=NAXIS1+ABS(BINCOMMON_BITPIX(NTAB,I))
     .      *BINCOMMON_DIMENS(NTAB,I)
         ENDIF
 1    CONTINUE
C     convert bits to bytes
      NAXIS1=NAXIS1/8
C     write (*,*)' naxis1 recl is ',naxis1
C
C     this is the routine to be called to open a generic XAS file
C
      CALL OPEN_NEW_XAS_FILE(LU,FILENAME,'PHO',NAXIS1,
     .NBINS,IXAS,IZOFF)
      IF (VOSCOMMON_ERROR.NE.0)RETURN
C
C     write mandatory keywords in header, flush it to disk
C     (this is the last "1" in the last call below)
C
      CALL H_ADD_JKEYWORD('BITPIX'  ,8,0,1)
      CALL H_ADD_JKEYWORD('NAXIS1'  ,naxis1,0,1)
      CALL H_ADD_JKEYWORD('NAXIS2'  ,nbins,0,1)
C     could as well write it here ... but defer it
      CALL H_ADD_JKEYWORD('TFIELDS' ,0,0,1)
      IF (VOSCOMMON_ERROR.NE.0)RETURN
       DO 2 I=1,BINCOMMON_MAXFIELDS
         IF(BINCOMMON_OFFSET(NTAB,I).GT.0)THEN
            KEY='TFORM'//LEFTNUMBER(BINCOMMON_OFFSET(NTAB,I),K)
            VAL=MAKETFORM(BINCOMMON_BITPIX(NTAB,I),
     .      BINCOMMON_DIMENS(NTAB,I))
C           write (*,*)KEY,VAL
            CALL H_ADD_KEYWORD(KEY,VAL,0)
            IF (VOSCOMMON_ERROR.NE.0)RETURN
         ENDIF
 2    CONTINUE
C     write it now AND FLUSH to disk
      CALL H_MODIFY_JKEYWORD('TFIELDS' ,NFIELDS,1,1)
C     IF (VOSCOMMON_ERROR.NE.0)RETURN is implicit
      RETURN
      END