*
* $Id$
*
* $Log$
* Revision 1.1  1996/03/08 12:01:11  mclareni
* Initial revision
*
*
#include "zbook/pilot.h"
      SUBROUTINE ZEPOUT (IZ,LUN,KEYS,NKEYS,IDCAT,IERR)
C
C     ******************************************************************
C     *                                                                *
C     *                                                                *
C     *       WRITES NEXT LOGICAL EVENT IDENTIFIED BY THE              *
C     *       LIST OF NKEY KEYWORDS                                    *
C     *       A CATALOG IS WRITTEN AS THE FIRST EP RECORD              *
C     *       AND IT IS IDENTIFIED BY IDCAT                            *
C     *                                                                *
C     *                                                                *
C     ******************************************************************
C
      DIMENSION IZ(1) , KEYS(1), IH(60) , IDUM(2)
C--- Inserted by HG
      COMMON/ZCFORM/NLFORM,JD(60)
      DIMENSION IFORBF(50)
      EQUIVALENCE (IFORBF(1),JD(11))
C---
      DIMENSION JL(10) , JM(10)
      DIMENSION MODSEP(8)
      LOGICAL ZIDOK
C
      DATA MAXLEV/10/
      DATA IBLA/4H    /
      DATA MODSEP/1,2,3,3,3,2,3,3/
C
#include "zbook/wlength.inc"
C
C     ------------------------------------------------------------------
C
C--- Inserted by HG
      NAMEL=0
      NWFORL=0
C---
      NKEY   = NKEYS
      IERR   = 0
      LC     = 0
      IDS    = IZ(1)
      IZ(IDS+6)=0
C
C     CHECK IF LUN IS DEFINED
C
      JBUF   = IZ(IDS - 3)
      IF (JBUF.LE.0)                             GO TO 10
C
      NUNIT  = IZ(JBUF) - 2
      LBUF   = IUCOMP (LUN,IZ(JBUF + 1),NUNIT)
      IF (LBUF.NE.0)                             GO TO 20
C
C     LUN IS UNDEFINED
C
   10 CALL ZERROR (IZ,900,'ZEPOUT',0)
      GO TO 260
C
C     LUN IS DEFINED
C
   20 JBUF   = IZ(JBUF - LBUF) + 3
      IH(2)  = 1
      IH(4)  = IDCAT
C
      IF (NKEY.LE.0)                             GO TO 30
C
      CALL ZBOOK (IZ,LC,NKEY)
      IF (LC.EQ.0)                               GO TO 260
C
      JBUF   = IZ(IDS - 3)
      JBUF   = IZ(JBUF - LBUF) + 3
C
      CALL UCOPY (KEYS,IZ(LC+1),NKEY)
      CALL ZTOIBM (IZ(LC+1),NKEY,2)
C
C     WRITE CATALOG
C
   30 CALL EPOUTL (LUN,3,4,IH,NKEY,IZ(LC+1),IZ(JBUF),IERR)
C
      IF (IERR.NE.0)                             GO TO 240
C
      JF     = JBUF - 2
      IZ(JF) = 4
C
      IF (NKEY.LE.0)                             GO TO 230
C
C     LOOP ON KEYS
C
      DO 220 N = 1,NKEY
      KEY    = KEYS(N)
C
C     CHECK IF ACTIVE KEY
C
      CALL ZEPLOC (IZ,KEY,NID,NMEMBS,ICODE)
      IF (NID.EQ.0)                              GO TO 220
C
      IDUM(1) = KEY
C
      IH(2)  = 2
      IDUM(2) = ICODE
      CALL ZTOIBM (IDUM,2,2)
C
C     WRITE KEY HEADER
C
      CALL EPOUTL (LUN,3,3,IH,2,IDUM,IZ(JBUF),IERR)
      IF (IERR.NE.0)                             GO TO 250
C
      IF (NMEMBS.LE.0)                           GO TO 220
C
      NMSS   = 0
C
C     LOOP ON MEMBERS
C
      DO 210 NMB = 1,NMEMBS
      IDSAVE = IZ(NID + NMB)
C
C     CHECK IF IT CAN BE WRITTEN
C
      NMAX   = 0
      NST    = 1
      JD(1)  = NID + NMB
      JL(1)  = 2
      JM(1)  = 1
C
   40 ID     = JD(NST)
      NLII   = JM(NST) - JL(NST) + 1
      IDD    = IZ(ID - NLII)
      NLINKS = 0
C
      IF (.NOT.ZIDOK(IZ,IDD))                    GO TO 50
C
      NDATA     = IZ(IDD) - 2
      NLINKS    = IZ(IDD+NDATA+3)
      IF (NDATA.LE.NMAX)                         GO TO 50
C
      NMAX      = NDATA
C
   50 JL(NST) = JL(NST) - 1
      IF (JL(NST).NE.0)                          GO TO 60
C
      NST    = NST - 1
C
   60 IF (NLINKS.NE.0)                           GO TO 70
      IF (NST.NE.1)                              GO TO 40
      GO TO 90
C
   70 NST    = NST + 1
      IF (NST.LE.MAXLEV)                         GO TO 80
C
C     TOO MANY LEVELS
C
      CALL ZERROR (IZ,800,'ZEPOUT',IDSAVE)
      GO TO 230
C
   80 JD(NST) = IDD
      JL(NST) = NLINKS
      JM(NST) = JL(NST)
      GO TO 40
C
C     LOOK FOR SPACE TO COPY THE BANKS
C
   90 IF (ICODE.LE.10)                           GO TO 110
C
      NDATA     = IZ(LC) - 2
      IF (NDATA.GE.NMAX)                         GO TO 110
C
      CALL ZPUSH (IZ,LC,NMAX-NDATA)
      IF (IZ(IDS + 6).EQ.0)                      GO TO 100
C
C     SPACE PROBLEM: STOP
C
      GO TO 230
C
  100 JBUF   = IZ(IDS - 3)
      JBUF   = IZ(JBUF - LBUF) + 3
C
C     WRITE A TREE
C
  110 NST    = 1
      JD(1)  = NID + NMB
      JL(1)  = 2
      JM(1)  = 1
C
  120 ID     = JD(NST)
      NLII   = JM(NST) - JL(NST) + 1
      IDD    = IZ(ID - NLII)
C
      IF (ZIDOK(IZ,IDD))                         GO TO 130
C
C     MISSING BANK
C
      NMSS   = NMSS + 1
      NLINKS = 0
      GO TO 185
C
C     WELL DEFINED BANK
C
  130 NDATA     = IZ(IDD) - 2
      NLINKS    = IZ(IDD+NDATA+3)
      NAME      = IZ(IDD+NDATA+1)
      NUMB      = IZ(IDD+NDATA+2)
C
      IF (NMSS.EQ.0)                             GO TO 140
C
      IH(2)  = 5
      IH(4)  = NMSS
      NMSS   = 0
C
      CALL EPOUTL (LUN,1,4,IH,0,IZ,IZ(JBUF),IERR)
C
      IF (IERR.NE.0)                             GO TO 250
C
  140 IH(2)  = 3
      ISIT   = 1
      IF (NLINKS.NE.0)                ISIT = ISIT + 1
      IF (NAME.NE.IBLA.OR.NUMB.NE.0)  ISIT = ISIT + 2
C--- Inserted by HG
C    CHECK WHETHER NAME IN FORMAT TABLE, GET REF.
C    DO NOTHING IF SAME NAME AS PREVIOUS
      IF(NAME.NE.NAMEL)  THEN
         CALL ZNAMSR(IZ,NAME,IPOS,LAST)
         NAMEL=NAME
         NWFORL=0
      ELSE
         IPOS=0
      ENDIF
C---
C
      GO TO (141,142,143,144), ISIT
C
  141 NWH    = 3
      GO TO 149
C
  142 NWH    = 4
      IH(4)  = NLINKS
      GO TO 149
C
  143 NWH    = 6
C
      CALL ZTOIBM (NAME,1,4)
C
      IH(4)  = JBYT (NAME, 1,16)
      IH(5)  = JBYT (NAME,17,16)
      IH(6)  = NUMB
      GO TO 149
C
  144 NWH    = 7
C
      CALL ZTOIBM (NAME,1,4)
C
      IH(4)  = NLINKS
      IH(5)  = JBYT (NAME, 1,16)
      IH(6)  = JBYT (NAME,17,16)
      IH(7)  = NUMB
C
  149 CONTINUE
C--- Inserted by HG
      IF(IPOS.GT.0.AND.NWH.GE.6)  THEN
C--- BANK HAS A FORMAT - PUT IT IN LOG. REC. HEADER
      CALL ZGTFOR(IZ,IPOS,NWFOR,IH(NWH+1))
      CALL UCOPY(IH(NWH+1),IFORBF,NWFOR)
      NWFORL=NWFOR
      NWH=NWH+NWFOR+1
      IH(NWH)=NWFOR
      ENDIF
C---
      MODE   = MOD (ICODE,10)
      MODEP  = MODSEP(MODE + 1)
      IDB    = IDD
      IF (NDATA.EQ. 0)                           GO TO 180
      IF (ICODE.LE.10)                           GO TO 150
C
      CALL UCOPY (IZ(IDD+1),IZ(LC+1),NDATA)
      IDD    = LC
C
  150 IF (MODE.NE.0)                             GO TO 160
C
      NDATA     = (NDATA*NBIT-1) / 16 + 1
      GO TO 180
C
  160 CONTINUE
C--- Inserted by HG
      IF(NWFORL.GT.0)  GOTO 170
C---
      IF (MODE.EQ.5)                             GO TO 180
C
      CALL ZTOIBM (IZ(IDD+1),NDATA,MODE)
C--- Inserted by HG
      GOTO 180
  170 CONTINUE
      IF(NDATA.GT.0)CALL ZFCONV(IFORBF,NWFOR,IZ(IDD+1),NDATA,1)
C---
C
C     WRITE A BANK
C
  180 CALL EPOUTL (LUN,MODEP,NWH,IH,NDATA,IZ(IDD+1),IZ(JBUF),IERR)
C
      IF (IERR.NE.0)                             GO TO 250
C
  185 JL(NST) = JL(NST) - 1
      IF (JL(NST).NE.0)                          GO TO 190
C
      NST    = NST - 1
      IF (NMSS.EQ.0)                             GO TO 190
C
      IH(2)  = 5
      IH(4)  = NMSS
      NMSS   = 0
C
      CALL EPOUTL (LUN,1,4,IH,0,IZ,IZ(JBUF),IERR)
C
      IF (IERR.NE.0)                             GO TO 250
C
  190 IF (NLINKS.NE.0)                           GO TO 200
      IF (NST.NE.1)                              GO TO 120
      GO TO 210
C
  200 NST    = NST + 1
      JD(NST) = IDB
      JL(NST) = NLINKS
      JM(NST) = JL(NST)
      GO TO 120
C
  210 CONTINUE
C
      IF (NMSS.EQ.0)                             GO TO 220
C
      IH(2)  = 5
      IH(4)  = NMSS
C
      CALL EPOUTL (LUN,1,4,IH,0,IZ,IZ(JBUF),IERR)
C
      IF (IERR.NE.0)                             GO TO 250
C
  220 CONTINUE
C
  230 IH(2)  = 4
C
C     WRITE TRAILER RECORD
C
      CALL EPOUTL (LUN,1,3,IH,0,IZ,IZ(JBUF),IERR)
C
  240 IF (LC.LE.0)                               GO TO 260
C
  250 CALL ZDELET (IZ,LC)
C
  260 IERR   = IERR + IZ(IDS + 6)
C
      RETURN
      END
