SUBROUTINE LEADDF( IFLGLD ) C----------------------------------------------------------------------- C LEAD(ING PARTICLE RAPIDITY FOR) D(I)F(FFRACTING SYSTEM) C C SELECTS THE RAPIDITY OF THE (ANTI)LEADING PARTICLES IN CASE OF C DIFFRACTION. THE NON-DIFFRACTING (ANTI)LEADER GETS ITS RAPIDITY C FROM THE REMAINDER ENERGY, THE DIFFRACTING (ANTI)LEADER GETS ITS C RAPIDITY FROM THE GAUSSIAN (STRING) OF THE DECAYING DIFFRACTIVE MASS. C THIS SUBROUTINE IS CALLED FROM HDPM C ARGUMENT: C IFLGLD = 0 RAPIDITY SELECTION SUCCESSFUL C = 1 RAPIDITY SELECTION NOT SUCCESSFULL C----------------------------------------------------------------------- IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,INTER. COMMON /INTER/ AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB, * FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3, * RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG, * WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN, * IDIF,ITAR DOUBLE PRECISION AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB, * FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3, * RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG, * WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN INTEGER IDIF,ITAR *KEEP,LEPAR. COMMON /LEPAR/ LEPAR1,LEPAR2,LASTPI,NRESPC,NRESPN,NCPLUS INTEGER LEPAR1,LEPAR2,LASTPI,NRESPC,NRESPN,NCPLUS *KEEP,NEWPAR. COMMON /NEWPAR/ EA,PT2,PX,PY,TMAS,YR,ITYP, * IA1,IA2,IB1,IB2,IC1,IC2,ID1,ID2,IE1,IE2,IF1,IF2, * IG1,IG2,IH1,IH2,II1,II2,IJ1,NTOT DOUBLE PRECISION EA(3000),PT2(3000),PX(3000),PY(3000),TMAS(3000), * YR(3000) INTEGER ITYP(3000), * IA1,IA2,IB1,IB2,IC1,IC2,ID1,ID2,IE1,IE2,IF1,IF2, * IG1,IG2,IH1,IH2,II1,II2,IJ1,NTOT *KEEP,RANDPA. COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR DOUBLE PRECISION FAC,U1,U2 REAL RD(3000) INTEGER ISEED(103,10),NSEQ LOGICAL KNOR *KEEP,RUNPAR. COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB, * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN, * MONIOU,MDEBUG,NUCNUC, * CETAPE, * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL, * N1STTR,MDBASE, * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR, * FIX1I,FMUADD,FNKG,FPRINT,FDBASE * ,GHEISH,GHESIG COMMON /RUNPAC/ DSN,HOST,USER DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB REAL STEPFC INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC, * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL, * N1STTR,MDBASE INTEGER CETAPE CHARACTER*79 DSN CHARACTER*20 HOST,USER LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR, * FIX1I,FMUADD,FNKG,FPRINT,FDBASE * ,GHEISH,GHESIG *KEND. C----------------------------------------------------------------------- IF ( DEBUG ) WRITE(MDEBUG,*) 'LEADDF: LEPAR1,LEPAR2=', * LEPAR1,LEPAR2 IF ( YY0 .GT. 0.D0 ) THEN C PROJECTILE DIFFRACTION; CALCULATE TARGET RAPIDITY USING TARGET C ENERGY ECMTAR AND LONGITUDINAL MOMENTUM PCMTAR THE IN C.M. SYSTEM ECMTAR = (ECMDPM**2 - ECMDIF**2 + TMAS(2)**2) / (2.D0 * ECMDPM) PTLSQ = ECMTAR**2 - TMAS(2)**2 IF ( PTLSQ .LE. 0.D0 ) THEN IFLGLD = 1 RETURN ENDIF PCMTAR = SQRT(PTLSQ) * YR(2) = -0.5D0 * LOG( (ECMTAR+PCMTAR) / (ECMTAR-PCMTAR) ) YR(2) = - LOG( (ECMTAR+PCMTAR) / TMAS(2) ) C RAPIDITY OF DIFFRACTING PROJECTILE CALL RMMAR( RD,1,1 ) IF ( RD(1) .GE. 0.5 ) THEN YR(1) = RANNOR( POSC2, WIDC2 ) + YY0 ELSE YR(1) = RANNOR(-POSC2, WIDC2 ) + YY0 ENDIF ELSE C TARGET DIFFRACTION; CALCULATE PROJECTILE RAPIDITY USING PROJECTILE C ENERGY ECMPRO AND LONGITUDINAL MOMENTUM PLPRO IN THE C.M. SYSTEM ECMPRO = (ECMDPM**2 -ECMDIF**2 +TMAS(1)**2) / (2.D0*ECMDPM) PPLSQ = ECMPRO**2 - TMAS(1)**2 IF ( PPLSQ .LE. 0.D0 ) THEN IFLGLD = 1 RETURN ENDIF PCMPRO = SQRT(PPLSQ) * YR(1) = 0.5D0 * LOG( (ECMPRO+PCMPRO) / (ECMPRO-PCMPRO) ) YR(1) = LOG( (ECMPRO+PCMPRO) / TMAS(1) ) C RAPIDITY OF DIFFRACTING TARGET NUCLEON CALL RMMAR( RD,1,1 ) IF ( RD(1) .GE. 0.5 ) THEN YR(2) = RANNOR( POSC2, WIDC2 ) + YY0 ELSE YR(2) = RANNOR(-POSC2, WIDC2 ) + YY0 ENDIF ENDIF IF ( DEBUG ) WRITE(MDEBUG,*) 'LEADDF: YR(2),YR(1)=', * SNGL(YR(2)),SNGL(YR(1)) IFLGLD = 0 RETURN END