source: trunk/MagicSoft/Simulation/Corsika/Mmcs/leaddf.f@ 687

      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