Mostly minor style modifications to be ready for cloning with EMCAL
[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / qend / zfatal.F
CommitLineData
fe4da5cc 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
12C- 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"
19C-------------- 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
35C---- 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
63C-- 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
72C-- 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
129C---- 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"