MINICERN/packlib/zebra/qend/zfatal.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 ZFATAL
  11
  12 C-    FATAL PROGRAM TERMINATION
  13
  14 #include "zebra/zmach.inc"
  15 #include "zebra/zstate.inc"
  16 #include "zebra/zunit.inc"
  17 #include "zebra/zvfaut.inc"
  18 #include "zebra/mqsys.inc"
  19 C--------------    END CDE                             --------------
  20 #if defined(CERNLIB_QMVDS)
  21       SAVE         INIT
  22 #endif
  23 #include "zebra/zfatalch.inc"
  24
  25 #include "zebra/zfatalre.inc"
  26
  27       IF (NQERR.NE.0)              GO TO 71
  28       NQERR = NQERR+1
  29       LUN   = IQTYPE
  30       IF (LUN.NE.0)                GO TO 22
  31
  32    21 LUN  = IQLOG
  33    22 IF (NQTRAC.EQ.0)             GO TO 31
  34
  35 C----              PRINT ZEBRA TRACE-BACK
  36
  37 #if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_QTRHOLL)||defined(CERNLIB_A6M))
  38       JT = NQTRAC - 1
  39       WRITE (LUN,9024) MQTRAC(JT+1)
  40  9024 FORMAT (1X/' !!!!! ZFATAL called from ',A6)
  41       GO TO 28
  42
  43    25 WRITE (LUN,9025) MQTRAC(JT+1)
  44  9025 FORMAT (14X,'called from ',A6)
  45    28 JT = JT - 1
  46 #endif
  47 #if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  48       JT = NQTRAC - 2
  49       WRITE (LUN,9024) MQTRAC(JT+1),MQTRAC(JT+2)
  50  9024 FORMAT (1X/' !!!!! ZFATAL called from ',2A4)
  51       GO TO 28
  52
  53    25 WRITE (LUN,9025) MQTRAC(JT+1),MQTRAC(JT+2)
  54  9025 FORMAT (14X,'called from ',2A4)
  55    28 JT = JT - 2
  56 #endif
  57 #if defined(CERNLIB_QPRINT)
  58       IF (JT.GE.0)                 GO TO 25
  59       IF (NQFATA.EQ.0)             GO TO 49
  60       GO TO 41
  61 #endif
  62
  63 C--                EXTERNAL CALL TO ZFATAL
  64
  65    31 IF (NQFATA.NE.0)             GO TO 41
  66 #if defined(CERNLIB_QPRINT)
  67       WRITE (LUN,9031)
  68  9031 FORMAT (1X/' !!!!! ZFATAL reached.')
  69 #endif
  70       GO TO 49
  71
  72 C--                ZEBRA INTERNAL CALL TO ZFATAL
  73
  74    41 CONTINUE
  75 #if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  76       WRITE (LUN,9041) IQUEST(10),NQCASE
  77  9041 FORMAT (1X/' !!!!! ZFATAL reached from ',A6,'  for Case=',I3/1X)
  78 #endif
  79 #if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  80       WRITE (LUN,9041) IQUEST(9),IQUEST(10),NQCASE
  81  9041 FORMAT (1X/' !!!!! ZFATAL reached from ',2A4,'  for Case=',I3/1X)
  82 #endif
  83 #if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_QTRHOLL))
  84       WRITE (LUN,9041) IQUEST(9),IQUEST(10),NQCASE
  85  9041 FORMAT (1X/' !!!!! ZFATAL reached from ',2A4,'  for Case=',I3/1X)
  86 #endif
  87 #if defined(CERNLIB_QPRINT)
  88
  89       JPOS = IQBITW - 7
  90
  91       DO 47  JW=11,10+NQFATA
  92       IT = IQUEST(JW)
  93       J  = JBYT (IT,JPOS,8)
  94       IF (J.EQ.0)                  GO TO 44
  95       IF (J.EQ.255)                GO TO 44
  96
  97       WRITE (LUN,9043,ERR=47)  JW,IT,IT,IT
  98       GO TO 47
  99
 100    44 WRITE (LUN,9044,ERR=47)  JW,IT,IT
 101 #endif
 102 #if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))
 103  9043 FORMAT (10X,'IQUEST(',I2,') = ',I9,1X,O22,1X,A6)
 104  9044 FORMAT (10X,'IQUEST(',I2,') = ',I9,1X,O22)
 105 #endif
 106 #if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))
 107  9043 FORMAT (10X,'IQUEST(',I2,') = ',I9,1X,Z16,1X,A6)
 108  9044 FORMAT (10X,'IQUEST(',I2,') = ',I9,1X,Z16)
 109 #endif
 110    47 CONTINUE
 111
 112    49 WRITE (LUN,9049) JQSTOR,JQDIVI
 113  9049 FORMAT (1X/10X,'Current Store number =',I3,'  (JQDIVI=',I2,')')
 114
 115       IF (IQVID(2).EQ.0)           GO TO 59
 116
 117       WRITE (LUN,9051) IQVID
 118       WRITE (LUN,9052) (J,IQVREM(1,J),IQVREM(2,J),J=1,6)
 119
 120  9051 FORMAT (1X/10X,'Automatic Verification Identifiers :'
 121      F/10X,'Current :',2X,2I11)
 122  9052 FORMAT (10X,'Stacked, J =',I2,' :',I6,I11,5(/22X,I2,' :',I6,I11))
 123
 124    59 IF (LUN.NE.IQLOG)            GO TO 21
 125       NQCASE = 0
 126       NQFATA = 0
 127       CALL ZABEND
 128
 129 C----              RECOVERY LOOP
 130
 131    71 NQERR = NQERR + 1
 132       IF (NQERR.GE.4)              GO TO 79
 133       WRITE (IQLOG,9071)
 134       IF (IQTYPE.EQ.0)             GO TO 79
 135       IF (IQTYPE.EQ.IQLOG)         GO TO 79
 136       WRITE (IQTYPE,9071)
 137  9071 FORMAT (1X/' !!!!! Stop for re-entry to ZFATAL.')
 138    79 CONTINUE
 139       CALL ABEND
 140       END
 141 *      ==================================================
 142 #include "zebra/qcardl.inc"