*
* $Id: teedia.F,v 1.1.1.1 1996/03/22 16:42:47 mclareni Exp $
*
* $Log: teedia.F,v $
* Revision 1.1.1.1  1996/03/22 16:42:47  mclareni
* Phtools
*
*
      SUBROUTINE TEEDIA
C--       CALLED FROM REDAT2.  PRINTS MULTIPERIPHERAL T-DIAGRAM.
      COMMON/UTIL/PLACE(150),WEIGHT(150),NP,TECM,AMASS(18),PCM(5,18),WT
      COMMON/BEAM/PRM,TARGM,PBM,ETA,GAM,DPBM
     +/TAPES / NTPNCH   ,NTPBIN   ,KONSOL
     +/KAJBYK/ KAJBYK    ,A(18)    ,UCUT(18) ,BCUT(18)
      DATA IBEAM,ITARG,IUCUT,JEXP,ILCUT/4HBEAM,4HTARG,4HUCUT,4HEXP ,
     +              4HLCUT/
C
      WRITE(6,1800)
      I = 1
      WRITE(6,1801)IBEAM,PRM,AMASS(1)
  100 IF(UCUT(I).EQ.0.) GOTO 120
      WRITE(6,1803)IUCUT,UCUT(I)
      GOTO 150
  120 WRITE(6,1803)
  150 IF(A(I).EQ.0.) GOTO 220
      WRITE(6,1804)I,JEXP,A(I)
      GOTO 250
  220 WRITE(6,1804)I
  250 IF(BCUT(I).EQ.0.) GOTO 320
      WRITE(6,1803)ILCUT,BCUT(I)
      GOTO 350
  320 WRITE(6,1803)
  350 I = I + 1
      IF(I.EQ.NP) GOTO 400
      WRITE(6,1805)AMASS(I)
      GOTO 100
  400 WRITE(6,1801)ITARG,TARGM,AMASS(NP)
      RETURN
 1800 FORMAT('1',9X,'BYCKLING-KAJANTIE METHOD REQUESTED AS FOLLOWS '//)
 1801 FORMAT(10X ,A4, F10.6, 1X ,46(1H-), F10.6)
 1803 FORMAT(40X ,1HI, 7X ,A4, F10.5)
 1804 FORMAT(40X ,4HI  T,I2, 2X ,A4, F10.5)
 1805 FORMAT(40X ,1HI ,30(1H-), F10.6)
      END
