MINICERN/packlib/zebra/qend/ztell.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/03/06 10:47:14  mclareni
   6 * Zebra
   7 *
   8 *
   9 #include "zebra/pilot.h"
  10       SUBROUTINE ZTELL (IDP,JFLP)
  11
  12 C-    Signal trouble situation,
  13 C-    called from the garbage collector if not enough space
  14 C-    may be user called with IDP > 100
  15
  16 #include "zebra/zstate.inc"
  17 #include "zebra/zunit.inc"
  18 #include "zebra/quest.inc"
  19 #include "zebra/mzca.inc"
  20 #include "zebra/mzcb.inc"
  21 #include "zebra/fzcx.inc"
  22 C--------------    END CDE                             --------------
  23       COMMON /ZTELLC/  ID,JFLUS
  24
  25       DIMENSION    IDP(9), JFLP(9)
  26
  27       PARAMETER   (NLIST = 3 )
  28       DIMENSION    LIST(NLIST), JFLDEF(NLIST)
  29 #if defined(CERNLIB_QMVDS)
  30       SAVE         LIST, JFLDEF
  31 #endif
  32 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  33       DIMENSION    NAMESR(2)
  34       DATA  NAMESR / 4HZTEL, 4HL    /
  35 #endif
  36 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  37       DATA  NAMESR / 6HZTELL  /
  38 #endif
  39 #if !defined(CERNLIB_QTRHOLL)
  40       CHARACTER    NAMESR*8
  41       PARAMETER   (NAMESR = 'ZTELL   ')
  42 #endif
  43       DATA  LIST   / 19, 61, 62 /
  44       DATA  JFLDEF /  2,  2,  2 /
  45
  46 C-    Return code:   0 return, 1 QNEXT, 2 ZFATAL, 3 ZEND
  47
  48
  49       ID    = IDP(1)
  50       JFLUS = JFLP(1)
  51       JFLSV = MAX (JFLUS,0)
  52       IQUEST(1) = ID
  53 #if defined(CERNLIB_QPRINT)
  54       LOGLEV = NQLOGD
  55       IF (ID.GE.11)  THEN
  56           IF (ID.LE.19)  LOGLEV = MAX (LOGLEV,LOGLVX)
  57           IF (ID.EQ.15)  LOGLEV = MAX (LOGLEV,NQLOGL)
  58           IF (ID.EQ.99)  LOGLEV = MAX (LOGLEV,NQLOGL)
  59         ENDIF
  60       IF (LOGLEV.GE.1)   WRITE (IQLOG,9001)  ID,JFLUS
  61  9001 FORMAT (' ZTELL.  ----   Called for Condition',I5,',',I4)
  62 #endif
  63
  64 C--                System conditions
  65
  66       IF (ID.GE.100)               GO TO 31
  67       J = IUCOMP (ID,LIST,NLIST)
  68       IF (J.NE.0)   THEN
  69           JFLUS = JFLDEF(J)
  70         ENDIF
  71
  72 C--                CALL ZTELUS
  73
  74    31 CALL ZTELUS
  75       JFLUS = MAX (JFLUS,JFLSV)
  76       JFLUS = MIN (JFLUS,3) + 1
  77       GO TO (40,41,42,43), JFLUS
  78
  79    41 IF (NQPHAS.LE.0)             GO TO 42
  80       NQTRAC = 0
  81       CALL QNEXTE
  82
  83    43 NQPHAS = -2
  84       CALL ZEND
  85
  86    42 CONTINUE
  87 #include "zebra/qtrace.inc"
  88       CALL ZFATAM ('EXIT VIA ZTELL.')
  89
  90    40 RETURN
  91       END
  92 *      ==================================================
  93 #include "zebra/qcardl.inc"