*
* $Id: fmkadd.F,v 1.1.1.1 1996/03/07 15:17:43 mclareni Exp $
*
* $Log: fmkadd.F,v $
* Revision 1.1.1.1  1996/03/07 15:17:43  mclareni
* Fatmen
*
*
#include "fatmen/pilot.h"
      SUBROUTINE FMKADD
#include "fatmen/faust.inc"
#include "fatmen/fatpara.inc"
#include "fatmen/fatbug.inc"
#include "fatmen/fatsys.inc"
#include "fatmen/fatloc.inc"
      PARAMETER (LURCOR=200000)
      COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
      DIMENSION    LQ(999),IQ(999),Q(999)
      EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
#include "fatmen/fatron.inc"
#include "fatmen/fatusr.inc"
      COMMON /QUEST/IQUEST(100)
      CHARACTER*255 GNAME,DSN,CHPATH,GNAME2
      CHARACTER*255 PATHN
      CHARACTER*20  FNAME
      CHARACTER*4   FFORM
      CHARACTER*8   HOSTN
      INTEGER       CPLEV,FSEQ
      CHARACTER*255 PREDIR
#include "fatmen/fatvidp.inc"
      CHARACTER*4   RECFM
      INTEGER       LRECL,BLOCK,FSIZE
      CHARACTER*80  COMM
      PARAMETER       (LKEYFA=10)
      DIMENSION KEYS(LKEYFA)
      DIMENSION IVECT(10)
      DATA    NENTRY/0/
      SAVE     NENTRY
#include "fatmen/fatinit.inc"
*
*     Add a new file to the FATMEN file catalogue
*
      CALL KUGETC(GNAME,LGNAME)
      IF(LGNAME.EQ.0) RETURN
 
      NFADDD = NFADDD + 1
*
*     GNAME is in current directory, if full path name not specified
*
 
      CALL FMFIXF(GNAME,GNAME2)
      GNAME  = GNAME2
      LGNAME = LENOCC(GNAME)
      IF(IDEBFA.GE.0) PRINT *,GNAME(1:LGNAME)
 
      CALL KUGETS(DSN, LDSN)
      IF(LDSN.EQ.0) THEN
         IF(IDEBFA.GE.0) PRINT *,'FMKADD. ',
     +      'Dataset name will be generated by FATMEN'
      CALL FMFNM(DSN)
      LDSN = LENOCC(DSN)
      ENDIF
      CALL KUGETC(FFORM,LFFORM)
      CALL KUGETI(CPLEV)
      CALL KUGETC(HOSTN,LHOSTN)
      CALL KUGETC(COMM,LCOMM)
      CALL KUGETC(RECFM,LRECFM)
      CALL KUGETI(LRECL)
      CALL KUGETI(BLOCK)
      CALL KUGETI(FSIZE)
      CALL KUGETI(LOCCOD)
      CALL KUGETI(IVECT(1))
      CALL KUGETI(IVECT(2))
      CALL KUGETI(IVECT(3))
      CALL KUGETI(IVECT(4))
      CALL KUGETI(IVECT(5))
      CALL KUGETI(IVECT(6))
      CALL KUGETI(IVECT(7))
      CALL KUGETI(IVECT(8))
      CALL KUGETI(IVECT(9))
      CALL KUGETI(IVECT(10))
 
*
*     Save current directory
*
      CALL RZCDIR(PREDIR,'R')
 
      IF(NENTRY.EQ.0) THEN
         JBIAS = 2
         CALL FMBOOK(GNAME,KEYS,LADDBK,LSUP,JBIAS,IRC)
         NENTRY = 1
      ELSE
         IQ(LADDBK+MMTPFA) = 1
         CALL FMFILL(GNAME,LADDBK,KEYS,'A',IRC)
      ENDIF
*
*     Override various fields as required
*
      IF(LDSN.GT.0) THEN
         CALL VBLANK(IQ(LADDBK+MFQNFA),NFQNFA/4)
         CALL UCTOH(DSN,IQ(LADDBK+MFQNFA),4,LDSN)
      ENDIF
 
      IF (HOSTN(1:8) .NE. 'THISNODE') THEN
         CALL VBLANK(IQ(LADDBK+MHSNFA),NHSNFA/4)
         CALL UCTOH(HOSTN,IQ(LADDBK+MHSNFA),4,LHOSTN)
      ENDIF
 
      CALL UCTOH(FFORM,IQ(LADDBK+MFLFFA),4,LFFORM)
      IQ(LADDBK+MCPLFA) = CPLEV
      IQ(LADDBK+MMTPFA) = 1
      IQ(LADDBK+MLOCFA) = LOCCOD
      KEYS(MKLCFA)      = LOCCOD
      KEYS(MKCLFA)      = CPLEV
 
      IF(NUMLOC.EQ.1) THEN
         IQ(LADDBK+MLOCFA) = MFMLOC(1)
         KEYS(MKLCFA)      = MFMLOC(1)
      ENDIF
 
      CALL VBLANK(IQ(LADDBK+MUCMFA),NUCMFA/4)
      CALL UCTOH(COMM,IQ(LADDBK+MUCMFA),4,LCOMM)
 
      CALL UCTOH(RECFM,IQ(LADDBK+MRFMFA),4,LRECFM)
      IQ(LADDBK+MRLNFA) = LRECL
      IQ(LADDBK+MBLNFA) = BLOCK
      IQ(LADDBK+MFSZFA) = FSIZE
*
*     Userwords
*
      CALL UCOPY(IVECT(1),IQ(LADDBK+MUSWFA),10)
*
*     Display entry
*
      IF(IDEBFA.GE.3) THEN
         CALL FMUPKY(GNAME,LADDBK,KEYS,IRC)
         CALL FMSHOW(GNAME,LADDBK,KEYS,'A',IRC)
      ENDIF
*
*     Output this entry
*
      CALL FMPUT(GNAME,LADDBK,IRC)
*
*     Reset current directory
*
      CALL RZCDIR(PREDIR(1:LENOCC(PREDIR)),' ')
 
      END