source: trunk/MagicSoft/Simulation/Corsika/Mmcs/nsd.f@ 10099

      SUBROUTINE NSD
 
C-----------------------------------------------------------------------
C  N(ON) S(INGLE) D(IFFRACTION CASE)
C
C  SETS PARAMETERS FOR HDPM IN CASE OF NON-SINGLE-DIFFRACTION EVENT
C  THIS SUBROUTINE IS CALLED FROM HDPM
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,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,*) 'NSD   :'
 
C  CENTRAL RAPIDITY DENSITY ( RHO ) FOR NSD REACTION
C  PARAMETRISATION SEE CAPDEVIELLE,J.PHYS.G:NUCL.PHYS.16(1990)1539 EQ.7
      IF ( ECMDPM .LE. 680.D0 ) THEN
        DC0   = 0.82D0 * (S**0.107D0)
      ELSE
        DC0   = 0.64D0 * (S**0.126D0)
      ENDIF
C  THERE ARE 3 ENERGY DEPENDENT FORMULAS FOR AVERAGE CHARGED
C  MULTIPLICITY ( AVCH0 );
C  PARAMETRISATIONS SEE CAPDEVIELLE,J.PHYS.G:NUCL.PHYS.16(1990)1539 EQ.8
      IF     ( ECMDPM .LE. 187.5D0 ) THEN
        AVCH0 = 0.57D0 + 0.584D0 * SLOG + 0.127D0 * SLOGSQ
      ELSEIF ( ECMDPM .LT. 945.5D0 ) THEN
        AVCH0 = -6.55D0 + 6.89D0 * S**0.131D0
      ELSE
        AVCH0 = 3.4D0 * S**0.17D0
      ENDIF
C  MINIMUM AVERAGE CHARGED MULTIPLICITY IS 1
      AVCH0   = MAX( 1.D0, AVCH0 )
C  EXCESS OF CHARGED PARTICLES WHICH COME FROM AIR TARGET
      IF ( ECMDPM .LE. 137.D0 ) THEN
        AVCH3 = 0.57D0 * AVCH0 * (GNU - 1.D0)
      ELSE
        AVCH3 = 0.5D0  * AVCH0 * (GNU - 1.D0)
      ENDIF
C  AVERAGE NUMBER OF ALL CHARGED
      AVCH    = AVCH0 + AVCH3
C  THE FOLOWING PROCEDURE IS TO PRODUCE PHOTONS FROM UNKNOWN NEUTRAL
C  DECAYS FOLLOWING CORRELATION WITH CHARGED PARTICLES BASED ON PHOTON
C  EXCESS AT COLLIDER EXPERIMENTS. SEUGP IS <N_PHOTON>
C  PARAMETRISATION OF UA5: ANSORGE ET AL., Z.PHYS.C43 (1989) 75
      IF ( ECMDPM .LE. 103.D0 ) THEN
        SEUGP = -1.27D0 + 0.52D0 * SLOG + 0.148D0 * SLOGSQ
      ELSE
C  PROBLEM OF THE RISE OF THE UNKNOWN ETA PRODUCTION CROSS SECTION
C  IS SOLVED WITH THOUW'S PARAMETRISATION OF UA5 DATA:
        SEUGP = -18.7D0 + 11.55D0 * S**0.1195D0
      ENDIF
      SEUGP   = MAX( 0.5D0, SEUGP )
      IF ( DEBUG ) WRITE(MDEBUG,100)
     *    SNGL(DC0),SNGL(AVCH0),SNGL(AVCH3),SNGL(AVCH),SNGL(SEUGP)
 100  FORMAT(' NSD   : DC0,AVCH0,AVCH3,AVCH,SEUGP=',5F12.7)
 
C  CENTER OF GAUSSIAN FOR CHARGED SECONDARIES 1ST AND 2ND STRING
C  NEEDED FOR SOME CALCULATION ; FINAL POSITION CALCULATED LATER
      POSC2   = 0.146D0 * SMLOG + 0.072D0
C  WIDTH  OF GAUSSIAN FOR CHARGED SECONDARIES 1ST AND 2ND STRING
      WIDC2   = 0.12D0 * SMLOG + 0.18D0
      IF ( GNU .LE. 1.D0 ) THEN
        POSC3 = 0.D0
        WIDC3 = 1.D0
      ELSE
C  CENTER OF GAUSSIAN 3RD STRING (TARGET CONTRIB. FOR PROJECTILE-AIR)
        POSC3 = 3.D0 - 2.575D0 * EXP( -0.081756452D0 * GNU )
C  WIDTH  OF GAUSSIAN FOR 3RD STRING
        WIDC3 = 1.2338466D0 + 0.078969916D0 * LOG(GNU)
      ENDIF
      IF ( DEBUG ) WRITE(MDEBUG,110)
     *            SNGL(POSC2),SNGL(WIDC2),SNGL(POSC3),SNGL(WIDC3)
 110  FORMAT(' NSD   : POSC2,WIDC2,POSC3,WIDC3=',4F12.7)
 
      RETURN
      END