*
* $Id$
*
* $Log$
* Revision 1.1  1996/03/08 12:01:11  mclareni
* Initial revision
*
*
#include "zbook/pilot.h"
      SUBROUTINE ZERROR(IZ,IERR,KEY,ID)
C
C     ******************************************************************
C     *                                                                *
C     *       PRINTS ERROR MESSAGES ON UNIT LOUT                       *
C     *                                                                *
C     ******************************************************************
C
      DIMENSION IZ(1),KEY(1),LAB(6),ID(1)
#if defined(CERNLIB_QMLXIA64)
      INTEGER*8 JUMPADR
#endif
C
C     ------------------------------------------------------------------
C
C             CALL USER ROUTINE
C
      NEWERR = IERR
      JZ     = IZ(1)
      IF(IZ(JZ+19).EQ.0) CALL ZUSER(IZ,NEWERR,KEY,ID)
#if (defined(CERNLIB_SINGLE)||defined(CERNLIB_DOUBLE)||defined(CERNLIB_UNIVAC)||defined(CERNLIB_PDP10))&&(!defined(CERNLIB_VAX))&&(!defined(CERNLIB_BESM6))&&(!defined(CERNLIB_QMLXIA64))
      IF(IZ(JZ+19).NE.0) CALL ZJUMP(IZ(JZ+19),IZ,NEWERR,KEY,ID)
#endif
#if defined(CERNLIB_VAX)
      IF(IZ(JZ+19).NE.0) CALL ZJUMP(%VAL(IZ(JZ+19)),IZ,NEWERR,KEY,ID)
#endif
#if defined(CERNLIB_BESM6)
      IF(IZ(JZ+19).NE.0) CALL ZJUMP(IZ,NEWERR,KEY,ID,IZ(JZ+19))
#endif
#if defined(CERNLIB_QMLXIA64)
      IF(IZ(JZ+19).NE.0)  THEN
        JUMPADR = IZ(JZ+19)
          print '(a,z17)','JUMPADR is:', JUMPADR
        CALL JUMPT4(JUMPADR,IZ,NEWERR,KEY,ID)
      END IF
#endif
C
      IF (NEWERR.LE.0)RETURN
C
      IZ(JZ + 6) = NEWERR
      IZ(JZ + 10) = IZ(JZ + 10) - 1
      IF (IZ(JZ + 10).LT.0)RETURN
      LOUT   = IZ(JZ + 4)
      NID    = LOCF(ID(1)) + IZ(JZ + 16) + 1
      CALL UCTOH1(KEY,LAB,6)
      WRITE(LOUT,1000)NEWERR,LAB,NID
      IF (IZ(JZ + 10).EQ.0)WRITE(LOUT,2000)
C
 1000 FORMAT(11X,'***** ERROR NO =',I4,2X,'IN CALLING ROUTINE ',
     + 6A1,5X,'NID =',I6,/)
 2000 FORMAT(/11X,'***** MAXIMUM NUMBER OF PRINTED MESSAGES REACHED IN'
     +,' ZBOOK'/)
C
      RETURN
      END
