C   19/02/84 409060934  MEMBER NAME  BANKPR5  (S)           FORTRAN
C
C-----------------------------------------------------------------------
      SUBROUTINE BANKPR
C-----------------------------------------------------------------------
C
C   AUTHOR:   L. O'NEILL     ?     :  PRINT BOS BANK NAMES OR CONTENTS.
C
C        MOD: J. OLSSON   15/11/83 :
C        MOD: C. BOWDERY  14/02/84 :  RESOLVE PROBLEM WITH DELETED BANKS
C   LAST MOD: C. BOWDERY  14/02/84 :  NAMES PRINTED BY S/R EVBKPR
C
C-----------------------------------------------------------------------
C
      IMPLICIT INTEGER*2 (H)
C
      REAL*8 DATE,TIME
C
#include "cgraph.for"
#include "cdata.for"
C
      COMMON / CWORK  / HDUM(8000),
     +                  HADC(2,42),HTDC(2,42),HTDC1(2,42),HADCF(2,16),
     +                  HTDCF(2,16),HTSPAR(16)
      COMMON / CWORK1 / HWORK(70),DATE,TIME
      COMMON / CHEADR / HEAD(108)
C
      DIMENSION HDSPL(68),HSYM(10),HDATSV(22),HTX(6),HTM1(4),HTM2(4)
      DIMENSION NAMES(20),HSX(13,16),HELP(2)
      DIMENSION HSY(13,16)
C
      EQUIVALENCE (IZWORD,HELP(1))
      EQUIVALENCE (HWORK(1),NAME)
      EQUIVALENCE (HWORK(3),HDSPL(1))
      EQUIVALENCE (HDATSV(1),IDATSV(1)),(DATE,HTM1(1)),(TIME,HTM2(1))
C
      DATA NAMES/'JETC','PATR','TAGC','JHTL','ZETC','GVTX','DEDX',
     $ 'ZVTX','LGCL','TOFR','TPEV','TPTR','ATOF','TPVX','VECT','TRIG',
     $ 'N50S','MPRS','BK17','ZTRG'/
C
      DATA HSYM /'0 ','1 ','2 ','3 ','4 ','5 ','6 ','7 ','8 ','9 '/
      DATA HBLANK/'  '/,HMINUS/'- '/, NNAMES /20/,MASKMH/Z001F/
      DATA HTX /'DS','N ','DA','TE','TI','ME'/
C
      DATA HSX/
     $'  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ',
     $'  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ',
     $'  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ',
     $'  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ',
     $'*M','UL','TI','HA','DR','ON','IC',' E','VE','NT','**','  ','  ',
     $'*N','ON','-B','AR','RE','L ','BH','AB','HA',' E','VE','NT','**',
     $'*B','AR','RE','L ','BH','AB','HA',' E','VE','NT','**','  ','  ',
     $'*2','-P','HO','TO','N ','EV','EN','T*','* ','  ','  ','  ','  ',
     $'*M','UO','N-','PA','IR',' E','VE','NT','**','  ','  ','  ','  ',
     $'*B','EA','M-','BE','AM',' E','VE','NT','**','  ','  ','  ','  ',
     $'*C','OS','MI','C ','EV','EN','T*','* ','  ','  ','  ','  ','  ',
     $'*B','EA','M-','GA','S ','EV','EN','T*','* ','  ','  ','  ','  ',
     $'*H','AL','O ','EV','EN','T*','* ','  ','  ','  ','  ','  ','  ',
     $'*L','UM','I ','EV','EN','T*','* ','  ','  ','  ','  ','  ','  ',
     $'*U','NI','DE','NT','IF','IE','D ','EV','EN','T*','* ','  ','  ',
     $'*R','EJ','EC','TE','D ','EV','EN','T*','* ','  ','  ','  ','  '/
C
      DATA HSY/
     $'UN','EX','PE','CT','ED',' I','NT','ER','RU','PT',' N','-3','  ',
     $'UN','EX','PE','CT','ED',' I','NT','ER','RU','PT',' N','-2','  ',
     $'NO','N ','IN','CR','EA','SI','NG',' W','IR','E-','NU','MB','ER',
     $'IL','LE','GA','L ','HI','T ','CO','UN','TE','R ','  ','  ','  ',
     $'NE','GA','TI','VE',' D','AT','A ','FO','UN','D ','  ','  ','  ',
     $'JE','TC',' B','AN','K ','LO','NG','ER',' T','HA','N ','40','00',
     $'WI','RE',' N','UM','BE','R ','GR','EA','TE','R ','15','36','  ',
     $'NO',' H','IT','S ','IN',' R','IN','G2','  ','  ','  ','  ','  ',
     $'LA','ST',' C','EL','L ','IN',' R','IN','G ','IN','CO','MP','L.',
     $'  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ',
     $'  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ',
     $'  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ',
     $'T2','  ','RE','JE','CT','  ','  ','  ','  ','  ','  ','  ','  ',
     $'Z-','VE','RT','EX',' R','EJ','EC','T ','  ','  ','  ','  ','  ',
     $'  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ','  ',
     $'AC','TU','AL','LY',' R','EJ','EC','TE','D ','BY',' N','10','  '/
C
C------------------  C O D E  ------------------------------------------
C
      NN = ACMD
      IF( NN .GE. 0 ) GO TO 1803
C
C                            NEGATIVE INDEX --> PRINT BOS BANK NAMES
C
      CALL EVBKPR(ICODE)
      IF( ICODE .EQ. 0 ) RETURN
      CALL TRMOUT(80,'ERROR IN BMRT (CURRENT LIST), CALLED IN BANKPR^')
      RETURN
C
1803  CALL TRMOUT(80,' * * PLEASE ENTER NAME OF DESIRED BANK.^')
      CALL TRMIN(4,NAMEB)
      IBANK=IBLN(NAMEB)
      IPBANK=IDATA(IBANK)
200   LIM1=IPBANK-2
210   IF(LIM1.GE.1) GO TO 3
35    CALL TRMOUT(80,'THE BANK IS EMPTY OR DOES NOT EXIST.^')
      RETURN
C** CHECK IF MORE THAN ONE BANK WITH SAME NAME; IF SO, REQUEST NUMBER.
3     IF(IDATA(LIM1+1).EQ.0) GO TO 300
      IF(NAMEB.EQ.NAMES(15)) GO TO 300
      CALL TRMOUT(80,'FOLLOWING BOS BANK NRS ARE PRESENT:^')
      LM1 = LIM1
3332  CALL DIAGIN('                    ',1,IDATA(LM1),N,N,N,N,N)
      IF(IDATA(LM1+1).EQ.0) GO TO 3333
      LM1 = IDATA(LM1+1)-2
      GO TO 3332
3333  CALL TRMOUT(80,'PLEASE ENTER DESIRED BOS BANK NUMBER.^')
      NBOS = TERNUM(DUMMY)
33    IF(NBOS.EQ.IDATA(LIM1)) GO TO 300
      IF(IDATA(LIM1+1).NE.0) GO TO 34
      GO TO 35
34    LIM1 = IDATA(LIM1+1) - 2
      GO TO 33
300   CALL ERASE
      IRETUR = 1
C********************** WRITE CAPTION
      CALL HOME
      CALL CHRSIZ(4)
      HWORK(1) = HTX(1)
      HWORK(2) = HTX(2)
      HWORK(3) = HBLANK
      DO 4988  I = 1,22
4988  HWORK(I+3) = HDATSV(I)
      CALL EOUTST(50,HWORK)
      KCNT=0
      IHEAD=IBLN('HEAD')
      IPHEAD=IDATA(IHEAD)
      IHHEAD=2*IPHEAD
      DO 5001 III=1,3
      IF(III.EQ.1) NUMCAP=HDATA(IHHEAD+10)
      IF(III.EQ.2) NUMCAP=HDATA(IHHEAD+11)
      IF(III.EQ.3) NUMCAP=ICREC
      IF(NUMCAP.LT.0) KCNT=KCNT+1
      IF(NUMCAP.LT.0) HWORK(KCNT)=HMINUS
      NUMCAP=IABS(NUMCAP)
      NDIG=1
      ACAP=NUMCAP
      IF(NUMCAP.GT.0) NDIG=1+ALOG10(ACAP+0.001)
      IF(NDIG.GT.8) NDIG=8
      DO 5002 JJJ=1,NDIG
      KKK=KCNT+NDIG-JJJ+1
      NTEN=NUMCAP/10
      IDIG=NUMCAP-10*NTEN
      HWORK(KKK)=HSYM(IDIG+1)
      NUMCAP=NTEN
 5002 CONTINUE
      KCNT=KCNT+NDIG
      IF(III.LT.3) KCNT=KCNT+1
      IF(III.LT.3) HWORK(KCNT)=HBLANK
 5001 CONTINUE
      KCNT = 2*KCNT
      CALL NEWLIN
      CALL EOUTST(KCNT,HWORK)
5118  CONTINUE
C WRITE DATE AND TIME
      CALL DAY(DATE,TIME)
      HWORK(1) = HTX(3)
      HWORK(2) = HTX(4)
      HWORK(3) = HBLANK
      DO 4987  I = 1,4
4987  HWORK(I+3) = HTM1(I)
      CALL NEWLIN
      CALL EOUTST(14,HWORK)
      HWORK(1) = HTX(5)
      HWORK(2) = HTX(6)
      HWORK(3) = HBLANK
      DO 4986  I = 1,4
4986  HWORK(I+3) = HTM2(I)
      CALL NEWLIN
      CALL EOUTST(14,HWORK)
      CALL NEWLIN
      CALL CHRSIZ(3)
      CALL NEWLIN
C****************************** WRITE BANK HEADER
      LIM2=LIM1+3
      LIMX = LIM2-1
      LIMHX = 2*LIMX
      NAME=IDATA(LIM1-1)
      CALL CORE(HDSPL,76)
      WRITE(10,9001) (IDATA(LHO),LHO=LIM1,LIMX),(HDATA(LIMHX+J),J=1,2)
 9001 FORMAT(3I10,2I10)
      CALL EOUTST(80,HWORK)
      CALL NEWLIN
C     CALL PROMPT
      CALL SEELOC(IXT,IYT)
      XS = IXT
      YS = IYT
      CALL CHRSIZ(4)
      CALL CSIZE(IX,IXT)
      SIZE = IXT*.8
      DEL = 1.7*SIZE
C****************************** WRITE BANK CONTENT
      NWO = IDATA(LIM2-1) - 1
      LENGB=2*NWO
      NCYCLE=1+(LENGB-1)/20
      INNAM = 0
      DO 1473  INN = 1,NNAMES
      IF(NAMEB.NE.NAMES(INN)) GO TO 1473
      INNAM = INN
      GO TO 1474
1473  CONTINUE
      GO TO 1092
1474  GO TO (2001,877,1092,1092,5177,1277,1377,1577,1677,1977,2077,2177,
     $ 3177,4177,277,1092,3235,1940,2240,2550), INNAM
C-------------- NORMAL PRINT OF BANKS, INTEGER*2 OR Z4 FORMAT
1092  CONTINUE
      DO 9010 LHO=1,NCYCLE
9006  YS = YS - DEL
      IF(YS.GT.50.) GO TO 9012
      IRETUR = 4
      GO TO 9965
9012  LIML=2*LIM2+20*(LHO-1)+1
      LIMU = LIML + 19
      IF(LIMU.GT.(2*LIM2+LENGB)) LIMU=2*LIM2+LENGB
      ILIM = LIMU - LIML + 1
      IF(ILIM.LE.0) GO TO 9020
      DO 9025  I = 1,ILIM
      LLO = LIML + I - 1
9025  HWORK(I+100) = HDATA(LLO)
      IILIM = 6*ILIM + 1
      CALL CORE(HWORK,IILIM)
      IF(NAMEB.NE.NAMES(3).AND.NAMEB.NE.NAMES(4).AND.NAMEB.NE.NAMES(16))
     $ WRITE(JUSCRN,9011) (HWORK(LLO+100),LLO=1,ILIM)
      IF(NAMEB.EQ.NAMES(3).OR.NAMEB.EQ.NAMES(4).OR.NAMEB.EQ.NAMES(16))
     $ WRITE(JUSCRN,9111) (HWORK(LLO+100),LLO=1,ILIM)
 9011 FORMAT(' ',20I6)
 9111 FORMAT(' ',20(Z4,2X))
      CALL SYSSYM(XS,YS,SIZE,HWORK,IILIM,0.)
 9010 CONTINUE
      GO TO 9020
C____________________________ SPECIAL FORMAT FOR JETC BANK
2001  LENGB = LENGB + 2
      NCYCLE=1+(LENGB-1)/20
      LENGB = LENGB - 2
      DO 8010 LHO=1,NCYCLE
8006  YS = YS - DEL
      IF(YS.GT.50.) GO TO 8012
      IRETUR = 5
      GO TO 9965
8012  LIML=2*LIM2+20*(LHO-1)+1
      IF(LHO.GT.5) LIML = LIML - 2
      LIMU = LIML + 19
      IF(LHO.EQ.5) LIMU = LIMU - 2
      IF(LIMU.GT.(2*LIM2+LENGB)) LIMU=2*LIM2+LENGB
      ILIM = LIMU - LIML + 1
      IF(ILIM.LE.0) GO TO 9020
      DO 8025  I = 1,ILIM
      LLO = LIML + I - 1
8025  HWORK(I+100) = HDATA(LLO)
      IF(LHO.LE.5) GO TO 8026
      DO 8027  I = 1,ILIM,4
      IX = HWORK(I+100)
      IX = SHFTR(IX,3)
8027  HWORK(I+100) = IX
8026  IILIM = 6*ILIM + 1
      CALL CORE(HWORK,IILIM)
      WRITE(JUSCRN,9011) (HWORK(LLO+100),LLO=1,ILIM)
      CALL SYSSYM(XS,YS,SIZE,HWORK,IILIM,0.)
 8010 CONTINUE
      GO TO 9020
C--------------- SPECIAL FORMAT FOR ATOF BANK
3177  IPTOF = LIM2-1
      CALL AGRPR(IPTOF,&3173)
      GO TO 3174
3173  WRITE(6,3175)
3175  FORMAT(' ATFUGR ERROR, WRONG BANK DESCRIPTOR...' )
      RETURN
3174  CALL CORE(HWORK,107)
      WRITE(JUSCRN,3181)
3181  FORMAT(' NR   ADC(L)  ADC(R)   TDC(L)  TDC(R)   TDC1(L)  TDC1(R)
     $ ADCF(L)  ADCF(R)   TDCF(L)  TDCF(R)   TDC(SPARE)')
      CALL SYSSYM(XS,YS,SIZE,HWORK,107,0.)
      YS = YS - .9*DEL
      DO 3178  I = 1,42
      IF(I.GT.16) GO TO 3179
      CALL CORE(HWORK,106)
      WRITE(JUSCRN,3185) I,(HADC(J,I),J=1,2),(HTDC(J,I),J=1,2),
     $(HTDC1(J,I),J=1,2),(HADCF(J,I),J=1,2),(HTDCF(J,I),J=1,2),HTSPAR(I)
3185  FORMAT(' ',I2,2X,I6,2X,I6,3X,I6,2X,I6,3(3X,I7,2X,I7),3X,I10)
      CALL SYSSYM(XS,YS,SIZE,HWORK,106,0.)
      GO TO 3186
3179  CALL CORE(HWORK,55)
      WRITE(JUSCRN,3187) I,(HADC(J,I),J=1,2),(HTDC(J,I),J=1,2),
     $ (HTDC1(J,I),J=1,2)
3187  FORMAT(' ',I2,2X,I6,2X,I6,3X,I6,2X,I6,3X,I7,2X,I7)
      CALL SYSSYM(XS,YS,SIZE,HWORK,55,0.)
3186  YS = YS - .9*DEL
      IF(MOD(I,10).EQ.0) YS = YS -.2*DEL
3178  CONTINUE
      GO TO 9020
C--------------- SPECIAL FORMAT FOR VECT BANK
C-  FIRST VECT 0, THEN VECT 1 IF IT EXISTS
C-
277   IVPS = 0
      LIM2 = LIM2 - 1
2782  LO = IDATA(LIM2+1)
      LTR = IDATA(LIM2+2)
      NTR = IDATA(LIM2+4)
      IPO = LIM2 + LO
      CALL CORE(HWORK,106)
      WRITE(JUSCRN,278) (IDATA(LIM2+II),II=1,LO)
278   FORMAT('  ',6I8,2F8.4,5I8)
      LOO = LO*8+2
      CALL SYSSYM(XS,YS,SIZE,HWORK,LOO,0.)
      LO1 = MIN0(12,LO)
      IF(LO1.LT.7) GO TO 2791
      YS = YS - DEL
      CALL CORE(HWORK,124)
      WRITE(JUSCRN,178) (ADATA(LIM2+II),II=7,LO1)
178   FORMAT(' HEADER WORDS 7-.. ',6E14.6)
      LOO = (LO1-6)*14+19
      CALL SYSSYM(XS,YS,SIZE,HWORK,LOO,0.)
2791  ICNT = 0
279   ICNT = ICNT + 1
      IF(ICNT.GT.NTR.AND.IVPS.EQ.1) GO TO 9020
      IF(ICNT.GT.NTR.AND.IVPS.EQ.0) GO TO 2781
275   YS = YS - DEL
      IF(YS.GT.50.) GO TO 276
      IRETUR = 3
      GO TO 9965
276   IPP = IPO + (ICNT-1)*LTR
      IF(LTR.EQ.10) CALL CORE(HWORK,95)
      IF(LTR.EQ.12) CALL CORE(HWORK,115)
      IF(LTR.EQ.10)
     1  WRITE(JUSCRN,274) (ADATA(IPP+I),I=1,5),(IDATA(IPP+I),I=6,7),
     2 (ADATA(IPP+I),I=8,10)
274   FORMAT(' ',4F10.4,2X,F10.6,2X,2I4,2X,3F10.3)
      IF(LTR.EQ.12)
     1  WRITE(JUSCRN,284) (ADATA(IPP+I),I=1,5),(IDATA(IPP+I),I=6,7),
     2 (ADATA(IPP+I),I=8,10),HDATA(2*IPP+21),HDATA(2*IPP+22),
     3  ADATA(IPP+12)
284   FORMAT(' ',4F10.4,2X,F10.6,2X,2I4,2X,3F10.3,2I5,F10.2)
      IF(LTR.EQ.10) CALL SYSSYM(XS,YS,SIZE,HWORK,95,0.)
      IF(LTR.EQ.12) CALL SYSSYM(XS,YS,SIZE,HWORK,115,0.)
      GO TO 279
2781  CONTINUE
      LIM2 = IDATA(LIM2-1)
      IF(LIM2.LT.1) GO TO 9020
      IVPS = 1
C* WRITE BANK HEADER FOR VECT 1
      CALL NEWLIN
      CALL NEWLIN
      LIM1=LIM2-2
      LIMX = LIM2
      LIMHX = 2*LIMX
      NAME=IDATA(LIM2-3)
      CALL CORE(HDSPL,76)
      WRITE(10,9001) (IDATA(LHO),LHO=LIM1,LIMX),(HDATA(LIMHX+J),J=1,2)
      CALL EOUTST(80,HWORK)
      CALL NEWLIN
      CALL SEELOC(IXT,IYT)
      XS = IXT
      YS = IYT
      CALL CHRSIZ(4)
      CALL CSIZE(IX,IXT)
      GO TO 2782
C--------------- SPECIAL FORMAT FOR TPVX BANK
4177  LIM2 = LIM2 - 1
      LIMLIM = 2*LIM2
      CALL CORE(HWORK,13)
      WRITE(JUSCRN,4178) HDATA(LIMLIM+1),HDATA(LIMLIM+2)
4178  FORMAT(' ',I4,I8)
      CALL SYSSYM(XS,YS,SIZE,HWORK,13,0.)
      YS = YS - DEL
      CALL CORE(HWORK,108)
      WRITE(JUSCRN,4179) (ADATA(LIM2+1+I),I=1,7),IDATA(LIM2+9),
     1 ADATA(LIM2+10)
4179  FORMAT(' ',3E12.4,2X,3E12.4,2X,E12.4,I4,3X,E12.4)
      CALL SYSSYM(XS,YS,SIZE,HWORK,108,0.)
      YS = YS - DEL
      CALL CORE(HWORK,51)
      WRITE(JUSCRN,4175) (HDATA(LIMLIM+20+I),I=1,10)
4175  FORMAT(' ',10I5)
      CALL SYSSYM(XS,YS,SIZE,HWORK,51,0.)
      MULSEC = HDATA(LIMLIM+22)
      IF(MULSEC.LE.0) GO TO 9020
      IVX = 30
4171  IVX1 = 20
      IF(MULSEC+30.LT.IVX+IVX1) IVX1 = MULSEC+30-IVX
      YS = YS - DEL
      CALL CORE(HWORK,101)
      WRITE(JUSCRN,4174) (HDATA(LIMLIM+IVX+I),I=1,IVX1)
4174  FORMAT(' ',20I5)
      LIMLO = IVX1*5 + 1
      CALL SYSSYM(XS,YS,SIZE,HWORK,LIMLO,0.)
      IVX = IVX + 20
      IF(IVX.GT.30+MULSEC) GO TO 9020
      GO TO 4171
C--------------- SPECIAL FORMAT FOR PATR BANKS
877   LIM2 = LIM2 - 1
      LO = IDATA(LIM2+1)
      NTR = IDATA(LIM2+2)
      LTR = IDATA(LIM2+3)
      IPO = LIM2 + LO
      CALL CORE(HWORK,72)
      WRITE(JUSCRN,878) (IDATA(LIM2+II),II=1,LO)
878   FORMAT('  ',3I5,2X,Z8,3I5,2X,Z8,4I5)
      LO = LO*5+12
      CALL SYSSYM(XS,YS,SIZE,HWORK,LO,0.)
      IF(NTR.GT.100) RETURN
      ICNT = 0
879   ICNT = ICNT + 1
      IF(ICNT.GT.NTR) GO TO 9020
875   YS = YS - DEL
      IF(YS.GT.50.) GO TO 876
      IRETUR = 2
      GO TO 9965
876   IPP = IPO + (ICNT-1)*LTR
      CALL CORE(HWORK,123)
      WRITE(JUSCRN,679) IDATA(IPP+1),(HDATA(IPP*2+I),I=3,4),
     $ (IDATA(IPP+I),I=3,4),(ADATA(IPP+I),I=5,10),
     1                  IDATA(IPP+11),(ADATA(IPP+I),I=12,17)
679   FORMAT(' ',I2,1X,2(Z2,2X),I5,I3,2X,2F8.3,F10.3,3F7.3,2X,I3,2X,
     1 2F8.3,F10.3,3F7.3)
      CALL SYSSYM(XS,YS,SIZE,HWORK,123,0.)
      YS = YS - DEL
      CALL CORE(HWORK,124)
      WRITE(JUSCRN,873) IDATA(IPP+18),(ADATA(IPP+I),I=19,23),
     1                  IDATA(IPP+24),(ADATA(IPP+I),I=25,28),
     2                  IDATA(IPP+29),(ADATA(IPP+I),I=30,32),
     3                  IDATA(IPP+33)
873   FORMAT(' ',I2,1X,F10.6,2F8.3,F10.6,F8.3,I3,1X,4F10.6,I2,1X,F10.2,
     1 2F8.2,I3)
      CALL SYSSYM(XS,YS,SIZE,HWORK,124,0.)
      YS = YS - DEL
      CALL CORE(HWORK,122)
      WRITE(JUSCRN,872) (IDATA(IPP+I),I=34,48),HDATA(1+2*(IPP+1)),
     $ HDATA(2+2*(IPP+1))
872   FORMAT('  ',14I6,2X,Z8,2X,' VECTNR',I4,' PART.TYPE',I3)
      CALL SYSSYM(XS,YS,SIZE,HWORK,122,0.)
      GO TO 879
1277  CONTINUE
C--------------- SPECIAL FORMAT FOR GVTX BANKS
      NV = IDATA(LIM2)
      IPO = LIM2
      DO 1278  INV = 1,NV
      IPO = LIM2+(INV-1)*10
      CALL CORE(HWORK,72)
      WRITE(JUSCRN,1279) IDATA(IPO+1),(ADATA(IPO+1+JJ),JJ=1,6),IDATA(IPO
     $ +8),ADATA(IPO+9),IDATA(IPO+10)
1279  FORMAT(' ',I3,3F8.2,3F8.2,I4,F8.2,I8)
      CALL SYSSYM(XS,YS,SIZE,HWORK,72,0.)
1278  YS = YS - DEL
      NT = IDATA(IPO+11)
      CALL CORE(HWORK,4)
      WRITE(JUSCRN,1280) NT
1280  FORMAT(' ',I3)
      CALL SYSSYM(XS,YS,SIZE,HWORK,4,0.)
      YS = YS - DEL
      IPO = IPO + 11 - 15
      DO 1281  INT = 1,NT
      IPO = IPO+15
      CALL CORE(HWORK,64)
      WRITE(JUSCRN,1282) IDATA(IPO+1),(ADATA(IPO+1+JJ),JJ=1,8)
1282  FORMAT(' ',I3,F8.2,2F7.3,3F8.2,2F7.3)
      CALL SYSSYM(XS,YS,SIZE,HWORK,64,0.)
      YS = YS - DEL
      CALL CORE(HWORK,42)
      WRITE(JUSCRN,1285) (ADATA(IPO+1+JJ),JJ=9,11),
     $ IDATA(IPO+13),IDATA(IPO+14),ADATA(IPO+15)
1285  FORMAT(' ',3F8.2,I4,I3,F10.2)
      CALL SYSSYM(XS,YS,SIZE,HWORK,42,0.)
      YS = YS - DEL
      IF(YS.GT.80.) GO TO 1281
      IRETUR = 6
      GO TO 9965
1286  CONTINUE
1281  CONTINUE
      GO TO 9020
1377  CONTINUE
C--------------- SPECIAL FORMAT FOR DEDX BANKS
      NTR = IDATA(LIM2+1)
      CALL CORE(HWORK,4)
      WRITE(JUSCRN,1380) NTR
1380  FORMAT(' ',I3)
      CALL SYSSYM(XS,YS,SIZE,HWORK,4,0.)
      NTR = MIN0(NTR,60)
      YS = YS - DEL
      DO 1378  ITR = 1,NTR
      IPO = LIM2+1+(ITR-1)*10
      CALL CORE(HWORK,82)
      WRITE(JUSCRN,1379) IDATA(IPO+1),(ADATA(IPO+1+JJ),JJ=1,6),IDATA(IPO
     $ +8),ADATA(IPO+9)
1379  FORMAT(' ',I3,2F8.2,4E12.4,I4,F10.3)
      CALL SYSSYM(XS,YS,SIZE,HWORK,82,0.)
      YS = YS - DEL
      IF(YS.GT.80.) GO TO 1378
      IRETUR = 7
      GO TO 9965
1376  CONTINUE
1378  CONTINUE
      GO TO 9020
1977  CONTINUE
C--------------- SPECIAL FORMAT FOR TOFR BANKS
      NTR = IDATA(LIM2)
      LIM2 = LIM2 - 1
      CALL CORE(HWORK,17)
      WRITE(JUSCRN,1980) (IDATA(LIM2+I),I=1,4)
1980  FORMAT(' ',4I4)
      CALL SYSSYM(XS,YS,SIZE,HWORK,17,0.)
      YS = YS - DEL
      NTRR = IDATA(LIM2+1)
      DO 1978  ITR = 1,NTRR
      IPO = LIM2+4+(ITR-1)*14
      CALL CORE(HWORK,118)
      WRITE(JUSCRN,1979) (IDATA(IPO+I),I=1,3),(ADATA(IPO+I),I=4,14)
1979  FORMAT(' ',3I3,F8.1,F8.0,4F8.0,2F8.1,I3,F8.2,F8.0)
      CALL SYSSYM(XS,YS,SIZE,HWORK,118,0.)
      YS = YS - DEL
      IF(YS.GT.80.) GO TO 1978
      IRETUR = 9
      GO TO 9965
1976  CONTINUE
1978  CONTINUE
      GO TO 9020
1677  CONTINUE
C--------------- SPECIAL FORMAT FOR LGCL BANKS
      LIM2 = LIM2 - 1
      CALL CORE(HWORK,29)
      WRITE(JUSCRN,1680) (IDATA(LIM2+LL),LL=1,4)
1680  FORMAT(' ',4I7)
      CALL SYSSYM(XS,YS,SIZE,HWORK,29,0.)
      LIM2 = LIM2 + 4
      YS = YS - DEL
      CALL CORE(HWORK,118)
      WRITE(JUSCRN,1681) (IDATA(LIM2+LL),LL=1,6),(ADATA(LIM2+LL),LL=7,1000052800
     $),IDATA(LIM2+11),(ADATA(LIM2+LL),LL=12,15),(IDATA(LIM2+L),L=16,21)
1681  FORMAT(' ',I3,I9,4I4,4F8.3,I4,4F8.3,2I3,I6,3I3)
      CALL SYSSYM(XS,YS,SIZE,HWORK,118,0.)
      NCLST = IDATA(LIM2+3)
      NWPCL = IDATA(LIM2+21)
      ILABEL = IDATA(LIM2+17)
      NCLS2 = NCLST*2+ 2
      LIM2 = LIM2 + 21
      LIM22 = 2*LIM2
      YS = YS - DEL
      CALL CORE(HWORK,101)
      WRITE(JUSCRN,1682) ((HDATA(LIM22+L),HDATA(LIM22+L+1)),L=1,NCLS2,2)
1682  FORMAT(' ',20I5)
      CALL SYSSYM(XS,YS,SIZE,HWORK,101,0.)
      IF(NCLST.LE.0) GO TO 9020
      LIM2 = LIM2 + NCLST + 1
      YS = YS - DEL
      DO 1678  ITR = 1,NCLST
      IPO = LIM2+(ITR-1)*NWPCL
      CALL CORE(HWORK,119)
C     IF(ILABEL.EQ.2)
      WRITE(JUSCRN,1679) IDATA(IPO+1),(ADATA(IPO+1+JJ),JJ=1,6),IDATA(IPO
     $ +8),(ADATA(IPO+JJ),JJ=9,NWPCL)
1679  FORMAT(' ',I3,2F8.3,2F9.2,2F8.3,I4,4F8.3,F10.3,2F6.3,F7.3)
C     IF(ILABEL.EQ.1)
C    $WRITE(JUSCRN,1675) IDATA(IPO+1),(ADATA(IPO+1+JJ),JJ=1,6),IDATA(IPO
C    $ +8),(ADATA(IPO+8+JJ),JJ=1,6),IDATA(IPO+15)
C1675  FORMAT(' ',I3,2F8.3,2F9.2,2F8.3,I4,6F9.3,I11)
      CALL SYSSYM(XS,YS,SIZE,HWORK,119,0.)
      YS = YS - DEL
      IF(YS.GT.80.) GO TO 1678
      IRETUR = 8
      GO TO 9965
1676  CONTINUE
1678  CONTINUE
      GO TO 9020
2240  CONTINUE
C--------------- SPECIAL FORMAT FOR FAMP BANKS (NOW TEMPORARILY BK17)
      LIM2 = LIM2 - 1
      LH2 = LIM2*2
      YS = YS - DEL
      CALL CORE(HWORK,28)
      WRITE(JUSCRN,2241) HDATA(LH2+3)
2241  FORMAT(' FAMP PROGRAM VERSION ',I6)
      CALL SYSSYM(XS,YS,SIZE,HWORK,28,0.)
C TRIGGERS
      NTRI = HDATA(LH2+4)
      IF(NTRI.GT.0) GO TO 2242
C      YS = YS - DEL
C      CALL CORE(HWORK,28)
C      WRITE(JUSCRN,2243)
C2243  FORMAT(' ---> NO TRIGGER INFORMATION')
C      CALL SYSSYM(XS,YS,SIZE,HWORK,28,0.)
       GO TO 2244
2242  YS = YS - DEL
      CALL CORE(HWORK,77)
      WRITE(JUSCRN,2245) (HDATA(LH2+NTRI+K),K=1,4)
2245  FORMAT(' #T2 TRACKS ',I3,' R3 TRACKS CELLS 33-48 ',Z4,'  CELLS 17-
     $32 ',Z4,'  CELLS 1-16 ',Z4)
      CALL SYSSYM(XS,YS,SIZE,HWORK,77,0.)
C COUNTERS
2244  NCOU = HDATA(LH2+5)
      IF(NCOU.GT.0) GO TO 2246
C     YS = YS - DEL
C     CALL CORE(HWORK,28)
C     WRITE(JUSCRN,2247)
C2247  FORMAT(' ---> NO COUNTER INFORMATION')
C     CALL SYSSYM(XS,YS,SIZE,HWORK,28,0.)
      GO TO 2248
2246  AA = HDATA(LH2+NCOU+2)*.1
      YS = YS - DEL
      CALL CORE(HWORK,53)
      WRITE(JUSCRN,2249) HDATA(LH2+NCOU+1),AA,HDATA(LH2+NCOU+3),
     $ HDATA(LH2+NCOU+4)
2249  FORMAT(' #TOFS ',I3,' TDIF(NS) ',F8.1,' ZVTOF ',I6,' ZVLG ',I6)
      CALL SYSSYM(XS,YS,SIZE,HWORK,53,0.)
C LEAD GLASS
2248  NL = HDATA(LH2+6)
      IF(NL.GT.0) GO TO 2250
C      YS = YS - DEL
C      CALL CORE(HWORK,31)
C      WRITE(JUSCRN,2251)
C2251  FORMAT(' ---> NO LEAD GLASS INFORMATION')
C      CALL SYSSYM(XS,YS,SIZE,HWORK,31,0.)
      GO TO 2252
2250  AA1 = HDATA(LH2+NL+5)*.001
      AA2 = HDATA(LH2+NL+6)*.001
      AA3 = HDATA(LH2+NL+7)*.001
      AA4 = HDATA(LH2+NL+8)*.001
      YS = YS - DEL
      CALL CORE(HWORK,124)
      WRITE(JUSCRN,2253) (HDATA(LH2+NL+K),K=1,4),AA1,AA2,AA3,AA4,
     $ (HDATA(LH2+NL+KK),KK=9,10)
2253  FORMAT(' NR CLUSTERS TOTAL,BARREL,-EC,+EC : ',4I5,' ENERGIES: ',
     $4F8.3,' NHCLI ',I6,' ERES ',I6)
      CALL SYSSYM(XS,YS,SIZE,HWORK,124,0.)
C INNER DETECTOR ANALYSIS
2252  ND = HDATA(LH2+7)
      IF(ND.GT.0) GO TO 2254
      YS = YS - DEL
      CALL CORE(HWORK,35)
      WRITE(JUSCRN,2255)
2255  FORMAT(' ---> NO INNER DETECTOR INFORMATION')
      CALL SYSSYM(XS,YS,SIZE,HWORK,35,0.)
      GO TO 2256
2254  CONTINUE
      YS = YS - DEL
      CALL CORE(HWORK,46)
      WRITE(JUSCRN,2257) (HDATA(LH2+ND+K),K=1,3)
2257  FORMAT(' ID ZVTX FLAG ',I3,'  ZVTX IN MM ',I6,' INRGZV ',I2)
      CALL SYSSYM(XS,YS,SIZE,HWORK,46,0.)
      YS = YS - DEL
      INRGZV = HDATA(LH2+ND+3)
      NTR = HDATA(LH2+ND+4)
      NTRT = HDATA(LH2+ND+5)
      CALL CORE(HWORK,49)
      IF(NTR.LT.0) WRITE(JUSCRN,2258)
2258  FORMAT(' PATTERN RECOGNITION NOT PERFORMED              ')
      IF(NTR.EQ.0) WRITE(JUSCRN,2259)
2259  FORMAT(' PATTERN RECOGNITION PERFORMED, NO TRACKS FOUND ')
      IF(NTR.LE.0) CALL SYSSYM(XS,YS,SIZE,HWORK,47,0.)
      IF(NTR.LE.0) GO TO 2256
      WRITE(JUSCRN,2260) NTRT,NTR
2260  FORMAT(' PATREC PERFORMED,',I3,' TRACKS FOUND',I3,' TRACK BANKS')
      CALL SYSSYM(XS,YS,SIZE,HWORK,49,0.)
      LORT = HDATA(LH2+ND+6)
      LTRT = HDATA(LH2+ND+7)
      MWR1 = HDATA(LH2+ND+8)
      MWR2 = HDATA(LH2+ND+9)
      MWR3 = HDATA(LH2+ND+10)
      IEFA = HDATA(LH2+ND+11)
      IPLT = LH2+ND+LORT-LTRT
      YS = YS - DEL
      CALL CORE(HWORK,102)
      WRITE(JUSCRN,2261) NTRT,LORT,LTRT,MWR1,MWR2,MWR3,IEFA
2261  FORMAT(' TRACKS LISTED ',I4,'  LO AND LT FOR EACH ',2I4,
     $' NR WORDS MAP RING1-3: ',3I5,' ERROR FLAG ',Z4)
      CALL SYSSYM(XS,YS,SIZE,HWORK,102,0.)
C
      DO 2262  ITR = 1,NTR
      IPLT = IPLT + LTRT
      IFTR = HDATA(IPLT)
      RR1 = HDATA(IPLT+1)*.1
      FI1 = HDATA(IPLT+2)
      Z1 = HDATA(IPLT+3)*.1
      RR2 = HDATA(IPLT+4)*.1
      FI2 = HDATA(IPLT+5)
      Z2 = HDATA(IPLT+6)*.1
      HELP(1) = HDATA(IPLT+8)
      HELP(2) = HDATA(IPLT+9)
      RR = FLOAT(IZWORD)*.1
      SIGXY = HDATA(IPLT+10)*.01
      NXY = HDATA(IPLT+11)
      TANTH = HDATA(IPLT+12)*001
      Z0 = HDATA(IPLT+13)*.1
      SIGZ = HDATA(IPLT+14)*.1
      NZ = HDATA(IPLT+15)
      YS = YS - DEL
      IF(YS.GT.50.) GO TO 2199
      IRETUR = 11
      GO TO 9965
2199  CONTINUE
      CALL CORE(HWORK,120)
      WRITE(6,2263) ITR,IFTR,RR1,FI1,Z1,RR2,FI2,Z2,RR,SIGXY,NXY
2263  FORMAT(' ',I2,' SEC. ',I3,' R-FI-Z 1 ',F8.1,F5.0,F8.1,' R-FI-Z 2 '
     $,F8.1,F5.0,F8.1,' RCURV SIGXY NHITXY ',E14.6,F8.2,I4)
      CALL SYSSYM(XS,YS,SIZE,HWORK,120,0.)
C
      YS = YS - DEL
      CALL CORE(HWORK,115)
      WRITE(6,2264) TANTH,Z0,SIGZ,NZ
2264  FORMAT(' ',59X,' TANTHETA ',F10.5,' Z0 ',F8.2,' SIGZ(MM) ',F7.4,
     $ ' NZ ',I2)
      CALL SYSSYM(XS,YS,SIZE,HWORK,115,0.)
C
2262  CONTINUE
      IPLT = IPLT + LTRT
      IPLT1 = IPLT
      IPLT2 = IPLT1+MWR1
      IPLT3 = IPLT2+MWR2
      IPLT4 = IPLT3+MWR3
      YS = YS - DEL
      IF(YS.GT.50.) GO TO 2299
      IRETUR = 12
      GO TO 9965
2299  CONTINUE
      CALL CORE(HWORK,44)
      WRITE(6,2291) IPLT1,IPLT2,IPLT3,IPLT4
2291  FORMAT(' FAMP HIT MAP POINTERS: ',4I5)
      CALL SYSSYM(XS,YS,SIZE,HWORK,44,0.)
      IF(IPLT2.EQ.IPLT1) GO TO 2292
2295  IPLT22 = IPLT2-1
      IF(IPLT22.GT.IPLT1+19) IPLT22 = IPLT1+19
      IRESV = 22+5*(IPLT22-IPLT1+1)
      YS = YS - DEL
      IF(YS.GT.50.) GO TO 2399
      IRETUR = 13
      GO TO 9965
2399  CONTINUE
      CALL CORE(HWORK,IRESV)
      WRITE(6,2293) (HDATA(II),II=IPLT1,IPLT22)
 2293  FORMAT(' ',14X,' RING1 ',20(Z4,1X))
      CALL SYSSYM(XS,YS,SIZE,HWORK,IRESV,0.)
      IF(IPLT22.GE.IPLT2-1) GO TO 2292
      IPLT1 = IPLT22+1
      GO TO 2295
2292  CONTINUE
      IF(IPLT3.EQ.IPLT2) GO TO 2296
2297  IPLT33 = IPLT3-1
      IF(IPLT33.GT.IPLT2+19) IPLT33 = IPLT2+19
      IRESV = 22+5*(IPLT33-IPLT2+1)
      YS = YS - DEL
      IF(YS.GT.50.) GO TO 2499
      IRETUR = 14
      GO TO 9965
2499  CONTINUE
      CALL CORE(HWORK,IRESV)
      WRITE(6,2298) (HDATA(II),II=IPLT2,IPLT33)
2298  FORMAT(' ',14X,' RING2 ',20(Z4,1X))
      CALL SYSSYM(XS,YS,SIZE,HWORK,IRESV,0.)
      IF(IPLT33.GE.IPLT3-1) GO TO 2296
      IPLT2 = IPLT33+1
      GO TO 2297
2296  CONTINUE
      IF(IPLT4.EQ.IPLT3) GO TO 2301
      IF(INRGZV.NE.3) GO TO 2301
2302  IPLT44 = IPLT3-1
      IF(IPLT44.GT.IPLT3+19) IPLT44 = IPLT3+19
      IRESV = 22+5*(IPLT44-IPLT3+1)
      YS = YS - DEL
      IF(YS.GT.50.) GO TO 2599
      IRETUR = 15
      GO TO 9965
2599  CONTINUE
      CALL CORE(HWORK,IRESV)
      WRITE(6,2303) (HDATA(II),II=IPLT3,IPLT44)
2303  FORMAT(' ',14X,' RING3 ',20(Z4,1X))
      CALL SYSSYM(XS,YS,SIZE,HWORK,IRESV,0.)
      IF(IPLT44.GE.IPLT4-1) GO TO 2301
      IPLT3 = IPLT44+1
      GO TO 2302
2301  CONTINUE
C
2256  NM = HDATA(LH2+8)
      IF(NM.GT.0) GO TO 2266
C      YS = YS - DEL
C      CALL CORE(HWORK,25)
C      WRITE(JUSCRN,2267)
C2267  FORMAT(' ---> NO MUON INFORMATION')
C      CALL SYSSYM(XS,YS,SIZE,HWORK,25,0.)
      GO TO 2268
2266  CONTINUE
      YS = YS - DEL
      NMU = HDATA(LH2+NM)
      IF(NMU.GT.5) NMU =  5
      NCORE = 44 + NMU*4
      NMU = 2*NMU + 1
      CALL CORE(HWORK,64)
      WRITE(JUSCRN,2269) HDATA(LH2+NM),HDATA(LH2+NM+1),
     $ (HDATA(LH2+NM+K),K=2,NMU,2)
2269  FORMAT(' NR MUON TRACKS ',I2,'   IN BARREL ',I3,' POSITION ',5I4)
      CALL SYSSYM(XS,YS,SIZE,HWORK,NCORE,0.)
      YS = YS - DEL
      CALL CORE(HWORK,64)
      WRITE(JUSCRN,2270) (HDATA(LH2+NM+K+1),K = 2,NMU,2)
2270  FORMAT('                ',3X,'             ',3X,' QUALITY ',5I4)
      CALL SYSSYM(XS,YS,SIZE,HWORK,NCORE,0.)
C
2268  CONTINUE
      NTG = HDATA(LH2+9)
      IF(NTG.GT.0) GO TO 2271
C     YS = YS - DEL
C     CALL CORE(HWORK,25)
C     WRITE(JUSCRN,2272)
C2272  FORMAT(' ---> NO TAGG INFORMATION')
C     CALL SYSSYM(XS,YS,SIZE,HWORK,25,0.)
      GO TO 2273
2271  CONTINUE
      YS = YS - DEL
      CALL CORE(HWORK,50)
      WRITE(JUSCRN,2274) (HDATA(LH2+NTG+K),K=1,2)
2274  FORMAT(' TAGGING ENERGIES(MEV) IN -Z, +Z: ',2I8)
      CALL SYSSYM(XS,YS,SIZE,HWORK,50,0.)
C
2273  CONTINUE
C WRITE NOW FAMP ACTION WORD, FROM THE HEADBANK
C     IPHEA = IDATA(IBLN('HEAD'))
C     FAMACT = HDATA(2*IPHEA+26)
C     YS = YS - DEL
C     CALL CORE(HWORK,45)
C     WRITE(JUSCRN,2275) FAMACT
C2275  FORMAT('  FAMP ACTION WORD FROM HEAD BANK 26: ',Z4)
C      CALL SYSSYM(XS,YS,SIZE,HWORK,45,0.)
      GO TO 9020
C-------------------------
C----   SPECIAL FORMAT FOR ZTRG BANKS
C-------------------------
2550  CONTINUE
      LIM2 = LIM2 - 1
      LEZTRG = IDATA(LIM2)
      HPOINT = 2*( LIM2 + 1 )
      HZLENG = 2*( LEZTRG - 1 )
      YS = YS - DEL
C                    WRITE HEADER
      IILIM = 110
      CALL CORE(HWORK,IILIM)
      WRITE(JUSCRN,2551)
 2551 FORMAT(' DATA  B15 CHANNEL FIFOF HITCN UFLOW OFLOW Z-VALUE',10X,
     $' DATA  B15 CHANNEL FIFOF HITCN UFLOW OFLOW Z-VALUE')
      CALL SYSSYM(XS,YS,SIZE,HWORK,IILIM,0.)
C
      DO 2553 IHIT = 1,HZLENG,2
        HELP(2) = HDATA(HPOINT+IHIT)
        IZWRD1 = IZWORD
        KANAL1 = LAND( SHFTR(IZWORD,11),15)
        HITCN1 = LAND( SHFTR(IZWORD,8),3)
        IBT151 = 0
        IF(TBIT(IZWORD,16)) IBT151 = 1
        IZWRT1 = LAND( IZWORD,63 )
        IOVRF1 = 0
        IF(LAND(IZWORD,64).NE.0) IOVRF1 = 1
        IUNDF1 = 0
        IF(LAND(IZWORD,128).NE.0) IUNDF1 = 1
        IFIFF1 = 0
        IF(LAND(IZWORD,1024).NE.0) IFIFF1 = 1
C
        HELP(2) = HDATA(HPOINT+IHIT+1)
        IZWRD2 = IZWORD
        KANAL2 = LAND( SHFTR(IZWORD,11),15)
        HITCN2 = LAND( SHFTR(IZWORD,8),3)
        IBT152 = 0
        IF(TBIT(IZWORD,16)) IBT152 = 1
        IZWRT2 = LAND( IZWORD,63 )
        IOVRF2 = 0
        IF(LAND(IZWORD,64).NE.0) IOVRF2 = 1
        IUNDF2 = 0
        IF(LAND(IZWORD,128).NE.0) IUNDF2 = 1
        IFIFF2 = 0
        IF(LAND(IZWORD,1024).NE.0) IFIFF2 = 1
C
        YS = YS - DEL
        IF(YS.GT.50.) GO TO 2554
      IRETUR = 16
      GO TO 9965
2554    IILIM = 108
        CALL CORE(HWORK,IILIM)
        WRITE(JUSCRN,2552) IZWRD1,IBT151,KANAL1,IFIFF1,HITCN1,IUNDF1,
     $  IOVRF1,IZWRT1,
     $  IZWRD2,IBT152,KANAL2,IFIFF2,HITCN2,IUNDF2,
     $  IOVRF2,IZWRT2
 2552   FORMAT(' ',Z4,3X,I1,4X,I2,5X,I1,5X,I1,5X,I1,5X,I1,4X,I5,
     $ 13X,,Z4,3X,I1,4X,I2,5X,I1,5X,I1,5X,I1,5X,I1,4X,I5)
        CALL SYSSYM(XS,YS,SIZE,HWORK,IILIM,0.)
 2553 CONTINUE
C
      GO TO 9020
3235  CONTINUE
C--------------- SPECIAL FORMAT FOR N50S BANKS
      LIM2 = LIM2 - 1
      LH2 = LIM2*2
      YS = YS - DEL
      CALL CORE(HWORK,86)
      WRITE(JUSCRN,3236) HDATA(LH2+3),HDATA(LH2+11),HDATA(LH2+12)
3236  FORMAT(' N50 PROGRAM VERSION ',I6,' ANALYSIS FLAG ',Z4,'  LOOSE MU
     $LTIHADRON SELECTION FLAG ',I5)
      CALL SYSSYM(XS,YS,SIZE,HWORK,86,0.)
C TRIGGERS
      NTRI = HDATA(LH2+4)
      IF(NTRI.GT.0) GO TO 3227
      YS = YS - DEL
      CALL CORE(HWORK,28)
      WRITE(JUSCRN,3228)
3228  FORMAT(' ---> NO TRIGGER INFORMATION')
      CALL SYSSYM(XS,YS,SIZE,HWORK,28,0.)
      GO TO 3229
3227  YS = YS - DEL
      CALL CORE(HWORK,77)
      WRITE(JUSCRN,3231) (HDATA(LH2+NTRI+K),K=1,4)
3231  FORMAT(' #T2 TRACKS ',I3,' R3 TRACKS CELLS 33-48 ',Z4,'  CELLS 17-
     $32 ',Z4,'  CELLS 1-16 ',Z4)
      CALL SYSSYM(XS,YS,SIZE,HWORK,77,0.)
C COUNTERS
3229  NCOU = HDATA(LH2+5)
      IF(NCOU.GT.0) GO TO 3237
      YS = YS - DEL
      CALL CORE(HWORK,28)
      WRITE(JUSCRN,3238)
3238  FORMAT(' ---> NO COUNTER INFORMATION')
      CALL SYSSYM(XS,YS,SIZE,HWORK,28,0.)
      GO TO 3239
3237  AA = HDATA(LH2+NCOU+2)*.1
      YS = YS - DEL
      CALL CORE(HWORK,53)
      WRITE(JUSCRN,3241) HDATA(LH2+NCOU+1),AA,HDATA(LH2+NCOU+3),
     $ HDATA(LH2+NCOU+4)
3241  FORMAT(' #TOFS ',I3,' TDIF(NS) ',F8.1,' ZVTOF ',I6,' ZVLG ',I6)
      CALL SYSSYM(XS,YS,SIZE,HWORK,53,0.)
C LEAD GLASS
3239  NL = HDATA(LH2+6)
      IF(NL.GT.0) GO TO 3242
      YS = YS - DEL
      CALL CORE(HWORK,31)
      WRITE(JUSCRN,3243)
3243  FORMAT(' ---> NO LEAD GLASS INFORMATION')
      CALL SYSSYM(XS,YS,SIZE,HWORK,31,0.)
      GO TO 3244
3242  AA1 = HDATA(LH2+NL+5)*.001
      AA2 = HDATA(LH2+NL+6)*.001
      AA3 = HDATA(LH2+NL+7)*.001
      AA4 = HDATA(LH2+NL+8)*.001
      YS = YS - DEL
      CALL CORE(HWORK,124)
      WRITE(JUSCRN,3245) (HDATA(LH2+NL+K),K=1,4),AA1,AA2,AA3,AA4,
     $ (HDATA(LH2+NL+KK),KK=9,10)
3245  FORMAT(' NR CLUSTERS TOTAL,BARREL,-EC,+EC : ',4I5,' ENERGIES: ',
     $4F8.3,' NHCLI ',I6,' ERES ',I6)
      CALL SYSSYM(XS,YS,SIZE,HWORK,124,0.)
C INNER DETECTOR ANALYSIS
3244  ND = HDATA(LH2+7)
      IF(ND.GT.0) GO TO 3246
      YS = YS - DEL
      CALL CORE(HWORK,35)
      WRITE(JUSCRN,3247)
3247  FORMAT(' ---> NO INNER DETECTOR INFORMATION')
      CALL SYSSYM(XS,YS,SIZE,HWORK,35,0.)
      GO TO 3248
3246  CONTINUE
      YS = YS - DEL
      CALL CORE(HWORK,46)
      WRITE(JUSCRN,3249) (HDATA(LH2+ND+K),K=1,3)
3249  FORMAT(' ID ZVTX FLAG ',I3,'  ZVTX IN MM ',I6,' INRGZV ',I2)
      CALL SYSSYM(XS,YS,SIZE,HWORK,46,0.)
      YS = YS - DEL
      NTR = HDATA(LH2+ND+4)
      NTRT = HDATA(LH2+ND+5)
      CALL CORE(HWORK,47)
      IF(NTR.LT.0) WRITE(JUSCRN,3250)
3250  FORMAT(' PATTERN RECOGNITION NOT PERFORMED             ')
      IF(NTR.EQ.0) WRITE(JUSCRN,3251)
3251  FORMAT(' PATTERN RECOGNITION PERFORMED, NO TRACKS FOUND')
      IF(NTR.LE.0) CALL SYSSYM(XS,YS,SIZE,HWORK,47,0.)
      IF(NTR.LE.0) GO TO 3248
      WRITE(JUSCRN,3252) NTR
3252  FORMAT(' PATTERN RECOGNITION PERFORMED,',I3,' TRACKS FOUND')
      CALL SYSSYM(XS,YS,SIZE,HWORK,47,0.)
      LORT = HDATA(LH2+ND+6)
      LTRT = HDATA(LH2+ND+7)
      IPLT = LH2+ND+LORT-LTRT
      YS = YS - DEL
      CALL CORE(HWORK,48)
      WRITE(JUSCRN,3212) NTRT,LORT,LTRT
3212  FORMAT(' TRACKS LISTED ',I4,'  LO AND LT FOR EACH ',2I4)
      CALL SYSSYM(XS,YS,SIZE,HWORK,48,0.)
C
      DO 4614  ITR = 1,NTRT
      IPLT = IPLT + LTRT
      X1 = HDATA(IPLT+1)*.1
      Y1 = HDATA(IPLT+2)*.1
      Z1 = HDATA(IPLT+3)*.1
      X2 = HDATA(IPLT+4)*.1
      Y2 = HDATA(IPLT+5)*.1
      Z2 = HDATA(IPLT+6)*.1
      HELP(1) = HDATA(IPLT+8)
      HELP(2) = HDATA(IPLT+9)
      RR = FLOAT(IZWORD)*.1
      SIGXY = HDATA(IPLT+10)*10.
      NXY = HDATA(IPLT+11)
      TANTH = HDATA(IPLT+12)
      Z0 = HDATA(IPLT+13)*.1
      SIGZ = HDATA(IPLT+14)*.1
      NZ = HDATA(IPLT+15)
      YS = YS - DEL
      CALL CORE(HWORK,114)
      WRITE(6,461) ITR,X1,Y1,Z1,X2,Y2,Z2,RR,SIGXY,NXY
461   FORMAT(' ',I2,' XYZ1 ',3F8.1,' XYZ2 ',3F8.1,' RADIUS ',E14.6,
     $'  SIGXY(MY) ',F10.0,' NXY ',I2)
      CALL SYSSYM(XS,YS,SIZE,HWORK,114,0.)
C
      YS = YS - DEL
      CALL CORE(HWORK,114)
      WRITE(6,462) TANTH,Z0,SIGZ,NZ
462   FORMAT(' ',59X,' TANTHETA ',F10.0,' Z0 ',F8.1,' SIGZ(MM) ',F6.1,
     $ ' NZ ',I2)
      CALL SYSSYM(XS,YS,SIZE,HWORK,114,0.)
C
4614  CONTINUE
C
3248  NM = HDATA(LH2+8)
      IF(NM.GT.0) GO TO 3253
      YS = YS - DEL
      CALL CORE(HWORK,25)
      WRITE(JUSCRN,3254)
3254  FORMAT(' ---> NO MUON INFORMATION')
      CALL SYSSYM(XS,YS,SIZE,HWORK,25,0.)
      GO TO 3255
3253  CONTINUE
      YS = YS - DEL
      NMU = HDATA(LH2+NM)
      IF(NMU.GT.5) NMU =  5
      NCORE = 44 + NMU*4
      NMU = 2*NMU + 1
      CALL CORE(HWORK,64)
      WRITE(JUSCRN,3256) HDATA(LH2+NM),HDATA(LH2+NM+1),
     $ (HDATA(LH2+NM+K),K=2,NMU,2)
3256  FORMAT(' NR MUON TRACKS ',I2,'   IN BARREL ',I3,' POSITION ',5I4)
      CALL SYSSYM(XS,YS,SIZE,HWORK,NCORE,0.)
      YS = YS - DEL
      CALL CORE(HWORK,64)
      WRITE(JUSCRN,3257) (HDATA(LH2+NM+K+1),K = 2,NMU,2)
3257  FORMAT('                ',3X,'             ',3X,' QUALITY ',5I4)
      CALL SYSSYM(XS,YS,SIZE,HWORK,NCORE,0.)
C
3255  CONTINUE
      NTG = HDATA(LH2+9)
      IF(NTG.GT.0) GO TO 3283
      YS = YS - DEL
      CALL CORE(HWORK,25)
      WRITE(JUSCRN,3284)
3284  FORMAT(' ---> NO TAGG INFORMATION')
      CALL SYSSYM(XS,YS,SIZE,HWORK,25,0.)
      GO TO 3285
3283  CONTINUE
      YS = YS - DEL
      CALL CORE(HWORK,50)
      WRITE(JUSCRN,3286) (HDATA(LH2+NTG+K),K=1,2)
3286  FORMAT(' TAGGING ENERGIES(MEV) IN -Z, +Z: ',2I8)
      CALL SYSSYM(XS,YS,SIZE,HWORK,50,0.)
C
3285  CONTINUE
C WRITE NOW N50 ACTION WORD, FROM THE HEADBANK
      IPHEA = IDATA(IBLN('HEAD'))
      N50ACT = HDATA(2*IPHEA+26)
      YS = YS - DEL
      CALL CORE(HWORK,45)
      WRITE(JUSCRN,3258) N50ACT
3258  FORMAT('  NORD 50 ACTION WORD FROM HEAD BANK 26: ',Z4)
      CALL SYSSYM(XS,YS,SIZE,HWORK,45,0.)
C
      IF(LAND(N50ACT,MASKMH).NE.0) GO TO 3263
      N50ACT = SHFTL(N50ACT,1)
      DO 3232 IBT = 1,16
      N50ACT = SHFTR(N50ACT,1)
      IF(IBT.LT.6) GO TO 3232
      IF(.NOT.TBIT(N50ACT,31)) GO TO 3232
C BIT IBT IS ON, WRITE CORRESPONDING INFORMATION
      DO 3287  I = 1,13
3287  HDUM(I) = HSX(I,IBT)
      YS = YS - 2*DEL
      CALL CORE(HWORK,43)
      WRITE(JUSCRN,3261) (HDUM(I),I=1,13)
3261  FORMAT('  CLASSIFICATION ',13A2)
      CALL SYSSYM(XS,YS,SIZE,HWORK,43,0.)
3232  CONTINUE
      GO TO 3264
3263  MUH = LAND(N50ACT,MASKMH)
      DO 3289  I = 1,13
3289  HDUM(I) = HSX(I,5)
      YS = YS - 2*DEL
      CALL CORE(HWORK,61)
      WRITE(JUSCRN,3262) (HDUM(I),I=1,13),MUH
3262  FORMAT('  CLASSIFICATION ',13A2,' MULTIPLICITY ',I4)
      CALL SYSSYM(XS,YS,SIZE,HWORK,61,0.)
3264  CONTINUE
C
C MPRS BANK PART, INCLUDE SO THAT ALSO INDEPENDENT PRINT POSSIBLE
C
      IPLNAM = IDATA(IBLN('MPRS'))
      IF(IPLNAM.LE.0) GO TO 9020
      LIM2=IPLNAM+1
      YS = YS - DEL
      CALL CORE(HWORK,54)
      WRITE(JUSCRN,6231)
6231  FORMAT(' ------------->>>   MIPROC RESULTS   <<<--------------')
      CALL SYSSYM(XS,YS,SIZE,HWORK,54,0.)
C---------
1940  LIM2 = LIM2 - 1
      LH2 = LIM2*2
      YS = YS - DEL
      CALL CORE(HWORK,46)
      WRITE(JUSCRN,6232) HDATA(LH2+10)
6232  FORMAT(' MIPROC EVENT COUNT (=TRIGGER NUMBER) ',I8)
      CALL SYSSYM(XS,YS,SIZE,HWORK,46,0.)
C
      YS = YS - DEL
      CALL CORE(HWORK,59)
      WRITE(JUSCRN,6233) HDATA(LH2+4),(HDATA(LH2+K),K=7,9)
6233  FORMAT(' MIPROC ZVTX',I6,' ZVX AND BACKG. PEAKS',2I6,' FLAG ',I2)
      CALL SYSSYM(XS,YS,SIZE,HWORK,59,0.)
C
      YS = YS - DEL
      CALL CORE(HWORK,27)
      WRITE(JUSCRN,6234) HDATA(LH2+5)
6234  FORMAT(' MIPROC FOUND ',I3,' R3 TRACKS')
      CALL SYSSYM(XS,YS,SIZE,HWORK,27,0.)
C
      YS = YS - DEL
      CALL CORE(HWORK,37)
      WRITE(JUSCRN,6235) HDATA(LH2+3)
6235  FORMAT(' MIPROC REJECTION AND ERROR FLAG ',Z4)
      CALL SYSSYM(XS,YS,SIZE,HWORK,37,0.)
C
      MIPROC = HDATA(LH2+3)
      MIPROC = SHFTL(MIPROC,1)
      DO 8232 IBT = 1,16
      MIPROC = SHFTR(MIPROC,1)
      IF(.NOT.TBIT(MIPROC,31)) GO TO 8232
C BIT IBT IS ON, WRITE CORRESPONDING INFORMATION
      DO 8287  I = 1,13
8287  HDUM(I) = HSY(I,IBT)
      YS = YS - DEL
      CALL CORE(HWORK,41)
      WRITE(JUSCRN,8261) (HDUM(I),I=1,13)
8261  FORMAT('  ACTION/ERROR ',13A2)
      CALL SYSSYM(XS,YS,SIZE,HWORK,41,0.)
8232  CONTINUE
C
      GO TO 9020
1577  CONTINUE
C--------------- SPECIAL FORMAT FOR ZVTX BANKS
      LIM2 = LIM2 - 1
      CALL CORE(HWORK,50)
      WRITE(JUSCRN,1579) (ADATA(LIM2+I),I=1,3),(IDATA(LIM2+I),I=4,6)
1579  FORMAT('  ',3F10.3,3I6)
      CALL SYSSYM(XS,YS,SIZE,HWORK,50,0.)
      GO TO 9020
C--------------- SPECIAL FORMAT FOR TPEV BANK
2077  LIM2 = LIM2 - 1
      LIMH2 = 2*LIM2
      CALL CORE(HWORK,62)
      WRITE(JUSCRN,2079) IDATA(LIM2+1),IDATA(LIM2+2),(HDATA(LIMH2+I),I=
     $5,14)
2079  FORMAT('  ',I8,2X,I8,2X,10I4)
      CALL SYSSYM(XS,YS,SIZE,HWORK,62,0.)
      YS = YS - DEL
      CALL CORE(HWORK,114)
      WRITE(JUSCRN,2080) (HDATA(LIMH2+I),I=15,34)
2080  FORMAT('  ',16I5,4I8)
      CALL SYSSYM(XS,YS,SIZE,HWORK,114,0.)
      YS = YS - DEL
      CALL CORE(HWORK,122)
      WRITE(JUSCRN,2081) (ADATA(LIM2+I),I=18,27)
2081  FORMAT('  ',10E12.4)
      CALL SYSSYM(XS,YS,SIZE,HWORK,122,0.)
      YS = YS - DEL
      CALL CORE(HWORK,54)
      WRITE(JUSCRN,2082)(HDATA(LIMH2+I),I=55,56),(ADATA(LIM2+I),I=29,31)
2082  FORMAT('  ',2I5,3E14.6)
      CALL SYSSYM(XS,YS,SIZE,HWORK,54,0.)
      YS = YS - DEL
      CALL CORE(HWORK,110)
      WRITE(JUSCRN,2083) (ADATA(LIM2+I),I=32,40)
2083  FORMAT('  ',9E12.4)
      CALL SYSSYM(XS,YS,SIZE,HWORK,110,0.)
      YS = YS - DEL
      CALL CORE(HWORK,120)
      WRITE(JUSCRN,2084)(HDATA(LIMH2+I),I=81,82),(ADATA(LIM2+I),I=42,50)
2084  FORMAT('  ',2I5,9E12.4)
      CALL SYSSYM(XS,YS,SIZE,HWORK,120,0.)
      YS = YS - DEL
      CALL CORE(HWORK,72)
      WRITE(JUSCRN,2085) (ADATA(LIM2+I),I=51,55)
2085  FORMAT('  ',5E14.6)
      CALL SYSSYM(XS,YS,SIZE,HWORK,72,0.)
      YS = YS - DEL
      CALL CORE(HWORK,52)
      WRITE(JUSCRN,2086) (HDATA(LIMH2+I),I=111,120)
2086  FORMAT('  ',10I5)
      CALL SYSSYM(XS,YS,SIZE,HWORK,52,0.)
      GO TO 9020
C--------------- SPECIAL FORMAT FOR TPTR BANKS
2177  LIM2 = LIM2 - 1
      LIMH2 = 2*LIM2
      CALL CORE(HWORK,110)
      WRITE(JUSCRN,2179) (HDATA(LIMH2+I),I=1,18)
2179  FORMAT('  ',18I6)
      CALL SYSSYM(XS,YS,SIZE,HWORK,110,0.)
      YS = YS - DEL
      CALL CORE(HWORK,122)
      WRITE(JUSCRN,2180) (ADATA(LIM2+I),I=10,19)
2180  FORMAT('  ',10E12.4)
      CALL SYSSYM(XS,YS,SIZE,HWORK,122,0.)
      YS = YS - DEL
      CALL CORE(HWORK,78)
      WRITE(JUSCRN,2181) IDATA(LIM2+20),ADATA(LIM2+21),IDATA(LIM2+22),
     $ (ADATA(LIM2+I),I=23,25),IDATA(LIM2+26)
2181  FORMAT('  ',I6,E14.6,I6,3E14.6,I8)
      CALL SYSSYM(XS,YS,SIZE,HWORK,78,0.)
      YS = YS - DEL
      CALL CORE(HWORK,112)
      WRITE(JUSCRN,2182)(ADATA(LIM2+I),I=27,33),(HDATA(LIMH2+I),I=67,68)
2182  FORMAT('  ',7E14.6,2I6)
      CALL SYSSYM(XS,YS,SIZE,HWORK,112,0.)
      YS = YS - DEL
      CALL CORE(HWORK,112)
      WRITE(JUSCRN,2183)(ADATA(LIM2+I),I=35,38),(HDATA(LIMH2+I),I=77,78)
     $,(ADATA(LIM2+I),I=40,42)
2183  FORMAT('  ',4E14.6,2I6,3E14.6)
      CALL SYSSYM(XS,YS,SIZE,HWORK,112,0.)
      YS = YS - DEL
      CALL CORE(HWORK,74)
      WRITE(JUSCRN,2184) (HDATA(LIMH2+I),I=85,96)
2184  FORMAT('  ',12I6)
      CALL SYSSYM(XS,YS,SIZE,HWORK,74,0.)
      YS = YS - DEL
      CALL CORE(HWORK,120)
      WRITE(JUSCRN,2185) (ADATA(LIM2+I),I=49,57)
2185  FORMAT('   ',9E13.5)
      CALL SYSSYM(XS,YS,SIZE,HWORK,120,0.)
      YS = YS - DEL
      CALL CORE(HWORK,86)
      WRITE(JUSCRN,2186) IDATA(LIM2+58),(ADATA(LIM2+I),I=59,64)
2186  FORMAT('   ',I5,6E13.5)
      CALL SYSSYM(XS,YS,SIZE,HWORK,86,0.)
      YS = YS - DEL
      CALL CORE(HWORK,100)
      WRITE(JUSCRN,2187) (ADATA(LIM2+I),I=65,71)
2187  FORMAT('  ',7E14.6)
      CALL SYSSYM(XS,YS,SIZE,HWORK,100,0.)
      YS = YS - DEL
      CALL CORE(HWORK,98)
      WRITE(JUSCRN,2188) IDATA(LIM2+72),(ADATA(LIM2+I),I=73,78)
     $ ,(IDATA(LIM2+I),I=79,80)
2188  FORMAT('  ',I6,6E13.5,2I6)
      CALL SYSSYM(XS,YS,SIZE,HWORK,98,0.)
      GO TO 9020
C____________________________ SPECIAL FORMAT FOR ZETC BANK
5177  LENGB = LENGB + 2
      NCYCLE=1+(LENGB-1)/20
      LENGB = LENGB - 2
      DO 5010 LHO=1,NCYCLE
5006  YS = YS - DEL
      IF(YS.GT.50.) GO TO 5012
      IRETUR = 10
      GO TO 9965
5012  LIML=2*LIM2+20*(LHO-1)+1
      LIMU = LIML + 19
      IF(LIMU.GT.(2*LIM2+LENGB)) LIMU=2*LIM2+LENGB
      ILIM = LIMU - LIML + 1
      IF(ILIM.LE.0) GO TO 9020
      DO 5025  I = 1,ILIM
      LLO = LIML + I - 1
5025  HWORK(I+100) = HDATA(LLO)
      DO 5027  I = 1,ILIM,4
      IX = HWORK(I+100)
      IX = SHFTR(IX,3)
5027  HWORK(I+100) = IX
5026  IILIM = 6*ILIM + 1
      CALL CORE(HWORK,IILIM)
      WRITE(JUSCRN,9011) (HWORK(LLO+100),LLO=1,ILIM)
      CALL SYSSYM(XS,YS,SIZE,HWORK,IILIM,0.)
 5010 CONTINUE
      GO TO 9020
C---------------    CONTINUATION SECTION
9965  CALL CORE(HWORK,14)
      WRITE(JUSCRN,9005)
9005  FORMAT(' CONTINUED ...')
      CALL SYSSYM(XS,YS,SIZE,HWORK,14,0.)
      GO TO 9029
9020  IRETUR = 1
9029  CALL TRMOUT(80,'HARDCOPY ?^')
      CALL DECIDE(IANSW)
      IF(IANSW.NE.1) GO TO 5901
      CALL TRMOUT(80,'HARDCOPY ON EXTERNAL PLOTTER ?^')
      CALL DECIDE(JANSW)
      IF(JANSW.EQ.2) CALL HDCOPY
      IF(JANSW.EQ.1) CALL HDCEXT
5901  IF(IRETUR.EQ.1) GO TO 9566
      IF(IANSW.EQ.1) CALL PROMPT
      CALL ERASE
      YS = IYT
      CALL TRMOUT(80,'TERMINATE THIS LISTING?^')
      CALL DECIDE(IANSW)
      IF(IANSW.EQ.1) GO TO 9566
      CALL ERASE
      GO TO (9566,875,275,9006,8006,1286,1376,1676,1976,5012,2199,
     $ 2299,2399,2499,2599,2554),IRETUR
9566  RETURN
      END
