C   14/08/84 408271209  MEMBER NAME  MUPR21   (PWMUS)       FORTRAN
C   26/03/80 004291628  MEMBER NAME  MUPR21   (JADEMUS)     FORTRAN
C
C   LAST CHANGE 10.40  14/08/84  P.WARMING   -- OUTPUT COMMENTED
C        CHANGE 17.17  23/04/80  HUGH MCCANN -- TO MAKE SELF-CONTAINED.
C-----------------------------------------------------------------------
C
      SUBROUTINE MUPR21
C
C
C  THIS ROUTINE WRITES OUT SELECTED WORDS FROM BANK MUR2/1.
C
      IMPLICIT INTEGER*2 (H)
#include "cmubcs.for"
C
C  FIND MUR2/0 ---- FOR INFO RE NO. OF TRACKS IN MUR2/1 AND
C                   NO. OF (4-BYTE) WORDS/TRACK IN MUR2/1.
C
      CALL CLOC(INDEX0,'MUR2',0)
      IF(INDEX0.LE.0)GO TO 2
      NUMTRK=IDATA(INDEX0+1)
      NMUW  =IDATA(INDEX0+2)
C
C  FIND MUR2/1
C
      CALL CLOC(INDEX,'MUR2',1)
      IF(INDEX.LE.0)GO TO 1
C
C  PICK UP MAGNETIC FIELD FROM HEADER .
C
      IP=IDATA(IBLN('HEAD'))
      BGAUSS=HDATA(2*IP+30)
C
C  PICK UP PATREC BANK POINTER & NO. OF WORDS/TRACK IN PATREC BANK.
C
      IPPATR=IDATA(IBLN('PATR'))
      ISTART=IDATA(IPPATR+1)+1
      NWTRK=IDATA(IPPATR+3)
      IPT=IPPATR+ISTART-1
C
C  LOOP ROUND TRACKS.
C
      J=INDEX
      J2=2*J
      DO 10 I=1,NUMTRK
C
C PICK UP PATREC INFO.
C
      DCZ=ADATA(IPT+17)
      CURV=-ADATA(IPT+28)
      PT=3.E-8*BGAUSS/CURV
      P=ABS(PT/SQRT(1.0-DCZ*DCZ))
      CHARGE=SIGN(1.,-CURV*BGAUSS)
      ICH=INT(CHARGE)
      IF (I.EQ.1) WRITE (6,610)
  610 FORMAT('0 MUR2/1    MUON INFO FOR I.D. TRACKS'/
     *    '                     MUHIT      CHI2   ENERGY #ABS-  PI-MU',
     *    '   PI     K-MU   MUON    PION     FAKE-PROB-(GOOD-MU)',
     *    ' FAKE-PROB-(ANY-MU) '/
     *    '    TR# CHG MOMENTM MSNLAH QUAL PROBAB   LOSS LENGTH  PROB',
     *    '  SNEAK   PROB   PROB    PROB      PI    K    P   -P ',
     *    '  PI    K    P   -P ')
      WRITE(6,620)IDATA(J+1),ICH,P,IDATA(J+4),IDATA(J+6),ADATA(J+11),
     *        ADATA(J+14),ADATA(J+15),ADATA(J+21),ADATA(J+22),
     *        (ADATA(J+II),II=24,26),(ADATA(J+JJ),JJ=30,37)
  620 FORMAT(' ',I5,I4,F9.2,I7,I5,F7.4,F7.3,F6.3,F7.3,F7.4,
     *        F7.3,F8.3,F8.4,3X,8F5.2)
      J=J+NMUW
      J2=2*J
      IPT=IPT+NWTRK
   10 CONTINUE
      RETURN
C
    1 CONTINUE
C
C  BANK MUR2/1 DOES NOT EXIST
C
      WRITE(6,100)
  100 FORMAT('0',21X,'*****  BANK MUR2/1 DOES NOT EXIST  *****')
      RETURN
    2 CONTINUE
C
C  BANK MUR2/0 DOES NOT EXIST
C
      WRITE(6,110)
  110 FORMAT('0',21X,'*****  BANK MUR2/0 DOES NOT EXIST  *****')
      RETURN
      END
