[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / qend / zfatal.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/03/06 10:47:14  mclareni
* Zebra
*
*
#include "zebra/pilot.h"
      SUBROUTINE ZFATAL

C-    FATAL PROGRAM TERMINATION

#include "zebra/zmach.inc"
#include "zebra/zstate.inc"
#include "zebra/zunit.inc"
#include "zebra/zvfaut.inc"
#include "zebra/mqsys.inc"
C--------------    END CDE                             --------------
#if defined(CERNLIB_QMVDS)
      SAVE         INIT
#endif
#include "zebra/zfatalch.inc"

#include "zebra/zfatalre.inc"

      IF (NQERR.NE.0)              GO TO 71
      NQERR = NQERR+1
      LUN   = IQTYPE
      IF (LUN.NE.0)                GO TO 22

   21 LUN  = IQLOG
   22 IF (NQTRAC.EQ.0)             GO TO 31

C----              PRINT ZEBRA TRACE-BACK

#if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_QTRHOLL)||defined(CERNLIB_A6M))
      JT = NQTRAC - 1
      WRITE (LUN,9024) MQTRAC(JT+1)
 9024 FORMAT (1X/' !!!!! ZFATAL called from ',A6)
      GO TO 28

   25 WRITE (LUN,9025) MQTRAC(JT+1)
 9025 FORMAT (14X,'called from ',A6)
   28 JT = JT - 1
#endif
#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
      JT = NQTRAC - 2
      WRITE (LUN,9024) MQTRAC(JT+1),MQTRAC(JT+2)
 9024 FORMAT (1X/' !!!!! ZFATAL called from ',2A4)
      GO TO 28

   25 WRITE (LUN,9025) MQTRAC(JT+1),MQTRAC(JT+2)
 9025 FORMAT (14X,'called from ',2A4)
   28 JT = JT - 2
#endif
#if defined(CERNLIB_QPRINT)
      IF (JT.GE.0)                 GO TO 25
      IF (NQFATA.EQ.0)             GO TO 49
      GO TO 41
#endif

C--                EXTERNAL CALL TO ZFATAL

   31 IF (NQFATA.NE.0)             GO TO 41
#if defined(CERNLIB_QPRINT)
      WRITE (LUN,9031)
 9031 FORMAT (1X/' !!!!! ZFATAL reached.')
#endif
      GO TO 49

C--                ZEBRA INTERNAL CALL TO ZFATAL

   41 CONTINUE
#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
      WRITE (LUN,9041) IQUEST(10),NQCASE
 9041 FORMAT (1X/' !!!!! ZFATAL reached from ',A6,'  for Case=',I3/1X)
#endif
#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
      WRITE (LUN,9041) IQUEST(9),IQUEST(10),NQCASE
 9041 FORMAT (1X/' !!!!! ZFATAL reached from ',2A4,'  for Case=',I3/1X)
#endif
#if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_QTRHOLL))
      WRITE (LUN,9041) IQUEST(9),IQUEST(10),NQCASE
 9041 FORMAT (1X/' !!!!! ZFATAL reached from ',2A4,'  for Case=',I3/1X)
#endif
#if defined(CERNLIB_QPRINT)

      JPOS = IQBITW - 7

      DO 47  JW=11,10+NQFATA
      IT = IQUEST(JW)
      J  = JBYT (IT,JPOS,8)
      IF (J.EQ.0)                  GO TO 44
      IF (J.EQ.255)                GO TO 44

      WRITE (LUN,9043,ERR=47)  JW,IT,IT,IT
      GO TO 47

   44 WRITE (LUN,9044,ERR=47)  JW,IT,IT
#endif
#if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))
 9043 FORMAT (10X,'IQUEST(',I2,') = ',I9,1X,O22,1X,A6)
 9044 FORMAT (10X,'IQUEST(',I2,') = ',I9,1X,O22)
#endif
#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))
 9043 FORMAT (10X,'IQUEST(',I2,') = ',I9,1X,Z16,1X,A6)
 9044 FORMAT (10X,'IQUEST(',I2,') = ',I9,1X,Z16)
#endif
   47 CONTINUE

   49 WRITE (LUN,9049) JQSTOR,JQDIVI
 9049 FORMAT (1X/10X,'Current Store number =',I3,'  (JQDIVI=',I2,')')

      IF (IQVID(2).EQ.0)           GO TO 59

      WRITE (LUN,9051) IQVID
      WRITE (LUN,9052) (J,IQVREM(1,J),IQVREM(2,J),J=1,6)

 9051 FORMAT (1X/10X,'Automatic Verification Identifiers :'
     F/10X,'Current :',2X,2I11)
 9052 FORMAT (10X,'Stacked, J =',I2,' :',I6,I11,5(/22X,I2,' :',I6,I11))

   59 IF (LUN.NE.IQLOG)            GO TO 21
      NQCASE = 0
      NQFATA = 0
      CALL ZABEND

C----              RECOVERY LOOP

   71 NQERR = NQERR + 1
      IF (NQERR.GE.4)              GO TO 79
      WRITE (IQLOG,9071)
      IF (IQTYPE.EQ.0)             GO TO 79
      IF (IQTYPE.EQ.IQLOG)         GO TO 79
      WRITE (IQTYPE,9071)
 9071 FORMAT (1X/' !!!!! Stop for re-entry to ZFATAL.')
   79 CONTINUE
      CALL ABEND
      END
*      ==================================================
#include "zebra/qcardl.inc"
Commit	Line	Data
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
	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"