5 * Revision 1.1.1.1 1995/10/24 10:21:13 cernlib
9 #include "geant321/pilot.h"
10 *CMZ : 3.21/02 29/03/94 15.41.40 by S.Giani
12 SUBROUTINE COHERT(IPPP,NFL,AVERN)
14 C *** GENERATION OF X- AND PT- VALUES FOR ALL PRODUCED PARTICLES ***
17 C GENERATION OF DIFFRACTION DISSOCIATION AT HIGH ENERGIES
18 C (NOT USED IN STANDARD VERSION)
20 #include "geant321/s_defcom.inc"
21 #include "geant321/s_genio.inc"
24 DIMENSION SIDE(200),C1PAR(5),G1PAR(5),NUCSUP(5)
26 DATA C1PAR/0.6,0.6,0.35,0.15,0.10/
27 DATA G1PAR/2.6,2.6,1.8,1.30,1.20/
28 DATA NUCSUP/1.0,0.8,0.6,0.5,0.4/
31 BPP(X)=5.000+0.300*LOG(X)
48 CFA=0.025*((ATNO2-1.)/120.)*EXP(-(ATNO2-1.)/120.)
49 IF(P.LT.0.001) GOTO 60
53 IF(IABS(IPA(1)).NE.IPART) IREHMF=5
55 C** CHECK MASS-INDICES FOR ALL PARTICLES
58 IF(IPA(I).EQ.0) GOTO 1
62 CALL VZERO(IPA(NT+1),MXGKCU-NT)
64 C** SET THE EFFECTICE 4-MOMENTUM-VECTOR FOR INTERACTION
78 C** DISTRIBUTE PARTICLES IN FORWARD AND BACKWARD HEMISPHERE OF CMS
79 C** OF THE HADRON NUCLEON INTERACTION
87 IF (I .LE. 2) GO TO 78
89 IF (SIDE(I) .LT. 0.) GO TO 76
91 C --- PARTICLE IN FORWARD HEMISPHERE ---
94 IF (IFOR .LE. 18) GO TO 78
96 C --- CHANGE IT TO BACKWARD ---
102 C --- PARTICLE IN BACKWARD HEMISPHERE ---
105 IF (IBACK .LE. 18) GO TO 78
107 C --- CHANGE IT TO FORWARD ---
112 C** SUPPRESSION OF CHARGED PIONS FOR VARIOUS REASONS
114 78 IF(IPART.EQ.15.OR.IPART.GE.17) GOTO 3
115 IF(ABS(IPA(I)).GE.10) GOTO 3
116 IF(ABS(IPA(I)).EQ. 8) GOTO 3
118 IF(RNDM(1).GT.(10.-P)/6.) GOTO 3
120 IF(RNDM(1).GT.ATNO2/300.) GOTO 3
123 IF(RNDM(1).GT.ZNO2/ATNO2) IPA(I)=16
128 IF(RS.LT.(2.0+RNDM(1))) TB=(2.*IBACK+NT)/2.
130 C** NUCLEONS + SOME PIONS FROM INTRANUCLEAR CASCADE
132 AFC=0.312+0.200*LOG(LOG(S))
133 XTARG=AFC*(ATNO2**0.33-1.0)*TB
134 IF(XTARG.LE.0.) XTARG=0.01
135 CALL POISSO(XTARG,NTARG)
137 IF(NT2.LE.MXGKPV-30) GOTO 2
142 *WRITE(NEWBCD,3001) NTARG,NT
144 IF(NTARG.EQ.0) GOTO 51
150 IF(RAN.LT.NUCSUP(IPX)) GOTO 52
152 IPA(I)=-(7+IFIX(RNDM(1)*3.0))
157 IF(RNDM(1).GT.PNRAT) IPA(I)=-14
162 C** CHOOSE MASSES AND CHARGES FOR ALL PARTICLES
169 IF(PV(5,I).LT.0.) PV(7,I)=-1.
173 C** MARK LEADING STRANGE PARTICLES
176 IF(IPART.LT.10.OR.IPART.EQ.14.OR.IPART.EQ.16) GOTO 6
178 IF(IPA1.LT.10.OR.IPA1.EQ.14.OR.IPA1.EQ.16) GOTO 531
182 IF(IPA1.LT.10.OR.IPA1.EQ.14.OR.IPA1.EQ.16) GOTO 6
185 C** CHECK AVAILABLE KINETIC ENERGY , CHANGE HEMISPHERE FOR PARTICLES
188 6 IF(NT.LE.1) GOTO 60
191 IF(SIDE(I).LT.-1.5) GOTO 7
192 TAVAI=TAVAI+ABS(PV(5,I))
194 IF(TAVAI.LT.RS) GOTO 12
196 *WRITE(NEWBCD,3002) (IPA(I),I=1,20),(SIDE(I),I=1,20),TAVAI,RS
197 3002 FORMAT(' *COHERT* CHECK AVAILABLE ENERGIES'/
198 * 1H ,20I5/1H ,20F5.0/1H ,'TAVAI,RS ',2F10.3)
201 IF(SIDE(II).LT.-1.5) GOTO 10
216 12 IF(NT.LE.1) GOTO 60
220 C** CHOOSE MASSES FOR THE 3 CLUSTER: 1. FORWARD CLUSTER
221 C** 2. BACKWARD MESON CLUSTER 3. BACKWARD NUCLEON CLUSTER
230 IF(SIDE(I).GT.0.) RMC0=RMC0+ABS(PV(5,I))
231 IF(SIDE(I).GT.0.) NTC =NTC +1
232 IF(SIDE(I).LT.0..AND.SIDE(I).GT.-1.5) RMD0=RMD0+ABS(PV(5,I))
233 IF( SIDE(I).LT.-1.5) RME0=RME0+ABS(PV(5,I))
234 IF(SIDE(I).LT.0..AND.SIDE(I).GT.-1.5) NTD =NTD +1
235 IF( SIDE(I).LT.-1.5) NTE =NTE +1
237 32 CALL GRNDM(RNDM,1)
247 IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
248 RMC=RMC0+RMC**CPAR/DUMNVE
259 IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
260 RMD=RMD0+RMD**CPAR/DUMNVE
261 34 IF(RMC+RMD.LT.RS) GOTO 35
262 IF (RMC.LE.RMC0.AND.RMD.LE.RMD0) THEN
263 HNRMDC = 0.999*RS/(RMC+RMD)
271 35 IF(NTE.LE.0) GOTO 38
282 IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
283 RME=RME0+RME**CPAR/DUMNVE
285 C** SET BEAM , TARGET OF FIRST INTERACTION IN CMS
291 PV(4,MX1)=SQRT(P*P+AMAS*AMAS)
298 C** TRANSFORM INTO CMS.
300 CALL ADD(MX1,MX2,MX )
301 CALL LOR(MX1,MX ,MX1)
302 CALL LOR(MX2,MX ,MX2)
303 PF=(S+RMD*RMD-RMC*RMC)**2 - 4*S*RMD*RMD
304 IF(PF.LT.0.0001) PF=0.0001
306 IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
308 IF(NPRT(4)) WRITE(6,2002) PF,RMC,RMD,RS
310 C** SET FINAL STATE MASSES AND ENERGIES IN CMS
314 PV(4,MX3)=SQRT(PF*PF+PV(5,MX3)*PV(5,MX3))
315 PV(4,MX4)=SQRT(PF*PF+PV(5,MX4)*PV(5,MX4))
317 C** SET |T| AND |TMIN|
321 IF (B .NE. 0.0) T=LOG(1.-RNDM(1))/B
323 TACMIN=(PV(4,MX1)-PV(4,MX3))**2-(PIN-PF)**2
325 C** CACULATE (SIN(TETA/2.)**2 AND COS(TETA), SET AZIMUTH ANGLE PHI
328 IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
329 CTET=-(T-TACMIN)/DUMNVE
331 IF (CTET .GT. 1.0) CTET=1.0
332 IF (CTET .LT. -1.0) CTET=-1.0
334 IF (DUMNVE .LT. 0.0) DUMNVE=0.0
339 C** CALCULATE FINAL STATE MOMENTA IN CMS
341 PV(1,MX3)=PF*STET*SIN(PHI)
342 PV(2,MX3)=PF*STET*COS(PHI)
348 C** SIMULATE BACKWARD NUCLEON CLUSTER IN LAB. SYSTEM AND TRANSFORM IN
355 IF(EK.GT.5.) GOTO 666
356 EKIT1=EKIT1*EK**2/25.
357 EKIT2=EKIT2*EK**2/25.
358 666 A=(1.-GA)/(EKIT2**(1.-GA)-EKIT1**(1.-GA))
360 IF(SIDE(I).GT.-1.5) GOTO 29
363 EKIT=(RAN*(1.-GA)/A+EKIT1**(1.-GA))**(1./(1.-GA))
365 DUMNVE=ABS(PV(4,I)**2-PV(5,I)**2)
368 COST=LOG(2.23*RAN+0.383)/0.96
369 IF (COST .LT. -1.0) COST=-1.0
370 IF (COST .GT. 1.0) COST=1.0
372 IF (DUMNVE .LT. 0.0) DUMNVE=0.0
375 PV(1,I)=PP*SINT*SIN(PHI)
376 PV(2,I)=PP*SINT*COS(PHI)
381 C** FRAGMENTATION OF FORWARD CLUSTER AND BACKWARD MESON CLUSTER
393 16 PV(J,I)=-PV(J,I-2)
395 17 PV(J,I)= PV(J,I-2)
401 IF(SIDE(I).LT.0.) GOTO 18
403 AMASS(NPG)=ABS(PV(5,I))
405 IF(NPRT(4)) WRITE(NEWBCD,2004) TECM,NPG,(AMASS(I),I=1,NPG)
409 IF(SIDE(I).LT.0.) GOTO 19
415 IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
417 IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
419 26 IF(NTD.LE.1) GOTO 27
423 IF(SIDE(I).GT.0..OR.SIDE(I).LT.-1.5) GOTO 20
425 AMASS(NPG)=ABS(PV(5,I))
427 IF(NPRT(4)) WRITE(NEWBCD,2004) TECM,NPG,(AMASS(I),I=1,NPG)
431 IF(SIDE(I).GT.0..OR.SIDE(I).LT.-1.5) GOTO 21
437 IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
439 IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
442 C** LORENTZ TRANSFORMATION IN LAB SYSTEM
446 IF(PV(5,I).GT.0.5) TARG=TARG+1.
449 IF(TARG.LT.0.5) TARG=1.
451 C** SOMETIMES THE LEADING STRANGE PARTICLES ARE LOST , SET THEM BACK
453 IF(LEAD.EQ.0) GOTO 6085
455 IF(ABS(IPA(I)).EQ.LEAD) GOTO 6085
458 IF(LEAD.GE.14.AND.ABS(IPA(2)).GE.14) I=2
459 IF(LEAD.LT.14.AND.ABS(IPA(2)).LT.14) I=2
461 EKIN=PV(4,I)-ABS(PV(5,I))
464 IF(PV(5,I).LT.0.) PV(7,I)=-1.
469 DUMNVE=ABS(PV(4,I)**2-PV(5,I)**2)
472 IF (PP .GE. 1.0E-6) GO TO 8000
476 PV(1,I)=PP1*SIN(RTHNVE)*COS(PHINVE)
477 PV(2,I)=PP1*SIN(RTHNVE)*SIN(PHINVE)
478 PV(3,I)=PP1*COS(RTHNVE)
481 PV(1,I)=PV(1,I)*PP1/PP
482 PV(2,I)=PV(2,I)*PP1/PP
483 PV(3,I)=PV(3,I)*PP1/PP
486 C** FOR VARIOUS REASONS, THE ENERGY BALANCE IS NOT SUFFICIENT,
487 C** CHECK THAT, ENERGY BALANCE, ANGLE OF FINAL SYSTEM E.T.C.
492 PV(4,MX4)=SQRT(P*P+AMAS*AMAS)
494 EKIN0=PV(4,MX4)-PV(5,MX4)
500 EKIN=PV(4,MX4)+PV(4,MX5)
502 IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
504 IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,5)
505 CALL ADD(MX4,MX5,MX6)
506 CALL LOR(MX4,MX6,MX4)
507 CALL LOR(MX5,MX6,MX5)
508 TECM=PV(4,MX4)+PV(4,MX5)
517 IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
519 EKIN1=EKIN1+PV(4,I)-PV(5,I)
524 IF(NPG.GT.18) GOTO 597
533 CALL LOR(MX7,MX5,MX7)
534 599 EKIN=EKIN+PV(4,MX7)-PV(5,MX7)
535 CALL ANG(MX8,MX4,COST,TETA)
536 IF(NPRT(4)) WRITE(NEWBCD,2003) TETA,EKIN0,EKIN1,EKIN
538 C** MAKE SHURE, THAT KINETIC ENERGIES ARE CORRECT
539 C** THE 3. CLUSTER IS NOT PRODUCED WITHIN PROPER KINEMATICS!!!
540 C** EKIN= KINETIC ENERGY THEORETICALLY
541 C** EKIN1= KINETIC ENERGY SIMULATED
544 IF(EKIN1.EQ.0.) GOTO 600
556 DUMNVE=ABS(PV(4,I)**2-PV(5,I)**2)
560 IF (PP1 .GE. 1.0E-6) GO TO 8002
564 PV(1,I)=PP*SIN(RTHNVE)*COS(PHINVE)
565 PV(2,I)=PP*SIN(RTHNVE)*SIN(PHINVE)
566 PV(3,I)=PP*COS(RTHNVE)
569 PV(1,I)=PV(1,I)*PP/PP1
570 PV(2,I)=PV(2,I)*PP/PP1
571 PV(3,I)=PV(3,I)*PP/PP1
577 CALL ANG(MX7,MX4,COST,TETA)
578 IF(NPRT(4)) WRITE(NEWBCD,2003) TETA,EKIN0,EKIN1
580 C** ROTATE IN DIRECTION OF Z-AXIS, SEE COMMENTS IN 'GENXPT'
588 596 CALL ADD(MX7,I,MX7)
589 * call rannor(ran1,ran2)
597 PV(1,MX7)=PV(1,MX7)+RAN1*0.020*TARG
598 PV(2,MX7)=PV(2,MX7)+RAN2*0.020*TARG
599 CALL DEFS(MX4,MX7,MX8)
607 C 595 CALL ADD(MX7,I,MX7)
608 C CALL ANG(MX7,MX4,COST,TETA)
609 IF(NPRT(4)) WRITE(NEWBCD,2003) TETA
611 C** ROTATE IN DIRECTION OF PRIMARY PARTICLE
617 CALL DEFS1(I,MXGKPV-1,I)
618 IF(NPRT(4)) WRITE(NEWBCD,2001) I,(PV(J,I),J=1,10),IPA(I),SIDE(I)
619 IF(ATNO2.LT.1.5) GOTO 25
621 EKIN=PV(4,I)-ABS(PV(5,I))
623 EKIN=EKIN-CFA*(1.+0.5*RAN)
624 IF (EKIN .LT. 1.0E-6) EKIN=1.0E-6
626 DEKIN=DEKIN+EKIN*(1.-XXH)
628 IF(ABS(IPA(I)).GE.7.AND.ABS(IPA(I)).LE.9) NPIONS=NPIONS+1
629 IF(ABS(IPA(I)).GE.7.AND.ABS(IPA(I)).LE.9) EK1=EK1+EKIN
630 PP1=SQRT(EKIN*(EKIN+2.*ABS(PV(5,I))))
631 PV(4,I)=EKIN+ABS(PV(5,I))
633 IF (PP .GE. 1.0E-6) GO TO 8004
637 PV(1,I)=PP1*SIN(RTHNVE)*COS(PHINVE)
638 PV(2,I)=PP1*SIN(RTHNVE)*SIN(PHINVE)
639 PV(3,I)=PP1*COS(RTHNVE)
642 PV(1,I)=PV(1,I)*PP1/PP
643 PV(2,I)=PV(2,I)*PP1/PP
644 PV(3,I)=PV(3,I)*PP1/PP
649 IF(EK1.EQ.0.) GOTO 23
650 IF(NPIONS.LE.0) GOTO 23
653 IF(ABS(IPA(I)).LT.7.OR.ABS(IPA(I)).GT.9) GOTO 22
655 EKIN=PV(4,I)-ABS(PV(5,I))
657 IF (EKIN .LT. 1.0E-6) EKIN=1.0E-6
658 PP1=SQRT(EKIN*(EKIN+2.*ABS(PV(5,I))))
659 PV(4,I)=EKIN+ABS(PV(5,I))
661 IF (PP .GE. 1.0E-6) GO TO 8006
665 PV(1,I)=PP1*SIN(RTHNVE)*COS(PHINVE)
666 PV(2,I)=PP1*SIN(RTHNVE)*SIN(PHINVE)
667 PV(3,I)=PP1*COS(RTHNVE)
670 PV(1,I)=PV(1,I)*PP1/PP
671 PV(2,I)=PV(2,I)*PP1/PP
672 PV(3,I)=PV(3,I)*PP1/PP
677 IF(ATNO2.LT.1.5) GOTO 40
679 C** ADD BLACK TRACK PARTICLES
684 IF(TEX.LT.0.001) GOTO 445
685 BLACK=(1.5+1.25*TARG)*ENP(1)/(ENP(1)+ENP(3))
686 CALL POISSO(BLACK,NBL)
688 *WRITE(NEWBCD,3003) NBL,TEX
689 IF(IFIX(TARG)+NBL.GT.ATNO2) NBL=ATNO2-TARG
690 IF(NT+NBL.GT.MXGKPV-2) NBL=MXGKPV-2-NT
691 IF(NBL.LE.0) GOTO 445
697 IF(RNDM(1).LT.SPROB) GOTO 441
698 IF(NT.EQ.MXGKPV-2) GOTO 441
699 IF(EKIN2.GT.TEX) GOTO 443
703 EKIN1=-EKIN*LOG(RAN1)-CFA*(1.+0.5*RAN2)
704 IF(EKIN1.LT.0.0) EKIN1=-0.010*LOG(RAN1)
707 IF(EKIN2.GT.TEX) EKIN1=TEX-(EKIN2-EKIN1)
708 IF (EKIN1 .LT. 0.0) EKIN1=1.0E-6
712 IF(RNDM(1).GT.PNRAT) IPA1=14
715 COST=-1.0+RNDM(2)*2.0
717 IF (DUMNVE .LT. 0.0) DUMNVE=0.0
722 PV(5,NT)=ABS(RMASS(IPA1))
723 PV(6,NT)=RCHARG(IPA1)
725 PV(4,NT)=EKIN1+PV(5,NT)
726 DUMNVE=ABS(PV(4,NT)**2-PV(5,NT)**2)
728 PV(1,NT)=PP*SINT*SIN(PHI)
729 PV(2,NT)=PP*SINT*COS(PHI)
732 443 IF(ATNO2.LT.10.) GOTO 445
733 IF(EK.GT.2.0) GOTO 445
737 IF(EKA.GT.1.) EKA=EKA*EKA
738 IF(EKA.LT.0.1) EKA=0.1
739 IKA=3.6*EXP((ZNO2**2/ATNO2-35.56)/6.45)/EKA
740 IF(IKA.LE.0) GO TO 445
743 IF(IPA(II).NE.-14) GOTO 444
746 PV(5,II)=ABS(RMASS(IPA1))
747 PV(6,II)=RCHARG(IPA1)
749 IF(KK.GT.IKA) GOTO 445
752 IF(TEX.LT.0.001) GOTO 40
753 BLACK=(1.5+1.25*TARG)*ENP(3)/(ENP(1)+ENP(3))
754 CALL POISSO(BLACK,NBL)
755 IF(NT+NBL.GT.MXGKPV-2) NBL=MXGKPV-2-NT
761 *WRITE(NEWBCD,3004) NBL,TEX
764 IF(RNDM(1).LT.SPROB) GOTO 442
765 IF(NT.EQ.MXGKPV-2) GOTO 442
766 IF(EKIN2.GT.TEX) GOTO 40
770 EKIN1=-EKIN*LOG(RAN1)-CFA*(1.+0.5*RAN2)
771 IF(EKIN1.LT.0.0) EKIN1=-0.005*LOG(RAN1)
774 IF(EKIN2.GT.TEX) EKIN1=TEX-(EKIN2-EKIN1)
775 IF (EKIN1 .LT. 0.0) EKIN1=1.0E-6
777 COST=-1.0+RNDM(1)*2.0
779 IF (DUMNVE .LT. 0.0) DUMNVE=0.0
784 IF(RAN.GT.0.60) IPA(NT+1)=-31
785 IF(RAN.GT.0.90) IPA(NT+1)=-32
787 PV(5,NT+1)=(ABS(IPA(NT+1))-28)*MP
788 SPALL=SPALL+PV(5,NT+1)*1.066
789 IF(SPALL.GT.ATNO2) GOTO 40
792 IF(IPA(NT).EQ.-32) PV(6,NT)=2.
794 PV(4,NT)=PV(5,NT)+EKIN1
795 DUMNVE=ABS(PV(4,NT)**2-PV(5,NT)**2)
797 PV(1,NT)=PP*SINT*SIN(PHI)
798 PV(2,NT)=PP*SINT*COS(PHI)
802 C** STORE ON EVENT COMMON
804 40 CALL GRNDM(RNDM,1)
805 IF(RS.GT.(4.+RNDM(1)*1.)) GOTO 42
810 PV(4,I)=SQRT(PV(5,I)**2+ETF**2)
812 IF (DUMNVE .EQ. 0.0) DUMNVE=1.0E-10
818 42 EKIN=PV(4,MXGKPV)-ABS(PV(5,MXGKPV))
819 EKIN1=PV(4,MXGKPV-1)-ABS(PV(5,MXGKPV-1))
824 TOF=TOF-TOF1*LOG(RAN)
826 EKIN2=EKIN2+PV(4,I)-ABS(PV(5,I))
827 IF(PV(7,I).LT.0.) PV(5,I)=-PV(5,I)
832 IF(NPRT(4)) WRITE(NEWBCD,2006) NT,EKIN,ENP(1),ENP(3),EKIN1,EKIN2
835 IF(SPALL.LT.0.5.AND.ATNO2.GT.1.5) NMODE=14
841 IF(NTOT.LT.NSIZE/12) GOTO 43
848 C** IT IS NOT POSSIBLE TO PRODUCE A PROPER TWO CLUSTER FINAL STATE.
849 C** CONTINUE WITH QUASI ELASTIC SCATTERING
851 60 IF(NPRT(4)) WRITE(NEWBCD,2005)
856 IF(NFL.EQ.2) IPA(2)=16
857 CALL TWOB(IPPP,NFL,AVERN)
860 2000 FORMAT(' *COHERT* CMS PARAMETERS OF FINAL STATE PARTICLES',
861 $ ' AFTER ',I3,' TRIALS')
862 2001 FORMAT(' *COHERT* TRACK',2X,I3,2X,10F8.2,2X,I3,2X,F3.0)
863 2002 FORMAT(' *COHERT* MOMENTUM ',F8.3,' MASSES ',2F8.4,' RS ',F8.4)
864 2003 FORMAT(' *COHERT* TETA,EKIN0,EKIN1,EKIN ',4F10.4)
865 2004 FORMAT(' *COHERT* TECM,NPB,MASSES: ',F10.4,1X,I3,1X,8F10.4/
866 $ 1H ,26X,15X,8F10.4)
867 2005 FORMAT(' *COHERT* NUMBER OF FINAL STATE PARTICLES',
868 $ ' LESS THAN 2 ==> CONTINUE WITH 2-BODY SCATTERING')
869 2006 FORMAT(' *COHERT* COMP.',1X,I5,1X,5F7.2)
870 3001 FORMAT(' *COHERT* NUCLEAR EXCITATION ',I5,' PARTICLES PRODUCED',
871 $ ' IN ADDITION TO',I5,' NORMAL PARTICLES')
872 3003 FORMAT(' *COHERT* ',I3,' BLACK TRACK PARTICLES PRODUCED',
873 $ ' WITH TOTAL KINETIC ENERGY OF ',F8.3,' GEV')
874 3004 FORMAT(' *COHERT* ',I5,' HEAVY FRAGMENTS WITH TOTAL ENERGY OF ',